(*

   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)`,
(* }}} *)
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'