(*

   Proof of the Jordan curve theorem
   Format: HOL-LIGHT (OCaml version 2003)
   File started April 20, 2004
   Completed January 19, 2005
   Author: Thomas C. Hales

   The proof follows
   Carsten Thomassen
   "The Jordan-Schoenflies theorem and the classification of
    surfaces"
   American Math Monthly 99 (1992) 116 - 130.

   There is one major difference from Thomassen's proof.
   He uses general polygonal jordan curves in the "easy" case of the
   Jordan curve theorem.  This file restricts the "easy" case
   even further to jordan curves that are made of horizontal
   and vertical segments with integer length.

   Thomassen shows finite planar graphs admit polygonal
   embeddings.  This file shows that finite planar graphs such
   that every vertex has degree at most 4 admit
   embeddings with edges that are piecewise horizontal and
   vertical segments of integer length.

   I have apologies:

   1. I'm still a novice and haven't settled on a style.  The
      entire proof is a clumsy experiment.
   2. The lemmas have been ordered by my stream of consciousness.
      The file is long, the dependencies are nontrivial, and reordering
      is best accomplished by an automated tool.

*)


let jordan_def = local_definition "jordan";;
mk_local_interface "jordan";;
prioritize_real();;

let basic_rewrite_bak = basic_rewrites();;
let basic_net_bak = basic_net();;
let PARTIAL_REWRITE_CONV thl =
  GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net_bak) thl;;
let PARTIAL_REWRITE_TAC thl = CONV_TAC(PARTIAL_REWRITE_CONV thl);;

let reset() = (set_basic_rewrites basic_rewrite_bak);;
extend_basic_rewrites
  (* sets *)
  [(* UNIV *)
   INR IN_UNIV;
   UNIV_NOT_EMPTY;
   EMPTY_NOT_UNIV;
   DIFF_UNIV;
   INSERT_UNIV;
   INTER_UNIV ;
   EQ_UNIV;
   UNIV_SUBSET;
   SUBSET_UNIV;
   (* EMPTY *)
   IN;IN_ELIM_THM';
   (* EMPTY_EXISTS; *)  (* leave EMPTY EXISTS out next time *)
   EMPTY_DELETE;
   INTERS_EMPTY;
   INR NOT_IN_EMPTY;
   EMPTY_SUBSET;
   (* SUBSET_EMPTY; *)  (* leave out *)
   (* INTERS *)
   inters_singleton;
   (* SUBSET_INTER; *)
   (* unions *)
   UNIONS_0;
   UNIONS_1;
  ];;


let DISCH_THEN_REWRITE = (DISCH_THEN (fun t -> REWRITE_TAC[t]));;
let ISUBSET = INR SUBSET;;

(* ------------------------------------------------------------------ *)
(* Logic, Sets, Metric Space Material *)
(* ------------------------------------------------------------------ *)

(* logic *)


(* sets *)
let PAIR_LEMMAv2 = 
prove_by_refinement(
   `!x (i:A) (j:B). (x = (i,j)) <=> ((FST x = i) /\ (SND x = j))` ,

(* {{{ proof *)
   [
   MESON_TAC[FST;SND;PAIR];
   ]);;
(* }}} *)

let PAIR_SPLIT = 
prove_by_refinement(
   `!x (y:A#B). (x = y) <=> ((FST x = FST y) /\ (SND x = SND y))` ,

(* {{{ proof *)
   [
   MESON_TAC[FST;SND;PAIR];
   ]);;
(* }}} *)

let single_inter = 
prove_by_refinement(
  `!(a:A) U. ( ~({a} INTER U = EMPTY) <=> U a)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[INSERT;INTER;EMPTY_EXISTS ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let inters_inter = 
prove_by_refinement(
  `!(X:A->bool) Y. (X INTER Y) = (INTERS {X,Y})`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `{X,Y} Y` SUBGOAL_TAC;
  REWRITE_TAC[INSERT ];
  DISCH_TAC;
  USE 0 (MATCH_MP delete_inters);
  ASM_REWRITE_TAC[DELETE_INSERT; ];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[INTER;];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let unions_delete_choice = 
prove_by_refinement(
  `!(A:(A->bool)->bool). ~(A =EMPTY) ==>
     (UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[];
  DISCH_ALL_TAC;
  REWRITE_TAC[UNIONS;UNION;DELETE  ];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (INR CHOICE_DEF  );
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let image_delete_choice = 
prove_by_refinement(
  `!(A:(A->bool)) (f:A->B). ~(A= EMPTY) ==>
     (IMAGE f A =
        ((IMAGE f (A DELETE CHOICE A)) UNION {(f (CHOICE A))}))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[];
  DISCH_ALL_TAC;
  REWRITE_TAC[IMAGE;UNION;DELETE];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INSERT ];
  TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (INR CHOICE_DEF  );
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let UNIONS_UNION = 
prove_by_refinement(
  `!(A:(A->bool)->bool) B.
    UNIONS (A UNION B) = (UNIONS A) UNION (UNIONS B)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[UNIONS;UNION];
  IMATCH_MP_TAC EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  MESON_TAC[];
  ]);;
  (* }}} *)

(* reals *)

let half_pos = 
prove_by_refinement(
  `!x. (&.0 < x) ==> (&.0 < x/(&.2)) /\ (x/(&.2)) < x`,

  (* {{{ proof *)
  [
  MESON_TAC[REAL_LT_HALF2;REAL_LT_HALF1];
  ]);;
  (* }}} *)

(* topology *)
let convex_inter = 
prove_by_refinement(
  `!S T. (convex S) /\ (convex T) ==> (convex (S INTER T))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[convex;mk_segment;INTER;SUBSET_INTER  ];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  TYPEL_THEN [`x`;`y`] (USE 0 o ISPECL);
  REWR 0;
  TYPEL_THEN [`x`;`y`] (USE 1 o ISPECL);
  REWR 1;
  ]);;
  (* }}} *)

let closed_inter2 = 
prove_by_refinement(
  `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==>
   (closed_ U (A INTER B))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[inters_inter];
  IMATCH_MP_TAC  closed_inter ;
  ASM_REWRITE_TAC[INR INSERT;EMPTY_EXISTS ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let closure_univ = 
prove_by_refinement(
  `!U (X:A->bool). ~(X SUBSET UNIONS U) ==> (closure U X = UNIV)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  REWRITE_TAC[closure;closed];
  TYPE_THEN `{B | (B SUBSET UNIONS U /\ open_ U (UNIONS U DIFF B)) /\ X SUBSET B} = EMPTY ` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 1 (REWRITE_RULE[EMPTY_EXISTS ]);
  CHO 1;
  ASM_MESON_TAC[SUBSET_TRANS];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let closure_inter = 
prove_by_refinement(
  `!(X:A->bool) Y U.
   (topology_ U)
    ==> ((closure U (X INTER Y) SUBSET
   (closure U X) INTER closure U Y))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  TYPE_THEN `X SUBSET UNIONS  U` ASM_CASES_TAC THEN (TYPE_THEN `Y SUBSET UNIONS  U` ASM_CASES_TAC) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t]) closure_univ)  THEN (  IMATCH_MP_TAC  closure_subset );
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  closed_inter2;
  ASM_SIMP_TAC[closure_closed ];
  REWRITE_TAC[INTER;ISUBSET ];
  ASM_MESON_TAC[subset_closure;ISUBSET];
  ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ];
  ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ];
  ]);;
  (* }}} *)

let closure_open_ball = 
prove_by_refinement(
  `!(X:A->bool) d Z .
    ((metric_space(X,d)) /\ (Z SUBSET X)) ==>
     (({a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}
         = closure (top_of_metric(X,d)) Z))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `topology_ (top_of_metric(X,d)) /\ (Z SUBSET (UNIONS (top_of_metric (X,d))))` SUBGOAL_TAC;
  ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions];
  DISCH_TAC;
  USE 2 (MATCH_MP closure_open);
  TYPE_THEN `{a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}` (USE 2 o SPEC);
  ASM_REWRITE_TAC[];
  CONJ_TAC; (* 1st prong *)
  REWRITE_TAC[ISUBSET;];
  GEN_TAC;
  DISCH_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_MESON_TAC[SUBSET;IN;INR open_ball_nonempty];
  CONJ_TAC;
  REWRITE_TAC[closed;open_DEF ];
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  CONJ_TAC;
  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';
open_ball ;];
  DISCH_ALL_TAC;
  TYPE_THEN `&.1` (USE 3 o SPEC);
  UND 3;
  REDUCE_TAC;
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  MESON_TAC[];
  ASM_SIMP_TAC[top_of_metric_nbd];
  REWRITE_TAC[IN;DIFF; ISUBSET ];
  CONJ_TAC;
  MESON_TAC[];
  DISCH_ALL_TAC;
  LEFT 4 "r";
  CHO 4;
  USE 4 (REWRITE_RULE[NOT_IMP]);
  TYPE_THEN `r` EXISTS_TAC;
  NAME_CONFLICT_TAC;
  ASM_REWRITE_TAC[NOT_IMP];
  DISCH_ALL_TAC;
  AND 4;
  SUBCONJ_TAC;
  UND 5;
  REWRITE_TAC[open_ball;  ];
  MESON_TAC[];
  DISCH_TAC;
  LEFT_TAC "r'";
  JOIN 0 5;
  USE 0 (MATCH_MP (INR open_ball_center));
  CHO 0;
  TYPE_THEN `r'` EXISTS_TAC;
  UND 0;
  UND 4;
  MESON_TAC[SUBSET;IN];
  (* final prong *)
  (* fp  *)
  ONCE_REWRITE_TAC[TAUT (`a /\ b ==> e <=> (a /\ ~e ==> ~b)`)];
  REWRITE_TAC[open_DEF;EMPTY_EXISTS ];
  DISCH_ALL_TAC;
  CHO 4;
  USE 4 (REWRITE_RULE[INTER ]);
  AND 4;
  UND 3;
  ASM_SIMP_TAC[top_of_metric_nbd;];
  DISCH_ALL_TAC;
  TSPEC `u` 6;
  REWR 6;
  CHO 6;
  TSPEC `r` 4;
  REWR 4;
  CHO 4;
  TYPE_THEN `z` EXISTS_TAC;
  REWRITE_TAC[INTER];
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let closed_union = 
prove_by_refinement(
  `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==>
     (closed_ U (A UNION B))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed;open_DEF;union_subset  ];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `UNIONS U DIFF (A UNION B) = (UNIONS U DIFF A) INTER  (UNIONS U DIFF B)` SUBGOAL_TAC;
  REWRITE_TAC[DIFF;UNION;IN;INTER;IN_ELIM_THM'];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
  ASM_MESON_TAC[SUBSET;IN];
  DISCH_THEN (fun t->REWRITE_TAC[t]);
  ASM_MESON_TAC[top_inter];
  ]);;
  (* }}} *)

(* euclid *)
let euclid_scale0 = 
prove_by_refinement(
  `!x. (&.0 *# x) = (euclid0)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[euclid_scale;euclid0];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let euclid_minus0 = 
prove_by_refinement(
  `!x. (x - euclid0) = x`,

  (* {{{ proof *)
  [
  REWRITE_TAC[euclid0;euclid_minus];
  REDUCE_TAC;
(*** Changed by JRH since MESON no longer automatically applies extensionality
  MESON_TAC[];
 ***)
  REWRITE_TAC[FUN_EQ_THM]
  ]);;
  (* }}} *)

let norm_scale2 = 
prove_by_refinement(
  `!t x. (euclidean x) ==> (norm (t *# x) = abs(t) * norm x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP norm_scale);
  TYPEL_THEN [`t`;`&.0`] (USE 0 o ISPECL);
  USE 0 (REWRITE_RULE[euclid_scale0;d_euclid;euclid_minus0]);
  UND 0;
  REDUCE_TAC;
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* half-spaces  *)
(* ------------------------------------------------------------------ *)

let closed_half_space = jordan_def `closed_half_space n v b =
  {z | (euclid n z) /\ (dot v z <=. b) }`;;

let open_half_space = jordan_def `open_half_space n v b =
  {z | (euclid n z) /\ (dot v z <. b) }`;;

let hyperplane = jordan_def `hyperplane n v b =
  {z | (euclid n z) /\ (dot v z = b) }`;;

let closed_half_space_euclid = 
prove_by_refinement(
  `!n v b. (closed_half_space n v b SUBSET euclid n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM'  ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let open_half_space_euclid = 
prove_by_refinement(
  `!n v b. (open_half_space n v b SUBSET euclid n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[open_half_space;SUBSET;IN;IN_ELIM_THM'  ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let hyperplane_euclid = 
prove_by_refinement(
  `!n v b. (hyperplane n v b SUBSET euclid n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[hyperplane;SUBSET;IN;IN_ELIM_THM'  ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let closed_half_space_scale = 
prove_by_refinement(
  `!n v b r. ( &.0 < r) /\ (euclid n v) ==>
   (closed_half_space n (r *# v) (r * b) = closed_half_space n v b)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[closed_half_space];
  IMATCH_MP_TAC  EQ_EXT ;
  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
  DISCH_ALL_TAC;
  JOIN 1 2;
  USE 1 (MATCH_MP dot_scale);
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[dot_scale];
  IMATCH_MP_TAC  REAL_LE_LMUL_EQ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let open_half_space_scale = 
prove_by_refinement(
  `!n v b r. ( &.0 < r) /\ (euclid n v) ==>
   (open_half_space n (r *# v) (r * b) = open_half_space n v b)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[open_half_space];
  IMATCH_MP_TAC  EQ_EXT ;
  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
  DISCH_ALL_TAC;
  JOIN 1 2;
  USE 1 (MATCH_MP dot_scale);
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[dot_scale];
  IMATCH_MP_TAC  REAL_LT_LMUL_EQ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let hyperplane_scale = 
prove_by_refinement(
  `!n v b r. ~( r = &.0) /\ (euclid n v) ==>
   (hyperplane n (r *# v) (r * b)= hyperplane n v  b)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[hyperplane];
  IMATCH_MP_TAC  EQ_EXT ;
  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
  DISCH_ALL_TAC;
  JOIN 1 2;
  USE 1 (MATCH_MP dot_scale);
  ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL ];
  ]);;
  (* }}} *)

let open_half_space_diff = 
prove_by_refinement(
  `!n v b. (euclid n v) ==>
     ((euclid n) DIFF (open_half_space n v b) =
       (closed_half_space n (-- v) (--. b)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[open_half_space;closed_half_space;DIFF ];
  REWRITE_TAC[IN; IN_ELIM_THM'];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IN_ELIM_THM;dot_neg ];
  GEN_TAC;
  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let closed_half_space_diff = 
prove_by_refinement(
  `!n v b. (euclid n v) ==>
     ((euclid n) DIFF (closed_half_space n v b) =
       (open_half_space n (-- v) (--. b)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[open_half_space;closed_half_space;DIFF ];
  REWRITE_TAC[IN; IN_ELIM_THM'];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IN_ELIM_THM;dot_neg ];
  GEN_TAC;
  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let closed_half_space_inter = 
prove_by_refinement(
  `!n v b. (euclid n v) ==>
    (closed_half_space n v b INTER closed_half_space n (-- v) (--b) =
    hyperplane n v b)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[closed_half_space;INTER;IN;hyperplane;IN_ELIM_THM' ];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[IN_ELIM_THM'];
  REWRITE_TAC[GSYM CONJ_ASSOC ];
  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
  DISCH_TAC;
  ASM_REWRITE_TAC[dot_neg ];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let open_half_space_convex = 
prove_by_refinement(
  `!n v b. (euclid n v) ==> (convex (open_half_space n v b))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[convex;open_half_space;mk_segment;IN_ELIM_THM';
SUBSET;IN  ];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  CHO 5;
  UND 5;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  KILL 7;
  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;];
  TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC;
  ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ];
  DISCH_THEN (fun t -> REWRITE_TAC[t]);
  ASM_CASES_TAC `&.0 = a`;
  EXPAND_TAC "a";
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`];
  IMATCH_MP_TAC  REAL_LTE_ADD2;
  CONJ_TAC;
  MP_TAC (REAL_ARITH `~(&.0 = a) /\ (&.0 <= a) ==> (&.0 < a)`);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[REAL_LT_LMUL_EQ];
  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
  IMATCH_MP_TAC  REAL_LE_LMUL;
  UND 6;
  UND 4;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let closed_half_space_convex = 
prove_by_refinement(
  `!n v b. (euclid n v) ==> (convex (closed_half_space n v b))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[convex;closed_half_space;mk_segment;IN_ELIM_THM';
SUBSET;IN];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  CHO 5;
  UND 5;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  KILL 7;
  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;];
  TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC;
  ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ];
  DISCH_THEN (fun t -> REWRITE_TAC[t]);
  GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
  USE 6 (MATCH_MP (REAL_ARITH `(a <= &.1) ==> (&.0 <= (&1-a))`));
  CONJ_TAC THEN (IMATCH_MP_TAC REAL_LE_LMUL) THEN ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let hyperplane_convex = 
prove_by_refinement(
  `!n v b. (euclid n v) ==> convex(hyperplane n v b)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[GSYM closed_half_space_inter];
  IMATCH_MP_TAC  convex_inter;
  ASM_MESON_TAC[closed_half_space_convex;neg_dim ];
  ]);;
  (* }}} *)

let open_half_space_open = 
prove_by_refinement(
  `!n v b. (euclid n v) ==>
    (top_of_metric(euclid n,d_euclid)) (open_half_space n v b)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[top_of_metric_nbd;metric_euclid;SUBSET;IN;IN_ELIM_THM' ];
  REWRITE_TAC[open_half_space;open_ball;IN_ELIM_THM' ];
  CONJ_TAC ;
  MESON_TAC[];
  DISCH_ALL_TAC;
  ASM_CASES_TAC `v = euclid0`;
  UND 2;
  ASM_REWRITE_TAC[dot_lzero];
  MESON_TAC[];
  TYPE_THEN `(b - (dot v a))/(norm v)` EXISTS_TAC;
  TYPE_THEN `&.0 < (norm v)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ (~(x = &.0)) ==> (&.0 < x)`);
  ASM_MESON_TAC[norm;norm_nonneg;dot_nonneg;SQRT_EQ_0;dot_zero];
  DISCH_ALL_TAC;
  SUBCONJ_TAC;
  ASM_SIMP_TAC[REAL_LT_RDIV_0];
  UND 2;
  REAL_ARITH_TAC;
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(x:num->real) = a + (x - a)` SUBGOAL_TAC;
  REWRITE_TAC[euclid_plus;euclid_minus];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC THEN BETA_TAC;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
  TYPE_THEN `dot v (a + (x - a)) = (dot v a) + (dot v (x-a))` SUBGOAL_TAC;
  IMATCH_MP_TAC  dot_linear2;
  TYPE_THEN `n` EXISTS_TAC;
  ASM_SIMP_TAC[euclid_sub_closure];
  DISCH_THEN (fun t -> REWRITE_TAC[t]);
  IMATCH_MP_TAC  (REAL_ARITH `(?d. (b<=d) /\ d < C - a) ==> a +b < C`);
  TYPE_THEN `(norm v)*. (d_euclid a x)` EXISTS_TAC;
  CONJ_TAC;
  ASSUME_TAC metric_euclid;
  TYPE_THEN `n` (USE 9 o SPEC);
  COPY 7;
  JOIN  6 7;
  JOIN 9 6;
  USE 6 (MATCH_MP metric_space_symm);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[d_euclid];
  IMATCH_MP_TAC  (REAL_ARITH `||. u <=. C ==> (u <=. C)`);
  IMATCH_MP_TAC  cauchy_schwartz;
  ASM_MESON_TAC[euclidean;euclid_sub_closure];
  UND 8;
  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let closed_half_space_closed = 
prove_by_refinement(
  `!n v b. (euclid n v) ==>
     closed_ (top_of_metric(euclid n,d_euclid))
      (closed_half_space n v b)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed;open_DEF ];
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;closed_half_space_diff;open_half_space_open;euclid_neg_closure ];
  REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM' ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let hyperplane_closed = 
prove_by_refinement(
  `!n v b. (euclid n v) ==>
     closed_ (top_of_metric(euclid n,d_euclid))
     (hyperplane n v b)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[GSYM closed_half_space_inter];
  IMATCH_MP_TAC  closed_inter2;
  ASM_MESON_TAC[euclid_neg_closure;top_of_metric_top ;metric_euclid ;closed_half_space_closed;];
  ]);;
  (* }}} *)

let closure_half_space = 
prove_by_refinement(
  `!n v b. (euclid n v) /\ (~(v = euclid0)) ==>
   ((closure (top_of_metric(euclid n,d_euclid))
    (open_half_space n v b)) = (closed_half_space n v b))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  closure_subset;
  ASM_SIMP_TAC [top_of_metric_top;metric_euclid];
  ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;closed_half_space_closed];
  REWRITE_TAC[SUBSET;IN;closed_half_space;open_half_space;IN_ELIM_THM' ];
  MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
  ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;open_half_space_euclid];
  REWRITE_TAC[open_half_space;closed_half_space;SUBSET;IN;IN_ELIM_THM'];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `t = ((r/(&.2))/(norm v ))` ABBREV_TAC;
  TYPE_THEN `u = x - (t)*# v` ABBREV_TAC;
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `&.0 < (dot v v)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 < x)`);
  REWRITE_TAC[dot_nonneg];
  ASM_MESON_TAC[euclidean;dot_zero_euclidean ];
  DISCH_TAC;
  TYPE_THEN `&.0 < t` SUBGOAL_TAC;
  EXPAND_TAC "t";
  IMATCH_MP_TAC  REAL_LT_DIV;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  REWRITE_TAC[norm];
  IMATCH_MP_TAC  SQRT_POS_LT;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  SUBCONJ_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[euclid_sub_closure ;euclid_scale_closure ];
  TYPE_THEN `dot v u = (dot v x - t* (dot v v))` SUBGOAL_TAC;
  EXPAND_TAC "u";
  ASM_MESON_TAC[dot_minus_linear2;dot_scale2;euclid_sub_closure;euclid_scale_closure];
  DISCH_THEN (fun t->REWRITE_TAC[t]);
  IMATCH_MP_TAC  (REAL_ARITH `(a <= b) /\ (&.0 < C) ==> (a - C < b)`);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LT_MUL;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[open_ball;IN_ELIM_THM' ];
  EXPAND_TAC "u";
  REWRITE_TAC[d_euclid];
  TYPE_THEN `euclid_minus x (euclid_minus x (t *# v)) = ( t) *# v` SUBGOAL_TAC;
  REWRITE_TAC[euclid_minus;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC THEN BETA_TAC;
  REAL_ARITH_TAC ;
  DISCH_THEN (fun t-> REWRITE_TAC[t]);
  TYPE_THEN `norm (t *# v) = t * norm v` SUBGOAL_TAC;
  ASM_MESON_TAC[euclidean;norm_scale2;ABS_REFL;REAL_ARITH `&.0 < t ==> &.0 <= t`];
  DISCH_THEN (fun t -> REWRITE_TAC[t]);
  EXPAND_TAC "t";
  TYPE_THEN `((r / &2) / norm v) * norm v = r/(&.2)` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_DIV_RMUL;
  REWRITE_TAC[norm];
  ASM_MESON_TAC[SQRT_POS_LT;REAL_ARITH `&.0 < x ==> ~(x = &.0)`];
  DISCH_THEN (fun t-> REWRITE_TAC[t]);
  ASM_MESON_TAC[half_pos];
  ]);;

  (* }}} *)


let subset_of_closure = 
prove_by_refinement(
  `!(A:A->bool) B U. (topology_ U) /\ (A SUBSET B) ==>
    (closure U A SUBSET closure U B)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `(A SUBSET (UNIONS U))` ASM_CASES_TAC;
  TYPE_THEN `(B SUBSET (UNIONS U))` ASM_CASES_TAC;
  IMATCH_MP_TAC  closure_subset;
  ASM_REWRITE_TAC[];
  WITH 0 (MATCH_MP subset_closure);
  USE 4 (ISPEC `B:A->bool`);
  JOIN 1 4;
  USE 1 (MATCH_MP SUBSET_TRANS);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC [closure_closed;];
  USE 3 (MATCH_MP closure_univ);
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(B SUBSET UNIONS U)` SUBGOAL_TAC;
  UND 2;
  UND 1;
  REWRITE_TAC[ISUBSET];
  MESON_TAC[];
  DISCH_TAC;
  USE 2 (MATCH_MP closure_univ);
  USE 3 (MATCH_MP closure_univ);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let closure_union = 
prove_by_refinement(
  `!(A:A->bool)  B U. (topology_ U) ==>
    (closure U (A UNION B) = (closure U A) UNION (closure U B))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN  `A SUBSET UNIONS U` ASM_CASES_TAC THEN (TYPE_THEN `B SUBSET UNIONS U` ASM_CASES_TAC ) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t;UNION_UNIV;SUBSET_UNIV;INTER_UNIV]) closure_univ)  THEN TRY (IMATCH_MP_TAC  closure_univ) THEN TRY (UNDISCH_FIND_TAC `(~)`);
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC closure_subset;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[closed_union; closure_closed];
  REWRITE_TAC[union_subset];
  TYPE_THEN `(A SUBSET closure U A) /\ (B SUBSET closure U B)` SUBGOAL_TAC;
  ASM_SIMP_TAC[subset_closure];
  REWRITE_TAC[UNION;ISUBSET ];
  ASM_MESON_TAC[];
  REWRITE_TAC[union_subset];
  CONJ_TAC THEN IMATCH_MP_TAC  subset_of_closure THEN ASM_REWRITE_TAC[ISUBSET;UNION ] THEN (MESON_TAC []);
  REWRITE_TAC [UNION;SUBSET; ];
  MESON_TAC[];
  REWRITE_TAC[UNION;SUBSET];
  MESON_TAC[];
  REWRITE_TAC[UNION;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let closure_empty = 
prove_by_refinement(
  `!U. (topology_ U) ==> (closure U (EMPTY:A->bool) = EMPTY)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  ASM_MESON_TAC[SUBSET_EMPTY;closure_subset;empty_closed];
  ]);;
  (* }}} *)

let closure_unions = 
prove_by_refinement(
  `!(A:(A->bool)->bool) U. (topology_ U) /\ (FINITE A) ==>
    (closure U (UNIONS A) = UNIONS (IMAGE (closure U) A))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  TYPE_THEN `n = CARD A` ABBREV_TAC;
  UND 0;
  TYPE_THEN `A` (fun t-> SPEC_TAC (t,t));
  TYPE_THEN `n` (fun t-> SPEC_TAC (t,t));
  INDUCT_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `A HAS_SIZE 0` SUBGOAL_TAC;
  ASM_REWRITE_TAC[HAS_SIZE];
  ASM_REWRITE_TAC[HAS_SIZE_0];
  DISCH_THEN_REWRITE;
  ASM_SIMP_TAC [closure_empty;IMAGE_CLAUSES];
  DISCH_ALL_TAC;
  TYPE_THEN `~(A HAS_SIZE 0)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[HAS_SIZE];
  ARITH_TAC;
  TYPE_THEN `A` (MP_TAC o ((C ISPEC)  CARD_DELETE_CHOICE));
  REWRITE_TAC[HAS_SIZE_0];
  DISCH_ALL_TAC;
  REWR 5;
  USE 5 (CONV_RULE REDUCE_CONV );
  TYPE_THEN `(A DELETE CHOICE A)` (USE 0 o ISPEC);
  USE 0 (REWRITE_RULE[FINITE_DELETE]);
  REWR 0;
  TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (INR CHOICE_DEF);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A)` SUBGOAL_TAC;
  IMATCH_MP_TAC  unions_delete_choice;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `(IMAGE  (closure U) A) = (IMAGE (closure U) (A DELETE CHOICE A) UNION {(closure U (CHOICE A))})` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_delete_choice ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_SIMP_TAC[closure_union];
  REWRITE_TAC[UNIONS_UNION];
  ]);;
  (* }}} *)

let metric_space_zero2 = 
prove_by_refinement(
  `!X d (x:A) y. (metric_space(X,d) /\ (X x) /\ (X y)) ==>
   ((d x y = &.0) <=> (x = y))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  USE 0 (REWRITE_RULE[metric_space]);
  TYPEL_THEN [`x`;`y`;`x`] (USE 0 o ISPECL);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let d_euclid_zero = 
prove_by_refinement(
  `!n x y. (euclid n x) /\ (euclid n y)  ==>
    ((d_euclid x y = &.0) <=> (x = y))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPEL_THEN [`euclid n`;`d_euclid`;`x`;`y`] (ASSUME_TAC o (C ISPECL) metric_space_zero2);
  ASM_MESON_TAC[metric_euclid];
  ]);;
  (* }}} *)

let d_euclid_pos2 = 
prove_by_refinement(
  `!x y n. ~(x = y) /\ euclid n x /\ euclid n y ==> &0 <. d_euclid x y`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `&.0 <= x /\ ~(x = &.0) ==> (&.0 < x)`);
  ASM_MESON_TAC[d_euclid_pos;d_euclid_zero];
  ]);;
  (* }}} *)

let euclid_segment = 
prove_by_refinement(
  `!n x y. (euclid n x) /\
   (!t. (&.0 <. t) /\ (t <=. &.1) ==>
         (euclid n (t *# x + (&.1 - t)*# y)))
     ==>
   (euclid n y)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `t = &.1/(&.2)` ABBREV_TAC;
  TYPE_THEN `y = ((&.2) *# ((t *# x) + (&.1 - t)*# y)) - x` SUBGOAL_TAC;
  REWRITE_TAC[euclid_minus;euclid_scale;euclid_plus];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC THEN BETA_TAC ;
  REWRITE_TAC[REAL_ADD_LDISTRIB];
  REWRITE_TAC[REAL_MUL_ASSOC;REAL_SUB_LDISTRIB ];
  EXPAND_TAC "t";
  SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&.2 = &.0)`];
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  TYPE_THEN `t` (USE 1 o SPEC);
  TYPE_THEN `v = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC;
  KILL 3;
  TYPE_THEN `&0 < t /\ t <= &1` SUBGOAL_TAC;
  EXPAND_TAC "t";
  CONJ_TAC ;
  IMATCH_MP_TAC  REAL_LT_DIV;
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  REAL_LE_LDIV;
  REAL_ARITH_TAC;
  DISCH_TAC;
  REWR 1;
  ASM_SIMP_TAC[euclid_sub_closure;euclid_scale_closure];
  ]);;
  (* }}} *)

let euclid_xy = 
prove_by_refinement(
  `!n x y. (!t . (&.0 < t) /\ (t < &.1) ==>
    (euclid n (t *# x + (&.1-t)*# y))) ==> (euclid n x) /\ (euclid n y)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  TYPE_THEN `u = (&.1/(&.3))*# x + (&.1 - (&.1/(&.3))) *# y` ABBREV_TAC;
  TYPE_THEN `v = (&.2/(&.3))*# x + (&.1 - (&.2/(&.3))) *# y` ABBREV_TAC;
  TYPE_THEN `euclid n u` SUBGOAL_TAC;
  EXPAND_TAC "u";
  UND 0;
  DISCH_THEN IMATCH_MP_TAC ;
  CONV_TAC REAL_RAT_REDUCE_CONV;
  DISCH_TAC;
  TYPE_THEN `euclid n v` SUBGOAL_TAC;
  EXPAND_TAC "v";
  UND 0;
  DISCH_THEN IMATCH_MP_TAC ;
  CONV_TAC REAL_RAT_REDUCE_CONV;
  DISCH_TAC;
  TYPE_THEN `x = (&.2)*# v - (&.1) *# u` SUBGOAL_TAC;
  EXPAND_TAC "u";
  EXPAND_TAC "v";
  REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  DISCH_ALL_TAC;
  BETA_TAC;
  TYPE_THEN `a = x x'`  ABBREV_TAC ;
  TYPE_THEN `b= y x'`  ABBREV_TAC ;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure];
  TYPE_THEN `y = (&.2)*# u - (&.1) *# v` SUBGOAL_TAC;
  EXPAND_TAC "u";
  EXPAND_TAC "v";
  REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  DISCH_ALL_TAC;
  BETA_TAC;
  TYPE_THEN `a = x x'`  ABBREV_TAC ;
  TYPE_THEN `b= y x'`  ABBREV_TAC ;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure];
  ]);;
  (* }}} *)


let closure_segment = 
prove_by_refinement(
  `!C n x y. (C SUBSET (euclid n)) /\
      (!t. (&.0 < t) /\ (t < &.1) ==> (C (t *# x + (&.1-t)*# y))) ==>
      (closure (top_of_metric(euclid n,d_euclid)) C y)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  TYPE_THEN `euclid n x /\ (euclid n y)` SUBGOAL_TAC;
  IMATCH_MP_TAC  euclid_xy;
  ASM_MESON_TAC[ISUBSET];
  DISCH_ALL_TAC;
  (* case x=y *)
  TYPE_THEN `x = y` ASM_CASES_TAC ;
  TYPE_THEN `C SUBSET (closure (top_of_metric (euclid n,d_euclid)) C)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  subset_closure;
  ASM_SIMP_TAC [top_of_metric_top;metric_euclid];
  REWRITE_TAC[ISUBSET];
  TYPE_THEN `C x` SUBGOAL_TAC;
  REWR 1;
  USE 1 (REWRITE_RULE[trivial_lin_combo]);
  TSPEC `&.1/(&.2)` 1;
  USE 1 (CONV_RULE (REAL_RAT_REDUCE_CONV));
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* now ~(x=y) *)
  TYPE_THEN `&.0 < d_euclid x y` SUBGOAL_TAC;
  ASM_MESON_TAC[d_euclid_pos2];
  DISCH_TAC;
  ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid];
  DISCH_ALL_TAC;
  REWRITE_TAC[open_ball];
  (* ## *)
  TYPE_THEN `?t. (&.0 <. t) /\ (t <. &.1) /\ (t *. (d_euclid x y) <. r)` SUBGOAL_TAC;
  TYPE_THEN  `(&.1/(&.2))*. d_euclid x y < r` ASM_CASES_TAC;
  TYPE_THEN `(&.1/(&.2))` EXISTS_TAC;
  CONV_TAC (REAL_RAT_REDUCE_CONV);
  ASM_REWRITE_TAC[];
  TYPE_THEN `(r/(&.2))/(d_euclid x y)` EXISTS_TAC;
  ASM_SIMP_TAC[REAL_LT_DIV;REAL_LT_HALF1];
  CONJ_TAC;
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
  REDUCE_TAC;
  TYPE_THEN `s = d_euclid x y ` ABBREV_TAC;
  ineq_lt_tac `r/(&.2) + ( (&1/(&2))*s - r)*(&1/(&2)) + (s)*(&3/(&4)) = s`;
  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ;REAL_LT_RDIV;half_pos];
  DISCH_TAC;
  CHO 7;
  TYPE_THEN `t` (USE 1 o SPEC);
  REWR 1;
  TYPE_THEN `z = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC ;
  TYPE_THEN `z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  EXPAND_TAC "z";
  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure];
  DISCH_TAC;
  TYPE_THEN `y = (t *# y) + ((&.1 - t)*# y)` SUBGOAL_TAC;
  ASM_MESON_TAC[trivial_lin_combo];
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
  EXPAND_TAC "z";
  TYPE_THEN `euclid n (t*# y) /\  (euclid n (t *# x)) /\ (euclid n ((&.1-t)*# y))` SUBGOAL_TAC;
  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure];
  DISCH_TAC;
  USE 10 (MATCH_MP metric_translate);
  KILL 8;
  ASM_REWRITE_TAC[];
  TYPE_THEN `d_euclid (t *# y) (t *# x) = d_euclid (t *# x) (t *# y)` SUBGOAL_TAC;
  ASM_MESON_TAC [ISPEC `euclid n` metric_space_symm; euclid_scale_closure;metric_euclid];
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
  JOIN 2 3;
  USE 2 (MATCH_MP norm_scale_vec);
  TSPEC `t` 2;
  ASM_REWRITE_TAC[];
  AND 7;
  USE 7 (MATCH_MP (REAL_ARITH `&.0 < t ==> (&.0 <=. t)`));
  USE 7 (REWRITE_RULE[GSYM ABS_REFL]);
  ASM_REWRITE_TAC [];
  ]);;

  (* }}} *)



(* ------------------------------------------------------------------ *)
(* POINTS *)
(* ------------------------------------------------------------------ *)


let point = jordan_def `point z =
   (FST z) *# (dirac_delta 0) + (SND z) *# (dirac_delta 1)`;;

let dest_pt = jordan_def `dest_pt p =
   @u.  p = point u`;;

let point_xy = 
prove_by_refinement(
  `!x y. point(x,y) = x *# (dirac_delta 0) + y *# (dirac_delta 1)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[point;];
  ]);;
  (* }}} *)

let coord01 = 
prove_by_refinement(
  `!p. (point p 0 = FST p) /\ (point p 1 = SND p)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[point;euclid_plus;euclid_scale ];
  REWRITE_TAC[dirac_delta;ARITH_RULE   `~(1=0) /\ ~(0=1)`];
  REDUCE_TAC ;
  ]);;
  (* }}} *)

let euclid_point = 
prove_by_refinement(
  `!p. euclid 2 (point p)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[point;euclid];
  REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta ];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP (ARITH_RULE `(2 <=| m) ==> (~(0=m) /\ (~(1=m)))`));
  ASM_REWRITE_TAC[];
  REDUCE_TAC ;
  ]);;
  (* }}} *)

let point_inj = 
prove_by_refinement(
  `!p q. (point p = point q) <=> (p = q)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  EQ_TAC ;
  DISCH_TAC ;
  WITH  0 (fun t -> AP_THM t `0`);
  USE 0 (fun t-> AP_THM t `1`);
  UND 0;
  UND 1;
  REWRITE_TAC[coord01;];
  ASM_MESON_TAC[PAIR];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let point_onto = 
prove_by_refinement(
  `!v. (euclid 2 v) ==> ?p. (v = point p)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `(v 0 ,v 1)` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_EXT ;
  GEN_TAC ;
  REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta];
  MP_TAC (ARITH_RULE `(0 = x) \/ ( 1 = x) \/ (2 <= x)`);
  REP_CASES_TAC;
  WITH 1 (MATCH_MP (ARITH_RULE  `(0=x) ==> ~(1=x)`));
  ASM_REWRITE_TAC[];
  EXPAND_TAC "x";
  REDUCE_TAC;
  WITH 1 (MATCH_MP (ARITH_RULE  `(1=x) ==> ~(0=x)`));
  ASM_REWRITE_TAC[];
  EXPAND_TAC "x";
  REDUCE_TAC;
  WITH 1 (MATCH_MP (ARITH_RULE  `(2 <=| x) ==> (~(0=x)/\ ~(1=x))`));
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASM_MESON_TAC[euclid];
  ]);;
  (* }}} *)

let dest_pt_point = 
prove_by_refinement(
  `!p. dest_pt(point p) = p`,

  (* {{{ proof *)
  [
  REWRITE_TAC[dest_pt];
  DISCH_ALL_TAC;
  SELECT_TAC;
  ASM_MESON_TAC[point_inj];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let point_dest_pt = 
prove_by_refinement(
  `!v. (euclid 2 v) <=> (point (dest_pt v) = v)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  EQ_TAC;
  REWRITE_TAC[dest_pt];
  DISCH_ALL_TAC;
  SELECT_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[point_onto];
  ASM_MESON_TAC[euclid_point];
  ]);;
  (* }}} *)

let Q_POINT = 
prove_by_refinement(
  `!Q z. (?u v. (point z = point (u,v)) /\ (Q z u v)) <=> (Q z (FST z) (SND z))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[point_inj];
  EQ_TAC;
  DISCH_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `FST z` EXISTS_TAC;
  TYPE_THEN `SND z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let pointI = jordan_def `pointI p =
   point(real_of_int (FST p),real_of_int (SND p))`;;

let convex_pointI = 
prove_by_refinement(
  `!p. (convex {(pointI p)})`,

  (* {{{ proof *)

  [
  REWRITE_TAC[convex;mk_segment;INSERT;IN_ELIM_THM';
SUBSET; ];
  REWRITE_TAC[IN;EMPTY];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[trivial_lin_combo];
  DISCH_ALL_TAC;
  CHO 2;
  ASM_REWRITE_TAC[];
  ]);;

  (* }}} *)

let point_closure = 
prove_by_refinement(
  `!p q a b. (?r. (a *# (point p) + (b *# (point q)) = (point r)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `euclid 2 (a *# (point p) + (b *# (point q)))` SUBGOAL_TAC;
  IMATCH_MP_TAC euclid_add_closure;
  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN REWRITE_TAC [euclid_point];
  MESON_TAC[point_onto];
  ]);;
  (* }}} *)

let point_scale = 
prove_by_refinement(
  `!a u v. a *# (point (u,v)) = point(a* u,a* v)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[point;euclid_scale;euclid_plus ];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC THEN BETA_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let point_add = 
prove_by_refinement(
  `!u v u' v'. (point(u,v))+(point(u',v')) = (point(u+u',v+v'))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[point;euclid_plus;euclid_scale];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC THEN BETA_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)



(* ------------------------------------------------------------------ *)
(* the FLOOR function *)
(* ------------------------------------------------------------------ *)


let floor = jordan_def `floor x =
   @m. (real_of_int m <=. x /\ (x < (real_of_int (m + &:1))))`;;

let int_suc = 
prove_by_refinement(
  `!m. (real_of_int (m + &:1) = real_of_int m + &.1)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[int_add_th;INT_NUM_REAL ];
  ]);;
  (* }}} *)

let floor_ineq = 
prove_by_refinement(
  `!x. (real_of_int (floor x) <=. x) /\ (x <. (real_of_int (floor x)) + &.1)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[floor];
  SELECT_TAC;
  REWRITE_TAC[int_suc];
  MP_TAC (SPEC `&.1` REAL_ARCH_LEAST);
  REDUCE_TAC;
  DISCH_TAC;
  ASM_CASES_TAC `&.0 <= x`;
  TSPEC `x` 1;
  REWR 1;
  CHO 1;
  LEFT 0 "y";
  TSPEC `&:n` 0;
  USE 0  (REWRITE_RULE[INT_NUM_REAL;int_add_th;REAL_OF_NUM_ADD ]);
  ASM_MESON_TAC[];
  TSPEC `--. x` 1;
    COPY 2;
  IMP_REAL `~(&.0 <=. x) ==> (&.0 <=. (-- x))` 2;
  REWR 1;
  CHO 1;
  LEFT 0 "y";
  ASM_CASES_TAC `&.n = --x`;
  TSPEC `-- (&:n)` 0;
  USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL;REAL_OF_NUM_ADD]);
  JOIN 0 1;
  USE 0 (REWRITE_RULE[ GSYM REAL_OF_NUM_ADD]);
  PROOF_BY_CONTR_TAC;
  UND 0;
  UND 4;
  REAL_ARITH_TAC ;
  TSPEC `--: (&:(n+| 1))` 0;
  JOIN 1 0;
  USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL; GSYM REAL_OF_NUM_ADD;]);
  JOIN 4 0;
  PROOF_BY_CONTR_TAC;
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let int_arch = 
prove_by_refinement(
  `!m n. (n <=: m) /\ (m <: (n +: (&:1))) <=> (n = m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[int_lt;int_le;int_eq ;int_add_th;int_of_num_th   ];
  DISCH_ALL_TAC;
  EQ_TAC;
  MP_TAC (SPEC `m:int` dest_int_rep);
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  MP_TAC (SPEC `n:int` dest_int_rep);
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC  `(/\)`)) THEN (  ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN  REDUCE_TAC THEN   TRY ARITH_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_int = 
prove_by_refinement(
  `!m. (floor (real_of_int m) = m)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `floor (real_of_int m) <=: m /\ (m <: (floor (real_of_int m)) + (&:1))` SUBGOAL_TAC;
  REWRITE_TAC[int_le;int_lt;int_add_th ;int_of_num_th;floor_ineq  ];
  REWRITE_TAC[int_arch ];
  ]);;
  (* }}} *)

let int_lt_suc_le = 
prove_by_refinement(
  `!m n. m <: n + &:1 <=> m <=: n`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  EQ_TAC;
  MP_TAC (SPEC `m:int` dest_int_rep);
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  MP_TAC (SPEC `n:int` dest_int_rep);
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC  `(+:)`)) THEN (  ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN  REDUCE_TAC THEN   TRY ARITH_TAC;
  REWRITE_TAC[int_le;int_lt;int_add_th;int_of_num_th];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_le = 
prove_by_refinement(
  `!m x. (real_of_int m <=. x) <=> (m <=: (floor x))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  EQ_TAC;
  DISCH_TAC;
  REWRITE_TAC[int_le];
  REWRITE_TAC[GSYM int_le ;GSYM   int_lt_suc_le;];
  REWRITE_TAC[int_lt ;int_add_th;int_of_num_th;];
  ASM_MESON_TAC[floor_ineq; REAL_LET_TRANS];
  REWRITE_TAC[int_le];
  MP_TAC (SPEC `x:real` floor_ineq);
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_lt = 
prove_by_refinement(
  `!m x. (x < real_of_int m + &.1) <=> (floor x <=: m)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  EQ_TAC;
  DISCH_TAC;
  REWRITE_TAC[GSYM int_lt_suc_le ;];
  REWRITE_TAC[int_lt;int_add_th;int_of_num_th;];
  UND 0;
  MP_TAC (SPEC `x:real` floor_ineq);
  REAL_ARITH_TAC;
  REWRITE_TAC[int_le;];
  MP_TAC (SPEC `x:real` floor_ineq);
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_mono = 
prove_by_refinement(
  `!x y. (x <=. y) ==> (floor x <=: floor y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM floor_le];
  REP_GEN_TAC;
  MP_TAC (SPEC `x:real` floor_ineq);
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_level = 
prove_by_refinement(
  `!m x. ((&.0 <=. x) /\ (x <. &.1)) ==> (floor (real_of_int(m) + x) = m)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  SUBGOAL_TAC  `!a b. (b <=: a /\ ~(b <: a)) ==> (a = b)`;
  REWRITE_TAC[int_le;int_lt;int_eq];
  REAL_ARITH_TAC;
  DISCH_THEN IMATCH_MP_TAC ;
  SUBCONJ_TAC;
  REWRITE_TAC[GSYM floor_le];
  UND 0;
  REAL_ARITH_TAC;
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  USE 3 (REWRITE_RULE[]);
  USE 3 (ONCE_REWRITE_RULE[GSYM INT_LT_RADD ]);
  USE 3 (GEN `z:int`);
  TSPEC `&:1` 3;
  USE 3 (REWRITE_RULE [int_lt_suc_le ;]);
  MP_TAC (SPEC `real_of_int m + x` floor_ineq);
  UND 3;
  UND 1;
  REWRITE_TAC[int_add_th;int_le;int_of_num_th];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)


let floor_range = 
prove_by_refinement(
  `!x m. (floor x = m) <=> (real_of_int m <=. x /\ x <. real_of_int m +. &.1)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_THEN (fun t -> REWRITE_TAC[GSYM t;floor_ineq]);
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[GSYM INT_LE_ANTISYM;GSYM floor_lt;GSYM floor_le;];
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* edges and squares *)
(* ------------------------------------------------------------------ *)


let h_edge = jordan_def `h_edge p =
   { Z  | ?u v. (Z = point(u,v)) /\
    (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p)+: (&:1)))) /\
       (v = real_of_int (SND p)) }`;;

let v_edge = jordan_def `v_edge p =
   { Z  | ?u v. (Z = point(u,v)) /\
    (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) /\
       (u = real_of_int (FST p)) }`;;

let squ = jordan_def `squ p =
   {Z | ?u v. (Z = point(u,v)) /\
    (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p) +: (&:1)))) /\
    (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) }`;;

let row = jordan_def `row k = {Z | ?u . (Z = point(u,real_of_int k))}`;;

let col = jordan_def `col k = {Z | ?v . (Z = point(real_of_int k ,v))}`;;


let pointI_inj = 
prove_by_refinement(
  `!p q. (pointI p = pointI q) <=> (p = q) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[pointI;point_inj;PAIR_EQ;GSYM int_eq ];
  MESON_TAC[PAIR;PAIR_EQ];
  ]);;
  (* }}} *)

let h_edge_row = 
prove_by_refinement(
  `!p . h_edge p  SUBSET  row (SND p) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;IN;h_edge;row;IN_ELIM_THM';
];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let h_edge_floor = 
prove_by_refinement(
  `!p. h_edge p SUBSET { z | floor (z 0)  = FST p }`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;IN;h_edge;IN_ELIM_THM';
int_of_num_th;int_add_th;];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[coord01;floor_range];
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let row_disj = 
prove_by_refinement(
  `!a b. ~((row a) INTER (row b) = EMPTY) <=> (a = b)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;row;IN_ELIM_THM'  ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  AND 0;
  CHO 0;
  CHO 1;
  REWRITE_TAC[int_eq];
  USE 1 (GSYM);
  REWR 1;
  USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]);
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> REWRITE_TAC [t]);
  MESON_TAC[];
   ]);;
  (* }}} *)

let h_edge_disj = 
prove_by_refinement(
  `!p q. ~(h_edge p INTER h_edge q = EMPTY) <=> (p = q)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM'];
  EQ_TAC;
  DISCH_TAC;
  CHO 0;
  ONCE_REWRITE_TAC [GSYM PAIR];
  REWRITE_TAC[PAIR_EQ];
  CONJ_TAC;
  MP_TAC h_edge_floor;
  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
  ASM_MESON_TAC[];
  MP_TAC h_edge_row;
  MP_TAC row_disj;
  REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';
EMPTY_EXISTS;];
  ASM_MESON_TAC[];
  REWRITE_TAC[h_edge;IN_ELIM_THM' ];
  DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]);
  NAME_CONFLICT_TAC;
  LEFT_TAC "u'";
  TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC;
  TYPE_THEN `&.1/(&.2)` EXISTS_TAC;
  IMATCH_MP_TAC  half_pos;
  ARITH_TAC;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `real_of_int (FST q) + x` EXISTS_TAC;
  LEFT_TAC "v'";
  TYPE_THEN `real_of_int (SND q)` EXISTS_TAC ;
  TYPE_THEN `point (real_of_int (FST q) + x,real_of_int (SND q))` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let h_edge_pointI = 
prove_by_refinement(
  `!p q. ~(h_edge p (pointI q))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[pointI;h_edge;IN_ELIM_THM' ];
  PROOF_BY_CONTR_TAC;
  USE 0 (REWRITE_RULE[]);
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]);
  USE 0 GSYM ;
  REWR 1;
  REWR 2;
  USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]);
  USE 2 (REWRITE_RULE[int_le]);
  UND 2;
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let v_edge_col = 
prove_by_refinement(
  `!p . v_edge p  SUBSET  col (FST p) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;IN;v_edge;col;IN_ELIM_THM';
];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let v_edge_floor = 
prove_by_refinement(
  `!p. v_edge p SUBSET { z | floor (z 1)  = SND  p }`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;IN;v_edge;IN_ELIM_THM';
int_of_num_th;int_add_th;];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[coord01;floor_range];
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let col_disj = 
prove_by_refinement(
  `!a b. ~((col a) INTER (col b) = EMPTY) <=> (a = b)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;col;IN_ELIM_THM'  ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  AND 0;
  CHO 0;
  CHO 1;
  REWRITE_TAC[int_eq];
  USE 1 (GSYM);
  REWR 1;
  USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]);
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> REWRITE_TAC [t]);
  MESON_TAC[];
   ]);;
  (* }}} *)

let v_edge_disj = 
prove_by_refinement(
  `!p q. ~(v_edge p INTER v_edge q = EMPTY) <=> (p = q)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM'];
  EQ_TAC;
  DISCH_TAC;
  CHO 0;
  ONCE_REWRITE_TAC [GSYM PAIR];
  REWRITE_TAC[PAIR_EQ];
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b/\ a`);
  CONJ_TAC;
  MP_TAC v_edge_floor;
  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
  ASM_MESON_TAC[];
  MP_TAC v_edge_col;
  MP_TAC col_disj;
  REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';
EMPTY_EXISTS;];
  ASM_MESON_TAC[];
  REWRITE_TAC[v_edge;IN_ELIM_THM' ];
  DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]);
  NAME_CONFLICT_TAC;
  LEFT_TAC "u'";
  TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC;
  TYPE_THEN `&.1/(&.2)` EXISTS_TAC;
  IMATCH_MP_TAC  half_pos;
  ARITH_TAC;
  DISCH_THEN CHOOSE_TAC;
  LEFT_TAC "v'";
  LEFT_TAC "v'";
  TYPE_THEN `real_of_int (SND q) + x` EXISTS_TAC;
  TYPE_THEN `real_of_int (FST  q)` EXISTS_TAC ;
  TYPE_THEN `point (real_of_int (FST q),real_of_int (SND q) +x)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let v_edge_pointI = 
prove_by_refinement(
  `!p q. ~(v_edge p (pointI q))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[pointI;v_edge;IN_ELIM_THM' ];
  PROOF_BY_CONTR_TAC;
  USE 0 (REWRITE_RULE[]);
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]);
  USE 0 GSYM ;
  REWR 1;
  REWR 2;
  USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]);
  USE 2 (REWRITE_RULE[int_le]);
  UND 2;
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let row_col = 
prove_by_refinement(
  `!a b. (row b INTER col a) = { (pointI(a,b)) }`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[col;row;INTER;IN;IN_ELIM_THM';
pointI];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IN_ELIM_THM';INSERT;NOT_IN_EMPTY ];
  GEN_TAC;
  ASM_MESON_TAC[PAIR_EQ ;point_inj];
  ]);;
  (* }}} *)

let hv_edge = 
prove_by_refinement(
  `!p q. h_edge p INTER v_edge q = EMPTY`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `h_edge p INTER v_edge q SUBSET (row (SND p)) INTER (col (FST q))` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET_INTER;];
  MESON_TAC[h_edge_row;v_edge_col;SUB_IMP_INTER ];
  REWRITE_TAC[row_col];
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  USE 1 (REWRITE_RULE[EMPTY_EXISTS;IN  ]);
  CHO 1;
  USE 0 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM';
INSERT;EMPTY ]);
  TSPEC `u` 0;
  REWR 0;
  REWR 1;
  USE 1 (REWRITE_RULE[INTER;IN;IN_ELIM_THM';h_edge_pointI]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let square_col = 
prove_by_refinement(
  `!p a. (squ p INTER col a) = EMPTY `,

  (* {{{ proof *)

  [
  REWRITE_TAC[squ;col];
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]);
  CHO 0;
  USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
  AND 0;
  CHO 0;
  CHO 1;
  CHO 1;
  UND 1;
  DISCH_ALL_TAC;
  REWR 0;
  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]);
  REWR 3;
  REWR 2;
  USE 3 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]);
  USE 3 (REWRITE_RULE[ int_le;]);
  UND 2;
  UND 3;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let square_row = 
prove_by_refinement(
  `!p a. (squ p INTER row a) = EMPTY `,

  (* {{{ proof *)
  [
  REWRITE_TAC[squ;row];
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]);
  CHO 0;
  USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
  AND 0;
  CHO 0;
  CHO 1;
  CHO 1;
  UND 1;
  DISCH_ALL_TAC;
  REWR 0;
  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]);
  REWR 5;
  REWR 4;
  USE 5 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]);
  USE 5 (REWRITE_RULE[ int_le;]);
  UND 5;
  UND 4;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let pointI_row = 
prove_by_refinement(
  `!p.   (row (SND p)) (pointI p)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[row;pointI;IN_ELIM_THM' ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let pointI_col = 
prove_by_refinement(
  `!p.   (col (FST p)) (pointI p)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[col;pointI;IN_ELIM_THM' ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let square_v_edge = 
prove_by_refinement(
  `!p q. (squ p INTER v_edge q = EMPTY)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  TYPE_THEN `squ p INTER v_edge q SUBSET squ p INTER col (FST q)` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET_INTER];
  MESON_TAC[SUB_IMP_INTER;v_edge_col;SUBSET_REFL];
  REWRITE_TAC[square_col;SUBSET_EMPTY ];
  ]);;
  (* }}} *)

let square_h_edge = 
prove_by_refinement(
  `!p q. (squ p INTER h_edge q = EMPTY)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  TYPE_THEN `squ p INTER h_edge q SUBSET squ p INTER row (SND  q)` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET_INTER];
  MESON_TAC[SUB_IMP_INTER;h_edge_row;SUBSET_REFL];
  REWRITE_TAC[square_row;SUBSET_EMPTY ];
  ]);;
  (* }}} *)

let square_pointI = 
prove_by_refinement(
  `!p q. ~(squ p (pointI q))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  TYPE_THEN `q` (fun t -> ASSUME_TAC (SPEC t pointI_col));
  TYPEL_THEN [`p`;`FST q`] (fun t -> MP_TAC (SPECL t square_col));
  REWRITE_TAC[INTER;IN;];
  IMATCH_MP_TAC  (TAUT `(a ==> ~b) ==> (b ==> ~ a)`);
  DISCH_TAC;
  REWRITE_TAC[EMPTY_EXISTS;IN ];
  TYPE_THEN `pointI q` EXISTS_TAC;
  ASM_REWRITE_TAC[IN_ELIM_THM'];
  ]);;
  (* }}} *)

let square_floor0 = 
prove_by_refinement(
  `!p. (squ p SUBSET { z | (floor (z 0)) = (FST p) })`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';
squ];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[coord01;floor_range];
  UND 1;
  UND 2;
  REWRITE_TAC[int_add_th;int_of_num_th];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let square_floor1 = 
prove_by_refinement(
  `!p. (squ p SUBSET { z | (floor (z 1)) = (SND p) })`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';
squ];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[coord01;floor_range];
  UND 3;
  UND 4;
  REWRITE_TAC[int_add_th;int_of_num_th];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let square_square = 
prove_by_refinement(
  `!p q. ~(squ p INTER squ q = {}) ==> (squ p = squ q)`,

  (* {{{ proof *)
  [
  MP_TAC square_floor0;
  MP_TAC square_floor1;
  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';
INTER;EMPTY_EXISTS  ];
  DISCH_ALL_TAC;
  REP_GEN_TAC;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `p = q` SUBGOAL_TAC;
  ONCE_REWRITE_TAC [GSYM PAIR];
  REWRITE_TAC[PAIR_EQ];
  ASM_MESON_TAC[];
  MESON_TAC[];
  ]);;
  (* }}} *)

let square_disj = 
prove_by_refinement(
  `!p q. ~(squ p INTER squ q = EMPTY) <=> (p = q)`,

  (* {{{ proof *)
  [
  MP_TAC square_floor0;
  MP_TAC square_floor1;
  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';
INTER;EMPTY_EXISTS  ];
  DISCH_ALL_TAC;
  REP_GEN_TAC;
  EQ_TAC;
  DISCH_THEN CHOOSE_TAC;
  ONCE_REWRITE_TAC [GSYM PAIR];
  REWRITE_TAC[PAIR_EQ];
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[squ];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "u''");
  TYPE_THEN `real_of_int (FST q) + (&.1/(&.2))` EXISTS_TAC;
  TYPE_THEN `real_of_int (SND q) + (&.1/(&.2))` EXISTS_TAC;
  REWRITE_TAC[int_suc];
  TYPE_THEN `a = real_of_int(FST q)` ABBREV_TAC;
(*** Modified by JRH since ABBREV_TAC now forbids existing variables
  TYPE_THEN `a = real_of_int(SND  q)` ABBREV_TAC;
 ****)
  TYPE_THEN `a' = real_of_int(SND  q)` ABBREV_TAC;
  MP_TAC (REAL_RAT_REDUCE_CONV `&.0 < &.1/(&.2) /\ (&.1/(&.2)) < &.1`);
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(*  cells *)
(* ------------------------------------------------------------------ *)


let cell = jordan_def `cell =
  {z | (?p. (z = { (pointI p) }) \/ (z = h_edge p) \/
              (z = v_edge p) \/ (z = squ p))}`;;

let cell_rules = 
prove_by_refinement(
  `!p. cell {(pointI p)} /\ (cell (h_edge p)) /\
      (cell (v_edge p)) /\ (cell (squ p))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cell;IN_ELIM_THM';
];
  MESON_TAC[];
  ]);;
  (* }}} *)

let cell_mem = 
prove_by_refinement(
  `!C. (cell C) <=> (?p. C = ({(pointI p)})) \/ (?p. C = h_edge p) \/
    (?p. C = v_edge p) \/ (?p. C = squ p)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cell;IN_ELIM_THM'];
  MESON_TAC[];
  ]);;
  (* }}} *)

let square_domain = 
prove_by_refinement(
  `!z.  (let (p = (floor(FST z),floor(SND z))) in
       (({(pointI p)} UNION
        (h_edge p) UNION
        (v_edge p) UNION
        (squ p) ))) (point z) `,

  (* {{{ proof *)
  [
  GEN_TAC;
  LET_TAC;
  REWRITE_TAC[UNION;IN;IN_ELIM_THM' ];
  REWRITE_TAC[pointI;h_edge;v_edge;squ;int_add_th;int_of_num_th;IN_ELIM_THM';
INSERT;EMPTY;point_inj;Q_POINT ];
  ASSUME_TAC floor_ineq;
  TYPE_THEN `FST z` (WITH 0 o SPEC);
  TSPEC `SND z` 0;
  UND 0;
  UND 1;
  REWRITE_TAC[PAIR_LEMMAv2];
  REWRITE_TAC[REAL_ARITH `(a <= b) <=> ((a = b) \/ (a < b))`];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let square_cell = 
prove_by_refinement(
  `!z. (let (p = (floor(FST z),floor(SND z))) in
       (({(pointI p)} UNION
        (h_edge p) UNION
        (v_edge p) UNION
        (squ p) ))) SUBSET (UNIONS cell) `,

  (* {{{ proof *)
  [
  GEN_TAC;
  LET_TAC;
  REWRITE_TAC[union_subset];
  REPEAT CONJ_TAC THEN (IMATCH_MP_TAC  sub_union) THEN (REWRITE_TAC[cell_rules]);
  ]);;
  (* }}} *)

let cell_unions = 
prove_by_refinement(
  `!z. (UNIONS cell (point z))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  ASM_MESON_TAC[square_cell;square_domain;SUBSET;IN];
  ]);;
  (* }}} *)

let cell_partition = 
prove_by_refinement(
  `!C D. (cell C) /\ (cell D) /\ ~(C INTER D = EMPTY) ==> (C = D)`,

  (* {{{ proof *)
  let revr = PURE_ONCE_REWRITE_RULE [INTER_COMM] in
  [
  PARTIAL_REWRITE_TAC[cell_mem;];
  PARTIAL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR ];
  REP_GEN_TAC;
  PARTIAL_REWRITE_TAC[TAUT `((a \/ b ==> C)) <=> ((a ==> C) /\ (b ==> C))`];
  PARTIAL_REWRITE_TAC[TAUT `((a /\ b) ==> C) <=> (a ==> b ==> C)`];
  REPEAT CONJ_TAC THEN (REPEAT (DISCH_THEN CHOOSE_TAC)) THEN (TRY (UNDISCH_FIND_TAC `(INTER)`))  THEN (ASM PARTIAL_REWRITE_TAC[])  THEN ASM PARTIAL_REWRITE_TAC[square_h_edge;square_v_edge;revr square_h_edge;revr square_v_edge;v_edge_disj;h_edge_disj;hv_edge;revr hv_edge;revr single_inter; single_inter;square_pointI;v_edge_pointI;h_edge_pointI; square_square;INR NOT_IN_EMPTY;INR IN_SING ] THEN (DISCH_THEN (fun t-> REWRITE_TAC[t]));
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* adjacency, closure, convexity, AND strict dominance on cells. *)
(* ------------------------------------------------------------------ *)


let top2 = jordan_def `top2 = top_of_metric (euclid 2,d_euclid)`;;

let adj = jordan_def `adj X Y <=> (~(X = Y) /\
   ~(closure top2 X INTER (closure top2 Y) = EMPTY))`;;

let strict_dom = jordan_def `strict_dom X Y <=> (cell X) /\ (cell Y) /\
  (closure top2 Y PSUBSET (closure top2 X))`;;

let adj_symm = 
prove_by_refinement(
  `!X Y. (adj X Y) <=> (adj Y X)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[adj];
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let adj_irrefl = 
prove_by_refinement(
  `!X. (~(adj X X))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[adj;];
  ]);;
  (* }}} *)

let strict_dom_trans = 
prove_by_refinement(
  `!X Y Z. (strict_dom X Y) /\ (strict_dom Y Z) ==> (strict_dom X Z)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[strict_dom];
  MESON_TAC[PSUBSET_TRANS];
  ]);;
  (* }}} *)

let strict_dom_irrefl = 
prove_by_refinement(
  `!X. ~(strict_dom X X)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[strict_dom;PSUBSET_IRREFL ];
  ]);;
  (* }}} *)

let dot_point = 
prove_by_refinement(
  `!p q . (dot (point p) (point q)) = (FST p)*(FST q) + (SND p)*(SND q)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `dot (point p) (point q) = sum (0,2) (\i. (point p i)*(point q i))` SUBGOAL_TAC;
  IMATCH_MP_TAC dot_euclid;
  ASM_SIMP_TAC[euclid_point];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[ARITH_RULE `2 = SUC 1`];
  REWRITE_TAC[sum];
  REWRITE_TAC[ARITH_RULE `1 = SUC 0`];
  REWRITE_TAC[sum];
  REDUCE_TAC;
  REWRITE_TAC[ARITH_RULE `SUC 0 = 1`;coord01];
  ]);;
  (* }}} *)


(* 2d half planes *)
let open_half_plane2D_FLT = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (FST p <. r))  } =
     open_half_space 2 (point (&.1,&.0)) r `,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC [];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let open_half_plane2D_LTF = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (r <. FST p ))  } =
     open_half_space 2 (point (--. (&.1),&.0)) (--. r) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let open_half_plane2D_SLT = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (SND p <. r ))  } =
     open_half_space 2 (point (&.0,&.1)) ( r) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let open_half_plane2D_LTS = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (r <. SND p  ))  } =
     open_half_space 2 (point (&.0,--.(&.1))) (--. r) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let closed_half_plane2D_FLE = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (FST p <=. r))  } =
     closed_half_space 2 (point (&.1,&.0)) r `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC [];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let closed_half_plane2D_LEF = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (r <=. FST p))  } =
     closed_half_space 2 (point (--.(&.1),&.0)) (--. r) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC [];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let closed_half_plane2D_SLE = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (SND p <=. r))  } =
     closed_half_space 2 (point (&.0,&.1)) r `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC [];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let closed_half_plane2D_LES = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (r <=. SND p ))  } =
     closed_half_space 2 (point (&.0,(--. (&.1)))) (--. r) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC [];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let line2D_F = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (FST p = r))  } =
     hyperplane 2 (point (&.1,&.0)) r `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC [];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let line2D_S = 
prove_by_refinement(
  `!r. { z | ?p. ((z = point p) /\ (SND p = r))  } =
     hyperplane 2 (point (&.0,&.1)) r `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASM_REWRITE_TAC[dot_point;euclid_point;];
  REDUCE_TAC;
  ASM_REWRITE_TAC [];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP point_onto);
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
  USE 1 (CONV_RULE REDUCE_CONV);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let open_half_plane2D_FLT_open = 
prove_by_refinement(
  `!r. top2 { z | ?p. ((z = point p) /\ (FST p <. r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_FLT;top2];
  SIMP_TAC[open_half_space_open;euclid_point];
  ]);;
  (* }}} *)

let open_half_plane2D_LTF_open = 
prove_by_refinement(
  `!r. top2 { z | ?p. ((z = point p) /\ (r <. FST p ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_LTF;top2];
  SIMP_TAC[open_half_space_open;euclid_point];
  ]);;
  (* }}} *)

let open_half_plane2D_SLT_open = 
prove_by_refinement(
  `!r. top2 { z | ?p. ((z = point p) /\ (SND p <. r  ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_SLT;top2];
  SIMP_TAC[open_half_space_open;euclid_point];
  ]);;
  (* }}} *)

let open_half_plane2D_LTS_open = 
prove_by_refinement(
  `!r. top2 { z | ?p. ((z = point p) /\ (r <. SND p   ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_LTS;top2];
  SIMP_TAC[open_half_space_open;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_FLT_closed = 
prove_by_refinement(
  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p <=. r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_FLE;top2];
  SIMP_TAC[closed_half_space_closed;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_LTF_closed = 
prove_by_refinement(
  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. FST p ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_LEF;top2];
  SIMP_TAC[closed_half_space_closed;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_SLT_closed = 
prove_by_refinement(
  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p <=. r  ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_SLE;top2];
  SIMP_TAC[closed_half_space_closed;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_LTS_closed = 
prove_by_refinement(
  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. SND p   ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_LES;top2];
  SIMP_TAC[closed_half_space_closed;euclid_point];
  ]);;
  (* }}} *)

let line2D_F_closed = 
prove_by_refinement(
  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p = r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[line2D_F;top2];
  SIMP_TAC[hyperplane_closed;euclid_point];
  ]);;
  (* }}} *)

let line2D_S_closed = 
prove_by_refinement(
  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p = r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[line2D_S;top2];
  SIMP_TAC[hyperplane_closed;euclid_point];
  ]);;
  (* }}} *)

let open_half_plane2D_FLT_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (FST p <. r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_FLT;];
  SIMP_TAC[open_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let open_half_plane2D_LTF_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (r <. FST p ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_LTF;];
  SIMP_TAC[open_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let open_half_plane2D_SLT_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (SND p <. r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_SLT;];
  SIMP_TAC[open_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let open_half_plane2D_LTS_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (r <. SND p ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_LTS;];
  SIMP_TAC[open_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_FLT_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (FST p <=. r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_FLE;];
  SIMP_TAC[closed_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_LTF_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (r <=. FST p ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_LEF;];
  SIMP_TAC[closed_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_SLT_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (SND p <=. r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_SLE;];
  SIMP_TAC[closed_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let closed_half_plane2D_LTS_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (r <=. SND p ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[closed_half_plane2D_LES;];
  SIMP_TAC[closed_half_space_convex;euclid_point];
  ]);;
  (* }}} *)

let line2D_F_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ ( FST p = r ))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[line2D_F;];
  SIMP_TAC[hyperplane_convex;euclid_point];
  ]);;
  (* }}} *)

let line2D_S_convex = 
prove_by_refinement(
  `!r. convex { z | ?p. ((z = point p) /\ (SND p = r))  }`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[line2D_S;];
  SIMP_TAC[hyperplane_convex;euclid_point];
  ]);;
  (* }}} *)

let closure_FLT = 
prove_by_refinement(
  `!r. (closure top2 { z | ?p. ((z = point p) /\ (FST p <. r))  } =
       { z | ?p. ((z = point p) /\ (FST p <=. r))  })`,

  (* {{{ proof *)

  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_FLT;closed_half_plane2D_FLE;top2];
  TYPE_THEN `~(point(&.1,&.0) = euclid0)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 0(REWRITE_RULE[]);
  USE 0  (fun t -> AP_THM t `0`);
  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]);
  ASM_REWRITE_TAC[];
  SIMP_TAC[closure_half_space;euclid_point];
  ]);;
  (* }}} *)

let closure_LTF = 
prove_by_refinement(
  `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. FST p))  } =
       { z | ?p. ((z = point p) /\ (r <=. FST p ))  })`,

  (* {{{ proof *)

  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_LTF;closed_half_plane2D_LEF;top2];
  TYPE_THEN `~(point(--. (&.1),&.0) = euclid0)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 0(REWRITE_RULE[]);
  USE 0  (fun t -> AP_THM t `0`);
  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]);
  ASM_REWRITE_TAC[];
  SIMP_TAC[closure_half_space;euclid_point];
  ]);;
  (* }}} *)

let closure_SLT = 
prove_by_refinement(
  `!r. (closure top2 { z | ?p. ((z = point p) /\ (SND  p <. r))  } =
       { z | ?p. ((z = point p) /\ (SND  p <=. r))  })`,

  (* {{{ proof *)

  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_SLT;closed_half_plane2D_SLE;top2];
  TYPE_THEN `~(point(&.0,&.1) = euclid0)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 0(REWRITE_RULE[]);
  USE 0  (fun t -> AP_THM t `1`);
  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]);
  ASM_REWRITE_TAC[];
  SIMP_TAC[closure_half_space;euclid_point];
  ]);;
  (* }}} *)

let closure_LTS = 
prove_by_refinement(
  `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. SND  p))  } =
       { z | ?p. ((z = point p) /\ (r <=. SND  p ))  })`,

  (* {{{ proof *)

  [
  GEN_TAC;
  REWRITE_TAC[open_half_plane2D_LTS;closed_half_plane2D_LES;top2];
  TYPE_THEN `~(point(&.0, --. (&.1)) = euclid0)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 0(REWRITE_RULE[]);
  USE 0  (fun t -> AP_THM t `1`);
  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]);
  ASM_REWRITE_TAC[];
  SIMP_TAC[closure_half_space;euclid_point];
  ]);;
  (* }}} *)



(* ------------------------------------------------------------------ *)
(* SECTION B *)
(* ------------------------------------------------------------------ *)

(* -> sets *)
let single_subset = 
prove_by_refinement(
  `!(x:A) A. ({x} SUBSET A) <=> (A x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;INSERT];
  MESON_TAC[];
  ]);;
  (* }}} *)

let top2_top = 
prove_by_refinement(
  `topology_ top2  `,

  (* {{{ proof *)
  [
  ASM_SIMP_TAC [top2;top_of_metric_top;metric_euclid];
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* H_edge & v_edge, convexity, closure, closed, adj, etc. *)
(* ------------------------------------------------------------------ *)

let e1 = jordan_def `e1 = point(&.1,&.0)`;;
let e2 = jordan_def `e2 = point(&.0,&.1)`;;

let hc_edge = jordan_def `hc_edge m =
   (h_edge m) UNION {(pointI m)} UNION {(pointI m + e1)}`;;

let vc_edge = jordan_def `vc_edge m =
   (v_edge m) UNION {(pointI m)} UNION {(pointI m + e2)}`;;



(* H edge *)
let h_edge_inter = 
prove_by_refinement(
  `!m. (h_edge m) =
   ({z | ?p. (z = point p) /\ (real_of_int (FST  m) <. FST p)}
      INTER {z | ?p. (z = point p) /\ (FST p <. real_of_int(FST  m +: &:1))}
      INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND  m))})`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  REWRITE_TAC[INTER;h_edge];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[point_inj];
  REPEAT CONJ_TAC THEN (TYPE_THEN `(u,real_of_int(SND m))` EXISTS_TAC) THEN ASM_REWRITE_TAC[PAIR_SPLIT];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 1;
  CHO 2;
  TYPE_THEN `FST p` EXISTS_TAC;
  TYPE_THEN `SND  p` EXISTS_TAC;
  REWR 1;
  REWR 2;
  USE 2 (REWRITE_RULE[point_inj]);
  USE 1 (REWRITE_RULE[point_inj]);
  AND 1;
  AND 2;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let h_edge_convex = 
prove_by_refinement(
  `!m. (convex (h_edge m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[h_edge_inter;];
  IMATCH_MP_TAC convex_inter;
  CONJ_TAC;
  REWRITE_TAC [open_half_plane2D_LTF_convex;];
  IMATCH_MP_TAC  convex_inter;
  REWRITE_TAC[open_half_plane2D_FLT_convex;line2D_S_convex];
  ]);;
  (* }}} *)

let hc_edge_inter = 
prove_by_refinement(
  `!m. (hc_edge m) =
   ({z | ?p. (z = point p) /\ (real_of_int (FST  m) <=. FST p)}
      INTER {z | ?p. (z = point p) /\ (FST p <=. real_of_int(FST  m +: &:1))}
      INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND  m))})`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[hc_edge;e1];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  REPEAT (CONJ_TAC);
  REWRITE_TAC[h_edge_inter];
  REWRITE_TAC[SUBSET;INTER];
  ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc];
  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc];
  REDUCE_TAC;
  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) + &.1,real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
  REWRITE_TAC[INTER;SUBSET;UNION;e1;h_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ];
  GEN_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  REWR 1;
  REWR 2;
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])];
  UND 2;
  UND 1;
  REWRITE_TAC[point_inj;];
  REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])];
  AND 0;
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let hc_edge_closed = 
prove_by_refinement(
  `!m. (closed_ top2 (hc_edge m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[hc_edge_inter];
  GEN_TAC;
  IMATCH_MP_TAC  closed_inter2;
  REWRITE_TAC[top2_top;closed_half_plane2D_LTF_closed];
  IMATCH_MP_TAC  closed_inter2;
  REWRITE_TAC[top2_top;closed_half_plane2D_FLT_closed;line2D_S_closed;];
  ]);;
  (* }}} *)

let hc_edge_convex = 
prove_by_refinement(
  `!m. (convex (hc_edge m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[hc_edge_inter];
  GEN_TAC;
  IMATCH_MP_TAC convex_inter;
  REWRITE_TAC[closed_half_plane2D_LTF_convex];
  IMATCH_MP_TAC  convex_inter;
  REWRITE_TAC[closed_half_plane2D_FLT_convex;line2D_S_convex;];
  ]);;
  (* }}} *)

let h_edge_subset = 
prove_by_refinement(
  `!m. (h_edge m SUBSET hc_edge m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[hc_edge;SUBSET;UNION;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let h_edge_euclid = 
prove_by_refinement(
  `!m. (h_edge m) SUBSET (euclid 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;h_edge];
  MESON_TAC[euclid_point];
  ]);;
  (* }}} *)

let h_edge_closure = 
prove_by_refinement(
  `!m. (closure top2 (h_edge m)) = hc_edge m`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  closure_subset;
  REWRITE_TAC[h_edge_subset;top2_top;hc_edge_closed];
  REWRITE_TAC[hc_edge];
  REWRITE_TAC[union_subset;e1;pointI;single_subset;point_add];
  CONJ_TAC;
  IMATCH_MP_TAC  subset_closure;
  REWRITE_TAC[top2_top];
  REWRITE_TAC[top2];
  SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ;
  REWRITE_TAC[GSYM REAL_RDISTRIB];
  REAL_ARITH_TAC;
  DISCH_TAC;
  CONJ_TAC THEN (IMATCH_MP_TAC  closure_segment) THEN REWRITE_TAC[h_edge_euclid];
  TYPE_THEN `(pointI m)+point(&.1,&.0)` EXISTS_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REDUCE_TAC;
  ASM_REWRITE_TAC[int_suc];
  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
  UND 1;
  UND 2;
  REAL_ARITH_TAC ;
  TYPE_THEN `pointI m` EXISTS_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REDUCE_TAC;
  ASM_REWRITE_TAC[int_suc];
  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
  UND 1;
  UND 2;
  REAL_ARITH_TAC ;
  ]);;
  (* }}} *)

(* move up *)
let point_split = 
prove_by_refinement(
  `!z u v. (z = point(u,v)) <=> (u = z 0) /\ (v = z 1) /\ (euclid 2 z)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  EQ_TAC ;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[coord01;euclid_point];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  DISJ_CASES_TAC (ARITH_RULE  `(x = 0) \/ (x = 1) \/ (2 <= x)`);
  ASM_REWRITE_TAC[coord01];
  UND 3;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[coord01];
  ASM_MESON_TAC[euclid;euclid_point]
  ]);;
  (* }}} *)


(* V edge *)
let v_edge_inter = 
prove_by_refinement(
  `!m. (v_edge m) =
   ({z | ?p. (z = point p) /\ (real_of_int (SND   m) <. SND  p)}
      INTER {z | ?p. (z = point p) /\ (SND  p <. real_of_int(SND  m +: &:1))}
      INTER {z | ?p. (z = point p) /\ (FST p = real_of_int(FST  m))})`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[INTER;v_edge;int_suc ];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[point_inj];
  CONV_TAC (dropq_conv "p");
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "p");
  CONV_TAC (dropq_conv "p'");
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[point_split;];
  CONV_TAC (dropq_conv "v");
  ASM_MESON_TAC[FST;SND;PAIR;coord01;euclid_point;point_onto];
  ]);;
  (* }}} *)

let v_edge_convex = 
prove_by_refinement(
  `!m. (convex (v_edge m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[v_edge_inter;];
  IMATCH_MP_TAC convex_inter;
  CONJ_TAC;
  REWRITE_TAC [open_half_plane2D_LTS_convex;];
  IMATCH_MP_TAC  convex_inter;
  REWRITE_TAC[open_half_plane2D_SLT_convex;line2D_F_convex];
  ]);;
  (* }}} *)

let vc_edge_inter = 
prove_by_refinement(
  `!m. (vc_edge m) =
   ({z | ?p. (z = point p) /\ (real_of_int (SND   m) <=. SND  p)}
      INTER {z | ?p. (z = point p) /\ (SND p <=. real_of_int(SND  m +: &:1))}
      INTER {z | ?p. (z = point p) /\ (FST  p = real_of_int(FST   m))})`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[vc_edge;e2];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  REPEAT (CONJ_TAC);
  REWRITE_TAC[v_edge_inter];
  REWRITE_TAC[SUBSET;INTER];
  ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc];
  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc];
  REDUCE_TAC;
  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) ,real_of_int(SND m) + &.1)` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
  REWRITE_TAC[INTER;SUBSET;UNION;e2;v_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ];
  GEN_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  REWR 1;
  REWR 2;
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])];
  UND 2;
  UND 1;
  REWRITE_TAC[point_inj;];
  REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])];
  AND 0;
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let vc_edge_closed = 
prove_by_refinement(
  `!m. (closed_ top2 (vc_edge m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[vc_edge_inter];
  GEN_TAC;
  IMATCH_MP_TAC  closed_inter2;
  REWRITE_TAC[top2_top;closed_half_plane2D_LTS_closed];
  IMATCH_MP_TAC  closed_inter2;
  REWRITE_TAC[top2_top;closed_half_plane2D_SLT_closed;line2D_F_closed;];
  ]);;
  (* }}} *)

let vc_edge_convex = 
prove_by_refinement(
  `!m. (convex (vc_edge m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[vc_edge_inter];
  GEN_TAC;
  IMATCH_MP_TAC convex_inter;
  REWRITE_TAC[closed_half_plane2D_LTS_convex];
  IMATCH_MP_TAC  convex_inter;
  REWRITE_TAC[closed_half_plane2D_SLT_convex;line2D_F_convex;];
  ]);;
  (* }}} *)

let v_edge_subset = 
prove_by_refinement(
  `!m. (v_edge m SUBSET vc_edge m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[vc_edge;SUBSET;UNION;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let v_edge_euclid = 
prove_by_refinement(
  `!m. (v_edge m) SUBSET (euclid 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;v_edge];
  MESON_TAC[euclid_point];
  ]);;
  (* }}} *)

let v_edge_closure = 
prove_by_refinement(
  `!m. (closure top2 (v_edge m)) = vc_edge m`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  closure_subset;
  REWRITE_TAC[v_edge_subset;top2_top;vc_edge_closed];
  REWRITE_TAC[vc_edge];
  REWRITE_TAC[union_subset;e2;pointI;single_subset;point_add];
  CONJ_TAC;
  IMATCH_MP_TAC  subset_closure;
  REWRITE_TAC[top2_top];
  REWRITE_TAC[top2];
  SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ;
  REWRITE_TAC[GSYM REAL_RDISTRIB];
  REAL_ARITH_TAC;
  DISCH_TAC;
  CONJ_TAC THEN (IMATCH_MP_TAC  closure_segment) THEN REWRITE_TAC[v_edge_euclid];
  TYPE_THEN `(pointI m)+point(&.0,&.1)` EXISTS_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REDUCE_TAC;
  ASM_REWRITE_TAC[int_suc];
  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
  UND 1;
  UND 2;
  REAL_ARITH_TAC ;
  TYPE_THEN `pointI m` EXISTS_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REDUCE_TAC;
  ASM_REWRITE_TAC[int_suc];
  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
  UND 1;
  UND 2;
  REAL_ARITH_TAC ;
  ]);;
  (* }}} *)

let squ_euclid = 
prove_by_refinement(
  `!m. (squ m) SUBSET (euclid 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;squ];
  MESON_TAC[euclid_point];
  ]);;
  (* }}} *)

let cell_euclid = 
prove_by_refinement(
  `!X. (cell X) ==> (X SUBSET euclid 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cell];
  GEN_TAC;
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  REP_CASES_TAC THEN ASM_REWRITE_TAC[h_edge_euclid;squ_euclid;v_edge_euclid];
  REWRITE_TAC[ISUBSET;INR IN_SING;pointI;euclid_point];
  ASM_MESON_TAC[euclid_point];
  ]);;
  (* }}} *)

let edge = jordan_def `edge C <=> ?m. ((C = v_edge m) \/ (C = h_edge m))`;;

let edge_v = 
prove_by_refinement(
  `!m. edge (v_edge m)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[edge];
  ]);;
  (* }}} *)

let edge_h = 
prove_by_refinement(
  `!m. edge (h_edge m)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[edge];
  ]);;
  (* }}} *)

let num_closure = jordan_def `num_closure G x =
      CARD { C | (G C) /\ (closure top2 C x) }`;;

let num_lower = jordan_def `num_lower G n =
   CARD { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;;

let set_lower = jordan_def `set_lower G n =
    { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;;

let num_lower_set = 
prove_by_refinement(
  `!G n. num_lower G n = CARD (set_lower G n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[num_lower;set_lower];
  ]);;
  (* }}} *)

let even_cell = jordan_def `even_cell G C <=>
   (?m. (C = {(pointI m)}) /\ (EVEN (num_lower G m))) \/
   (?m. (C = h_edge m) /\ (EVEN (num_lower G m))) \/
   (?m. (C = v_edge m) /\ (EVEN (num_lower G m))) \/
   (?m. (C = squ m) /\ (EVEN (num_lower G m)))`;;

(* set *)
let eq_sing = prove_by_refinement(
(*** Parens added by JRH; parser no longer hacks "=" specially
     so it is really right associative
  `!X (y:A). X = {y} = ((X y) /\ (!u. (X u) ==> (u=y)))`,
 ***)
  `!X (y:A). (X = {y}) <=> ((X y) /\ (!u. (X u) ==> (u=y)))`,
  (* {{{ proof *)
  [
  REWRITE_TAC[INSERT ;];
  DISCH_ALL_TAC;
  EQ_TAC ;
  DISCH_THEN_REWRITE;
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let h_edge_pointIv2 = 
prove_by_refinement(
  `!p q. ~(h_edge p = {(pointI q)})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[eq_sing;h_edge_pointI];
  ]);;
  (* }}} *)

let v_edge_pointIv2 = 
prove_by_refinement(
  `!p q. ~(v_edge p = {(pointI q)})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[eq_sing;v_edge_pointI];
  ]);;
  (* }}} *)

let square_pointIv2 = 
prove_by_refinement(
  `!p q. ~(squ p = {(pointI q)})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[eq_sing;square_pointI];
  ]);;
  (* }}} *)

let cell_nonempty = 
prove_by_refinement(
  `!z. (cell z) ==> ~(z = EMPTY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cell_mem];
  GEN_TAC;
  REP_CASES_TAC ;
  CHO 1;
  USE 1(  REWRITE_RULE [eq_sing]);
  ASM_MESON_TAC[EMPTY];
  CHO 1;
  ASM_MESON_TAC[h_edge_disj;INTER_EMPTY];
  CHO 1;
  ASM_MESON_TAC[v_edge_disj;INTER_EMPTY];
  CHO 1;
  ASM_MESON_TAC[square_disj;INTER_EMPTY];
  ]);;
  (* }}} *)

let hv_edgeV2 = 
prove_by_refinement(
  `!p q. ~(h_edge p = v_edge q)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[cell_rules;cell_nonempty;hv_edge;INTER_IDEMPOT];
  ]);;
  (* }}} *)

let square_v_edgeV2 = 
prove_by_refinement(
  `!p q. ~(squ p = v_edge q)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[cell_rules;cell_nonempty;square_v_edge;INTER_IDEMPOT];
  ]);;
  (* }}} *)

let square_h_edgeV2 = 
prove_by_refinement(
  `!p q. ~(squ p = h_edge q)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[cell_rules;cell_nonempty;square_h_edge;INTER_IDEMPOT];
  ]);;
  (* }}} *)

let h_edge_inj = 
prove_by_refinement(
  `!p q . (h_edge p = h_edge q) <=> (p = q)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[cell_rules;cell_nonempty;h_edge_disj;INTER_IDEMPOT];
  ]);;
  (* }}} *)

let v_edge_inj = 
prove_by_refinement(
  `!p q . (v_edge p = v_edge q) <=> (p = q)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[cell_rules;cell_nonempty;v_edge_disj;INTER_IDEMPOT];
  ]);;
  (* }}} *)

let squ_inj = 
prove_by_refinement(
  `!p q . (squ p = squ q) <=> (p = q)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[cell_rules;cell_nonempty;square_disj;INTER_IDEMPOT];
  ]);;
  (* }}} *)

let finite_set_lower = 
prove_by_refinement(
  `!G n. (FINITE G) ==> (FINITE (set_lower G n))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `INJ h_edge (set_lower G n) G` SUBGOAL_TAC;
  REWRITE_TAC[INJ;set_lower;h_edge_inj];
  ASM_MESON_TAC[];
  DISCH_TAC;
  JOIN  0 1;
  USE 0 (MATCH_MP FINITE_INJ);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let even_cell_point = 
prove_by_refinement(
  `!G m. even_cell G {(pointI m)} <=> EVEN(num_lower G m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[even_cell;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2];
  REWRITE_TAC[pointI_inj;INSERT;eq_sing];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let even_cell_h_edge = 
prove_by_refinement(
  `!G m. even_cell G (h_edge m) <=> EVEN(num_lower G m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[even_cell;h_edge_pointIv2];
  REWRITE_TAC[pointI_inj;INSERT;h_edge_inj;GSYM square_h_edgeV2;hv_edgeV2;eq_sing];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let even_cell_v_edge = 
prove_by_refinement(
  `!G m. even_cell G (v_edge m) <=> EVEN(num_lower G m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[even_cell;v_edge_pointIv2];
  REWRITE_TAC[pointI_inj;INSERT;v_edge_inj;GSYM square_v_edgeV2;hv_edgeV2;eq_sing];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let even_cell_squ = 
prove_by_refinement(
  `!G m. even_cell G (squ m) <=> EVEN(num_lower G m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[even_cell;v_edge_pointIv2];
  REWRITE_TAC[pointI_inj;INSERT;squ_inj;GSYM square_v_edgeV2;GSYM square_h_edgeV2;square_pointI;eq_sing];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let h_edge_squ_parity = 
prove_by_refinement(
  `!G m. even_cell G (h_edge m) <=> even_cell G (squ m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower];
  ]);;
  (* }}} *)

let up = jordan_def `up (m:int#int) = (FST m,SND m +: (&:1))`;;
let down = jordan_def `down (m:int#int) = (FST m,SND m -: (&:1))`;;
let left = jordan_def `left (m:int#int) = (FST m -: (&:1),SND m)`;;
let right = jordan_def `right (m:int#int) = (FST m +: (&:1),SND m)`;;

let set_lower_delete = 
prove_by_refinement(
  `!G n. set_lower G (down n) = (set_lower G n) DELETE n`,

  (* {{{ proof *)
  [
  REWRITE_TAC[set_lower;down;DELETE ];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[PAIR_SPLIT;INT_LE_SUB_LADD;GSYM INT_LT_DISCRETE;];
  REWRITE_TAC[int_le;int_lt;];
  REWRITE_TAC[ (ARITH_RULE `! x y. (x <. y) <=> ((x <= y) /\ ~(x = y))`)];
  REWRITE_TAC[GSYM int_eq];
  MESON_TAC[];
  ]);;
  (* }}} *)

let set_lower_n = 
prove_by_refinement(
  `!G n. set_lower G n n = (G (h_edge n))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[set_lower;int_le ; REAL_LE_REFL];
  ]);;
  (* }}} *)

(* set *)
let CARD_SUC_DELETE = 
prove_by_refinement(
  `!(x:A) s. FINITE s /\ s x ==>
    ((SUC (CARD (s DELETE x))) = CARD s)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `s = (x INSERT (s DELETE x))` SUBGOAL_TAC;
  ASM_MESON_TAC[INR INSERT_DELETE];
  USE 0 (ONCE_REWRITE_RULE[GSYM FINITE_DELETE]);
  TYPE_THEN `b = s DELETE x`  ABBREV_TAC ;
  DISCH_THEN_REWRITE;
  ASM_SIMP_TAC [INR CARD_CLAUSES];
  COND_CASES_TAC;
  ASM_MESON_TAC[INR IN_DELETE];
  REWRITE_TAC[];
  ]);;
  (* }}} *)

let even_delete = 
prove_by_refinement(
  `!(x:A) s. FINITE s ==>
     ((EVEN (CARD (s DELETE x)) <=> EVEN (CARD s)) <=> ~(s x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `s x`  ASM_CASES_TAC ;
  ASM_MESON_TAC[CARD_SUC_DELETE;EVEN ];
  ASM_SIMP_TAC[CARD_DELETE];
  ]);;
  (* }}} *)

let num_lower_down = 
prove_by_refinement(
  `!G m. (FINITE G) ==>
       ((EVEN (num_lower G (down m)) <=> EVEN (num_lower G m)) <=>
           ~(set_lower G m m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[num_lower_set;set_lower_delete];
  IMATCH_MP_TAC  even_delete;
  REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower;down];
  ASM_MESON_TAC[finite_set_lower];
  ]);;
  (* }}} *)

let squ_down = 
prove_by_refinement(
  `!G m. (FINITE G) ==>
        ((even_cell G (squ (down m)) <=> even_cell G (squ m)) <=>
             ~(set_lower G m m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[even_cell_squ;num_lower_down];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(*  edge combinatorics *)
(* ------------------------------------------------------------------ *)

let pair_size_2 = 
prove_by_refinement(
  `!(a:A) b. ~(a= b) ==> ({a, b} HAS_SIZE 2)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[HAS_SIZE];
  ASM_SIMP_TAC[FINITE_SING;CARD_CLAUSES;INR IN_SING ];
  CONJ_TAC;
  REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
  REWRITE_TAC[ARITH_RULE `2 = SUC 1`;SUC_INJ;];
  MESON_TAC[SING;CARD_SING];
  ]);;
  (* }}} *)

let has_size2 = 
prove_by_refinement(
  `!u. (u HAS_SIZE 2) <=> (?(a:A) b. (u = {a , b}) /\ ~(a=b))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  EQ_TAC;
  REWRITE_TAC[HAS_SIZE];
  DISCH_ALL_TAC;
  TYPE_THEN `~(u = EMPTY)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  REWR 2;
  REWR 1;
  USE 1 (REWRITE_RULE[CARD_CLAUSES]);
  UND 1;
  ARITH_TAC;
  DISCH_TAC;
  COPY 0;
  COPY 2;
  JOIN 0 2;
  USE 0 (MATCH_MP CARD_DELETE_CHOICE);
  TYPE_THEN `CARD (u DELETE CHOICE u) = 1` SUBGOAL_TAC;
  ONCE_REWRITE_TAC [GSYM SUC_INJ];
  ASM_REWRITE_TAC[];
  ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `u DELETE CHOICE u HAS_SIZE 1` SUBGOAL_TAC;
  REWRITE_TAC[HAS_SIZE];
  ASM_REWRITE_TAC[FINITE_DELETE];
  DISCH_TAC;
  USE 5 (MATCH_MP CARD_SING_CONV);
  USE 5 (REWRITE_RULE [SING]);
  CHO 5;
  TYPE_THEN `CHOICE u` EXISTS_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  USE 5 (SYM);
  ASM_REWRITE_TAC[];
  USE 4 (MATCH_MP CHOICE_DEF);
  ASM_SIMP_TAC[INSERT_DELETE];
  TYPE_THEN `(u DELETE (CHOICE u)) x` SUBGOAL_TAC;
  USE 5 (SYM);
  ASM_REWRITE_TAC[INR IN_SING ];
  DISCH_TAC;
  TYPE_THEN `~((u DELETE CHOICE u) (CHOICE u))` SUBGOAL_TAC;
  REWRITE_TAC[INR IN_DELETE];
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[pair_size_2];
  ]);;
  (* }}} *)

let in_pair = 
prove_by_refinement(
  `!(a:A) b t. {a , b} t <=> (t = b) \/ (t = a)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INSERT];
  ]);;
  (* }}} *)

let pair_swap_select =
   jordan_def `pair_swap u (x:A) = @y. ~(x = y) /\ (u y)`;;

let pair_swap_pair = 
prove_by_refinement(
  `!(a:A) b. ~(a = b) ==>
       (pair_swap {a,b} a = b) /\ (pair_swap {a,b} b = a)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[pair_swap_select];
  REWRITE_TAC[in_pair];
  CONJ_TAC THEN SELECT_TAC THEN (ASM_MESON_TAC[]);
  ]);;
  (* }}} *)

let pair_swap = 
prove_by_refinement(
  `!u (x:A). (u HAS_SIZE 2)/\ (u x) ==>
         (~(pair_swap u x = x)) /\ (u (pair_swap u x))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[has_size2];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[];
  REWR 1;
  USE 1 (REWRITE_RULE[in_pair]);
  CONJ_TAC;
  ASM_MESON_TAC[pair_swap_pair];
  UND 1;
  DISCH_THEN (DISJ_CASES_TAC) THEN ASM_SIMP_TAC [pair_swap_pair] THEN REWRITE_TAC[INSERT];
  ]);;
  (* }}} *)

let pair_swap_invol = 
prove_by_refinement(
  `!u (x:A). (u HAS_SIZE 2) /\ (u x) ==>
       (pair_swap u (pair_swap u x) = x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[has_size2];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[];
  REWR 1;
  USE 1 (REWRITE_RULE[in_pair]);
  UND 1;
  DISCH_THEN (DISJ_CASES_TAC);
  ASM_SIMP_TAC [pair_swap_pair];
  ASM_SIMP_TAC [pair_swap_pair];
  ]);;
  (* }}} *)



(* ------------------------------------------------------------------ *)
(* SECTION C *)
(* ------------------------------------------------------------------ *)

(* ------------------------------------------------------------------ *)
(* rectagons *)
(* ------------------------------------------------------------------ *)

let rectagon = jordan_def `rectagon G <=>
  (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\
      (!m . ({0,2} (num_closure G (pointI m)))) /\
      (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\
        (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==>
        (S = G))`;;

let segment = jordan_def `segment G <=>
  (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\
      (!m . ({0,1,2} (num_closure G (pointI m)))) /\
      (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\
        (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==>
        (S = G))`;;

let psegment = jordan_def `psegment G <=>
   segment G /\ ~(rectagon G)`;;

let rectagon_segment = 
prove_by_refinement(
  `!G. (rectagon G ) ==> (segment G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment;rectagon;INSERT ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let endpoint = jordan_def `endpoint G m <=>
  (num_closure G (pointI m) = 1)`;;

let midpoint = jordan_def `midpoint G m <=>
  (num_closure G (pointI m) = 2)`;;

let psegment_endpoint = 
prove_by_refinement(
  `!G. (psegment G) ==> (?m. (endpoint G m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[psegment;rectagon;segment;endpoint];
  DISCH_ALL_TAC;
  UND 5;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  LEFT 5 "m";
  CHO 5;
  TSPEC `m` 3;
  USE 3 (REWRITE_RULE[INSERT]);
  USE 5 (REWRITE_RULE[INSERT]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let rectagon_endpoint = 
prove_by_refinement(
  `!G. (rectagon G) ==> ~(?m. (endpoint G m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectagon;endpoint;INSERT ];
  DISCH_ALL_TAC;
  CHO 0;
  ASM_MESON_TAC[ARITH_RULE `(~(1=2)) /\ ~(1=0)` ];
  ]);;
  (* }}} *)

let num_closure_mono = 
prove_by_refinement(
  `!G G' x. (FINITE G') /\ (G SUBSET G') ==>
       (num_closure G x <= num_closure G' x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[num_closure];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC CARD_SUBSET ;
  REWRITE_TAC[ISUBSET];
  CONJ_TAC;
  ASM_MESON_TAC[ISUBSET];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G'` EXISTS_TAC;
  ASM_REWRITE_TAC[ISUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let endpoint_psegment = 
prove_by_refinement(
  `!G. (?m. (endpoint G m)) /\ (segment G) ==> (psegment G)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC  [psegment;rectagon_endpoint];
  ]);;
  (* }}} *)

let num_closure_size = 
prove_by_refinement(
  `!G x. FINITE G ==>
     ({C | G C /\ closure top2 C x} HAS_SIZE (num_closure G x) )`,

  (* {{{ proof *)
  [
  REWRITE_TAC[HAS_SIZE;num_closure];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  REWRITE_TAC[ISUBSET];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let endpoint_edge = 
prove_by_refinement(
  `!G m.  (FINITE G) /\ (endpoint G m) ==> (?! e. (G e) /\
     (closure top2 e (pointI m)))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[endpoint;];
  DISCH_ALL_TAC;
  TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} HAS_SIZE 1` SUBGOAL_TAC;
  UND 1;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  IMATCH_MP_TAC  num_closure_size;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  USE 2 (MATCH_MP CARD_SING_CONV);
  USE 2 (REWRITE_RULE[SING]);
  CHO 2;
  USE 2 (REWRITE_RULE[eq_sing]);
  REWRITE_TAC[EXISTS_UNIQUE_ALT];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let midpoint_edge = 
prove_by_refinement(
  `!G m. (FINITE G) /\ (midpoint G m) ==>
     {C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[midpoint;];
  DISCH_ALL_TAC;
  UND 1;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  IMATCH_MP_TAC  num_closure_size;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let two_endpoint = 
prove_by_refinement(
  `!e. (edge e) ==> ({ m | (closure top2 e (pointI m)) } HAS_SIZE 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  DISCH_ALL_TAC;
  CHO 0;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[v_edge_closure;h_edge_closure];
  REWRITE_TAC[vc_edge;UNION;has_size2];
  TYPE_THEN `m` EXISTS_TAC;
  TYPE_THEN `(FST m,SND m +: (&:1))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INR IN_SING ;];
  TYPE_THEN `euclid_plus (pointI m) e2 = pointI (FST m,SND m +: (&:1))` SUBGOAL_TAC ;
  REWRITE_TAC[pointI;e2;point_add;int_suc ];
  REDUCE_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[v_edge_pointI;pointI_inj;];
  REWRITE_TAC[INSERT];
  MESON_TAC[];
  REWRITE_TAC[PAIR_SPLIT];
  INT_ARITH_TAC;
  (* 2nd case: *)
  ASM_REWRITE_TAC[v_edge_closure;h_edge_closure];
  REWRITE_TAC[hc_edge;UNION;has_size2];
  TYPE_THEN `m` EXISTS_TAC;
  TYPE_THEN `(FST m +: (&:1),SND m )` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INR IN_SING ;];
  TYPE_THEN `euclid_plus (pointI m) e1 = pointI (FST m +: (&:1),SND m )` SUBGOAL_TAC ;
  REWRITE_TAC[pointI;e1;point_add;int_suc ];
  REDUCE_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[h_edge_pointI;pointI_inj;];
  REWRITE_TAC[INSERT];
  MESON_TAC[];
  REWRITE_TAC[PAIR_SPLIT];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let edge_midend = 
prove_by_refinement(
  `!G e m. (segment G) /\ (G e) /\ (closure top2 e (pointI m)) ==>
      (midpoint G m) \/ (endpoint G m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment;midpoint;endpoint];
  DISCH_ALL_TAC;
  TSPEC `m` 3;
  USE 3 (REWRITE_RULE[INSERT]);
  TYPE_THEN `~(num_closure G (pointI m) = 0)` SUBGOAL_TAC;
  USE 0 (MATCH_MP num_closure_size);
  TSPEC `pointI m` 0;
  PROOF_BY_CONTR_TAC;
  REWR 7;
  REWR 0;
  USE 0(REWRITE_RULE[HAS_SIZE_0]);
  UND 0;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 3;
  ARITH_TAC;
  ]);;
  (* }}} *)

let plus_e12 = 
prove_by_refinement(
  `!m. ((pointI m) + e2 = pointI (FST m,SND m +: (&:1))) /\
      ((pointI m) + e1 = pointI (FST m +: (&:1),SND m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[e1;e2];
  REWRITE_TAC[pointI;point_add;int_suc];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let c_edge_euclid = 
prove_by_refinement(
  `!e. (edge e) ==> (closure top2 e) SUBSET (euclid 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  GEN_TAC;
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[hc_edge;vc_edge;h_edge_closure;v_edge_closure;union_subset;plus_e12] THEN MESON_TAC[cell_rules; cell_euclid];
  ]);;
  (* }}} *)

(* slow proof... *)
let inter_lattice = 
prove_by_refinement(
  `!x e e'. (edge e) /\ (edge e') /\ (~(e=e')) /\
    ((closure top2 e INTER closure top2 e') x) ==>
       (?m. x = pointI m)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `euclid 2 x` SUBGOAL_TAC;
  USE 3 (REWRITE_RULE[INTER]);
  AND 3;
  USE 0 (MATCH_MP c_edge_euclid);
  USE 0 (REWRITE_RULE[ISUBSET]);
  ASM_MESON_TAC[];
  DISCH_THEN (MP_TAC o (MATCH_MP point_onto));
  DISCH_TAC;
  CHO 4;
  ASM_REWRITE_TAC[];
  ASSUME_TAC square_domain;
  TSPEC `p` 5;
  USE 5 (CONV_RULE (NAME_CONFLICT_CONV));
  UND 5;
  LET_TAC ;
  REWRITE_TAC[UNION];
  UND 3;
  ASM_REWRITE_TAC[INTER];
  KILL 4;
  UND 2;
  UND 0;
  REWRITE_TAC[edge] ;
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  UND 1;
  REWRITE_TAC[edge] ;
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  REP_CASES_TAC THEN UNDISCH_FIND_TAC `(~)` THEN UNDISCH_FIND_TAC `(closure)` THEN  UNDISCH_FIND_TAC `(point p)` THEN ASM_REWRITE_TAC[] THEN (REWRITE_TAC[INR IN_SING;h_edge_closure;v_edge_closure;UNION;vc_edge;hc_edge;plus_e12 ]) THEN
  (* 1st,2nd,3rd, *)
  (* tx *)
  (let tx = REWRITE_RULE[EQ_EMPTY;INTER ] in  MESON_TAC[tx hv_edge;tx v_edge_disj;tx h_edge_disj;tx square_v_edge;tx square_h_edge;v_edge_inj;h_edge_inj]);
  ]);;
  (* }}} *)

let edgec_convex = 
prove_by_refinement(
  `!e. (edge e) ==> (convex (closure top2 e))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[v_edge_closure;h_edge_closure;hc_edge_convex;vc_edge_convex];
  ]);;
  (* }}} *)

let midpoint_h_edge = 
prove_by_refinement(
  `!m. (h_edge m) (((&.1)/(&.2))*# (pointI m) +
         ((&.1)/(&.2))*# (pointI m + e1))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[plus_e12];
  REWRITE_TAC[h_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc];
  GEN_TAC;
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC;
  TYPE_THEN `b = real_of_int(FST  m)` ABBREV_TAC;
  CONJ_TAC;
  real_poly_tac ;
  CONJ_TAC;
  ineq_lt_tac `b + (&.1/(&.2)) = &1 / &2 * b + &1 / &2 * (b + &1)`;
  ineq_lt_tac `((&1 / &2) * b + &1 / &2 * (b + &1)) + (&1 / &2) = b +. &1`
  ]);;
  (* }}} *)

let midpoint_v_edge = 
prove_by_refinement(
  `!m. (v_edge m) (((&.1)/(&.2))*# (pointI m) +
         ((&.1)/(&.2))*# (pointI m + e2))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[plus_e12];
  REWRITE_TAC[v_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc];
  GEN_TAC;
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC;
  TYPE_THEN `b = real_of_int(FST  m)` ABBREV_TAC;
  CONJ_TAC;
  real_poly_tac ;
  CONJ_TAC;
  ineq_lt_tac `a +. (&1/ &2)= &1 / &2 * a + &1 / &2 * (a + &1)`;
  ineq_lt_tac `(&1 / &2 * a + &1 / &2 * (a + &1)) +(&1/ &2) =  a + &1`;
  ]);;
  (* }}} *)

let midpoint_unique = 
prove_by_refinement(
  `!x y e e'. (edge e) /\ (edge e') /\ (~(e = e')) /\
    ((closure top2 e INTER closure top2 e') x) /\
    ((closure top2 e INTER closure top2 e') y) ==>
    ( x = y)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `convex (closure top2 e INTER closure top2 e')` SUBGOAL_TAC;
  IMATCH_MP_TAC  convex_inter ;
  ASM_MESON_TAC[edgec_convex];
  TYPE_THEN `(?m. x = pointI m) /\ (?n. y = pointI n)` SUBGOAL_TAC;
  ASM_MESON_TAC[inter_lattice];
  DISCH_ALL_TAC;
  CHO 6;
  CHO 7;
  ASM_REWRITE_TAC[];
  REWR 3;
  REWR 4;
  KILL 6;
  KILL 7;
  TYPE_THEN `(closure top2 e (pointI n)) /\ closure top2 e (pointI m)` SUBGOAL_TAC;
  UND 4;
  UND 3;
  REWRITE_TAC[INTER];
  MESON_TAC[];
  DISCH_ALL_TAC;
  WITH 0 (MATCH_MP edgec_convex);
  UND 6;
  USE 0 (REWRITE_RULE[edge]);
  CHO 0;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[];
  (* ml -- start of 1st main branch. *)
  DISCH_ALL_TAC;
  TYPE_THEN `((n = m') \/ (n = (FST m',SND m' + &:1))) /\ ((m = m') \/ (m = (FST m',SND m' + &:1)))` SUBGOAL_TAC;
  UND 6;
  UND 7;
  ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI];
  MESON_TAC[];
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  TYPE_THEN  `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC;
  (* start A*)
  TYPE_THEN `X (pointI m') /\ X (pointI m' + e2) ==> ~(X INTER (v_edge m') = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  USE 5 (REWRITE_RULE[convex;mk_segment]);
  DISCH_TAC ;
  H_MATCH_MP (HYP "5") (HYP "10");
  USE 11 (REWRITE_RULE[ISUBSET]);
  TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e2)` ABBREV_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  TSPEC `b` 11;
  CONJ_TAC;
  UND 11;
  DISCH_THEN IMATCH_MP_TAC  ;
  TYPE_THEN `&1/ &2` EXISTS_TAC;
  CONV_TAC REAL_RAT_REDUCE_CONV;
  EXPAND_TAC "b";
  MESON_TAC[];
  EXPAND_TAC "b";
  MATCH_ACCEPT_TAC midpoint_v_edge; (* end of goal A *)
  REWRITE_TAC[plus_e12];
  (* start  B*)
  TYPE_THEN `X INTER (v_edge m') = EMPTY ` SUBGOAL_TAC;
  REWRITE_TAC[EQ_EMPTY];
  DISCH_ALL_TAC;
  USE 10 (REWRITE_RULE[INTER]);
  TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC;
  ASM_MESON_TAC[inter_lattice;edge];
  DISCH_TAC;
  CHO 11;
  REWR 10;
  ASM_MESON_TAC[v_edge_pointI];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  REP_CASES_TAC THEN ASM_MESON_TAC[];
  (* end of FIRST main branch  -- snd main branch -- fully parallel *)
  DISCH_ALL_TAC;
  TYPE_THEN `((n = m') \/ (n = (FST m' + &:1,SND m'))) /\ ((m = m') \/ (m = (FST m' + &:1,SND m' )))` SUBGOAL_TAC;
  UND 6;
  UND 7;
  ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI];
  MESON_TAC[];
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  TYPE_THEN  `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC;
  (* start A'  *)
  TYPE_THEN `X (pointI m') /\ X (pointI m' + e1) ==> ~(X INTER (h_edge m') = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  USE 5 (REWRITE_RULE[convex;mk_segment]);
  DISCH_TAC ;
  H_MATCH_MP (HYP "5") (HYP "10");
  USE 11 (REWRITE_RULE[ISUBSET]);
  TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e1)` ABBREV_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  TSPEC `b` 11;
  CONJ_TAC;
  UND 11;
  DISCH_THEN IMATCH_MP_TAC  ;
  TYPE_THEN `&1/ &2` EXISTS_TAC;
  CONV_TAC REAL_RAT_REDUCE_CONV;
  EXPAND_TAC "b";
  MESON_TAC[];
  EXPAND_TAC "b";
  MATCH_ACCEPT_TAC midpoint_h_edge; (* end of goal A' *)
  REWRITE_TAC[plus_e12];
  (* start  B' *)
  TYPE_THEN `X INTER (h_edge m') = EMPTY ` SUBGOAL_TAC;
  REWRITE_TAC[EQ_EMPTY];
  DISCH_ALL_TAC;
  USE 10 (REWRITE_RULE[INTER]);
  TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC;
  ASM_MESON_TAC[inter_lattice;edge];
  DISCH_TAC;
  CHO 11;
  REWR 10;
  ASM_MESON_TAC[h_edge_pointI];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  REP_CASES_TAC  THEN ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let edge_inter = 
prove_by_refinement(
  `!C C'. (edge C) /\ (edge C') /\ (adj C C')  ==>
      (?m. (closure top2 C) INTER (closure top2 C') = {(pointI m)}) `,

  (* {{{ proof *)

  [
  REWRITE_TAC[adj];
  DISCH_ALL_TAC;
  USE 3 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 3;
  TYPE_THEN `(?m. u = pointI m)` SUBGOAL_TAC;
  ASM_MESON_TAC[inter_lattice];
  DISCH_THEN (CHOOSE_TAC);
  REWR 3;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC [eq_sing];
  ASM_MESON_TAC[midpoint_unique];
  ]);;
  (* }}} *)

let inter_midpoint = 
prove_by_refinement(
  `!G C C' m. (segment G) /\ (G C) /\ (G C') /\ (adj C C') /\
      (((closure top2 C) INTER (closure top2 C')) (pointI m)) ==>
    (midpoint G m) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[midpoint;segment];
  DISCH_ALL_TAC;
  TSPEC `m` 3;
  USE 3 (REWRITE_RULE[INSERT]);
  UND 3;
  USE 0 (MATCH_MP num_closure_size);
  TSPEC `pointI m` 0;
  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ;
  TYPE_THEN `X C /\ X C'` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  UND 8;
  REWRITE_TAC[INTER]; (* done WITH subgoal *)
  DISCH_TAC;
  TYPE_THEN `~(C = C')` SUBGOAL_TAC;
  ASM_MESON_TAC[adj];
  DISCH_TAC;
  REP_CASES_TAC;
  ASM_REWRITE_TAC[];
  REWR 0;
  USE 0 (MATCH_MP CARD_SING_CONV);
  USE 0 (REWRITE_RULE[SING;eq_sing]);
  ASM_MESON_TAC[];
  REWR 0;
  USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let mid_end_disj = 
prove_by_refinement(
  `!G m. ~(endpoint G m /\ midpoint G m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[endpoint;midpoint];
  ASM_MESON_TAC[ARITH_RULE `~(1=2)`];
  ]);;
  (* }}} *)

let two_exclusion  = 
prove_by_refinement(
  `!X p q (r:A). (X HAS_SIZE 2) /\ (X p) /\ (X q) /\ (X r) /\ (~(p = r))
    /\ (~(q = r)) ==> (p = q)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[has_size2;];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  UND 1;
  UND 2;
  UND 3;
  ASM_REWRITE_TAC[INSERT];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let midpoint_exists = 
prove_by_refinement(
  `!G e. (segment G) /\ (G e) /\ (~(G = {e})) ==>
      (?m. (closure top2 e (pointI m)) /\ (midpoint G m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `!m. (closure top2 e (pointI m)) ==> (endpoint G m)` SUBGOAL_TAC;
  ASM_MESON_TAC[edge_midend];
  DISCH_TAC;
  UND 2;
  REWRITE_TAC[];
  UND 0;
  REWRITE_TAC[segment];
  DISCH_ALL_TAC;
  TSPEC `{e}` 7;
  UND 7;
  DISCH_THEN (IMATCH_MP_TAC  o GSYM);
  ASM_REWRITE_TAC[ISUBSET;INR IN_SING;];
  CONJ_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC [eq_sing];
  DISCH_ALL_TAC;
  TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 C') = {(pointI m)})` SUBGOAL_TAC;
  IMATCH_MP_TAC  edge_inter;
  ASM_MESON_TAC[ISUBSET];
  DISCH_THEN CHOOSE_TAC;
  TSPEC `m` 4;
  TYPE_THEN `endpoint G m` SUBGOAL_TAC;
  UND 4;
  DISCH_THEN IMATCH_MP_TAC ;
  UND 10;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  REWRITE_TAC[endpoint];
  USE 0 (MATCH_MP num_closure_size);
  TSPEC `(pointI m)` 0;
  DISCH_TAC;
  REWR 0;
  USE 0 (MATCH_MP CARD_SING_CONV);
  USE 0 (REWRITE_RULE[SING]);
  CHO 0;
  USE 0 (REWRITE_RULE[eq_sing]);
  USE 10 (REWRITE_RULE[eq_sing]);
  USE 10 (REWRITE_RULE[INTER]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let pair_swap_unique = 
prove_by_refinement(
  `!u x (y:A). (u HAS_SIZE 2) /\ (u x) /\ (u y) /\ ~(x = y) ==>
    (y = pair_swap u x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  two_exclusion ;
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[pair_swap];
  ]);;
  (* }}} *)

let pair_swap_adj = 
prove_by_refinement(
  `!G e m e'. (segment G) /\ (G e) /\ (midpoint G m) /\
     (closure top2 e (pointI m)) /\
     (e' = pair_swap {C | G C /\ closure top2 C (pointI m)} e) ==>
     ({C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2) /\
             G e' /\ adj e' e /\ (closure top2 e' (pointI m)) `,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
  USE 3 (REWRITE_RULE[midpoint]);
  USE 1 (REWRITE_RULE[segment]);
  UND 1;
  DISCH_ALL_TAC;
  USE 1 (MATCH_MP num_closure_size);
  TSPEC `pointI m` 1;
  REWR 1;
  DISCH_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `X e` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (*  SUBCONJ_TAC; *)
  TYPE_THEN `X e'` SUBGOAL_TAC;
  ASM_MESON_TAC[pair_swap];
  DISCH_TAC;
  SUBCONJ_TAC;
  UND 8;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  MESON_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  SUBCONJ_TAC;
  UND 8;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  MESON_TAC[];
  ASM_REWRITE_TAC[adj];
  ASM_SIMP_TAC[pair_swap];
  REWRITE_TAC[EMPTY_EXISTS];
  ASM_REWRITE_TAC[INTER];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)


(*
   A terminal edge is expressed as
   (endpoint G m) /\ (closure top2 e (pointI m))
*)

let terminal_edge_adj = 
prove_by_refinement(
  `!G e m. (segment G) /\ (G e) /\ (~(G = {e})) /\
     (endpoint G m) /\ (closure top2 e (pointI m))
     ==>
       (?! e'. (G e') /\ (adj e e')) `,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  DISCH_ALL_TAC;
  REWRITE_TAC[EXISTS_UNIQUE_ALT ];
  TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  midpoint_exists;
  ASM_REWRITE_TAC[];
  DISCH_THEN CHOOSE_TAC;
  AND 5;
  COPY 5;
  USE 5 (REWRITE_RULE[midpoint]);
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  USE 8 (MATCH_MP num_closure_size);
  TSPEC `pointI m'` 8;
  REWR 8;
  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m')}` ABBREV_TAC;
  TYPE_THEN `X e` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `pair_swap X e` EXISTS_TAC;
  GEN_TAC;

  EQ_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 y) = {(pointI m)}) ` SUBGOAL_TAC;
  IMATCH_MP_TAC  edge_inter;
  ASM_MESON_TAC[segment;ISUBSET;];
  DISCH_THEN CHOOSE_TAC;
  (* show m''=m', then X y, then y != e, then it is the PAIR swap *)
  TYPE_THEN `ec = (closure top2 e)` ABBREV_TAC;
  TYPE_THEN `ec (pointI m'')` SUBGOAL_TAC;
  UND 13;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `m'' = m'` SUBGOAL_TAC;
  TYPE_THEN `Z = {m | ec (pointI m)}` ABBREV_TAC;
  IMATCH_MP_TAC  two_exclusion;
  TYPE_THEN `Z` EXISTS_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  CONJ_TAC;
  EXPAND_TAC "Z";
  EXPAND_TAC "ec";
  IMATCH_MP_TAC  two_endpoint;
  ASM_MESON_TAC[segment;ISUBSET];
  EXPAND_TAC "Z";
  ASM_REWRITE_TAC[];
  TYPE_THEN `midpoint G m''` SUBGOAL_TAC ;
  IMATCH_MP_TAC  inter_midpoint;
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `y` EXISTS_TAC;
  ASM_REWRITE_TAC[INR IN_SING ];
  ASM_MESON_TAC[mid_end_disj]; (* m'' = m' done *)
  DISCH_TAC;
  TYPE_THEN `X y` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  USE 13 (REWRITE_RULE[INTER;eq_sing]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(y = e)` SUBGOAL_TAC;
  UND 12;
  MESON_TAC[adj];
  DISCH_TAC;
  IMATCH_MP_TAC  (GSYM pair_swap_unique);
  ASM_REWRITE_TAC[];
  (* now second direction nsd *)
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  ASSUME_TAC pair_swap_adj;
  TYPEL_THEN [`G`;`e`;`m'`;`pair_swap X e`] (USE 11 o ISPECL);
  UND 11;
  ASM_REWRITE_TAC[];
  TYPE_THEN `X (pair_swap X e)` SUBGOAL_TAC;
  ASM_MESON_TAC[pair_swap];
  DISCH_TAC;
  TYPE_THEN `closure top2 (pair_swap X e) (pointI m')` SUBGOAL_TAC;
  UND 11;
  TYPE_THEN  `e'' = pair_swap X e` ABBREV_TAC ;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  MESON_TAC[];
  ASM_MESON_TAC[adj_symm];
  ]);;
  (* }}} *)

let psegment_edge = 
prove_by_refinement(
  `!e. (edge e) ==> (psegment {e})`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  endpoint_psegment;
  ASM_REWRITE_TAC[endpoint;segment;EQ_EMPTY ;INR IN_SING;FINITE_SING;ISUBSET;num_closure];
  CONJ_TAC;
  UND 0;
  REWRITE_TAC[edge];
  DISCH_TAC ;
  CHO 0;
  TYPE_THEN `m` EXISTS_TAC;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  CARD_SING;
  REWRITE_TAC[SING];
  TYPE_THEN `v_edge m` EXISTS_TAC;
  REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ];
  MESON_TAC[];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  CARD_SING;
  REWRITE_TAC[SING];
  TYPE_THEN `h_edge m` EXISTS_TAC;
  REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ];
  MESON_TAC[];
  CONJ_TAC;
  MESON_TAC[];
  CONJ_TAC ;
  ASM_MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[INSERT];
  GEN_TAC;
  TYPE_THEN `closure top2 e (pointI m)`  ASM_CASES_TAC ;
  DISJ1_TAC THEN DISJ2_TAC ;
  IMATCH_MP_TAC  CARD_SING;
  REWRITE_TAC[SING ;eq_sing];
  ASM_MESON_TAC[];
  DISJ2_TAC ;
  TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI m)} = {}` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 2;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[CARD_CLAUSES];
  DISCH_ALL_TAC;
  REWRITE_TAC[eq_sing];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_delete = 
prove_by_refinement(
  `!G e m. (segment G) /\ (endpoint G m) /\
        (closure top2 e (pointI m)) /\ (~(G = {e}))
                ==> (segment (G DELETE e))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  TYPE_THEN `~G e` ASM_CASES_TAC;
  USE 0 (REWRITE_RULE[INR DELETE_NON_ELEMENT]);
  ASM_MESON_TAC[];
  REWRITE_TAC[segment];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[FINITE_DELETE;delete_empty];
  CONJ_TAC;
  UND 3;
  MESON_TAC[ISUBSET ;INR IN_DELETE];
  CONJ_TAC;
  GEN_TAC;
  REWRITE_TAC[INSERT];
  TYPE_THEN `num_closure (G DELETE e) (pointI m')  <=| (num_closure G (pointI m'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  num_closure_mono;
  ASM_REWRITE_TAC[INR IN_DELETE;ISUBSET];
  MESON_TAC[];
  TSPEC `m'` 4;
  USE 4 (REWRITE_RULE[INSERT]);
  UND 4;
  ARITH_TAC;
  DISCH_ALL_TAC;
  (* tsh1 *)
  TYPE_THEN `(?! e'. (G e') /\ (adj e e'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  terminal_edge_adj;
  REWRITE_TAC[segment];
  TYPE_THEN `m` EXISTS_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[EXISTS_UNIQUE_ALT];
  DISCH_THEN CHOOSE_TAC;
  (* tsh2 *)
  TYPE_THEN `(e INSERT S = G) ==> (S = G DELETE e)` SUBGOAL_TAC;
  UND 9;
  IMATCH_MP_TAC  (TAUT `(a ==> b ==> C) ==> (b ==> a ==> C)`);
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  REWRITE_TAC[DELETE_INSERT];
  REWRITE_TAC[DELETE;ISUBSET;];
  DISCH_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  UND 9;
  MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  (* tsh3 *)
  TYPE_THEN `S e'` ASM_CASES_TAC;
  TSPEC `e INSERT S` 5;
  UND 5;
  DISCH_THEN IMATCH_MP_TAC ;
  REWR 0;
  ASM_REWRITE_TAC [INR INSERT_SUBSET;NOT_INSERT_EMPTY];
  CONJ_TAC;
  UND 9;
  MESON_TAC[ISUBSET;INR IN_DELETE];
  DISCH_ALL_TAC;
  TSPEC `C` 11;
  TSPEC `C'` 11;
  REWR 11; (* ok to here *)
  (* oth1 *)
  TYPE_THEN `C' = e` ASM_CASES_TAC;
  ASM_REWRITE_TAC[INSERT];
  ASM_REWRITE_TAC[INSERT]; (* *)
  (* UND 12; *)
  TYPE_THEN `C = e` ASM_CASES_TAC;
  REWR 15;
  TSPEC `C'` 12;
  REWR 12;
  ASM_MESON_TAC[];
  (* start not not -- *)
  UND 11;
  DISCH_THEN IMATCH_MP_TAC ;
  CONJ_TAC;
  UND 5;
  REWRITE_TAC[INSERT];
  ASM_MESON_TAC[];
  UND 14;
  REWRITE_TAC[DELETE];
  ASM_MESON_TAC[];
  (* LAST case *)
  TSPEC `S` 5;
  TYPE_THEN `S = G` SUBGOAL_TAC;
  UND 5;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  UND 9;
  REWRITE_TAC[DELETE;ISUBSET];
  MESON_TAC[];
  DISCH_TAC;
  DISCH_ALL_TAC;
  TYPEL_THEN [`C`;`C'`] (USE 11 o ISPECL);
  UND 11;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[DELETE];
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  TSPEC `C` 12;
  TYPE_THEN `G C /\ adj e C` SUBGOAL_TAC;
  ASM_MESON_TAC[adj_symm;ISUBSET];
  DISCH_TAC;
  REWR 12;
  ASM_MESON_TAC[];
  TSPEC `e'` 12;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let other_end = jordan_def `other_end e m =
  pair_swap {m | closure top2 e (pointI m)} m`;;

let other_end_prop = 
prove_by_refinement(
  `!e m. (edge e) /\ (closure top2 e (pointI m))==>
   (closure top2 e (pointI (other_end e m))) /\
      (~(other_end e m = m)) /\
      (other_end e (other_end e m) = m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[other_end];
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP two_endpoint);
  TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC;
  TYPE_THEN `X m` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC [];
  DISCH_TAC;
  ASM_SIMP_TAC[pair_swap_invol;pair_swap];
  TYPE_THEN `X (pair_swap X m)` SUBGOAL_TAC ;
  ASM_SIMP_TAC[pair_swap];
  EXPAND_TAC "X";
  REWRITE_TAC[];
  ]);;
  (* }}} *)

let num_closure_delete = 
prove_by_refinement(
  `!G e p. (FINITE G) ==> ((num_closure (G DELETE e) p) =
    (if ((G e) /\ (closure top2 e p)) then ((num_closure G p) -| 1)
       else (num_closure G p)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  COND_CASES_TAC;
  REWRITE_TAC[num_closure];
  TYPE_THEN `{C | (G DELETE e) C /\ closure top2 C p} = {C | G C /\ closure top2 C p} DELETE e` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[DELETE ];
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `FINITE {C | G C /\ closure top2 C p}` SUBGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[ISUBSET;];
  MESON_TAC[];
  DISCH_TAC;
  USE 2 (MATCH_MP CARD_DELETE);
  TSPEC `e` 2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[num_closure;DELETE ];
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  GEN_TAC;
  TYPE_THEN `x = e` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let psegment_delete_end = 
prove_by_refinement(
  `!G m e. (psegment G) /\ (endpoint G m) /\ (G e) /\
        (closure top2 e (pointI m)) /\ (~(G = {e})) ==>
     (endpoint (G DELETE e) =
       (((other_end e m) INSERT (endpoint G)) DELETE m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[psegment;segment];
  DISCH_TAC;
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[psegment;segment;ISUBSET];
  DISCH_TAC;
  TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC;
  TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
  EXPAND_TAC "X";
  IMATCH_MP_TAC  two_endpoint;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[endpoint;ISUBSET;INSERT;];
  GEN_TAC;
  ASM_SIMP_TAC[num_closure_delete];
  REWRITE_TAC[DELETE];
  TYPE_THEN `x = m` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  USE 1 (REWRITE_RULE[endpoint]);
  ASM_REWRITE_TAC[];
  ARITH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `x = other_end e m` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  COND_CASES_TAC;
  DISCH_TAC;
  TYPE_THEN `X x /\ X m /\ X (other_end e m) /\ (~(m= other_end e m))` SUBGOAL_TAC ;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[other_end_prop];
  DISCH_ALL_TAC;
  ASM_MESON_TAC[two_exclusion];
  MESON_TAC[];
  (* snd half *)
  REWRITE_TAC[SUBSET;endpoint;DELETE_INSERT];
  ASM_SIMP_TAC[other_end_prop];
  ASM_SIMP_TAC[num_closure_delete];
  REWRITE_TAC[INSERT;DELETE ];
  GEN_TAC;
  TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
  ASM_MESON_TAC[psegment;midpoint_exists];
  DISCH_THEN CHOOSE_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  (* ---m *)
  COND_CASES_TAC;
  TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m' = m)) /\ (~(x = m'))` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[mid_end_disj];
  ASM_MESON_TAC[two_exclusion];
  USE 10 (REWRITE_RULE[endpoint]);
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[other_end_prop];
  TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m = m'))` SUBGOAL_TAC;
   EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[other_end_prop];
  ASM_MESON_TAC[mid_end_disj];
  DISCH_TAC;
  TYPE_THEN `x = m'` SUBGOAL_TAC;
  ASM_MESON_TAC[two_exclusion];
  USE 9 (REWRITE_RULE[midpoint]);
  ASM_MESON_TAC[ARITH_RULE `(x = 2) ==> (x -| 1 = 1)`];
  ]);;
  (* }}} *)

let endpoint_size2 = 
prove_by_refinement(
  `!G. (psegment G) ==> (endpoint G HAS_SIZE 2)`,

  (* {{{ proof *)
  [
  TYPE_THEN `(!n G. (psegment G) /\ (G HAS_SIZE n) ==> (endpoint G HAS_SIZE 2)) ==> (!G. (psegment G) ==> endpoint G HAS_SIZE 2)` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `?n. G HAS_SIZE n` SUBGOAL_TAC;
  REWRITE_TAC[HAS_SIZE];
  CONV_TAC (dropq_conv "n");
  ASM_MESON_TAC[psegment;segment];
  DISCH_THEN CHOOSE_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  INDUCT_TAC;
  REWRITE_TAC[psegment;segment];
  ASM_MESON_TAC[HAS_SIZE_0];
  DISCH_ALL_TAC;
  TYPE_THEN `(?m. (endpoint G m))` SUBGOAL_TAC;
  ASM_SIMP_TAC[psegment_endpoint];
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC ;
  ASM_MESON_TAC[psegment;segment];
  DISCH_TAC;
  TYPE_THEN `?e. (G e /\ closure top2 e (pointI m))` SUBGOAL_TAC;
  USE 3 (REWRITE_RULE[endpoint]);
  USE 4 (MATCH_MP num_closure_size);
  TSPEC `(pointI m)` 4;
  REWR 4;
  USE 4 (MATCH_MP CARD_SING_CONV);
  USE 4(REWRITE_RULE[SING]);
  CHO 4;
  USE 4 (REWRITE_RULE[eq_sing]);
  ASM_MESON_TAC[];
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `G = {e}` ASM_CASES_TAC;
  TYPE_THEN `endpoint G = { m | closure top2 e (pointI m)}` SUBGOAL_TAC;
  MATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[endpoint];
  USE 4 (MATCH_MP num_closure_size );
  GEN_TAC;
  TSPEC `pointI x` 4;
  REWR 4;
  USE 4 (REWRITE_RULE[INR IN_SING]);
  EQ_TAC;
  DISCH_TAC;
  REWR 4;
  USE 4 (MATCH_MP CARD_SING_CONV);
  USE 4(REWRITE_RULE[SING;eq_sing]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI x)} ={e}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING ];
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 4;
  USE 4 (REWRITE_RULE[HAS_SIZE]);
  ASM_MESON_TAC[CARD_SING;SING];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  two_endpoint;
  ASM_MESON_TAC[psegment;segment;ISUBSET];
  (*pm*)
  (* main case *)
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[psegment;segment;ISUBSET];
  DISCH_TAC;
  TSPEC `G DELETE e` 0;
  TYPE_THEN `psegment (G DELETE e) /\ G DELETE e HAS_SIZE n` SUBGOAL_TAC;
  CONJ_TAC;
  REWRITE_TAC[psegment];
  CONJ_TAC;
  IMATCH_MP_TAC  segment_delete;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[psegment];
  ASM_MESON_TAC[psegment];
  (* it isn't a rectagon if it has an endpoint *)
  TYPE_THEN `(endpoint (G DELETE e) (other_end e m)) ` SUBGOAL_TAC;
  ASM_SIMP_TAC[psegment_delete_end];
  REWRITE_TAC[DELETE_INSERT];
  COND_CASES_TAC;
  ASM_MESON_TAC[other_end_prop];
  REWRITE_TAC[INSERT];
  ASM_MESON_TAC[rectagon_endpoint];
  UND 2;
  REWRITE_TAC[HAS_SIZE];
  ASM_MESON_TAC[SUC_INJ;FINITE_DELETE_IMP;CARD_SUC_DELETE];
  DISCH_TAC;
  REWR 0;
  UND 0;
  ASM_SIMP_TAC[psegment_delete_end];
  DISCH_TAC;
  TYPE_THEN `G' = (other_end e m INSERT endpoint G)` ABBREV_TAC;
  TYPE_THEN `G' HAS_SIZE 3` SUBGOAL_TAC;
  UND 0;
  REWRITE_TAC[HAS_SIZE;ARITH_RULE `3 = SUC 2`;FINITE_DELETE];
  TYPE_THEN `G' m` SUBGOAL_TAC;
  EXPAND_TAC "G'";
  KILL 9;
  ASM_REWRITE_TAC [INSERT];
  ASM_MESON_TAC[CARD_SUC_DELETE];
  (* nearly there! *)
  EXPAND_TAC "G'";
  REWRITE_TAC[HAS_SIZE;FINITE_INSERT];
  DISCH_ALL_TAC;
  UND 11;
  ASM_SIMP_TAC [CARD_CLAUSES];
  COND_CASES_TAC;
  TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  midpoint_exists;
  ASM_MESON_TAC[psegment];
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `X = { m | closure top2 e (pointI m) }` ABBREV_TAC;
  TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
  USE 7 (MATCH_MP two_endpoint);
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `X m /\ X m' /\ X (other_end e m) /\ (~(m=m')) /\ (~(m= other_end e m)) /\ (~(m'=other_end e m))` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[other_end_prop];
  ASM_MESON_TAC [mid_end_disj];
  ASM_MESON_TAC[two_exclusion];
  ARITH_TAC;
  ]);;
  (* }}} *)

let sing_has_size1 = 
prove_by_refinement(
  `!(x:A). {x} HAS_SIZE 1`,

  (* {{{ proof *)
  [
  REWRITE_TAC[HAS_SIZE];
  DISCH_ALL_TAC;
  CONJ_TAC;
  REWRITE_TAC[FINITE_SING ];
  ASM_MESON_TAC[CARD_SING;SING];
  ]);;
  (* }}} *)

let num_closure1 = 
prove_by_refinement(
  `!G x. (FINITE G) ==>
       ((num_closure G (x) = 1) <=>
          (?e. (!e'. (G e' /\ (closure top2 e' (x))) <=> (e = e'))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  COPY 0;
  USE 0 (MATCH_MP (num_closure_size));
  TSPEC `x` 0;
  TYPE_THEN `t = num_closure G x` ABBREV_TAC;
  EQ_TAC;
  DISCH_TAC;
  REWR 0;
  USE 0 (MATCH_MP CARD_SING_CONV);
  USE 0 (REWRITE_RULE[SING;eq_sing]);
  CHO 0;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  CHO 3;
  TYPE_THEN `{C | G C /\ closure top2 C x} = {e}` SUBGOAL_TAC;
  REWRITE_TAC[eq_sing];
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 0;
  TYPE_THEN `e` (fun t -> ASSUME_TAC (ISPEC t sing_has_size1));
  UND 5;
  UND 0;
  REWRITE_TAC [HAS_SIZE];
  MESON_TAC[];
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* SECTION D *)
(* ------------------------------------------------------------------ *)



let inductive_set = jordan_def `inductive_set G S <=>
   S SUBSET G /\
              ~(S = {}) /\
              (!C C'. S C /\ G C' /\ adj C C' ==> S C')`;;

let inductive_univ = 
prove_by_refinement(
  `!G. (~(G = EMPTY )) ==> (inductive_set G G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[inductive_set];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let inductive_inter = 
prove_by_refinement(
  `!T G. (T SUBSET G) /\ (~(T = EMPTY )) ==>
        (inductive_set G
            (INTERS {S | (T SUBSET S) /\ (inductive_set G S)}))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ONCE_REWRITE_TAC[inductive_set];
  CONJ_TAC;
  IMATCH_MP_TAC  INTERS_SUBSET2;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL];
  IMATCH_MP_TAC  inductive_univ;
  UND 1;
  REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[ISUBSET];
  CONJ_TAC;
  USE 1 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 1;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  REWRITE_TAC[INTERS];
  DISCH_ALL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_ALL_TAC;
  USE  2 (REWRITE_RULE[INTERS]);
  REWRITE_TAC[INTERS];
  DISCH_ALL_TAC;
  TSPEC `u` 2;
  REWR 2;
  ASM_MESON_TAC[inductive_set];
  ]);;
  (* }}} *)

let segment_of = jordan_def `segment_of G e =
   INTERS { S | S e /\ inductive_set G S }`;;

let inductive_segment = 
prove_by_refinement(
  `!G e. (G e) ==> (inductive_set G (segment_of G e))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[segment_of];
  ASSUME_TAC inductive_inter;
  TYPEL_THEN [`{e}`;`G`] (USE 1 o ISPECL);
  USE 1 (REWRITE_RULE[single_subset;EMPTY_EXISTS;INR IN_SING ]);
  UND 1;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_of_G = 
prove_by_refinement(
  `!G e. (G e) ==> (segment_of G e ) SUBSET G`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment_of];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  (INR INTERS_SUBSET2 );
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL];
  IMATCH_MP_TAC  inductive_univ;
  REWRITE_TAC [EMPTY_EXISTS];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_not_in = 
prove_by_refinement(
  `!G e. ~(G e) ==> (segment_of G e = UNIV)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment_of;];
  DISCH_ALL_TAC;
  TYPE_THEN `{S | S e /\ inductive_set G S} = EMPTY ` SUBGOAL_TAC ;
  REWRITE_TAC[EQ_EMPTY];
  GEN_TAC;
  REWRITE_TAC[inductive_set];
  ASM_MESON_TAC[ISUBSET];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let segment_of_finite = 
prove_by_refinement(
  `!G e. (FINITE G) /\ (G e) ==> (FINITE (segment_of G e))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  ASM_MESON_TAC[segment_of_G];
  ]);;
  (* }}} *)

let segment_of_in = 
prove_by_refinement(
  `!G e.  (segment_of G e e)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `G e` ASM_CASES_TAC;
  REWRITE_TAC[segment_of;INTERS;inductive_set ];
  MESON_TAC[];
  ASM_SIMP_TAC[segment_not_in];
  ]);;
  (* }}} *)

let segment_of_subset = 
prove_by_refinement(
  `!G e f. (G e) /\ (segment_of G e f) ==>
      (segment_of G f) SUBSET (segment_of G e)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ISUBSET;segment_of;INTERS ];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let inductive_diff = 
prove_by_refinement(
  `!G S S'. (inductive_set G S) /\
        (inductive_set G S') /\ ~(S DIFF S' = {}) ==>
        (inductive_set G (S DIFF S'))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[inductive_set;DIFF;SUBSET  ];
  ASM_MESON_TAC[adj_symm];
  ]);;
  (* }}} *)

(* sets *)
let subset_imp_eq = 
prove_by_refinement(
  `!A (B:A->bool). (A SUBSET B) /\ (B DIFF A = EMPTY) ==> (A = B)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;DIFF;EQ_EMPTY];
  MESON_TAC[EQ_EXT];
  ]);;
  (* }}} *)

let segment_of_eq = 
prove_by_refinement(
  `!G e f. (G e) /\ (segment_of G e f) ==>
      ((segment_of G e) = (segment_of G f))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  (GSYM subset_imp_eq);
  CONJ_TAC;
  ASM_MESON_TAC[segment_of_subset];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `G f` SUBGOAL_TAC;
  USE 0 (MATCH_MP segment_of_G);
  USE 0 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `X = (segment_of G e DIFF segment_of G f)` ABBREV_TAC;
  TYPE_THEN `X e` SUBGOAL_TAC;
  EXPAND_TAC "X";
  REWRITE_TAC[DIFF];
  ASM_SIMP_TAC [segment_of_in];
  DISCH_ALL_TAC;
  USE 2 (GSYM);
  USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 2;
  UND 2;
  EXPAND_TAC "X";
  REWRITE_TAC[DIFF];
  JOIN 3 5;
  USE 2 (MATCH_MP segment_of_subset);
  ASM_MESON_TAC[ISUBSET]; (* done WITH X e *)
  DISCH_TAC;
  TYPE_THEN `inductive_set G (segment_of G e DIFF segment_of G f)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  inductive_diff;
  ASM_SIMP_TAC[inductive_segment];
  DISCH_TAC;
  TYPE_THEN `segment_of G e SUBSET X` SUBGOAL_TAC;
  REWRITE_TAC[segment_of];
  IMATCH_MP_TAC  INTERS_SUBSET;
  REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET];
  LEFT_TAC "x";
  TYPE_THEN `f` EXISTS_TAC;
  EXPAND_TAC "X";
  REWRITE_TAC[DIFF];
  ASM_MESON_TAC[segment_of_in];
  ]);;
  (* }}} *)

let segment_of_segment = 
prove_by_refinement(
  `!G P e. (segment G) /\ (P SUBSET G) /\ (P e) ==>
      (segment (segment_of P e))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  TYPE_THEN `FINITE P` SUBGOAL_TAC;
  ASM_MESON_TAC[FINITE_SUBSET];
  DISCH_TAC;
  REWRITE_TAC[segment];
  ASM_SIMP_TAC[segment_of_finite;EMPTY_EXISTS];
  CONJ_TAC;
  ASM_MESON_TAC[segment_of_in];
  SUBCONJ_TAC;
  UND 1;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  MP_TAC  segment_of_G;
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASSUME_TAC segment_of_G;
  (* ok to here *)
  CONJ_TAC;
  GEN_TAC;
  REWRITE_TAC[INSERT];
  TYPEL_THEN [`P`;`e`] (USE 6 o ISPECL);
  REWR 6;
  JOIN 4 6;
  USE 4 (MATCH_MP num_closure_mono);
  TSPEC `pointI m` 4;
  UND 4;
  JOIN 3 1;
  USE 1 (MATCH_MP num_closure_mono);
  TSPEC `(pointI m)` 1;
  UND 1;
  UND 0;
  REWRITE_TAC[segment];
  REWRITE_TAC[INSERT];
  DISCH_ALL_TAC;
  TSPEC `m` 7;
  UND 7;
  UND 0;
  UND 1;
  ARITH_TAC;
  (* ok2 *)
  DISCH_ALL_TAC;
  CHO 8;
  (* IMATCH_MP_TAC  subset_imp_eq; *)
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  ASM_REWRITE_TAC[];
  (*   PROOF_BY_CONTR_TAC; *)
  TYPE_THEN `! C C'. S C /\ P C' /\ adj C C' ==> S C'` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `segment_of P C C'` SUBGOAL_TAC;
  REWRITE_TAC[segment_of;INTERS;];
  X_GEN_TAC `R:((num->real)->bool)->bool`;
  REWRITE_TAC[inductive_set];
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `segment_of P e = segment_of P C` SUBGOAL_TAC ;
  IMATCH_MP_TAC  segment_of_eq;
  ASM_MESON_TAC[ISUBSET];
  DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `inductive_set P S` SUBGOAL_TAC;
  REWRITE_TAC[inductive_set];
  ASM_REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[ISUBSET;segment_of_G];
  TYPE_THEN `segment_of P e = segment_of P u` SUBGOAL_TAC;
  IMATCH_MP_TAC  segment_of_eq;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[segment_of];
  DISCH_TAC;
  IMATCH_MP_TAC  (INR INTERS_SUBSET);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

(* move up *)
let rectagon_subset = 
prove_by_refinement(
  `!G S. (rectagon G) /\ (segment S) /\ (G SUBSET S) ==> (G = S)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[rectagon;segment];
  DISCH_ALL_TAC;
  TSPEC `G` 9;
  UND 9 ;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC;
  ASM_MESON_TAC[edge_inter];
  DISCH_TAC;
  CHO 14;
  (*loss*)
  COPY 10;
  COPY 5;
  JOIN 5 10;
  USE 5 (MATCH_MP num_closure_mono);
  TSPEC `pointI m` 5;
  TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC;
  TSPEC `m` 3;
  USE 3 (REWRITE_RULE[INSERT]);
  UND 3;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  UND 3;
  USE 0 (MATCH_MP num_closure_size);
  TSPEC  `(pointI m)` 0;
  DISCH_ALL_TAC;
  REWR 0;
  USE 0 (REWRITE_RULE[HAS_SIZE_0]);
  UND 0;
  REWRITE_TAC[EMPTY_EXISTS ];
  UND 14;
  REWRITE_TAC[INTER;eq_sing; ];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `num_closure S (pointI m) = 2` SUBGOAL_TAC;
  TSPEC `m` 8;
  USE 8(REWRITE_RULE[INSERT]);
  UND 8;
  TSPEC `m` 3;
  USE 3 (REWRITE_RULE[INSERT]);
  UND 3;
  UND 5;
  UND 10;
  ARITH_TAC;
  DISCH_TAC;
  (* ok  *)
  (* num_closure G = num_closure S, C' in latter, so in former *)
  TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} = {C | S C /\ closure top2 C (pointI m)}`  SUBGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET_LE;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `S` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET];
  MESON_TAC[];
  CONJ_TAC;
  UND 15;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  USE 0 (MATCH_MP num_closure_size);
  TSPEC `pointI m` 0;
  USE 16 (MATCH_MP num_closure_size);
  TSPEC `pointI m` 16;
  UND 16;
  UND 0;
  ASM_REWRITE_TAC [HAS_SIZE];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  ARITH_TAC;
  DISCH_TAC;
  TAPP `C'` 18;
  UND 18;
  ASM_REWRITE_TAC[];
  UND 14;
  REWRITE_TAC[INTER;eq_sing];
  MESON_TAC[];
  ]);;
  (* }}} *)

let rectagon_h_edge = 
prove_by_refinement(
  `!G. (rectagon G) ==> (?m. (G (h_edge m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `!e. G e ==> (?m. (e= (v_edge m))) ` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon;ISUBSET];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_THEN DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `X = {m | (G (v_edge m)) }` ABBREV_TAC;
  TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC;
  CONJ_TAC;
  TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (v_edge) C)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  finite_subset;
  REWRITE_TAC[IMAGE;SUBSET];
  EXPAND_TAC "X";
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  CONJ_TAC;
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[rectagon];
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_ALL_TAC;
  TYPE_THEN `C = X` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_ALL_TAC;
  UND 7;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  UND 6;
  REWRITE_TAC[IMAGE];
  DISCH_THEN_REWRITE ;
  DISCH_THEN CHOOSE_TAC;
  USE 6 (REWRITE_RULE[v_edge_inj;h_edge_inj]);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  USE 0 (REWRITE_RULE[rectagon]);
  UND 0;
  DISCH_ALL_TAC;
  USE 5(REWRITE_RULE[EMPTY_EXISTS]);
  CHO 5;
  TSPEC `u` 2;
  REWR 2;
  CHO 2;
  UND 0;
  EXPAND_TAC "X";
  REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* dwf done finite X ...  Messed up. X must have type real->bool. *)
  TYPE_THEN `Y = IMAGE (real_of_int o SND ) X` ABBREV_TAC;
  TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC;
  CONJ_TAC;
  EXPAND_TAC "Y";
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE;EMPTY_EXISTS ];
  CONV_TAC (dropq_conv "u");
  AND 4;
  USE 4 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 4;
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 6 (MATCH_MP min_finite);
  CHO 6;
  TYPE_THEN `?m. (G (v_edge m)) /\ (real_of_int (SND m) = delta)` SUBGOAL_TAC;
  USE 5 (REWRITE_RULE[IMAGE;o_DEF]);
  TAPP `delta` 5;
  REWR 5;
  CHO 5;
  TAPP `x` 3;
  REWR 3;
  ASM_MESON_TAC[];
  DISCH_TAC;
  CHO 7;
  (* now show that m is an endpoint *)
  TYPE_THEN `endpoint G m` SUBGOAL_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC;
  ASM_SIMP_TAC[num_closure1];
  TYPE_THEN `v_edge m` EXISTS_TAC;
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `edge e'` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon;ISUBSET];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[v_edge_inj];
  REWR 10;
  USE 10 (REWRITE_RULE[v_edge_closure;vc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; v_edge_pointI]);
  UND 10;
  DISCH_THEN   DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `  Y (real_of_int (SND m'))` SUBGOAL_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE];
  TYPE_THEN `m'` EXISTS_TAC;
  REWRITE_TAC[o_DEF];
  EXPAND_TAC "X";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  AND 6;
  TSPEC `(real_of_int(SND m'))` 6;
  REWR 6;
  USE 7 GSYM;
  REWR 6;
  USE 6 (REWRITE_RULE[int_suc ]);
  ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`];
  ASM_MESON_TAC[hv_edgeV2];
  DISCH_TAC;
  EXPAND_TAC "e'";
  ASM_REWRITE_TAC[];
  EXPAND_TAC "e'";
  REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING ;];
  ASM_MESON_TAC[rectagon_endpoint];
  ]);;
  (* }}} *)

let rectagon_v_edge = 
prove_by_refinement(
  `!G. (rectagon G) ==> (?m. (G (v_edge m)))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `!e. G e ==> (?m. (e= (h_edge m))) ` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon;ISUBSET];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_THEN DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `X = {m | (G (h_edge m)) }` ABBREV_TAC;
  TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC;
  CONJ_TAC;
  TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (h_edge) C)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  finite_subset;
  REWRITE_TAC[IMAGE;SUBSET];
  EXPAND_TAC "X";
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  CONJ_TAC;
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[rectagon];
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_ALL_TAC;
  TYPE_THEN `C = X` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_ALL_TAC;
  UND 7;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  UND 6;
  REWRITE_TAC[IMAGE];
  DISCH_THEN_REWRITE ;
  DISCH_THEN CHOOSE_TAC;
  USE 6 (REWRITE_RULE[h_edge_inj;v_edge_inj]);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  USE 0 (REWRITE_RULE[rectagon]);
  UND 0;
  DISCH_ALL_TAC;
  USE 5(REWRITE_RULE[EMPTY_EXISTS]);
  CHO 5;
  TSPEC `u` 2;
  REWR 2;
  CHO 2;
  UND 0;
  EXPAND_TAC "X";
  REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* dwfx done finite X ...  Messed up. X must have type real->bool. *)
  TYPE_THEN `Y = IMAGE (real_of_int o FST ) X` ABBREV_TAC;
  TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC;
  CONJ_TAC;
  EXPAND_TAC "Y";
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE;EMPTY_EXISTS ];
  CONV_TAC (dropq_conv "u");
  AND 4;
  USE 4 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 4;
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 6 (MATCH_MP min_finite);
  CHO 6;
  TYPE_THEN `?m. (G (h_edge m)) /\ (real_of_int (FST  m) = delta)` SUBGOAL_TAC;
  USE 5 (REWRITE_RULE[IMAGE;o_DEF]);
  TAPP `delta` 5;
  REWR 5;
  CHO 5;
  TAPP `x` 3;
  REWR 3;
  ASM_MESON_TAC[];
  DISCH_TAC;
  CHO 7;
  (* now show that m is an endpoint *)
  TYPE_THEN `endpoint G m` SUBGOAL_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC;
  ASM_SIMP_TAC[num_closure1];
  TYPE_THEN `h_edge m` EXISTS_TAC;
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `edge e'` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon;ISUBSET];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  IMATCH_MP_TAC  (TAUT `((A \/ B) ==> C) ==> ((B \/ A) ==> C)`);
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[h_edge_inj];
  REWR 10;
  USE 10 (REWRITE_RULE[h_edge_closure;hc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; h_edge_pointI]);
  UND 10;
  DISCH_THEN   DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `  Y (real_of_int (FST  m'))` SUBGOAL_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE];
  TYPE_THEN `m'` EXISTS_TAC;
  REWRITE_TAC[o_DEF];
  EXPAND_TAC "X";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  AND 6;
  TSPEC `(real_of_int(FST  m'))` 6;
  REWR 6;
  USE 7 GSYM;
  REWR 6;
  USE 6 (REWRITE_RULE[int_suc ]);
  ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`];
  ASM_MESON_TAC[hv_edgeV2];
  DISCH_TAC;
  EXPAND_TAC "e'";
  ASM_REWRITE_TAC[];
  EXPAND_TAC "e'";
  REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING ;];
  ASM_MESON_TAC[rectagon_endpoint];
  ]);;

  (* }}} *)

(* move down *)
let part_below = jordan_def `part_below G m =
   {C | G C /\
          ((?n. (C = v_edge n) /\ (SND n <=: SND m) /\ (FST n = FST m)) \/
           (?n. (C = h_edge n) /\ (SND n <=: SND m) /\
                 (closure top2 C (pointI (FST m,SND n))))) }`;;

let part_below_h = 
prove_by_refinement(
  `!G m n. part_below G m (h_edge n) <=>
         (set_lower G m n) \/ (set_lower G (left m) n)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  REWRITE_TAC[part_below;set_lower;left ];
  REWRITE_TAC[h_edge_closure;hc_edge;UNION ;h_edge_pointI];
  REWRITE_TAC[hv_edgeV2;plus_e12;INR IN_SING ;pointI_inj ;PAIR_SPLIT ];
  REWRITE_TAC[h_edge_inj];
  CONV_TAC (dropq_conv "n'");
  REWRITE_TAC[INT_ARITH `(x = y+: &:1) <=> (x -: (&:1) = y)`];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let part_below_v = 
prove_by_refinement(
  `!G m n. part_below G m (v_edge n) <=>
         (G (v_edge n)) /\ (FST n = FST m) /\ (SND n <=: SND m)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[part_below;v_edge_closure;vc_edge;UNION;plus_e12; INR IN_SING; pointI_inj ; PAIR_SPLIT; v_edge_inj; hv_edgeV2];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

(* sets *)
let has_size_bij = 
prove_by_refinement(
  `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f {m | m < n} A)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_TAC;
  USE 0 (MATCH_MP (INR HAS_SIZE_INDEX));
  CHO 0;
  REWRITE_TAC[BIJ;INJ ;SURJ ;];
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  USE 0 (REWRITE_RULE[EXISTS_UNIQUE_ALT]);
  ASM_MESON_TAC[];
  DISCH_THEN CHOOSE_TAC;
  REWRITE_TAC[HAS_SIZE];
  ASSUME_TAC CARD_NUMSEG_LT;
  TSPEC `n` 1;
  EXPAND_TAC "n";
  SUBCONJ_TAC;
  ASSUME_TAC FINITE_NUMSEG_LT;
  TSPEC `n` 2;
  JOIN 2 0;
  USE 0 (MATCH_MP FINITE_BIJ);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  (GSYM BIJ_CARD);
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[FINITE_NUMSEG_LT];
  ]);;
  (* }}} *)

let has_size_bij2 = 
prove_by_refinement(
  `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f A {m | m < n})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[has_size_bij];
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `INV f {m | m <| n} A` EXISTS_TAC;
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `INV f A {m | m <| n}` EXISTS_TAC;
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let fibre_card = 
prove_by_refinement(
  `!(f:A->B) A B m n.  (B HAS_SIZE n) /\ (IMAGE f A SUBSET B) /\
        (!b. (B b) ==> ({u | (A u) /\ (f u = b)} HAS_SIZE m)) ==>
           (A HAS_SIZE m*n)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `!b. ?g. (B b) ==> (BIJ g {u | (A u) /\ (f u = b)} {j | j <| m})` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  RIGHT_TAC "g";
  DISCH_TAC;
  REWRITE_TAC[GSYM has_size_bij2];
  TSPEC `b` 2;
  REWR 2;
  DISCH_TAC;
  LEFT 3 "g";
  CHO 3;
  (* case m=0 *)
  DISJ_CASES_TAC (ARITH_RULE `(m=0) \/ 0 < m`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  REWRITE_TAC[HAS_SIZE_0];
  REWR 2;
  USE 2 (REWRITE_RULE[HAS_SIZE_0]);
  USE 1 (REWRITE_RULE[IMAGE;ISUBSET ]);
  PROOF_BY_CONTR_TAC;
  USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 5;
  USE 1 (CONV_RULE NAME_CONFLICT_CONV);
  USE 1 (CONV_RULE (dropq_conv "x''"));
  TSPEC `u` 1;
  REWR 1;
  TSPEC `f u` 2;
  REWR 2;
  USE 2 (REWRITE_RULE[EQ_EMPTY]);
  ASM_MESON_TAC[];
  TYPE_THEN `BIJ (\x. (f x, g (f x) x)) A {(x,y) | B x /\ {j|j <|m} y}` SUBGOAL_TAC;
  REWRITE_TAC[BIJ;INJ;SURJ];
  SUBCONJ_TAC;
  SUBCONJ_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `f x` EXISTS_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "y");
  SUBCONJ_TAC;
  UND 1;
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TSPEC `f x` 3;
  REWR 3;
  UND 3;
  REWRITE_TAC[BIJ;SURJ];
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  DISCH_ALL_TAC;
  USE 8(REWRITE_RULE[PAIR_SPLIT]);
  AND 8;
  REWR 8;
  (* r8 *)
  TYPE_THEN `B (f y)` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC [IMAGE;SUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TSPEC `f y` 3;
  REWR 3;
  USE 3 (REWRITE_RULE[BIJ;INJ]);
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  GEN_TAC;
  NAME_CONFLICT_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "x'");
  NAME_CONFLICT_TAC;
  GEN_TAC;
  LEFT_TAC  "x''";
  GEN_TAC;
  RIGHT_TAC "y''";
  DISCH_THEN_REWRITE ;
  RIGHT_TAC "y''";
  DISCH_ALL_TAC;
  USE 9 GSYM;
  REWR 8;
  ASM_REWRITE_TAC[];
  KILL 9;
  TSPEC `FST x` 2;
  REWR 2;
  TSPEC `FST x` 3;
  REWR 3;
  USE 3 (REWRITE_RULE[BIJ;SURJ]);
  ASM_MESON_TAC[];
  REWRITE_TAC[HAS_SIZE];
  DISCH_TAC;
  (* r9 *)
  TYPE_THEN `FINITE B /\ FINITE {j | j <| m}` SUBGOAL_TAC;
  ASM_REWRITE_TAC[FINITE_NUMSEG_LT];
  ASM_MESON_TAC[HAS_SIZE];
  DISCH_TAC;
  COPY 6;
  USE 6 (MATCH_MP   (INR FINITE_PRODUCT));
  REWR 6;
  COPY 7;
  USE 7 (MATCH_MP (INR CARD_PRODUCT));
  SUBCONJ_TAC;
  JOIN  6 5;
  USE 5 (MATCH_MP FINITE_BIJ2);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  JOIN 9 5;
  USE 5 (MATCH_MP BIJ_CARD);
  REWR 7;
  ASM_REWRITE_TAC[CARD_NUMSEG_LT];
  USE 0 (REWRITE_RULE[HAS_SIZE]);
  ASM_REWRITE_TAC[];
  ARITH_TAC;
  ]);;
  (* }}} *)

(* sets *)
let even_card_even = 
prove_by_refinement(
  `!X (Y:A->bool). (FINITE X) /\ (FINITE Y) /\ (X INTER Y = EMPTY) ==>
    ((EVEN (CARD X) <=> EVEN (CARD Y)) <=> (EVEN (CARD (X UNION Y))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC [CARD_UNION];
  REWRITE_TAC[EVEN_ADD];
  ]);;
  (* }}} *)


(*
  terminal edge: (endpoint G m) /\ (closure top2 e (pointI m))
  produce bij-MAP from terminal edges to endpoints (of P SUBSET G)
  2-1 MAP from  terminal edges to segments.
  Hence an EVEN number of endpoints.

*)



let terminal_edge = jordan_def `terminal_edge G m =
    @e. (G e) /\ (closure top2 e (pointI m))`;;

let terminal_endpoint = 
prove_by_refinement(
  `!G m. (FINITE G) /\ (endpoint G m)  ==> ((G (terminal_edge G m)) /\
          (closure top2 (terminal_edge G m) (pointI m)) ) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[terminal_edge];
  SELECT_TAC;
  MESON_TAC[];
  ASM_MESON_TAC[endpoint_edge;EXISTS_UNIQUE_ALT];
  ]);;
  (* }}} *)

let terminal_unique = 
prove_by_refinement(
  `!G m e. (FINITE G) /\ (endpoint G m) ==>
       ( (G e) /\ (closure top2 e (pointI m)) <=> (e = terminal_edge G m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  EQ_TAC;
  REWRITE_TAC[terminal_edge];
  SELECT_TAC;
  USE 1(REWRITE_RULE[endpoint]);
  ASM_MESON_TAC[num_closure1];
  ASM_MESON_TAC[terminal_endpoint];
  ASM_MESON_TAC[terminal_endpoint];
  ]);;
  (* }}} *)


let segment_of_endpoint = 
prove_by_refinement(
  `!P e m. (P e) /\ (FINITE P) ==>
     (endpoint P m /\
         (segment_of P (terminal_edge P m) = segment_of P e)
        <=>
        endpoint (segment_of P e) m)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE (segment_of P e)` SUBGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  ASM_MESON_TAC[segment_of_G];
  DISCH_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  COPY 3;
  UND 5;
  REWRITE_TAC[endpoint];
  ASM_SIMP_TAC[num_closure1];
  DISCH_ALL_TAC;
  CHO 5;
  TYPE_THEN `e'` EXISTS_TAC;
  DISCH_ALL_TAC;
  EQ_TAC;
  USE 0 (MATCH_MP segment_of_G);
  ASM_MESON_TAC[ISUBSET];
  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
  COPY 5;
  TSPEC `e'` 5;
  USE 5 (REWRITE_RULE[]);
  ASM_REWRITE_TAC[];
  UND 4;
  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
  TSPEC `terminal_edge P m` 6;
  UND 4;
  ASM_SIMP_TAC[terminal_endpoint];
  REWRITE_TAC[segment_of_in];
  DISCH_TAC;
  (* se *)
  SUBCONJ_TAC;
  UND 3;
  REWRITE_TAC[endpoint];
  ASM_SIMP_TAC[num_closure1];
  DISCH_ALL_TAC;
  CHO 3;
  TYPE_THEN `e'` EXISTS_TAC;
  DISCH_ALL_TAC;
  EQ_TAC;
  TYPE_THEN `P e'' /\ closure top2 e'' (pointI m) ==> segment_of P e e''` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  COPY 3;
  TSPEC `e'` 3;
  USE 3 (REWRITE_RULE []);
  TYPE_THEN `e'' = e'` ASM_CASES_TAC;
  ASM_MESON_TAC[];
  USE 0 (MATCH_MP inductive_segment);
  USE 0 (REWRITE_RULE[inductive_set]);
  UND 0;
  DISCH_ALL_TAC;
  TYPEL_THEN [`e'`;`e''`] (USE 9 o ISPECL);
  UND 9;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[adj;EMPTY_EXISTS;];
  TYPE_THEN `pointI m` EXISTS_TAC;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
  ASM_MESON_TAC[segment_of_G;ISUBSET ];
  (* I'm getting lost in the thickets *)
  (* se2 *)
  DISCH_TAC;
  IMATCH_MP_TAC  (GSYM segment_of_eq);
  ASM_REWRITE_TAC[];
  COPY 4;
  COPY 3;
  UND 3;
  UND 4;
  REWRITE_TAC[endpoint];
  ASM_SIMP_TAC[num_closure1];
  DISCH_THEN CHOOSE_TAC;
  DISCH_THEN CHOOSE_TAC;
  (* *)
  COPY 3;
  TSPEC `e''` 3;
  TYPE_THEN `e' = e''` SUBGOAL_TAC;
  TSPEC `e''` 4;
  USE 4 (REWRITE_RULE[]);
  ASM_MESON_TAC[segment_of_G;ISUBSET ];
  DISCH_TAC;
  TSPEC `terminal_edge P m` 7;
  TYPE_THEN `e' = terminal_edge P m` SUBGOAL_TAC;
  ASM_MESON_TAC[terminal_endpoint];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let fibre2 = 
prove_by_refinement(
  `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==>
    (!S. ({ S | (?e. (P e) /\ (S = segment_of P e)) }  S) ==>
      ({m | (endpoint P m) /\ (segment_of P (terminal_edge P m) = S)}
              HAS_SIZE 2))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[];
  DISCH_ALL_TAC;
  CHO 3;
  ASM_REWRITE_TAC[];
  USE 3 (CONJUNCT1 );
  TYPE_THEN `psegment (segment_of P e)` SUBGOAL_TAC;
  REWRITE_TAC[psegment];
  CONJ_TAC;
  ASM_MESON_TAC[rectagon_subset;segment_of_G;segment_of_segment];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `segment_of P e = G` SUBGOAL_TAC;
  IMATCH_MP_TAC  rectagon_subset;
  REWR 4;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[SUBSET_TRANS;segment_of_G];
  USE 3 (MATCH_MP segment_of_G);
  DISCH_TAC;
  REWR 3;
  JOIN 1 3;
  USE 1 (MATCH_MP SUBSET_ANTISYM);
  REWR 4;
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 4 (MATCH_MP endpoint_size2);
  TYPE_THEN `{m | endpoint P m /\ (segment_of P (terminal_edge P m) = segment_of P e)} = endpoint (segment_of P e)` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC ;
  REWRITE_TAC[];
  (* f2 *)
  IMATCH_MP_TAC  segment_of_endpoint;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  FINITE_SUBSET;
  ASM_MESON_TAC[segment];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let endpoint_even = 
prove_by_refinement(
  `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==>
        (endpoint P HAS_SIZE 2 *|
           (CARD {S | (?e. (P e) /\ (S = segment_of P e))})  )`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN  `f =  (segment_of P) o (terminal_edge P)` ABBREV_TAC;
  TYPE_THEN `B = { S | (?e. (P e) /\ (S = segment_of P e)) }` ABBREV_TAC;
  TYPE_THEN `f` (fun t-> IMATCH_MP_TAC   (ISPEC t fibre_card));
  TYPE_THEN `B` EXISTS_TAC;
  ASM_REWRITE_TAC[HAS_SIZE;IMAGE;SUBSET ; ];
  EXPAND_TAC "B";
  EXPAND_TAC "f";
  REWRITE_TAC[o_DEF ];
  SUBCONJ_TAC;
  TYPE_THEN `{S | ?e. P e /\ (S = segment_of P e)} = IMAGE (\x. (segment_of P x)) P` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  FINITE_IMAGE;
  IMATCH_MP_TAC  FINITE_SUBSET ;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  CONJ_TAC;
  NAME_CONFLICT_TAC;
  GEN_TAC;
  DISCH_THEN CHOOSE_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `terminal_edge P x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `FINITE P` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;FINITE_SUBSET];
  ASM_MESON_TAC[terminal_endpoint];
  (* ee *)
  REWRITE_TAC[GSYM HAS_SIZE];
  ASSUME_TAC fibre2;
  USE 6 (REWRITE_RULE[]);
  UND 6;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let num_closure0 = 
prove_by_refinement(
  `! G x.
     FINITE G ==> ((num_closure G x = 0) <=>
             (!e. (G e) ==> (~(closure top2 e x))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP num_closure_size);
  TSPEC `x` 0;
  EQ_TAC;
  DISCH_TAC;
  REWR 0;
  USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY ]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `{C | G C /\ closure top2 C x} = {}` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 2;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 0;
  USE 0 (REWRITE_RULE[HAS_SIZE]);
  ASM_MESON_TAC[CARD_CLAUSES];
  ]);;
  (* }}} *)

let num_closure2 = 
prove_by_refinement(
  `!G x.
    FINITE G ==> ((num_closure G x = 2) <=>
           (?a b. (~(a = b)) /\
              ((!e. (G e /\ closure top2 e x) <=> (( e= a)\/ (e =b))))))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  USE 0 (MATCH_MP num_closure_size);
  TSPEC `x` 0;
  EQ_TAC;
  DISCH_TAC;
  REWR 0;
  USE 0 (REWRITE_RULE[has_size2 ; ]);
  CHO 0;
  CHO 0;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  AND 0;
  TAPP `e` 2;
  USE 2(REWRITE_RULE[INSERT]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  CHO 1;
  CHO 1;
  TYPE_THEN `X = {C | G C /\ closure top2 C x} ` ABBREV_TAC;
  TYPE_THEN `(?a b. (X = {a, b}) /\ ~(a = b))` SUBGOAL_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INSERT];
  EXPAND_TAC "X";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 3 (REWRITE_RULE[GSYM has_size2]);
  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
  ASM_MESON_TAC[];
  ]);;

  (* }}} *)

let endpoint_subrectagon = 
prove_by_refinement(
  `!G P m. (rectagon G) /\ (P SUBSET G) ==>
        ((endpoint P m) <=>
        (?C C'. (P C) /\ (G C') /\ (~(P C')) /\ (~(C = C')) /\
           (closure top2 C (pointI m)) /\ (closure top2 C' (pointI m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC;
  TYPE_THEN `FINITE P` SUBGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  ASM_MESON_TAC[];
  DISCH_TAC;
  EQ_TAC;
  DISCH_TAC;
  TYPE_THEN `midpoint G m` SUBGOAL_TAC;
  REWRITE_TAC[midpoint];
  USE 0 (REWRITE_RULE[rectagon;INSERT]);
  UND 0;
  DISCH_ALL_TAC;
  TSPEC `m` 7;
  UND 7;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  USE 4 (REWRITE_RULE[endpoint]);
  JOIN 0 1;
  USE 0 (MATCH_MP num_closure_mono);
  ASM_MESON_TAC[ARITH_RULE `~(1 <=| 0)`];
  REWRITE_TAC[midpoint];
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_THEN (MP_TAC o (MATCH_MP num_closure_size));
  DISCH_ALL_TAC;
  TSPEC `pointI m` 6;
  REWR 6;
  USE 4 (REWRITE_RULE[endpoint]);
  UND 4;
  ASM_SIMP_TAC[num_closure1];
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC;
  COPY 6;
  UND 8;
  REWRITE_TAC[has_size2];
  DISCH_THEN CHOOSE_TAC;
  CHO 8;
  TYPE_THEN `X a /\ X b /\ X e` SUBGOAL_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[INSERT ];
  CONJ_TAC;
  ASM_REWRITE_TAC[INSERT];
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  TSPEC `e` 4;
  USE 4(REWRITE_RULE[]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `P e /\ (closure top2 e (pointI m))` SUBGOAL_TAC;
  TSPEC `e` 4;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `G a /\ closure top2 a (pointI m) /\ G b /\ closure top2 b (pointI m)` SUBGOAL_TAC;
  UND 9;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  MESON_TAC[];
  DISCH_ALL_TAC;
  TYPE_THEN `(e =a) \/ (e = b)` SUBGOAL_TAC;
  ASM_MESON_TAC[two_exclusion];
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `a` EXISTS_TAC;
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  CHO 4;
  CHO 4;
  UND 4;
  DISCH_ALL_TAC;
  REWRITE_TAC[endpoint];
  UND 0;
  REWRITE_TAC[rectagon;INSERT ];
  DISCH_ALL_TAC;
  TSPEC `m` 12;
  UND 12;
  (* rg *)
  DISCH_THEN DISJ_CASES_TAC;
  USE 3 (MATCH_MP num_closure1);
  ASM_REWRITE_TAC[];
  USE 0 (MATCH_MP num_closure2);
  REWR 12;
  CHO 12;
  CHO 12;
  AND 12;
  TYPE_THEN `(C = a) \/ (C = b)` SUBGOAL_TAC;
  UND 12;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC;
  UND 12;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  TSPEC `e'` 12;
  REWR 12;
  TYPE_THEN `G e'` SUBGOAL_TAC;
  UND 17;
  UND 1;
  MESON_TAC[ISUBSET];
  DISCH_TAC;
  KILL 0;
  KILL 3;
  KILL 18;
  KILL 13;
  ASM_MESON_TAC[];
  KILL 0;
  KILL 3;
  KILL 13;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  ASM_REWRITE_TAC[];
  (* rg2 *)
  USE 0(MATCH_MP num_closure0);
  REWR 12;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let part_below_finite = 
prove_by_refinement(
  `!G m. (FINITE G) ==> FINITE(part_below G m)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[part_below;ISUBSET ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let part_below_subset = 
prove_by_refinement(
  `!G m. (part_below G m) SUBSET G`,

  (* {{{ proof *)
  [
  REWRITE_TAC[part_below;ISUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let v_edge_cpoint = 
prove_by_refinement(
  `!m n. (closure top2 (v_edge m) (pointI n) <=>
          ((n = m) \/ (n = (FST m,SND m +: (&:1)))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[v_edge_closure;vc_edge;UNION];
  REWRITE_TAC[v_edge_pointI;INR IN_SING ;plus_e12;pointI_inj];
  ]);;
  (* }}} *)

let h_edge_cpoint = 
prove_by_refinement(
  `!m n. (closure top2 (h_edge m) (pointI n) <=>
          ((n = m) \/ (n = (FST m +: (&:1),SND m ))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[h_edge_closure;hc_edge;UNION];
  REWRITE_TAC[h_edge_pointI;INR IN_SING ;plus_e12;pointI_inj];
  ]);;
  (* }}} *)

let endpoint_lemma = 
prove_by_refinement(
  `!G m x.  (rectagon G) /\
      (endpoint (part_below G m) x)
       ==>
      (? C C' m'.
          ((C = v_edge m') \/ (C = h_edge m')) /\
          (edge C') /\
          (!e. G e /\ closure top2 e (pointI x) <=> (e = C) \/ (e = C')) /\
          (~(G = {})) /\
          (G SUBSET edge) /\
          (part_below G m C) /\
          (G C') /\
          (~part_below G m C') /\
          (~(C = C')) /\
          (closure top2 C (pointI x)) /\
          (closure top2 C' (pointI x)) /\
         (part_below G m SUBSET G) /\
         (endpoint (part_below G m) x))
          `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC;
  ASM_MESON_TAC[part_below_subset];
  DISCH_TAC ;
  COPY 2;
  COPY 1;
  UND 1;
  UND 3;
  UND 0;
  SIMP_TAC[endpoint_subrectagon];
  DISCH_TAC;
  DISCH_TAC;
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_ALL_TAC;
  USE 0 (REWRITE_RULE[rectagon;INSERT ]);
  UND 0;
  DISCH_ALL_TAC;
  TSPEC `x` 12;
  UND 12;
  DISCH_THEN DISJ_CASES_TAC;
  USE 0 (MATCH_MP num_closure2);
  REWR 12;
  CHO 12;
  CHO 12;
  KILL 0;
  AND 12;
  TYPE_THEN `(C = a) \/ (C = b)`  SUBGOAL_TAC;
 TSPEC `C` 0;
  UND 0;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  ASM_MESON_TAC[ISUBSET];
  TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  DISCH_TAC;
  TYPE_THEN `!e. G e /\ closure top2 e (pointI x) <=> ((e = C) \/ (e = C'))` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  TSPEC `e` 0;
  ASM_REWRITE_TAC[];
  UND 15;
  UND 14;
  UND 12;
  UND 7;
  MESON_TAC[];
  DISCH_TAC;
  KILL 15;
  KILL 14;
  KILL 0;
  KILL 12;
  KILL 13;
  TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;];
  DISCH_ALL_TAC;
  USE 0 (REWRITE_RULE[edge]);
  UND 0;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `m'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* snd case *)
  USE 0 (MATCH_MP num_closure0);
  REWR 12;
  PROOF_BY_CONTR_TAC;
  UND 12;
  UND 5;
  UND 9;
  MESON_TAC[];
  ]);;
  (* }}} *)

let endpoint_lemma_small_fst = 
prove_by_refinement(
  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
       (FST m <=: FST x +: &:1) `,

  (* {{{ proof *)

  [
  REP_GEN_TAC;
  DISCH_TAC;
  COPY 0;
  USE 0 (MATCH_MP endpoint_lemma);
  CHO 0;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
  DISCH_ALL_TAC;
  (* setup complete *)
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  REWR 10;
  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 14;
  AND 6;
  AND 6;
  REWR 14;
  UND 14;
  INT_ARITH_TAC;
  (* 2nd case *)
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
  REWR 10;
  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  UND 14;
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

(* identical proof to endpoint_lemma_small_fst *)
let endpoint_lemma_big_fst = 
prove_by_refinement(
  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
       (FST x <=: FST m +: &:1) `,

  (* {{{ proof *)

  [
  REP_GEN_TAC;
  DISCH_TAC;
  COPY 0;
  USE 0 (MATCH_MP endpoint_lemma);
  CHO 0;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
  DISCH_ALL_TAC;
  (* setup complete *)
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  REWR 10;
  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 14;
  AND 6;
  AND 6;
  REWR 14;
  UND 14;
  INT_ARITH_TAC;
  (* 2nd case *)
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
  REWR 10;
  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  UND 14;
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let endpoint_lemma_big_snd = 
prove_by_refinement(
  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
       (SND  x <=: SND  m +: &:1) `,

  (* {{{ proof *)

  [
  REP_GEN_TAC;
  DISCH_TAC;
  COPY 0;
  USE 0 (MATCH_MP endpoint_lemma);
  CHO 0;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
  DISCH_ALL_TAC;
  (* setup complete *)
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  REWR 10;
  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  UND 14;
  AND 6;
  AND 6;
  UND 6;
  INT_ARITH_TAC;
  (* 2nd case *)
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
  REWR 10;
  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `SND x = SND m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `(SND m' <=: SND m)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  UND 14;
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let endpoint_lemma_mid_fst = 
prove_by_refinement(
  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
       (FST x = FST m) ==> (SND  x = SND  m +: &:1) `,

  (* {{{ proof *)

  [
  REP_GEN_TAC;
  DISCH_TAC;
  COPY 0;
  USE 0 (MATCH_MP endpoint_lemma);
  CHO 0;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  (* setup complete *)
  UND 2;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 7;
  USE 7 (REWRITE_RULE[part_below_v]);
  REWR 11;
  USE 11 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  AND 7;
  AND 7;
  UND 7;
  USE 3 (REWRITE_RULE[edge]);
  CHO 3;
  UND 3;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 9;
  USE 7 (REWRITE_RULE[part_below_v]);
  REWR 8;
  REWR 7;
  REWR 12;
  USE 9 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(FST m'' = FST m) /\ (FST x = FST m'')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 9;
  REWR 7;
  UND 7;
  UND 9;
  INT_ARITH_TAC;
  (* 2nd case *)
  REWR 12;
  USE 7 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  REWR 8;
  REWR 9;
  USE 9 (REWRITE_RULE[left ;set_lower;part_below_h]);
  REWR 9;
  TYPE_THEN `(FST x = FST m') ` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 7;
  DISCH_ALL_TAC;
  REWR 7;
  KILL 12;
  REWR 7;
  KILL  11;
  (* try *)
  UND 7;
  UND 17;
  UND 18;
  UND 9;
  INT_ARITH_TAC;
  (* 3rd case *)
  (* 3c *)
  REWR 11;
  USE 11(REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  USE 3(REWRITE_RULE[edge]);
  CHO 3;
  UND 3;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 9;
  USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
  REWR 8;
  REWR 9;
  UND 9;
  UND 11;
  UND 0;
  REWR 12;
  USE 0(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  UND 0;
  USE 1 (MATCH_MP endpoint_lemma_big_snd );
  UND 0;
  INT_ARITH_TAC;
  (* LAST case ,3d *)
  TYPE_THEN `G (h_edge m')` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  REWR 12;
  USE 12 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `SND x = SND m''` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 12;
  REWR 7;
   USE 7(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
  REWR 7;
  TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  UND 7;
  COPY 17;
  UND 7;
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  REWR 9;
   USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
  REWR 8;
  REWR 9;
  TYPE_THEN `SND x = SND m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  UND 11;
  COPY 18;
  UND 11;
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  TYPE_THEN `(FST m'' = FST m) \/ (FST m'' = FST m -: &:1)` SUBGOAL_TAC;
  UND 11;
  UND 7;
  UND 12;
  INT_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `~(SND m'' <=: SND m)` SUBGOAL_TAC;
  UND 19;
  UND 9;
  INT_ARITH_TAC;
  UND 16;
  UND 18;
  UND 17;
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let endpoint_lemma_upper_left = 
prove_by_refinement(
  `!G m . (rectagon G) ==>
       ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`,

  (* {{{ proof *)

  [
  (* needs to be rewritten, template only *)
  REP_GEN_TAC;
  TYPE_THEN  `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  GEN_TAC;
  DISCH_TAC;
  USE 0 (MATCH_MP endpoint_lemma);
  CHO 0;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  UND 1;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  REWR 10;
  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  INT_ARITH_TAC;
  (* 2nd case *)
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
  REWR 10;
  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let endpoint_lemma_upper_left = 
prove_by_refinement(
  `!G m . (rectagon G) ==>
       ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`,

  (* {{{ proof *)

  [
  (* needs to be rewritten, template only *)
  REP_GEN_TAC;
  TYPE_THEN  `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  GEN_TAC;
  DISCH_TAC;
  USE 0 (MATCH_MP endpoint_lemma);
  CHO 0;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  UND 1;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  REWR 10;
  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  INT_ARITH_TAC;
  (* 2nd case *)
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
  REWR 10;
  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let endpoint_lemma_upper_right = 
prove_by_refinement(
  `!G m . (rectagon G) ==>
       ~(endpoint (part_below G m) (FST m +: &:1, SND m +: &:1))`,

  (* {{{ proof *)

  [
  (* needs to be rewritten, template only *)
  REP_GEN_TAC;
  TYPE_THEN  `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m +: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m +: &:1,SND m +: &:1)))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  GEN_TAC;
  DISCH_TAC;
  USE 0 (MATCH_MP endpoint_lemma);
  CHO 0;
  CHO 0;
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  UND 1;
  DISCH_THEN DISJ_CASES_TAC;
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  REWR 10;
  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `FST m +: &:1 = FST m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  INT_ARITH_TAC;
  (* 2nd case *)
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
  REWR 10;
  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let endpoint_lemma_summary = 
prove_by_refinement(
  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
    ((FST x = FST m -: &:1) /\ (SND x <=: SND  m)) \/
    ((FST x = FST m +: &:1) /\ (SND x <=: SND m)) \/
    ((FST x = FST m) /\ (SND x = SND m +: &:1 )) `,

  (* {{{ proof *)
  [
  (* USE int -arith to show cases of fst x, then for each give *)
  REP_GEN_TAC;
  DISCH_TAC;
  TYPE_THEN `(FST x < FST m -: &:1) \/ (FST x = FST m -: &:1) \/ (FST x = FST m ) \/ (FST x = FST m +: &:1) \/ (FST m +: &:1 <: FST x  )` SUBGOAL_TAC;
  INT_ARITH_TAC;
  REP_CASES_TAC ;
  USE 0 (MATCH_MP endpoint_lemma_small_fst);
  PROOF_BY_CONTR_TAC;
  UND 0;
  UND 1;
  INT_ARITH_TAC;
  DISJ1_TAC;
  ASM_REWRITE_TAC[];
  COPY 0;
  USE 0 (MATCH_MP endpoint_lemma_big_snd);
  IMATCH_MP_TAC  (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`);
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  REWR 3;
  TYPE_THEN `x = (FST m -: &:1, SND m + &:1)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[PAIR_SPLIT];
  DISCH_TAC;
  REWR 2;
  ASM_MESON_TAC[endpoint_lemma_upper_left];
  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
  ASM_MESON_TAC[];
  DISJ2_TAC;
  DISJ1_TAC ;
  ASM_REWRITE_TAC[];
  COPY 0;
  USE 0 (MATCH_MP endpoint_lemma_big_snd);
  IMATCH_MP_TAC  (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`);
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  REWR 3;
  TYPE_THEN `x = (FST m +: &:1, SND m + &:1)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[PAIR_SPLIT];
  DISCH_TAC;
  REWR 2;
  ASM_MESON_TAC[endpoint_lemma_upper_right];
  USE 0 (MATCH_MP endpoint_lemma_big_fst);
  PROOF_BY_CONTR_TAC;
  UND 0;
  UND 1;
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let terminal_case1 = 
prove_by_refinement(
  `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
      (closure top2 (h_edge n) (pointI x)) /\ (set_lower G m n ) ==>
      (x = right  n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[h_edge_cpoint; set_lower];
  DISCH_ALL_TAC;
  USE 2 (REWRITE_RULE[PAIR_SPLIT]);
  UND 2;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  JOIN 0 1;
  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
  REWR 0;
  UND 0;
  UND 2;
  UND 5;
  INT_ARITH_TAC;
  TYPE_THEN `FST x = FST m +: &:1` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[PAIR_SPLIT;right  ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let terminal_case2 = 
prove_by_refinement(
  `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
      (closure top2 (h_edge n) (pointI x)) /\
          (set_lower G (left  m) n ) ==>
      (x =  n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[h_edge_cpoint; set_lower ];
  DISCH_ALL_TAC;
  USE 2 (REWRITE_RULE[PAIR_SPLIT]);
  UND 2;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
  UND 2;
  UND 4;
  REWRITE_TAC[left ];
  INT_ARITH_TAC ;
  DISCH_TAC;
  JOIN 0 1;
  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
  AND 2;
  UND 2;
  REWR 0;
  DISCH_TAC;
  UND 5;
  UND 0;
  REWRITE_TAC[left  ];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let terminal_case_v = 
prove_by_refinement(
  `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
      (closure top2 (v_edge n) (pointI x)) /\
          (part_below G m (v_edge n)) ==>
      (x = up m) /\ (m =n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[part_below_v; v_edge_cpoint;];
  DISCH_ALL_TAC;
  JOIN 0 1;
  USE 2 (REWRITE_RULE[PAIR_SPLIT]);
  REWR 1;
  TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 1;
  REWRITE_TAC[PAIR_SPLIT; up ;];
  ASM_REWRITE_TAC[];
  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
  REWR 0;
  ASM_REWRITE_TAC[];
  UND 0;
  UND 1;
  UND 5;
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let inj_terminal = 
prove_by_refinement(
  `!G m. (rectagon G) ==>
     (INJ (terminal_edge (part_below G m))
         (endpoint (part_below G m)) UNIV)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC ;
  ASM_MESON_TAC[part_below_finite;rectagon];
  DISCH_TAC;
  REWRITE_TAC[INJ];
  DISCH_ALL_TAC;
  TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC;
  TYPE_THEN `closure top2 e (pointI x) /\ closure top2 e (pointI y)` SUBGOAL_TAC;
  ASM_MESON_TAC[terminal_endpoint];
  DISCH_ALL_TAC;
  TYPE_THEN `(part_below G m) e` SUBGOAL_TAC;
  ASM_MESON_TAC[terminal_endpoint];
  DISCH_TAC;
  TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC;
  REWRITE_TAC[part_below;ISUBSET];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;rectagon];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
  TYPE_THEN `(x = up m) /\ (y = up m)` SUBGOAL_TAC;
  ASM_MESON_TAC[terminal_case_v];
  MESON_TAC[];
  (* h-case *)
  UND 4;
  REWR 8;
  USE 4 (REWRITE_RULE[part_below_h ;]);
  DISCH_TAC;
  UND 4;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `(x = right  m') /\ (y = right m')` SUBGOAL_TAC  ;
  ASM_MESON_TAC[terminal_case1];
  MESON_TAC[];
  TYPE_THEN `( x= m' ) /\ (y = m') ` SUBGOAL_TAC;
  ASM_MESON_TAC[terminal_case2];
  MESON_TAC[];
  ]);;
  (* }}} *)

(* now start on surjectivity results *)

let endpoint_criterion = 
prove_by_refinement(
  `!G m e. (FINITE G) /\
       (!e'. (G e' /\ (closure top2 e' (pointI m))) = (e = e')) ==>
     (endpoint G m) /\ (e = terminal_edge G m)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  SUBCONJ_TAC;
  REWRITE_TAC[endpoint;];
  ASM_SIMP_TAC[num_closure1];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_MESON_TAC[terminal_unique];
  ]);;
  (* }}} *)

let target_set = jordan_def `target_set G m =
    { e | (?n. (e = h_edge n) /\ (set_lower G m n)) \/
          (?n. (e = h_edge n) /\ (set_lower G (left m) n)) \/
          ((e = v_edge m) /\ G e)}`;;

let target_set_subset = 
prove_by_refinement(
  `!G m. target_set G m SUBSET G`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ISUBSET;target_set;set_lower];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let target_edge = 
prove_by_refinement(
  `!G m. target_set G m SUBSET edge`,

  (* {{{ proof *)
  [
  REWRITE_TAC[target_set;edge;ISUBSET ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let target_h = 
prove_by_refinement(
  `!G m n. target_set G m (h_edge n) <=>
         (set_lower G m n) \/ (set_lower G (left  m) n)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[target_set;h_edge_inj; hv_edgeV2;];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let target_v = 
prove_by_refinement(
  `!G m n. target_set G m (v_edge n) <=>
        (n = m) /\ G (v_edge n)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[target_set;hv_edgeV2;v_edge_inj;];
  ]);;
  (* }}} *)

let part_below_subset = 
prove_by_refinement(
  `!G m. (part_below G m SUBSET G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[part_below;ISUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let part_below_finite = 
prove_by_refinement(
  `!G m. (FINITE G ==> FINITE (part_below G m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[part_below_subset];
  ]);;
  (* }}} *)

let terminal_edge_image = 
prove_by_refinement(
  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
      (target_set G m (terminal_edge (part_below G m) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC;
  COPY 2;
  USE 2 ( MATCH_MP part_below_finite);
  TSPEC `m` 2;
  REWRITE_TAC[target_set];
  TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC;
  TYPE_THEN `(part_below G m e) /\ (closure top2 e (pointI x))` SUBGOAL_TAC;
  ASM_MESON_TAC[terminal_endpoint];
  DISCH_ALL_TAC;
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[part_below_subset;ISUBSET;rectagon];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
  ASM_REWRITE_TAC[hv_edgeV2;v_edge_inj];
  REWR 5;
  USE 5 (REWRITE_RULE[part_below_v]);
  ASM_REWRITE_TAC[PAIR_SPLIT ];
  REWR 6;
  USE 6 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
  TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 6;
  TYPE_THEN `SND x = SND m +: &:1` SUBGOAL_TAC;
  ASM_MESON_TAC[endpoint_lemma_mid_fst];
  UND 6;
  AND 5;
  AND 5;
  UND 5;
  INT_ARITH_TAC;
  (* H edge *)
  ASM_REWRITE_TAC[hv_edgeV2;h_edge_inj;];
  REWR 5;
  USE 5(REWRITE_RULE[part_below_h ]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let terminal_edge_surj = 
prove_by_refinement(
  `!G m e. (rectagon G) /\ (target_set G m e) ==>
       (?x. (endpoint (part_below G m) x) /\
          (e = terminal_edge (part_below G m) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC;
  TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC;
  ASM_MESON_TAC[part_below_finite];
  DISCH_TAC;
  TYPE_THEN `(part_below G m) SUBSET G` SUBGOAL_TAC;
  ASM_MESON_TAC[part_below_subset];
  DISCH_TAC;
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[target_edge;ISUBSET];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
  REWR 1;
  USE 1(REWRITE_RULE[target_v]);
  AND 1;
  REWR 1;
  REWR 5;
  KILL 6;
  TYPE_THEN `up m` EXISTS_TAC;
  IMATCH_MP_TAC  endpoint_criterion;
  ASM_REWRITE_TAC[];
  GEN_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `edge e'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;rectagon];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  ASM_REWRITE_TAC [v_edge_inj;PAIR_SPLIT];
  REWR 7;
  USE 7(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT;up;]);
  AND 6;
  AND 6;
  UND 6;
  UND 7;
  INT_ARITH_TAC;
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_h;set_lower;left  ;]);
  TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 7;
  USE 7(REWRITE_RULE[h_edge_cpoint; up; PAIR_SPLIT ]);
  UND 7;
  UND 9;
  INT_ARITH_TAC;
  DISCH_TAC;
  EXPAND_TAC "e'";
  KILL 6;
  ASM_REWRITE_TAC [part_below_v;v_edge_cpoint;up];
  INT_ARITH_TAC;
  (* half-on-proof , hedge *)
  (* hop *)
  REWR 1;
  USE 1(REWRITE_RULE[target_h]);
  UND 1;
  DISCH_THEN (DISJ_CASES_TAC); (* split LEFT and RIGHT H *)
  TYPE_THEN `right  m'` EXISTS_TAC;
  IMATCH_MP_TAC  endpoint_criterion;
  ASM_REWRITE_TAC[];
  GEN_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `edge e'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;rectagon];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); (* snd H or v *)
  REWR 6;
  USE 6 (REWRITE_RULE[part_below_v]);
  REWR 7;
  USE 7(REWRITE_RULE[v_edge_cpoint;right  ;PAIR_SPLIT; ]);
  REWRITE_TAC[h_edge_inj;hv_edgeV2;];
  USE 1 (REWRITE_RULE[set_lower]);
  ASM_MESON_TAC[INT_ARITH `~(x +: &:1 = x)`];
  ASM_REWRITE_TAC [h_edge_inj;PAIR_SPLIT ];  (* snd H *)
  KILL 5;
  UND 8;
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE [t]));
  RULE_ASSUM_TAC (REWRITE_RULE[part_below_h;h_edge_cpoint;PAIR_SPLIT;right  ]);
  UND 6;
  DISCH_THEN DISJ_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[set_lower]);
  ASM_MESON_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[set_lower;left  ]);
  AND 5;
  AND 5;
  PROOF_BY_CONTR_TAC;
  UND 8;
  UND 7;
  UND 1;
  INT_ARITH_TAC;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  REWRITE_TAC[part_below_h;h_edge_cpoint;right  ];
  ASM_REWRITE_TAC[];
  KILL 5;
  (* finally LEFT case: now everything needs to have an endpoint *)
  (* hop3*)
  USE 1 (REWRITE_RULE[set_lower;left  ]);
  TYPE_THEN `  m'` EXISTS_TAC ; (* was left  m *)
  IMATCH_MP_TAC  endpoint_criterion;
  ASM_REWRITE_TAC[];
  GEN_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `edge e'` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon;ISUBSET];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
  ASM_REWRITE_TAC[];
  UND 7;
  DISCH_THEN  (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  RULE_ASSUM_TAC  (REWRITE_RULE[part_below_v;v_edge_cpoint;left  ;PAIR_SPLIT ;]);
  UND 5;
  UND 6;
  UND 1;
  INT_ARITH_TAC;
  (* now H *)
  ASM_REWRITE_TAC[];
  UND 7;
  DISCH_THEN  (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  RULE_ASSUM_TAC  (REWRITE_RULE[part_below_h;h_edge_cpoint;left  ;PAIR_SPLIT ;]);
  UND 5;
  DISCH_THEN DISJ_CASES_TAC;
  USE 5(REWRITE_RULE[set_lower]);
  UND 5;
  UND 6;
  UND 1;
  INT_ARITH_TAC;
  (* hop2 *)
  USE 5 (REWRITE_RULE[set_lower]);
  REWRITE_TAC[h_edge_inj;PAIR_SPLIT;];
  UND 5;
  UND 6;
  UND 1;
  INT_ARITH_TAC;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  ASM_REWRITE_TAC[part_below_h;h_edge_cpoint; set_lower; left  ];
  ]);;
  (* }}} *)

(* set *)
let inj_subset = 
prove_by_refinement(
  `!t t' s (f:A->B). (INJ f s t') /\ (t SUBSET t') /\
         (IMAGE f s SUBSET t) ==> (INJ f s t)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;IMAGE;SUBSET ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let terminal_edge_bij = 
prove_by_refinement(
  `!G m. (rectagon G) ==>
     (BIJ (terminal_edge (part_below G m))
         (endpoint (part_below G m)) (target_set G m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  inj_subset;
  TYPE_THEN `UNIV:((num->real)->bool)->bool` EXISTS_TAC;
  ASM_SIMP_TAC[inj_terminal];
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[terminal_edge_image];
  REWRITE_TAC[INJ;SURJ];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[terminal_edge_surj];
  ]);;
  (* }}} *)

let target_set_finite = 
prove_by_refinement(
  `!G m. (FINITE  G) ==> (FINITE (target_set G m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_MESON_TAC[target_set_subset];
  ]);;
  (* }}} *)

let rectagon_endpoint0 = 
prove_by_refinement(
  `!G. (rectagon G) ==> ((endpoint G) HAS_SIZE 0)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `endpoint G = {}` SUBGOAL_TAC;
  REWRITE_TAC[EQ_EMPTY];
  ASM_MESON_TAC[rectagon_endpoint];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[HAS_SIZE_0];
  ]);;
  (* }}} *)

let target_set_even = 
prove_by_refinement(
  `!G m. (rectagon G) ==> (EVEN (CARD (target_set G m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `CARD (endpoint(part_below G m)) = CARD (target_set G m)` SUBGOAL_TAC;
  IMATCH_MP_TAC  BIJ_CARD ;
  TYPE_THEN `terminal_edge (part_below G m)` EXISTS_TAC;
  ASM_SIMP_TAC[terminal_edge_bij];
  ASSUME_TAC terminal_edge_bij;
  TYPEL_THEN [`G`;`m`] (USE 1 o ISPECL);
  REWR 1;
  ASSUME_TAC target_set_finite;
  TYPEL_THEN [`G`;`m`] (USE 2 o ISPECL);
  ASM_MESON_TAC[FINITE_BIJ2;rectagon];
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  TYPE_THEN `rectagon (part_below G m)` ASM_CASES_TAC;
  TYPE_THEN `CARD (endpoint (part_below G m)) =0` SUBGOAL_TAC;
  ASM_MESON_TAC[HAS_SIZE;rectagon_endpoint0];
  MESON_TAC[EVEN];
  TYPE_THEN `P = part_below G m` ABBREV_TAC ;
  TYPE_THEN `segment G /\ (P SUBSET G) /\ ~(rectagon P)` SUBGOAL_TAC;
  ASM_SIMP_TAC[rectagon_segment];
  ASM_MESON_TAC[part_below_subset];
  DISCH_TAC;
  USE 3 (MATCH_MP endpoint_even );
  USE 3 (REWRITE_RULE[HAS_SIZE]);
  ASM_REWRITE_TAC[EVEN_DOUBLE];
  ]);;
  (* }}} *)

let bij_target_set = 
prove_by_refinement(
  `!G m. (rectagon G) /\ ~(G (v_edge m)) ==>
     (BIJ h_edge (set_lower G (left  m) UNION (set_lower G m))
           (target_set G m))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; ];
  MESON_TAC[];
  REWRITE_TAC[h_edge_inj;];
  MESON_TAC[];
  REWRITE_TAC[INJ;SURJ];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[target_set;set_lower;UNION;];
  GEN_TAC;
  REP_CASES_TAC;
  CHO 4;
  UND 4;
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  CHO 4;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let bij_target_set_odd = 
prove_by_refinement(
  `!G m. (rectagon G) /\ (G (v_edge m)) ==>
     (BIJ h_edge (set_lower G (left  m) UNION
             (set_lower G m) )
           (target_set G m DELETE (v_edge m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; DELETE ];
  MESON_TAC[];
  REWRITE_TAC[h_edge_inj;];
  MESON_TAC[];
  REWRITE_TAC[INJ;SURJ];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[target_set;set_lower;UNION;DELETE ];
  GEN_TAC;
  DISCH_TAC;
  AND  4;
  REWR 5;
  UND 5;
  REP_CASES_TAC;
  CHO 5;
  UND 5;
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  CHO 5;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let target_set_odd = 
prove_by_refinement(
  `!G m. (rectagon G) /\ (G (v_edge m)) ==>
         ~(EVEN(CARD (target_set G m DELETE (v_edge m))))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM EVEN];
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE (target_set G m)` SUBGOAL_TAC;
  ASM_MESON_TAC[target_set_finite;rectagon];
  DISCH_TAC;
  TYPE_THEN `target_set G m (v_edge m)` SUBGOAL_TAC;
  ASM_REWRITE_TAC [target_v];
  DISCH_TAC;
  TYPE_THEN `SUC (CARD (target_set G m DELETE (v_edge m))) = CARD (target_set G m )` SUBGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUC_DELETE;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[target_set_even];
  ]);;
  (* }}} *)

let squ_left_even = 
prove_by_refinement(
  `!G m. (rectagon G) /\ ~(G (v_edge m)) ==>
     ((even_cell G (squ (left m)) = even_cell G(squ m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC;
  REWRITE_TAC[even_cell_squ;num_lower_set];
  TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC;
  IMATCH_MP_TAC  even_card_even;
  ASM_SIMP_TAC[finite_set_lower];
  REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ];
  MESON_TAC[INT_ARITH `~(z = z -: &:1)`];
  DISCH_THEN_REWRITE;
  TYPE_THEN `BIJ h_edge (set_lower G (left  m) UNION (set_lower G m)) (target_set G m) ` SUBGOAL_TAC;
  ASM_MESON_TAC[bij_target_set];
  DISCH_TAC;
  TYPE_THEN `CARD (set_lower G (left  m) UNION (set_lower G m)) = CARD (target_set G m)` SUBGOAL_TAC;
  IMATCH_MP_TAC  BIJ_CARD ;
  TYPE_THEN `h_edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[FINITE_UNION];
  ASM_MESON_TAC[finite_set_lower];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[target_set_even];
  ]);;
  (* }}} *)

let squ_left_odd = 
prove_by_refinement(
  `!G m. (rectagon G) /\ (G (v_edge m)) ==>
     (~(even_cell G (squ (left m)) = even_cell G(squ m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC;
  UND 0;
  REWRITE_TAC[even_cell_squ;num_lower_set];
  TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC;
  IMATCH_MP_TAC  even_card_even;
  ASM_SIMP_TAC[finite_set_lower];
  REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ];
  MESON_TAC[INT_ARITH `~(z = z -: &:1)`];
  DISCH_THEN_REWRITE;
  TYPE_THEN `BIJ h_edge (set_lower G (left  m) UNION (set_lower G m)) (target_set G m DELETE (v_edge m)) ` SUBGOAL_TAC;
  ASM_MESON_TAC[bij_target_set_odd];
  DISCH_TAC;
  TYPE_THEN `CARD (set_lower G (left  m) UNION (set_lower G m)) = CARD (target_set G m DELETE (v_edge m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  BIJ_CARD ;
  TYPE_THEN `h_edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[FINITE_UNION];
  ASM_MESON_TAC[finite_set_lower];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[target_set_odd];
  ]);;
  (* }}} *)

let squ_left_par = 
prove_by_refinement(
  `!G m. (rectagon G) ==>
       (((even_cell G (squ (left m)) = even_cell G(squ m))) <=>
            ~(G (v_edge m)))`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[squ_left_even;squ_left_odd];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION E *)
(* ------------------------------------------------------------------ *)


let rectangle = jordan_def `rectangle p q =
  {Z | ?u v. (Z = point(u,v)) /\
    (real_of_int (FST p ) <. u) /\ (u <. (real_of_int (FST q ))) /\
    (real_of_int (SND p ) <. v) /\ (v <. (real_of_int (SND q))) }`;;

let rectangle_inter = 
prove_by_refinement(
  `!p q. rectangle p q =
      {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER
      {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER
     {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST q)} INTER
    {z | ?r. (z = point r) /\ (SND  r ) <. real_of_int(SND  q)}  `,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[rectangle;INTER];
  GEN_TAC;
  EQ_TAC;
  DISCH_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[point_inj];
  CONV_TAC (dropq_conv "r");
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "r");
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "r'");
  CONV_TAC (dropq_conv "r");
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[point_inj]);
  USE 1(CONV_RULE (dropq_conv "r'"));
  REWR 2;
  USE 2(REWRITE_RULE[point_inj]);
  USE 2(CONV_RULE (dropq_conv "r'"));
  REWR 3;
  USE 3(REWRITE_RULE[point_inj]);
  USE 3(CONV_RULE (dropq_conv "r'"));
  REWRITE_TAC[point_inj;PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let rectangle_open = 
prove_by_refinement(
  `!p q. top2 (rectangle p q)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectangle_inter];
  ASSUME_TAC top2_top;
  DISCH_ALL_TAC;
  REPEAT (IMATCH_MP_TAC  top_inter THEN ASM_REWRITE_TAC[top_inter;open_half_plane2D_FLT_open;open_half_plane2D_LTF_open;open_half_plane2D_SLT_open;open_half_plane2D_LTS_open]);
  ]);;
  (* }}} *)

let rectangle_convex = 
prove_by_refinement(
  `!p q. convex (rectangle p q)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[rectangle_inter];
  REPEAT (IMATCH_MP_TAC  convex_inter THEN REWRITE_TAC[open_half_plane2D_FLT_convex;open_half_plane2D_LTF_convex;open_half_plane2D_SLT_convex;open_half_plane2D_LTS_convex]);
  ]);;
  (* }}} *)

let rectangle_squ = 
prove_by_refinement(
  `!p. squ p = rectangle p (FST p +: &:1,SND p +: &:1)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[squ;rectangle];
  ]);;
  (* }}} *)

let squ_inter = 
prove_by_refinement(
  `!p. squ p =
   {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER
      {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER
     {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST p +: &:1) } INTER
    {z | ?r. (z = point r) /\ (SND  r ) <. real_of_int(SND p +: &:1) }`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectangle_squ;rectangle_inter];
  ]);;
  (* }}} *)

(* set *)
let subset3_absorb = 
prove_by_refinement(
  `!(A:A->bool) B C. (B SUBSET C) ==> (B INTER A = B INTER C INTER A)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[INTER_ACI];
  AP_TERM_TAC;
  ASM_MESON_TAC[SUBSET_INTER_ABSORPTION];
  ]);;
  (* }}} *)

let rectangle_lemma1 = 
prove_by_refinement(
  `!p. squ(down p) =
     (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1))
    INTER {z | ?r. (z = point r) /\ (SND  r <. real_of_int(SND  p))}`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[squ_inter;rectangle_inter;down];
  REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
  REWRITE_TAC[INTER_ACI];
  AP_TERM_TAC;
  AP_TERM_TAC;
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER;int_suc ;];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  ASSUME_TAC (REAL_ARITH `!u. u <. u + &.1`);
  CONJ_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  ASM_MESON_TAC[REAL_LT_TRANS ];
  ASM_MESON_TAC[];
  MESON_TAC[];
  ]);;
  (* }}} *)


let rectangle_lemma2 = 
prove_by_refinement(
  `!p. squ(p) =
     (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1))
    INTER {z | ?r. (z = point r) /\ ( real_of_int(SND  p) <. SND  r)}`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[squ_inter;rectangle_inter;down];
  REWRITE_TAC[INTER_ACI];
  AP_TERM_TAC;
  TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND p -: &:1) < SND r}` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th];
  ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`];
  ]);;
  (* }}} *)

let rectangle_lemma3 = 
prove_by_refinement(
  `!q. h_edge q =
    (rectangle (FST q , SND q -: &:1) (FST q +: &:1 , SND q +: &:1))
    INTER {z | ?r. (z = point r) /\ ( SND  r = real_of_int(SND  q))}`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[h_edge_inter;rectangle_inter;];
  TYPE_THEN `B = {z | ?p. (z = point p) /\ (SND p = real_of_int (SND q))}` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ;
  TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
  REWRITE_TAC[INTER_ACI];
  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
  IMATCH_MP_TAC subset3_absorb;
  REWRITE_TAC[SUBSET_INTER];
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  EXPAND_TAC "D";
  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;];
  ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`];
  ]);;
  (* }}} *)

let rectangle_h = 
prove_by_refinement(
  `!p. rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1) =
     ((squ (down p)) UNION (h_edge p) UNION  (squ p) )`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[rectangle_lemma1;rectangle_lemma2;rectangle_lemma3];
  REWRITE_TAC[GSYM UNION_OVER_INTER];
  TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION  {z | ?r. (z = point r) /\ (SND r = real_of_int (SND p))} UNION  {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[UNION];
  ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`];
  DISCH_THEN_REWRITE;
  TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1) SUBSET  {z | ?r. z = point r}` SUBGOAL_TAC;
  REWRITE_TAC[rectangle;SUBSET ];
  ASM_MESON_TAC[];
  REWRITE_TAC [SUBSET_INTER_ABSORPTION;];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let rectangle_lemma4 = 
prove_by_refinement(
  `!p. squ(left   p) =
     (rectangle (FST p -: &:1 , SND p)(FST p +: &:1 , SND p +: &:1))
    INTER {z | ?r. (z = point r) /\ (FST   r <. real_of_int(FST  p))}`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[squ_inter;rectangle_inter;left  ];
  REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
  REWRITE_TAC[INTER_ACI];
  AP_TERM_TAC;
  AP_TERM_TAC;
  TYPE_THEN `B = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC  ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)}` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  REWRITE_TAC[SUBSET;int_suc];
  ASM_MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &.1`];
  ]);;
  (* }}} *)

let rectangle_lemma5 = 
prove_by_refinement(
  `!p. squ(p) =
     (rectangle (FST p -: &:1 , SND p) (FST p +: &:1 , SND p +: &:1))
    INTER {z | ?r. (z = point r) /\ ( real_of_int(FST   p) <. FST   r)}`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[squ_inter;rectangle_inter;];
TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r} ` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th];
  ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`];
  ]);;
  (* }}} *)

let rectangle_lemma6 = 
prove_by_refinement(
  `!q. v_edge q =
    (rectangle (FST q -: &:1 , SND q) (FST q +: &:1 , SND q +: &:1))
    INTER {z | ?r. (z = point r) /\ ( FST   r = real_of_int(FST   q))}`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[v_edge_inter;rectangle_inter;];
  REWRITE_TAC[INTER_ACI];
  TYPE_THEN `B = {z | ?p. (z = point p) /\ (FST  p = real_of_int (FST  q))}` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST q -: &:1) < FST r}` ABBREV_TAC ;
  TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST q +: &:1)}` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
  REWRITE_TAC[INTER_ACI];
  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
  IMATCH_MP_TAC subset3_absorb;
  REWRITE_TAC[SUBSET_INTER];
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  EXPAND_TAC "D";
  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;];
  ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`];
  ]);;
  (* }}} *)

let rectangle_v = 
prove_by_refinement(
  `!p. rectangle (FST p -: &:1 , SND p ) (FST p +: &:1 , SND p +: &:1) =
     ((squ (left p)) UNION (v_edge p) UNION  (squ p) )`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[rectangle_lemma4;rectangle_lemma5;rectangle_lemma6];
  REWRITE_TAC[GSYM UNION_OVER_INTER];
  TYPE_THEN `({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION  {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION  {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[UNION];
  ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`];
  DISCH_THEN_REWRITE;
  TYPE_THEN `rectangle (FST p -: &:1 ,SND p) (FST p +: &:1,SND p +: &:1) SUBSET  {z | ?r. z = point r}` SUBGOAL_TAC;
  REWRITE_TAC[rectangle;SUBSET ];
  ASM_MESON_TAC[];
  REWRITE_TAC [SUBSET_INTER_ABSORPTION;];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let long_v = jordan_def `long_v p =
  {z | (?r. (z = point r) /\ (FST r = real_of_int (FST p)) /\
       (real_of_int(SND  p) - &1 <. SND r) /\
       (SND r <. real_of_int(SND p) + &1) )}`;;

let long_v_inter = 
prove_by_refinement(
  `!p. long_v p =
    {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} INTER
      {z | ?r. (z = point r) /\ (real_of_int(SND p -: &:1) <. SND r)} INTER
     {z | ?r. (z = point r) /\ (SND  r  <. real_of_int(SND  p +: &:1))} `,

  (* {{{ proof *)

  [
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT ;
  REWRITE_TAC[long_v;INTER;int_add_th;int_sub_th;int_of_num_th];
  GEN_TAC;
  EQ_TAC;
  DISCH_THEN CHOOSE_TAC;
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  CHO 0;
  REWR 1;
  REWR 2;
  RULE_ASSUM_TAC  (REWRITE_RULE[point_inj]);
  USE 2(CONV_RULE (dropq_conv "r'"));
  USE 1(CONV_RULE (dropq_conv "r'"));
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let long_v_lemma1 = 
prove_by_refinement(
  `!q. v_edge (down q) =
     long_v q INTER
         {z | ?r. (z = point r) /\ (SND  r  <. real_of_int(SND  q))}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[v_edge_inter;long_v_inter;down ];
  REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
  GEN_TAC;
  TYPE_THEN `B = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q)}` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
  alpha_tac;
  REWRITE_TAC[INTER_ACI];
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  REWRITE_TAC[SUBSET;int_add_th;int_of_num_th];
  MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &1`];
  ]);;
  (* }}} *)

let long_v_lemma2 = 
prove_by_refinement(
  `!q. v_edge q =
     long_v q INTER
         {z | ?r. (z = point r) /\ (real_of_int(SND  q) <. SND  r  )}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[v_edge_inter;long_v_inter;down;int_suc;int_sub_th;int_of_num_th ];
  GEN_TAC;
  TYPE_THEN `B = {z | ?r. (z = point r) /\  real_of_int (SND q) < SND r}` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\  real_of_int (SND q) - &1 < SND r}` ABBREV_TAC ;
  alpha_tac;
  REWRITE_TAC[INTER_ACI];
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  REWRITE_TAC[SUBSET;int_add_th;int_of_num_th];
  MESON_TAC[REAL_ARITH `x <. y ==> x - &1 <. y`];
  ]);;
  (* }}} *)

let pointI_inter = 
prove_by_refinement(
  `!q. {(pointI q)} =
        {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))} INTER
        {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING;pointI ];
  GEN_TAC;
  EQ_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[point_inj];
  CONV_TAC (dropq_conv "r");
  CONV_TAC (dropq_conv "r'");
  DISCH_ALL_TAC;
  CHO 0;
  REWR 1;
  USE 1(REWRITE_RULE[point_inj]);
  USE 1(CONV_RULE (dropq_conv "r'"));
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;];
  ]);;
  (* }}} *)

let long_v_lemma3 = 
prove_by_refinement(
  `!q. {(pointI q)} = long_v q INTER
       { z | ?r. (z = point r) /\ (real_of_int(SND q) = SND r)}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[pointI_inter;long_v_inter];
  GEN_TAC;
  alpha_tac;
  TYPE_THEN `A = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))}` ABBREV_TAC ;
  TYPE_THEN `B = {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ;
  TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  AP_TERM_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  EXPAND_TAC "D";
  REWRITE_TAC[SUBSET;INTER;int_sub_th;int_of_num_th;int_add_th];
  ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &1 <. y /\ x <. y + &1)`];
  ]);;
  (* }}} *)

let long_v_union = 
prove_by_refinement(
  `!p. long_v p =
      (v_edge (down p)) UNION {(pointI p)} UNION (v_edge p)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[long_v_lemma1;long_v_lemma2;long_v_lemma3];
  REWRITE_TAC[GSYM UNION_OVER_INTER];
  TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION  {z | ?r. (z = point r) /\ (real_of_int (SND p) = SND r)} UNION  {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT  ;
  GEN_TAC;
  REWRITE_TAC[UNION;];
  EQ_TAC;
  MESON_TAC[];
  DISCH_THEN CHOOSE_TAC;
  ASM_REWRITE_TAC[point_inj];
  CONV_TAC (dropq_conv "r'");
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;];
  REWRITE_TAC[long_v;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let two_two_lemma1 = 
prove_by_refinement(
  `!p. rectangle(FST p - &:1 , SND p - &:1) (FST p , SND p + &:1) =
  rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
     INTER
  {z | (?r. (z = point r) /\ (FST r <. real_of_int(FST p)))}`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[rectangle_inter];
  alpha_tac;
  TYPE_THEN `B  = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC  ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  REWRITE_TAC[SUBSET;int_suc;];
  MESON_TAC[REAL_ARITH `x <. y ==> x < y + &1`];
  ]);;
  (* }}} *)

let two_two_lemma2 = 
prove_by_refinement(
  `!p. rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1) =
  rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
  INTER
  {z | (?r. (z = point r) /\ ( real_of_int(FST p) <. FST r ))}`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[rectangle_inter];
  alpha_tac;
  TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  REWRITE_TAC[SUBSET;int_sub_th;int_add_th;int_of_num_th;];
  ASM_MESON_TAC[REAL_ARITH `x < y ==> (x - &1 <. y)`];
  ]);;
  (* }}} *)

let two_two_lemma3 = 
prove_by_refinement(
  `!p. long_v p =
  rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
  INTER
    {z | (?r. (z = point r) /\ (  FST r =  real_of_int(FST p)  ))}`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[long_v_inter;rectangle_inter];
  alpha_tac;
  TYPE_THEN `B = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} ` ABBREV_TAC ;
  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
  TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ;
  REWRITE_TAC[INTER_ACI];
  TYPE_THEN `!A. (B INTER C INTER D INTER A) = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
  REWRITE_TAC[INTER_ACI];
  DISCH_THEN (fun t-> PURE_REWRITE_TAC[t]);
  IMATCH_MP_TAC  subset3_absorb;
  EXPAND_TAC "B";
  EXPAND_TAC "C";
  EXPAND_TAC "D";
  REWRITE_TAC[SUBSET;INTER;int_sub_th;int_add_th;int_of_num_th];
  GEN_TAC;
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &.1 <. y /\ x <. y+ &1)`];
  ]);;
  (* }}} *)

let two_two_union = 
prove_by_refinement(
  `!p. rectangle (FST p -: &:1 , SND p -: &:1)
     (FST p +: &:1 , SND p + &:1) =
   rectangle(FST p - &:1 , SND p - &:1) (FST p  , SND p + &:1) UNION
   long_v p UNION
   rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[two_two_lemma1;two_two_lemma2;two_two_lemma3];
  REWRITE_TAC[GSYM UNION_OVER_INTER];
  GEN_TAC;
  TYPE_THEN `{z | ?r. (z = point r)} = ({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r})` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[UNION];
  EQ_TAC;
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  DISCH_THEN_REWRITE;
  REWRITE_TAC [point_inj];
  CONV_TAC (dropq_conv "r'");
  REAL_ARITH_TAC;
  MESON_TAC[];
  DISCH_TAC;
  USE 0 SYM;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
  REWRITE_TAC[rectangle;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let two_two_nine = 
prove_by_refinement(
  `!p. rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) =
   squ (FST p -: &:1,SND p -: &:1) UNION squ (FST p -: &:1,SND p ) UNION
   squ (FST p,SND p -: &:1) UNION squ p UNION
   h_edge (left  p) UNION h_edge  p UNION
   v_edge (down p) UNION v_edge p UNION {(pointI p)}`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[two_two_union;rectangle_h;rectangle_v];
  TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p,SND p +: &:1) = rectangle (FST (left  p),SND (left  p) -: &:1) (FST (left  p) +: &:1,SND (left   p) +: &:1)` SUBGOAL_TAC;
  REWRITE_TAC[left ;INT_ARITH `x -: &:1 +: &:1 = x`];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[rectangle_h];
  REWRITE_TAC[left ;down; long_v_union];
  REWRITE_TAC[UNION_ACI];
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)

let curve_cell = jordan_def `curve_cell G = G UNION
   {z | (?n. (z = {(pointI n)}) /\ (closure top2 (UNIONS G) (pointI n)))}`;;

let curve_cell_cell = 
prove_by_refinement(
  `!G. (G SUBSET edge) ==> (curve_cell G SUBSET cell)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;edge;curve_cell;cell;UNION ];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  UND 1;
  DISCH_THEN DISJ_CASES_TAC;
  TSPEC `x` 0;
  REWR 0;
  CHO 0;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let curve_cell_point = 
prove_by_refinement(
  `!G n. (FINITE G) /\ (G SUBSET edge) ==> (curve_cell G {(pointI n)} <=>
           (?e. (G e /\ (closure top2 e (pointI n)))))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[curve_cell;UNION ;edge;SUBSET ];
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TSPEC `{(pointI n)}` 1;
  USE 1(GSYM);
  USE 1(REWRITE_RULE[eq_sing;v_edge_pointI;h_edge_pointI;]);
  ASM_MESON_TAC[];
  USE 2 (REWRITE_RULE[eq_sing;INR IN_SING ;pointI_inj]);
  USE 2(CONV_RULE (dropq_conv "n'"));
  ASSUME_TAC top2_top;
  UND 2;
  ASM_SIMP_TAC[closure_unions];
  REWRITE_TAC[IMAGE;INR IN_UNIONS ];
  DISCH_THEN CHOOSE_TAC;
  AND 2;
  CHO 4;
  ASM_MESON_TAC[];
  DISCH_THEN CHOOSE_TAC;
  DISJ2_TAC;
  REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;];
  CONV_TAC (dropq_conv "n'") ;
  TYPE_THEN `closure top2 e SUBSET closure top2 (UNIONS G)` SUBGOAL_TAC;
  IMATCH_MP_TAC  subset_of_closure;
  REWRITE_TAC[top2_top];
  IMATCH_MP_TAC  sub_union;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let curve_cell_h = 
prove_by_refinement(
  `!G n. (segment G) ==> (curve_cell G (h_edge n) = G (h_edge n))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI];
  ]);;
  (* }}} *)

let curve_cell_v = 
prove_by_refinement(
  `!G n. (segment G) ==> (curve_cell G (v_edge n) = G (v_edge n))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI];
  ]);;
  (* }}} *)

let curve_cell_in = 
prove_by_refinement(
  `!C G . (G SUBSET edge) /\ (curve_cell G C) ==>
    (?n. (C = {(pointI n)}) \/ (C = h_edge n) \/ (C = v_edge n))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[curve_cell;UNION ;SUBSET; edge ];
  DISCH_ALL_TAC;
  UND 1;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let curve_cell_subset = 
prove_by_refinement(
  `!G. (G SUBSET (curve_cell G))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;curve_cell;UNION ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let curve_closure = 
prove_by_refinement(
  `!G. (segment G) ==>
    (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC ;
  ASSUME_TAC top2_top;
  (* ASM_SIMP_TAC[closure_unions]; *)
  TYPE_THEN `G SUBSET edge ` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  ASM_SIMP_TAC[closure_unions];
  REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ];
  DISCH_ALL_TAC;
  CHO 4;
  AND 4;
  CHO 5;
  TYPE_THEN `edge x'` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
  REWR 5;
  REWR 4;
  COPY 4;
  USE 4(REWRITE_RULE[v_edge_closure;vc_edge;UNION ;INR IN_SING ]);
  UND 4;
  REP_CASES_TAC;
  TYPE_THEN `v_edge m` EXISTS_TAC;
  ASM_SIMP_TAC [curve_cell_v];
  TYPE_THEN `{(pointI m)}` EXISTS_TAC;

  ASM_SIMP_TAC [curve_cell_point];
  REWRITE_TAC[INR IN_SING];
  ASM_MESON_TAC[];
  USE 4(REWRITE_RULE[plus_e12]);
  TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC;

  ASM_SIMP_TAC [curve_cell_point];
  REWRITE_TAC[INR IN_SING];
  ASM_MESON_TAC[];
  (* dt2 , down to 2 goals *)
  REWR 5;
  REWR 4;
  COPY 4;
  USE 4 (REWRITE_RULE[h_edge_closure;hc_edge;UNION;INR IN_SING]);
  UND 4;
  REP_CASES_TAC;
  TYPE_THEN `h_edge m` EXISTS_TAC;
  ASM_SIMP_TAC[curve_cell_h];
  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
  ASM_MESON_TAC[];
  USE 4(REWRITE_RULE[plus_e12]);
  TYPE_THEN `{x}` EXISTS_TAC;
  ASM_REWRITE_TAC[INR IN_SING];
  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
  ASM_MESON_TAC[];
  (* dt1 *)
  REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset];
  ASM_SIMP_TAC[closure_unions];
  CONJ_TAC;
  REWRITE_TAC[SUBSET;IMAGE;UNIONS];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "u");
  NAME_CONFLICT_TAC;
  CHO 4;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[subset_closure;ISUBSET ];
  (* // *)
  TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ;
  REWRITE_TAC[UNIONS;SUBSET ];
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[INR IN_SING];
  MESON_TAC[];
  ]);;
  (* }}} *)

(* logic *)
let not_not = 
prove_by_refinement(
  `!x y. (~x = ~y) <=> (x = y)`,

  (* {{{ proof *)
  [
  MESON_TAC[];
  ]);;
  (* }}} *)

let not_eq = 
prove_by_refinement(
  `!x y. (~x = y) <=> (x = ~y)`,

  (* {{{ proof *)
  [
  MESON_TAC[];
  ]);;
  (* }}} *)

let cell_inter = 
prove_by_refinement(
  `!C D. (cell C) /\ (D SUBSET cell) ==>
         ((C INTER (UNIONS D) = EMPTY) <=> ~(D C))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[INTER;IN_UNIONS;SUBSET;EQ_EMPTY  ];
  DISCH_ALL_TAC;
  RIGHT_TAC  "x";
  REWRITE_TAC[not_not ];
  EQ_TAC;
  DISCH_THEN CHOOSE_TAC;
  AND 2;
  CHO 2;
  TYPE_THEN `t = C` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 0(MATCH_MP cell_nonempty);
  USE 0(REWRITE_RULE[EMPTY_EXISTS]);
  CHO 0;
  ASM_MESON_TAC[];
  ]);;

  (* }}} *)

let curve_cell_h_inter = 
prove_by_refinement(
  `!G m. (segment G) ==>
     (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
         (~(G (h_edge m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[GSYM curve_cell_h];
  IMATCH_MP_TAC  cell_inter;
  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
  ASM_MESON_TAC[segment;curve_cell_cell];
  ]);;
  (* }}} *)

let curve_cell_v_inter = 
prove_by_refinement(
  `!G m. (segment G) ==>
     (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
         (~(G (v_edge m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[GSYM curve_cell_v];
  IMATCH_MP_TAC  cell_inter;
  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
  ASM_MESON_TAC[segment;curve_cell_cell];
  ]);;
  (* }}} *)

let curve_cell_squ = 
prove_by_refinement(
  `!G m. (segment G) ==> ~curve_cell G (squ m)`,

  (* {{{ proof *)
  [
    REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment];
  REWRITE_TAC[SUBSET; edge];
  DISCH_ALL_TAC;
  TSPEC `squ m` 3;
  USE 3(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let curve_cell_squ_inter = 
prove_by_refinement(
  `!G m. (segment G) ==>
     (((squ m) INTER (UNIONS (curve_cell G)) = {}))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `cell (squ m)` SUBGOAL_TAC;
  REWRITE_TAC[cell_rules];
  DISCH_TAC;
  TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC;
  ASM_MESON_TAC[curve_cell_cell;segment];
  DISCH_TAC;
  ASM_SIMP_TAC [cell_inter];
  ASM_MESON_TAC [curve_cell_squ];
  ]);;
  (* }}} *)

let curve_point_unions = 
prove_by_refinement(
  `!G m. (segment G) ==>
     (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC;
  REWRITE_TAC[REWRITE_RULE[not_eq] single_inter];
  DISCH_THEN_REWRITE;
  REWRITE_TAC [not_eq];
  IMATCH_MP_TAC  cell_inter;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  ASM_MESON_TAC[cell_rules;curve_cell_cell];
  ]);;
  (* }}} *)

let curve_cell_not_point = 
prove_by_refinement(
  `!G m. (segment G) ==> ((curve_cell G {(pointI m)} <=>
     ~(num_closure G (pointI m) = 0)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G /\ (G SUBSET edge)` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  ASM_SIMP_TAC[curve_cell_point;num_closure0];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)

let par_cell = jordan_def `par_cell eps G C <=>
  ((?m. (C = {(pointI m)}) /\ (eps = EVEN (num_lower G m))) \/
         (?m. (C = h_edge m) /\ (eps = EVEN (num_lower G m))) \/
         (?m. (C = v_edge m) /\ (eps = EVEN (num_lower G m))) \/
         (?m. (C = squ m) /\ (eps= EVEN (num_lower G m)))) /\
   (C INTER (UNIONS (curve_cell G)) = EMPTY )`;;

let par_cell_curve_disj = 
prove_by_refinement(
  `!G C eps. (par_cell eps G C) ==>
          (C INTER (UNIONS (curve_cell G)) = EMPTY )`,

  (* {{{ proof *)
  [
 REWRITE_TAC[par_cell];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let par_cell_cell = 
prove_by_refinement(
  `!G eps.  (par_cell eps G SUBSET cell)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;par_cell;even_cell];
  DISCH_ALL_TAC;
  ASM_MESON_TAC[cell_rules];
  ]);;
  (* }}} *)

let par_cell_h = 
prove_by_refinement(
  `!G m eps. (segment G) ==> ((par_cell eps G (h_edge m) <=>
      (~(G (h_edge m))) /\ (eps = EVEN (num_lower G m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[par_cell;eq_sing;h_edge_inj;hv_edgeV2;h_edge_pointI;];
  REWRITE_TAC[square_h_edgeV2];
  ASM_SIMP_TAC[curve_cell_h_inter];
  CONV_TAC (dropq_conv "m'");
  MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_v = 
prove_by_refinement(
  `!G m eps. (segment G) ==> ((par_cell eps G (v_edge m) <=>
      (~(G (v_edge m))) /\ (eps = EVEN (num_lower G m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[par_cell;eq_sing;v_edge_inj;hv_edgeV2;v_edge_pointI;];
  REWRITE_TAC[square_v_edgeV2];
  ASM_SIMP_TAC[curve_cell_v_inter];
  CONV_TAC (dropq_conv "m'");
  MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_squ = 
prove_by_refinement(
  `!G m eps. (segment G) ==> ((par_cell eps G (squ m) <=>
       (eps = EVEN (num_lower G m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[par_cell;eq_sing;square_h_edgeV2;square_v_edgeV2;squ_inj];
  ASM_SIMP_TAC[curve_cell_squ_inter];
  REWRITE_TAC[square_pointI];
  CONV_TAC (dropq_conv "m'");
  ]);;
  (* }}} *)

let par_cell_point = 
prove_by_refinement(
  `!G m eps. (segment G) ==> ((par_cell eps G {(pointI m)} <=>
      ((num_closure G (pointI m) = 0) /\
          (eps = EVEN (num_lower G m)))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[par_cell;eq_sing;INR IN_SING;point_inj;];
  SUBGOAL_TAC  `!u x. ({(pointI u)} = x) <=> (x = {(pointI u)})` ;
  ASM_MESON_TAC[];
  DISCH_THEN (fun t-> REWRITE_TAC[t]);
  REWRITE_TAC[eq_sing;INR IN_SING ;h_edge_pointI; v_edge_pointI; square_pointI;];
  REWRITE_TAC[pointI_inj; REWRITE_RULE[not_eq] single_inter];
  CONV_TAC (dropq_conv "m'");
  ASM_SIMP_TAC [curve_point_unions;curve_cell_not_point];
  MESON_TAC[];
  ]);;
  (* }}} *)

let eq_sing_sym = 
prove_by_refinement(
  `!X (y:A). ({y} = X) <=> X y /\ (!u. X u ==> (u = y))`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[eq_sing];
  ]);;
  (* }}} *)

let par_cell_disjoint = 
prove_by_refinement(
  `!G eps. (par_cell eps G INTER par_cell (~eps) G = EMPTY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[EQ_EMPTY;INTER ];
  REP_GEN_TAC;
  REWRITE_TAC[par_cell];
  REPEAT (REPEAT (LEFT_TAC "m") THEN (GEN_TAC));
  REPEAT (LEFT_TAC "m");
  REPEAT (REPEAT (LEFT_TAC "m'") THEN  (GEN_TAC ));
  REPEAT (LEFT_TAC ("m'"));
  REPEAT (REPEAT (LEFT_TAC "m''") THEN  (GEN_TAC ));
  REPEAT (LEFT_TAC ("m''"));
  LEFT_TAC "m'''" THEN GEN_TAC;
  LEFT_TAC "m''''" THEN GEN_TAC;
  LEFT_TAC "m'''''" THEN GEN_TAC;
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  REWRITE_TAC[DE_MORGAN_THM];
  REPEAT (CONJ_TAC) THEN (REWRITE_TAC[GSYM DE_MORGAN_THM;GSYM CONJ_ASSOC]) THEN (REWRITE_TAC[TAUT `~(A /\ B) <=> (A ==> ~B)`]) THEN (DISCH_THEN_REWRITE ) THEN (REWRITE_TAC[eq_sing;eq_sing_sym;pointI_inj;h_edge_pointI;v_edge_pointI;square_pointI; INR IN_SING ; hv_edgeV2; h_edge_inj ; v_edge_inj; square_v_edgeV2;square_h_edgeV2;squ_inj ]) THEN (ASM_MESON_TAC[]);
  ]);;
  (* }}} *)

let par_cell_nonempty = 
prove_by_refinement(
  `!G eps. (rectagon G) ==> ~(par_cell eps G = EMPTY)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  COPY 1;
  USE 1 (MATCH_MP rectagon_h_edge);
  CHO 1;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon];
  DISCH_TAC ;
  USE 3(MATCH_MP squ_down);
  TSPEC `m` 3;
  USE 3 (REWRITE_RULE[set_lower_n]);
  UND 3;
  ASM_REWRITE_TAC[even_cell_squ;];
  PROOF_BY_CONTR_TAC;
  UND 0;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon_segment];
  DISCH_TAC ;
  TYPE_THEN `eps = EVEN (num_lower G m)` ASM_CASES_TAC;
  TYPE_THEN `squ m` EXISTS_TAC;
  ASM_SIMP_TAC [par_cell_squ];
  TYPE_THEN `squ (down m)` EXISTS_TAC;
  ASM_SIMP_TAC[par_cell_squ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_unions_nonempty = 
prove_by_refinement(
  `!G eps. (rectagon G) ==> ~(UNIONS (par_cell eps G) = EMPTY)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[UNIONS;EMPTY_EXISTS ];
  NAME_CONFLICT_TAC;
  DISCH_TAC ;
  USE 0 (MATCH_MP par_cell_nonempty);
  TSPEC `eps` 0;
  USE 0 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 0;
 LEFT_TAC "u'";
  TYPE_THEN `u` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `cell u` SUBGOAL_TAC;
  ASM_MESON_TAC[par_cell_cell;ISUBSET ];
  DISCH_THEN (fun t-> MP_TAC (MATCH_MP cell_nonempty t));
  REWRITE_TAC[EMPTY_EXISTS];
  ]);;
  (* }}} *)

let ctop = jordan_def `ctop G =
   induced_top top2 (euclid 2 DIFF (UNIONS (curve_cell G)))`;;

let top2_unions = 
prove_by_refinement(
  `UNIONS (top2) = (euclid 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC [top2];
  ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
  ]);;
  (* }}} *)

let curve_closed = 
prove_by_refinement(
  `!G. (segment G) ==> (closed_ top2 (UNIONS (curve_cell G)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[GSYM curve_closure];
  IMATCH_MP_TAC  closure_closed;
  REWRITE_TAC[top2_top];
  IMATCH_MP_TAC  UNIONS_SUBSET;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  REWRITE_TAC[SUBSET;top2_unions;edge;  ];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  TSPEC `A` 1;
  REWR 1;
  CHO 1;
  ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid];
  ]);;
  (* }}} *)

let ctop_unions = 
prove_by_refinement(
  `!G. UNIONS (ctop G) = (euclid 2 DIFF (UNIONS (curve_cell G)))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[ctop];
  REWRITE_TAC[induced_top_support];
  REWRITE_TAC[top2_unions];
  REWRITE_TAC[INTER;DIFF;];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_partition = 
prove_by_refinement(
  `!G eps. (segment G) ==>
  ((UNIONS (par_cell eps G) UNION (UNIONS (par_cell (~eps) G))) =
    (UNIONS (ctop G))) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM ;
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  TYPE_THEN `eps` (fun t-> SPEC_TAC (t,t));
  RIGHT_TAC "eps";
  SUBCONJ_TAC;
  GEN_TAC;
  IMATCH_MP_TAC  UNIONS_SUBSET;
  REWRITE_TAC[ctop_unions;DIFF_SUBSET ];
  DISCH_ALL_TAC;
  COPY 1;
  USE 2(MATCH_MP par_cell_curve_disj);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  cell_euclid;
  ASM_MESON_TAC[par_cell_cell ;ISUBSET ];
  DISCH_TAC ;
  GEN_TAC;
  TSPEC `~eps` 1;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[ctop_unions;SUBSET ;DIFF ; UNION ; UNIONS ];
  DISCH_ALL_TAC;
  USE 1(MATCH_MP point_onto);
  CHO 1;
  ASSUME_TAC cell_unions;
  TSPEC `p` 3;
  USE 3 (REWRITE_RULE[UNIONS]);
  CHO 3;
  USE 3 (REWRITE_RULE[cell]);
  AND 3;
  CHO 4;
  UND 4;
  REP_CASES_TAC;
  NAME_CONFLICT_TAC;
  ASM_REWRITE_TAC[];
  REWR 3;
  USE 3(REWRITE_RULE[INR IN_SING;pointI;point_inj ;]);
  ASM_REWRITE_TAC[GSYM pointI];
  LEFT_TAC "u'";
  TYPE_THEN `{(pointI p')}` EXISTS_TAC;
  ASM_SIMP_TAC[par_cell_point];
  REWRITE_TAC[INR IN_SING];
  LEFT 2 "u";
  TSPEC `{(pointI p')}` 2;
  REWR 2;
  USE 2(REWRITE_RULE[GSYM pointI;INR IN_SING ]);
  UND 2;
  ASM_SIMP_TAC [curve_cell_not_point];
  MESON_TAC[];
  (* case 2 *)
  LEFT_TAC "u";
  TYPE_THEN `h_edge p'` EXISTS_TAC ;
  ASM_SIMP_TAC [par_cell_h];
  LEFT 2 "u";
  REWR 3;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `(G (h_edge p'))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC ;
  TSPEC `h_edge p'` 2;
  ASM_MESON_TAC[curve_cell_h];
  (* case 3 *)
  LEFT_TAC "u";
  TYPE_THEN `v_edge p'` EXISTS_TAC ;
  ASM_SIMP_TAC [par_cell_v];
  LEFT 2 "u";
  REWR 3;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `(G (v_edge p'))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC ;
  TSPEC `v_edge p'` 2;
  ASM_MESON_TAC[curve_cell_v];
  (* case 4 *)
  LEFT_TAC "u";
  TYPE_THEN `squ p'` EXISTS_TAC ;
  ASM_SIMP_TAC [par_cell_squ];
  LEFT 2 "u";
  REWR 3;
  ASM_REWRITE_TAC[];
  MESON_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(*  openness of par_cell *)
(* ------------------------------------------------------------------ *)

let par_cell_h_squ = 
prove_by_refinement(
  `!G m eps. (segment G) /\ (par_cell eps G (h_edge m)) ==>
     (par_cell eps G (squ m) /\ par_cell eps G (squ (down m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  UND 1;
  ASM_SIMP_TAC [par_cell_h;par_cell_squ];
  DISCH_ALL_TAC;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC ;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  ASM_SIMP_TAC[num_lower_down];
  ASM_MESON_TAC[set_lower_n];
  ]);;
  (* }}} *)

let par_cell_v_squ = 
prove_by_refinement(
  `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==>
     (par_cell eps G (squ m) /\ par_cell eps G (squ (left m)))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  UND 1;
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon_segment];
  ASM_SIMP_TAC [par_cell_v;par_cell_squ];
  DISCH_ALL_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par];
  ]);;
  (* }}} *)

(* move up *)
let segment_finite = 
prove_by_refinement(
  `!G. (segment G) ==> (FINITE G)`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[segment];
  ]);;
  (* }}} *)

let num_closure0_edge = 
prove_by_refinement(
  `!G m. (FINITE G) /\ (num_closure G (pointI m) = 0) ==>
    ~G (v_edge m) /\ ~G (v_edge (down m)) /\
          ~G (h_edge m) /\ ~G(h_edge (left  m))`,

  (* {{{ proof *)

  let rule = REWRITE_RULE[down;left ;h_edge_closure;hc_edge;v_edge_closure;vc_edge;UNION ;plus_e12; INR IN_SING ; INT_ARITH `x -: &:1 +: &:1 = x`] in
  [
  DISCH_ALL_TAC;
  UND 1;
  ASM_SIMP_TAC[num_closure0];
  DISCH_TAC;
  REWRITE_TAC[GSYM DE_MORGAN_THM];
  PURE_REWRITE_TAC [GSYM IMP_CLAUSES];
  REP_CASES_TAC;
  TSPEC `v_edge m` 1;
  JOIN 1 2;
  USE 1(rule);
  ASM_MESON_TAC[];
  TSPEC `v_edge (down m)` 1;
  JOIN 2 1;
  USE 1(rule);
  ASM_MESON_TAC[];
  TSPEC `h_edge ( m)` 1;
  JOIN 1 2;
  USE 1(rule);
  ASM_MESON_TAC[];
  TSPEC `h_edge (left  m)` 1;
  JOIN 1 2;
  USE 1(rule);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_point_h = 
prove_by_refinement(
  `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
     (par_cell eps G (h_edge m) /\ par_cell eps G (h_edge (left m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  UND 1;
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon_segment];
  ASM_SIMP_TAC [par_cell_h;par_cell_point];
  DISCH_ALL_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par];
  UND 1;
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[segment_finite];
  ASM_MESON_TAC[num_closure0_edge];
  ]);;
  (* }}} *)

let par_cell_point_v = 
prove_by_refinement(
  `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
     (par_cell eps G (v_edge m) /\ par_cell eps G (v_edge (down m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  UND 1;
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon_segment];
  ASM_SIMP_TAC [par_cell_v;par_cell_point];
  DISCH_ALL_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_MESON_TAC[segment_finite];
  ASM_SIMP_TAC[num_lower_down];
  REWRITE_TAC [set_lower_n];
  ASM_MESON_TAC[num_closure0_edge];
  ]);;
  (* }}} *)

let par_cell_point_rectangle = 
prove_by_refinement(
  `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
     (rectangle (FST m -: &:1,SND m -: &:1) (FST m +: &:1,SND m +: &:1)
       SUBSET (UNIONS (par_cell eps G)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_SIMP_TAC[rectagon_segment];
  DISCH_TAC;
  REWRITE_TAC[two_two_union;union_subset];
  CONJ_TAC;
  TYPE_THEN `rectangle (FST m -: &:1,SND m -: &:1) (FST m,SND m +: &:1) = rectangle (FST (left  m),SND (left  m) -: &:1) (FST (left  m) +: &:1,SND (left  m) +: &:1)` SUBGOAL_TAC;
  REWRITE_TAC[left ;INT_ARITH ` x -: &:1 +: &:1 =x`];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[rectangle_h;union_subset ];
  TYPE_THEN `par_cell eps G (h_edge (left  m))` SUBGOAL_TAC;
  ASM_MESON_TAC[par_cell_point_h];
  ASM_MESON_TAC[sub_union;par_cell_h_squ];
  CONJ_TAC;
  REWRITE_TAC[long_v_union;union_subset;];
  ASM_MESON_TAC[sub_union; par_cell_point_v;];
  REWRITE_TAC[rectangle_h;union_subset ];
  TYPE_THEN `par_cell eps G (h_edge (  m))` SUBGOAL_TAC;
  ASM_MESON_TAC[par_cell_point_h];
  ASM_MESON_TAC[sub_union;par_cell_h_squ];
  ]);;
  (* }}} *)

let par_cell_h_rectangle = 
prove_by_refinement(
  `!G m eps. (rectagon G) /\ (par_cell eps G (h_edge m)) ==>
     (rectangle (FST m ,SND m -: &:1) (FST m +: &:1,SND m +: &:1)
       SUBSET (UNIONS (par_cell eps G)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_SIMP_TAC[rectagon_segment];
  DISCH_TAC;
  REWRITE_TAC[rectangle_h;union_subset ];
  ASM_MESON_TAC[sub_union;par_cell_h_squ];
  ]);;
  (* }}} *)

let par_cell_v_rectangle = 
prove_by_refinement(
  `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==>
     (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1)
       SUBSET (UNIONS (par_cell eps G)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_SIMP_TAC[rectagon_segment];
  DISCH_TAC;
  REWRITE_TAC[rectangle_v;union_subset ];
  ASM_MESON_TAC[sub_union;par_cell_v_squ];
  ]);;
  (* }}} *)

let par_cell_squ_rectangle = 
prove_by_refinement(
  `!G m eps. (rectagon G) /\ (par_cell eps G (squ m)) ==>
     (rectangle (FST m  ,SND m ) (FST m +: &:1,SND m +: &:1)
       SUBSET (UNIONS (par_cell eps G)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[GSYM rectangle_squ];
  IMATCH_MP_TAC  sub_union;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let par_cell_point_in_rectangle = 
prove_by_refinement(
  `!m. (rectangle (FST m -: &:1,SND m -: &:1)
            (FST m +: &:1,SND m +: &:1) (pointI m))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[two_two_union;UNION ;long_v_union ; INR IN_SING ;];
  ]);;
  (* }}} *)

let par_cell_h_in_rectangle = 
prove_by_refinement(
  `!m. (h_edge m SUBSET
     (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[rectangle_h; UNION ; ISUBSET; INR IN_SING ;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_v_in_rectangle = 
prove_by_refinement(
  `!m. (v_edge m SUBSET
     (rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[rectangle_v; UNION ; ISUBSET; INR IN_SING ;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let ctop_top = 
prove_by_refinement(
  `!G. topology_ (ctop G)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[ctop];
  IMATCH_MP_TAC induced_top_top;
  REWRITE_TAC[top2_top];
  ]);;
  (* }}} *)

let ctop_open = 
prove_by_refinement(
  `!G B eps. (segment G) /\ (B SUBSET UNIONS (par_cell eps G)) /\
      (top2 B) ==> (ctop G B)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[ctop;induced_top;IMAGE];
  TYPE_THEN `B` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;GSYM ctop_unions];
  ASM_SIMP_TAC[GSYM par_cell_partition];
  REWRITE_TAC[UNION;ISUBSET ];
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let par_cell_open = 
prove_by_refinement(
  `!G eps. (rectagon G) ==> (ctop G (UNIONS (par_cell eps G )))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_MESON_TAC[rectagon_segment];
  DISCH_TAC;
  ASSUME_TAC ctop_top;
  TSPEC `G` 2;
  USE 2(MATCH_MP open_nbd);
  UND 2;
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]) ;
  GEN_TAC;
  RIGHT_TAC "B";
  DISCH_TAC;
  USE 2(REWRITE_RULE[UNIONS]);
  CHO 2;
  TYPE_THEN `?p. (u = {(pointI p)}) \/ (u = h_edge p) \/ (u = v_edge p) \/ (u = squ p)` SUBGOAL_TAC;
  AND 2;
  USE 3 (MATCH_MP (REWRITE_RULE[ISUBSET ]par_cell_cell));
  USE 3(REWRITE_RULE[cell]);
  ASM_REWRITE_TAC[];
  DISCH_THEN (CHOOSE_THEN MP_TAC );
  ASSUME_TAC rectangle_open;
  REP_CASES_TAC ;
  (* 1st case *)
  REWR 2;
  USE 2(REWRITE_RULE[INR IN_SING]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
  REWRITE_TAC[par_cell_point_in_rectangle];
  SUBCONJ_TAC;
  ASM_SIMP_TAC[par_cell_point_rectangle];
  ASM_MESON_TAC[ctop_open];
  (* 2nd case *)
  REWR 2;
  TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
  ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_h_in_rectangle];
  SUBCONJ_TAC;
  ASM_SIMP_TAC[par_cell_h_rectangle];
  ASM_MESON_TAC[ctop_open];
  (* 3rd case *)
  REWR 2;
  TYPE_THEN `rectangle (FST p -: &:1,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
  ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_v_in_rectangle];
  SUBCONJ_TAC;
  ASM_SIMP_TAC[par_cell_v_rectangle];
  ASM_MESON_TAC[ctop_open];
  (* 4th case *)
  REWR 2;
  TYPE_THEN `rectangle (FST p,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
  ASSUME_TAC rectangle_squ;
  TSPEC `p` 5;
  SUBCONJ_TAC;
  ASM_SIMP_TAC[par_cell_squ_rectangle];
  DISCH_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[PAIR];
  ASM_MESON_TAC[ctop_open];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* start on connected components of ctop G *)
(* ------------------------------------------------------------------ *)

(* move *)
let connected_empty = 
prove_by_refinement(
  `!(U:(A->bool)->bool). connected U EMPTY `,

  (* {{{ proof *)
  [
  REWRITE_TAC[connected];
  ]);;
  (* }}} *)

let par_cell_union_disjoint = 
prove_by_refinement(
  `!G eps. (UNIONS (par_cell eps G) INTER (UNIONS (par_cell (~eps) G)) =
              EMPTY )`,

  (* {{{ proof *)

  [
  REWRITE_TAC[INTER;EQ_EMPTY ;UNIONS;];
  DISCH_ALL_TAC;
  AND 0;
  CHO 0;
  CHO 1;
  TYPE_THEN `cell u /\ cell u'` SUBGOAL_TAC;
  ASM_MESON_TAC[par_cell_cell;ISUBSET];
  DISCH_TAC;
  TYPE_THEN `u = u'` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASSUME_TAC par_cell_disjoint;
  USE 4(REWRITE_RULE[INTER;EQ_EMPTY]);
  TYPEL_THEN[`G`;`eps`;`u`] (USE 4 o ISPECL);
  USE 3 (GSYM);
  REWR 1;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_comp = 
prove_by_refinement(
  `!G eps x. (rectagon G) ==>
         (component  (ctop G) x SUBSET (UNIONS (par_cell eps G))) \/
            (component (ctop G) x SUBSET (UNIONS (par_cell (~eps) G)))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  TYPE_THEN `component  (ctop G) x SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
  REWRITE_TAC[component_DEF ;SUBSET ;connected ];
  MESON_TAC[];
  TYPE_THEN `segment G` SUBGOAL_TAC;
  ASM_MESON_TAC [rectagon_segment];
  DISCH_TAC;
  ASM_SIMP_TAC[GSYM par_cell_partition];
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  USE 3 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
  AND 3;
  LEFT 3 "x'";
  CHO 3;
  LEFT 4 "x'";
  CHO 4;
  TYPE_THEN `component  (ctop G) x x'' /\ component  (ctop G) x x' ` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `component  (ctop G) x' x'' ` SUBGOAL_TAC;
  ASM_MESON_TAC[component_symm;component_trans];
  DISCH_TAC;
  USE 6(REWRITE_RULE[component_DEF]);
  CHO 6;
  USE 6(REWRITE_RULE[connected]);
  AND 6;
  AND 6;
  AND 7;
  TYPE_THEN `A = UNIONS (par_cell eps G)` ABBREV_TAC ;
  TYPE_THEN `B = UNIONS (par_cell (~eps) G)` ABBREV_TAC ;
  TYPEL_THEN [`A`;`B`] (USE 7 o ISPECL);
  UND 7;
  REWRITE_TAC[];
  TYPE_THEN `ctop G A /\ ctop G B` SUBGOAL_TAC;
  ASM_MESON_TAC[par_cell_open];
  DISCH_THEN_REWRITE;
  TYPE_THEN `Z SUBSET (A UNION B)` SUBGOAL_TAC;
  ASM_MESON_TAC[par_cell_partition];
  DISCH_THEN_REWRITE;
  TYPE_THEN `A INTER B = EMPTY` SUBGOAL_TAC;
  EXPAND_TAC "A";
  EXPAND_TAC "B";
  ASM_MESON_TAC[par_cell_union_disjoint;INTER_ACI;];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[ISUBSET];
  ]);;

  (* }}} *)

(* move *)
let connected_component = 
prove_by_refinement(
  `!U Z (x:A). (connected U Z) /\ (Z x) ==> (Z SUBSET (component U x)) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[component_DEF  ;SUBSET ];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `Z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let cont_mk_segment = 
prove_by_refinement(
  `!x y n. (euclid n x) /\ (euclid n y) ==>
    (continuous (joinf (\u. x)
        (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1))
          (&.0))
   (top_of_metric (UNIV,d_real)) (top_of_metric (euclid n,d_euclid)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  joinf_cont;
  CONJ_TAC;
  IMATCH_MP_TAC  const_continuous;
  IMATCH_MP_TAC  top_of_metric_top;
  REWRITE_TAC[metric_real];
  CONJ_TAC;
  IMATCH_MP_TAC  joinf_cont;
  CONJ_TAC;
  IMATCH_MP_TAC  continuous_lin_combo;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  const_continuous;
  IMATCH_MP_TAC  top_of_metric_top;
  REWRITE_TAC[metric_real];
  BETA_TAC;
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_rzero ];
  REWRITE_TAC[joinf];
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero ];
  ]);;
  (* }}} *)

let mk_segment_image = 
prove_by_refinement(
  `!x y n. (euclid n x) /\ (euclid n y) ==> (?f.
     (continuous f
        (top_of_metric(UNIV,d_real))
        (top_of_metric (euclid n,d_euclid))) /\
     (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  cont_mk_segment;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[joinf;IMAGE ];
  REWRITE_TAC[mk_segment];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  ASM_REWRITE_TAC[];
  EQ_TAC;
  DISCH_TAC;
  CHO 2;
  UND 2;
  COND_CASES_TAC;
  DISCH_ALL_TAC;
  JOIN 3 2;
  ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
  DISCH_ALL_TAC;
  UND 5;
  COND_CASES_TAC;
  DISCH_TAC;
  TYPE_THEN `&1 - x''` EXISTS_TAC;
  SUBCONJ_TAC;
  UND 5;
  REAL_ARITH_TAC ;
  DISCH_TAC;
  CONJ_TAC;
  UND 3;
  REAL_ARITH_TAC ;
  ONCE_REWRITE_TAC [euclid_add_comm];
  REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  CONJ_TAC;
  REAL_ARITH_TAC ;
  CONJ_TAC;
  REAL_ARITH_TAC ;
  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
  (* 2nd half *)
  DISCH_TAC;
  CHO 2;
  TYPE_THEN `&1 - a` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  AND 2;
  AND 2;
  UND 3;
  UND 4;
  REAL_ARITH_TAC ;
  COND_CASES_TAC;
  ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
  COND_CASES_TAC;
  REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
  ASM_MESON_TAC [euclid_add_comm];
  TYPE_THEN `a = &.0` SUBGOAL_TAC;
  UND 4;
  UND 3;
  AND 2;
  UND 3;
  REAL_ARITH_TAC ;
  DISCH_TAC;
  REWR 2;
  REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
  ]);;
  (* }}} *)

let euclid_n_convex = 
prove_by_refinement(
  `!n. (convex (euclid n))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[convex;mk_segment;SUBSET ];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  CHO 2;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure];
  ]);;
  (* }}} *)

let connected_mk_segment = 
prove_by_refinement(
  `!x y n. (euclid n x) /\ (euclid n y) ==>
   (connected (top_of_metric(euclid n,d_euclid)) (mk_segment x y))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `?f. (continuous f    (top_of_metric(UNIV,d_real))  (top_of_metric (euclid n,d_euclid))) /\  (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y)` SUBGOAL_TAC;
  IMATCH_MP_TAC  mk_segment_image;
  ASM_REWRITE_TAC[];
  DISCH_THEN CHOOSE_TAC;
  USE 2(GSYM);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  connect_image;
  TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  USE 2(GSYM);
  ASM_REWRITE_TAC[];
  TYPE_THEN `UNIONS (top_of_metric (euclid n,d_euclid) ) = (euclid n)` SUBGOAL_TAC;
  ASM_MESON_TAC [top_of_metric_unions;metric_euclid];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[convex;euclid_n_convex];
  MATCH_ACCEPT_TAC connect_real;
  ]);;
  (* }}} *)

let ctop_open = 
prove_by_refinement(
  `!G A. (top2 A /\ (A SUBSET (UNIONS (ctop G))) ==> ctop G A)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[ctop;induced_top;IMAGE ];
  TYPE_THEN `A` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
  REWRITE_TAC[GSYM ctop_unions];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let ctop_top2 = 
prove_by_refinement(
  `!G A. (segment G /\ ctop G A ==> top2 A)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ctop;induced_top;IMAGE ;];
  DISCH_ALL_TAC;
  TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ;
  TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC;
  EXPAND_TAC "U";
  ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
  CHO 1;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  top_inter;
  ASM_REWRITE_TAC[top2_top;];
  ASM_SIMP_TAC[GSYM curve_closure;top2];
  IMATCH_MP_TAC  (REWRITE_RULE[open_DEF] closed_open);
  IMATCH_MP_TAC  closure_closed;
  CONJ_TAC;
  EXPAND_TAC "U";
  ASM_MESON_TAC[top_of_metric_top;metric_euclid];
  USE 3(GSYM);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  UNIONS_SUBSET;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  REWRITE_TAC[edge;ISUBSET;];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  TSPEC `A'` 4;
  REWR 4;
  CHO 4;
  UND 4;
  DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] ;
  MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] v_edge_euclid);
  MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] h_edge_euclid);
  ]);;
  (* }}} *)

let mk_segment_sym_lemma = 
prove_by_refinement(
  `!x y z. (mk_segment x y z ==> mk_segment y x z)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[mk_segment];
  DISCH_ALL_TAC;
  CHO 0;
  TYPE_THEN `&1 - a` EXISTS_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[REAL_ARITH `a <= &1 ==> &0 <= &1 - a`];
  CONJ_TAC;
  ASM_MESON_TAC[REAL_ARITH `&0 <= a ==> &1 - a <= &1`];
  ONCE_REWRITE_TAC[euclid_add_comm];
  ASM_REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
  ]);;
  (* }}} *)

let mk_segment_sym = 
prove_by_refinement(
  `!x y. (mk_segment x y = mk_segment y x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  EQ_TAC THEN ASM_MESON_TAC[mk_segment_sym_lemma];
  ]);;
  (* }}} *)

let mk_segment_end = 
prove_by_refinement(
  `!x y. (mk_segment x y x /\ mk_segment x y y)`,

  (* {{{ proof *)
  [
  RIGHT_TAC "y";
  RIGHT_TAC "x";
  SUBCONJ_TAC;
  DISCH_ALL_TAC;
  REWRITE_TAC[mk_segment];
  TYPE_THEN `&1` EXISTS_TAC;
  REDUCE_TAC;
  CONJ_TAC;
  ARITH_TAC;
  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
  DISCH_TAC;
  ONCE_REWRITE_TAC[mk_segment_sym];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let convex_connected = 
prove_by_refinement(
  `!G Z. (segment G /\ convex Z) /\ (Z SUBSET (UNIONS (ctop G))) ==>
            (connected (ctop G) Z)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[connected];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 7 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
  AND 7;
  LEFT 7 "x";
  CHO 7;
  LEFT 8 "x";
  CHO 8;
  TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC;
  USE 1(REWRITE_RULE[convex]);
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC;
  IMATCH_MP_TAC  connected_mk_segment;
  USE 2(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]);
  ASM_MESON_TAC[];
  REWRITE_TAC[connected];
  DISCH_ALL_TAC;
  AND 11;
  TYPEL_THEN [`A`;`B`] (USE 11 o ISPECL);
  REWR 11;
  TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC;
  REWRITE_TAC[GSYM top2];
  ASM_MESON_TAC[ctop_top2;top2];
  DISCH_TAC;
  UND 11;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[DE_MORGAN_THM;ISUBSET;];
  CONJ_TAC;
  LEFT_TAC "x''";
  TYPE_THEN `x'` EXISTS_TAC;
  REWRITE_TAC[mk_segment_end];
  ASM_MESON_TAC[];
  LEFT_TAC "x''";
  TYPE_THEN `x` EXISTS_TAC;
  REWRITE_TAC[mk_segment_end];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let component_replace = 
prove_by_refinement(
  `!U (x:A) y. component  U x y ==> (component  U x = component  U y)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  DISCH_ALL_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  USE 0(MATCH_MP component_symm);
  ASM_MESON_TAC[component_trans];
  ASM_MESON_TAC[component_trans;component_symm];
  ]);;
  (* }}} *)

let convex_component = 
prove_by_refinement(
  `!G Z x. (segment G /\ convex Z /\ (Z SUBSET (UNIONS (ctop G))) /\
     (~(Z INTER (component  (ctop G) x ) = EMPTY))  ==>
        (Z SUBSET (component  (ctop G) x)))  `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC;
  ASM_SIMP_TAC[convex_connected];
  DISCH_TAC;
  USE 3(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
  CHO 3;
  AND 3;
  USE 3(MATCH_MP component_replace);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  connected_component;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let cell_convex = 
prove_by_refinement(
  `!C.  (cell C) ==> (convex C)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cell];
  GEN_TAC;
  DISCH_THEN (CHOOSE_THEN MP_TAC ) THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[v_edge_convex;h_edge_convex;convex_pointI;rectangle_squ;rectangle_convex];

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)

let cell_of = jordan_def `cell_of C = { A | (cell A) /\ (A SUBSET C) }`;;

let unions_cell_of = 
prove_by_refinement(
  `!G x. (segment G ==>
     (UNIONS (cell_of (component  (ctop G) x)) =
           component  (ctop G) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  REWRITE_TAC[UNIONS;SUBSET;cell_of];
  CONJ_TAC;
  DISCH_ALL_TAC;
  CHO 1;
  AND 1;
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[component_DEF   ;connected;SUBSET ;ctop_unions;DIFF ];
  DISCH_THEN CHOOSE_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 2 (MATCH_MP point_onto);
  CHO 2;
  REWR 1;
  ASM_REWRITE_TAC[];
  ASSUME_TAC cell_unions;
  TSPEC `p` 3;
  USE 3 (REWRITE_RULE[UNIONS]);
  CHO 3;
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `u SUBSET (component  (ctop G) x) ==> (!x'. u x' ==> component  (ctop G) x x')` SUBGOAL_TAC;
  REWRITE_TAC[ISUBSET];
  ASM_REWRITE_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  IMATCH_MP_TAC  convex_component ;
  ASM_REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  ASM_MESON_TAC[cell_convex];
  CONJ_TAC;
  REWRITE_TAC[ctop_unions];
  REWRITE_TAC[DIFF;SUBSET ];
  DISCH_ALL_TAC;
  CONJ_TAC;
  AND 3;
  UND 5;
  UND 4;
  ASM_MESON_TAC[cell_euclid;ISUBSET];
  REWRITE_TAC[UNIONS];
  LEFT_TAC  "u";
  GEN_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  USE 6 (MATCH_MP   curve_cell_cell);
  USE 6 (REWRITE_RULE[ISUBSET]);
  TSPEC `u'` 6;
  REWR 6;
  TYPE_THEN `u = u'` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 1 (REWRITE_RULE[component_DEF;connected;SUBSET ]);
  TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ];
  DISJ2_TAC ;
  ASM_MESON_TAC[];
  NAME_CONFLICT_TAC;
  TYPE_THEN `point p` EXISTS_TAC;
  ASM_REWRITE_TAC [INTER];
  ]);;
  (* }}} *)




(* ------------------------------------------------------------------ *)
(* SECTION F *)
(* ------------------------------------------------------------------ *)

(* ------------------------------------------------------------------ *)
(* num_abs_of_int *)
(* ------------------------------------------------------------------ *)

let num_abs_of_int_exists = 
prove_by_refinement(
  `!m. ?i. &i = abs  (real_of_int(m))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[GSYM int_abs_th];
  ASSUME_TAC dest_int_rep;
  TSPEC `||: m` 0;
  CHO 0;
  TYPE_THEN `n` EXISTS_TAC;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  WITH 0 (REWRITE_RULE[int_abs_th]);
  TYPE_THEN `&0 <= abs  (real_of_int m)` SUBGOAL_TAC;
  REWRITE_TAC[REAL_ABS_POS];
  TYPE_THEN `abs  (real_of_int m) <= &.0` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  REDUCE_TAC ;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC ;
  ]);;
  (* }}} *)

let num_abs_of_int_select = new_definition
     `num_abs_of_int m = @i. (&i = abs  (real_of_int m))`;;
let num_abs_of_int_th = 
prove_by_refinement(
  `!m. &(num_abs_of_int m) = abs  (real_of_int m)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[num_abs_of_int_select];
  SELECT_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[num_abs_of_int_exists];
  ]);;
  (* }}} *)

let num_abs_of_int_mul = 
prove_by_refinement(
  `!m n. (num_abs_of_int (m * n) = num_abs_of_int m * num_abs_of_int n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;GSYM REAL_MUL;num_abs_of_int_th;int_mul_th;ABS_MUL;];
  ]);;
  (* }}} *)

let num_abs_of_int_num = 
prove_by_refinement(
  `!n. (num_abs_of_int (&: n) = n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_of_num_th;REAL_ABS_NUM;];
  ]);;
  (* }}} *)

let num_abs_of_int_triangle = 
prove_by_refinement(
  `!n m. num_abs_of_int (m + n) <=|
           num_abs_of_int(m) +| num_abs_of_int n`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[GSYM REAL_OF_NUM_LE;num_abs_of_int_th;int_add_th;GSYM REAL_OF_NUM_ADD;ABS_TRIANGLE;];
  ]);;
  (* }}} *)

let num_abs_of_int0 = 
prove_by_refinement(
  `!m. (num_abs_of_int m = 0) <=> (m = &:0)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;REAL_ABS_ZERO;];
  REWRITE_TAC[int_eq;];
  REWRITE_TAC[int_of_num_th;];
  ]);;
  (* }}} *)

let num_abs_of_int_neg = 
prove_by_refinement(
  `!m. (num_abs_of_int (--: m) = num_abs_of_int m)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_neg_th;REAL_ABS_NEG;];
  ]);;
  (* }}} *)

let num_abs_of_int_suc = 
prove_by_refinement(
  `!m. (&:0 <=: m) ==>
     (SUC (num_abs_of_int m) = num_abs_of_int (m +: &:1))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[int_le;int_of_num_th;];
  DISCH_ALL_TAC;
  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc];
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let num_abs_of_int_pre = 
prove_by_refinement(
  `!m. (m <=: &:0) ==>
     (SUC (num_abs_of_int m) = num_abs_of_int (m -: &:1))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[int_le;int_of_num_th;];
  DISCH_ALL_TAC;
  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc;int_sub_th;int_of_num_th;];
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* closure of squares *)
(* ------------------------------------------------------------------ *)

let right_left = 
prove_by_refinement(
  `!m. (right  (left  m) = m) /\ (left  (right  m) = m) /\
    (up (down m) = m) /\ (down (up m) = m) /\
    (up (right  m) = right  (up m)) /\ (up (left  m) = left  (up m)) /\
    (down (right  m) = right  (down m)) /\
    (down (left  m) = (left  (down m)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[right ;left ;up;down;PAIR_SPLIT];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let squc = jordan_def `squc p = {Z | ?u v.
                  (Z = point (u,v)) /\
                  real_of_int (FST p) <= u /\
                  u <= real_of_int (FST p +: &:1) /\
                  real_of_int (SND p) <= v /\
                  v <= real_of_int (SND p +: &:1)}`;;

let squc_inter = 
prove_by_refinement(
  `!p. squc p =
   {z | ?r. (z = point r) /\ real_of_int (FST p) <= FST r} INTER
         {z | ?r. (z = point r) /\ real_of_int (SND p) <= SND r} INTER
         {z | ?r. (z = point r) /\ FST r <= real_of_int (FST p +: &:1)} INTER
         {z | ?r. (z = point r) /\ SND r <= real_of_int (SND p +: &:1)}`,

  (* {{{ proof *)

  [
  REWRITE_TAC[squc];
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER];
  EQ_TAC;
  DISCH_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[point_inj;];
  CONV_TAC (dropq_conv "r");
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "r");
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "r'");
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "r");
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  CHO 0;
  AND 0;
  REWR 1;
  REWRITE_TAC[point_inj;PAIR_SPLIT ;];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  USE 1 (REWRITE_RULE[point_inj;]);
  USE 1 (CONV_RULE (dropq_conv "r'"));
  REWR 2;
  USE 2 (REWRITE_RULE[point_inj;]);
  USE 2 (CONV_RULE (dropq_conv "r'"));
  REWR 3;
  USE 3 (REWRITE_RULE[point_inj;]);
  USE 3 (CONV_RULE (dropq_conv "r'"));
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let squc_closed = 
prove_by_refinement(
  `!p. closed_ (top2) (squc p)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  ASSUME_TAC top2_top;
  REWRITE_TAC[squc_inter];
  ASM_SIMP_TAC[closed_inter2;closed_half_plane2D_LTS_closed;closed_half_plane2D_SLT_closed;closed_half_plane2D_LTF_closed;closed_half_plane2D_FLT_closed];
  ]);;
  (* }}} *)

let squ_subset_sqc = 
prove_by_refinement(
  `!p. (squ p SUBSET (squc p))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[SUBSET;squ;squc];
  GEN_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_MESON_TAC[REAL_ARITH `x < y ==> x <=. y`];
  ]);;
  (* }}} *)

let squc_union_lemma1 = 
prove_by_refinement(
  `!p. squc p INTER
     {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} =
   {(pointI p)} UNION (v_edge p) UNION {(pointI (up p))}`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[squc;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  REWR 1;
  USE 1(REWRITE_RULE[point_inj]);
  USE 1(CONV_RULE (dropq_conv "r"));
  UND 0;
  DISCH_ALL_TAC;
  UND 4;
  UND 5;
  REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`];
  KILL 2;
  KILL 3;
  KILL 0;
  USE 1 (GSYM);
  ASM_REWRITE_TAC[];
  KILL 0;
  REP_CASES_TAC;
  ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`];
  EXPAND_TAC "v";
  REWRITE_TAC[pointI;int_suc;];
  ASM_REWRITE_TAC[pointI];
  REWRITE_TAC[v_edge];
  DISJ2_TAC ;
  DISJ1_TAC ;
  REWRITE_TAC[point_inj; PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v'");
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[int_suc];
  REP_CASES_TAC;
  ASM_REWRITE_TAC[pointI;point_inj;];
  CONJ_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REAL_ARITH_TAC ;
  CONV_TAC (dropq_conv "r");
  USE 0 (REWRITE_RULE[v_edge]);
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[point_inj];
  CONJ_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v'");
  AND  0;
  UND 0;
  REWRITE_TAC[int_suc];
  REAL_ARITH_TAC ;
  CONV_TAC (dropq_conv "r");
  (* LAST *)
  ASM_REWRITE_TAC[pointI;point_inj;];
  CONJ_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REWRITE_TAC[int_suc];
  REAL_ARITH_TAC ;
  CONV_TAC (dropq_conv "r");
  ]);;
  (* }}} *)

let squc_union_lemma2 = 
prove_by_refinement(
  `!p. squc p INTER
     {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} =
   {(pointI (right  p))} UNION (v_edge (right  p)) UNION
     {(pointI (up (right  p)))}`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[squc;right  ;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  REWR 1;
  USE 1(REWRITE_RULE[point_inj]);
  USE 1(CONV_RULE (dropq_conv "r"));
  UND 0;
  DISCH_ALL_TAC;
  UND 4;
  UND 5;
  REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`];
  KILL 2;
  KILL 3;
  KILL 0;
  USE 1 (GSYM);
  ASM_REWRITE_TAC[];
  KILL 0;
  REP_CASES_TAC;
  ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`];
  EXPAND_TAC "v";
  REWRITE_TAC[pointI;int_suc;];
  (* 3 LEFT *)
  ASM_REWRITE_TAC[pointI;int_suc;];
  (* 2 LEFT *)
  REWRITE_TAC[v_edge];
  DISJ2_TAC ;
  DISJ1_TAC ;
  REWRITE_TAC[point_inj; PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[int_suc];
  CONV_TAC (dropq_conv "v'");
  ASM_REWRITE_TAC[];
  (* second half  *)
  ASM_REWRITE_TAC[int_suc];
  REP_CASES_TAC;
  ASM_REWRITE_TAC[pointI;point_inj;];
  CONJ_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  ASM_REWRITE_TAC[int_suc];
  REAL_ARITH_TAC ;
  CONV_TAC (dropq_conv "r");
  REWRITE_TAC[int_suc];
  (* 2 LEFT *)
  USE 0 (REWRITE_RULE[v_edge]);
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[point_inj];
  CONJ_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v'");
  AND  0;
  UND 0;
  REWRITE_TAC[int_suc];
  REAL_ARITH_TAC ;
  CONV_TAC (dropq_conv "r");
  REWRITE_TAC[int_suc];
  (* LAST *)
  ASM_REWRITE_TAC[pointI;point_inj;];
  CONJ_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REWRITE_TAC[int_suc];
  REAL_ARITH_TAC ;
  CONV_TAC (dropq_conv "r");
  REWRITE_TAC[int_suc];
  ]);;
  (* }}} *)

let squc_union_lemma3 = 
prove_by_refinement(
  `!p. squc p INTER
    {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\
       (real_of_int(FST p) <. FST r) } =
    (h_edge p) UNION squ p UNION (h_edge (up p))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER;squc;UNION;];
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  REWR 1;
  USE 1 (REWRITE_RULE[point_inj]);
  USE 1 (CONV_RULE (dropq_conv "r"));
  AND 0;
  UND 0;
  DISCH_ALL_TAC;
  KILL  0;
  KILL  3;
  UND 4;
  UND 5;
  REWRITE_TAC[REAL_ARITH `(x <= y) <=> (y = x) \/ (x <. y)`;int_suc];
  REP_CASES_TAC;
  ASM_MESON_TAC[REAL_ARITH `~(v = v + &1)`];
  EXPAND_TAC "v";
  REWRITE_TAC[up;h_edge];
  DISJ2_TAC;
  DISJ2_TAC;
  REWRITE_TAC[point_inj;];
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u'");
  CONV_TAC (dropq_conv "v");
  ASM_REWRITE_TAC[int_suc];
  (* 3 to go *)
  ASM_REWRITE_TAC[];
  DISJ1_TAC;
  REWRITE_TAC[h_edge;point_inj;PAIR_SPLIT];
  CONV_TAC (dropq_conv "u'");
  CONV_TAC (dropq_conv "v");
  ASM_REWRITE_TAC[int_suc];
  (* 2 to go *)
  DISJ2_TAC;
  DISJ1_TAC;
  REWRITE_TAC[squ;point_inj;PAIR_SPLIT];
  CONV_TAC (dropq_conv "u'");
  CONV_TAC (dropq_conv "v'");
  ASM_REWRITE_TAC[int_suc];
  (* 2nd half *)
  DISCH_TAC;
  TYPE_THEN `?q. x = point q` ASM_CASES_TAC;
  CHO 1;
  ASM_REWRITE_TAC[point_inj];
  CONJ_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REWR 0;
  UND 0;
  REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;];
  REP_CASES_TAC;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  UND 0;
  REAL_ARITH_TAC ;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  UND 0;
  REAL_ARITH_TAC ;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  UND 0;
  REAL_ARITH_TAC ;
  CONV_TAC (dropq_conv "r");
  REWR 0;
  UND 0;
  REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;];
  REP_CASES_TAC;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  UND 0;
  REAL_ARITH_TAC ;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  UND 0;
  REAL_ARITH_TAC ;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  UND 0;
  REAL_ARITH_TAC ;
  (* 1 goal LEFT *)
  PROOF_BY_CONTR_TAC;
  KILL 2;
  UND 1;
  REWRITE_TAC[];
  IMATCH_MP_TAC  point_onto;
  ASM_MESON_TAC[h_edge_euclid;squ_euclid;v_edge_euclid;ISUBSET ];
  ]);;
  (* }}} *)

let squc_lemma4 = 
prove_by_refinement(
  `!p. squc p SUBSET
    {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION
     {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION
      {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\
       (real_of_int(FST p) <. FST r) } `,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;UNION ;squc ];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[point_inj ;];
  LEFT_TAC "r";
  CONV_TAC (dropq_conv "r");
  UND 0;
  DISCH_ALL_TAC;
  UND 1;
  UND 2;
  ASM_REWRITE_TAC[int_suc];
  REAL_ARITH_TAC ;
  ]);;
  (* }}} *)

let squc_union = 
prove_by_refinement(
  `!p. squc p = {(pointI p)} UNION {(pointI (right  p))} UNION
       {(pointI (up p))} UNION {(pointI (up (right   p)))} UNION
       (h_edge p) UNION (h_edge (up p)) UNION
       (v_edge p) UNION (v_edge (right  p)) UNION
       (squ p)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  TYPE_THEN `squc p = squc p  INTER ({z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION   {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION   {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\  (real_of_int(FST p) <. FST r) } )` SUBGOAL_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  REWRITE_TAC  [GSYM SUBSET_INTER_ABSORPTION];
  MATCH_ACCEPT_TAC squc_lemma4;
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[squc_union_lemma1;squc_union_lemma2;squc_union_lemma3];
  REWRITE_TAC[UNION_ACI];
  ]);;
  (* }}} *)

let squ_closure_h = 
prove_by_refinement(
  `!p. (h_edge p) SUBSET (closure top2 (squ p))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[top2];
  IMATCH_MP_TAC  closure_segment;
  ASM_REWRITE_TAC[squ_euclid];
  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  point_onto;
  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid];
  DISCH_TAC;
  CHO 1;
  REWR 0;
  KILL 1;
  TYPE_THEN `point (FST q, SND q + &1)` EXISTS_TAC;
  REWRITE_TAC[point_scale;point_add;];
  UND 0;
  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
  REWRITE_TAC[];
  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
  PURE_REWRITE_TAC[point_add;point_scale];
  REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;];
  DISCH_ALL_TAC;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  UND 0;
  REWRITE_TAC[int_suc];
  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  UND 1;
  UND 2;
  REDUCE_TAC ;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let squ_closure_up_h = 
prove_by_refinement(
  `!p. (h_edge (up   p)) SUBSET (closure top2 (squ p))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;up  ];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[top2];
  IMATCH_MP_TAC  closure_segment;
  ASM_REWRITE_TAC[squ_euclid];
  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  point_onto;
  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid];
  DISCH_TAC;
  CHO 1;
  REWR 0;
  KILL 1;
  TYPE_THEN `point (FST q , SND q - &1)` EXISTS_TAC;
  REWRITE_TAC[point_scale;point_add;];
  UND 0;
  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
  REWRITE_TAC[];
  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
  PURE_REWRITE_TAC[point_add;point_scale];
  REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;];
  DISCH_ALL_TAC;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  UND 0;
  REWRITE_TAC[int_suc];
  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  UND 1;
  UND 2;
  REDUCE_TAC ;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let squ_closure_down_h = 
prove_by_refinement(
  `!p. (h_edge p SUBSET (closure top2 (squ (down p))))`,

  (* {{{ proof *)

  [
  GEN_TAC;
  ASSUME_TAC squ_closure_up_h ;
  TSPEC `down p` 0;
  USE 0 (REWRITE_RULE [right_left]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let squ_closure_v = 
prove_by_refinement(
  `!p. (v_edge p) SUBSET (closure top2 (squ p))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[top2];
  IMATCH_MP_TAC  closure_segment;
  ASM_REWRITE_TAC[squ_euclid];
  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  point_onto;
  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid];
  DISCH_TAC;
  CHO 1;
  REWR 0;
  KILL 1;
  TYPE_THEN `point (FST q + &1, SND q )` EXISTS_TAC;
  REWRITE_TAC[point_scale;point_add;];
  UND 0;
  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
  REWRITE_TAC[];
  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
  PURE_REWRITE_TAC[point_add;point_scale];
  REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;];
  DISCH_ALL_TAC;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  UND 0;
  REWRITE_TAC[int_suc];
  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  UND 1;
  UND 2;
  REDUCE_TAC ;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let squ_closure_right_v = 
prove_by_refinement(
  `!p. (v_edge (right     p)) SUBSET (closure top2 (squ p))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;right    ];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[top2];
  IMATCH_MP_TAC  closure_segment;
  ASM_REWRITE_TAC[squ_euclid];
  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  point_onto;
  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid];
  DISCH_TAC;
  CHO 1;
  REWR 0;
  KILL 1;
  TYPE_THEN `point (FST q - &1 , SND q )` EXISTS_TAC;
  REWRITE_TAC[point_scale;point_add;];
  UND 0;
  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
  REWRITE_TAC[];
  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
  PURE_REWRITE_TAC[point_add;point_scale];
  REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;];
  DISCH_ALL_TAC;
  USE 0 (CONV_RULE (dropq_conv "u"));
  USE 0 (CONV_RULE (dropq_conv "v"));
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  UND 0;
  REWRITE_TAC[int_suc];
  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`);
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  UND 1;
  UND 2;
  REDUCE_TAC ;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let squ_closure_left_v  = 
prove_by_refinement(
  `!p. (v_edge p SUBSET (closure top2 (squ (left  p))))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  ASSUME_TAC squ_closure_right_v;
  TSPEC `left  p` 0;
  USE 0 (REWRITE_RULE[right_left]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let squ_closure_hc = 
prove_by_refinement(
  `!p. (hc_edge p) SUBSET (closure top2 (squ p))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  REWRITE_TAC[GSYM h_edge_closure];
  IMATCH_MP_TAC  closure_subset;
  ASSUME_TAC top2_top;
  ASM_REWRITE_TAC[squ_closure_h];
  IMATCH_MP_TAC  closure_closed;
  ASM_REWRITE_TAC[top2_unions;squ_euclid];
  ]);;
  (* }}} *)

let squ_closure_up_hc = 
prove_by_refinement(
  `!p. (hc_edge (up p)) SUBSET (closure top2 (squ p))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[GSYM h_edge_closure];
  IMATCH_MP_TAC  closure_subset;
  ASSUME_TAC top2_top;
  ASM_REWRITE_TAC[squ_closure_up_h];
  IMATCH_MP_TAC  closure_closed;
  ASM_REWRITE_TAC[top2_unions;squ_euclid];
  ]);;
  (* }}} *)

let squ_closure_vc = 
prove_by_refinement(
  `!p. (vc_edge p) SUBSET (closure top2 (squ p))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[GSYM v_edge_closure];
  IMATCH_MP_TAC  closure_subset;
  ASSUME_TAC top2_top;
  ASM_REWRITE_TAC[squ_closure_v];
  IMATCH_MP_TAC  closure_closed;
  ASM_REWRITE_TAC[top2_unions;squ_euclid];
  ]);;
  (* }}} *)

let squ_closure = 
prove_by_refinement(
  `!p. (closure top2 (squ p)) = (squc p)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  ASSUME_TAC top2_top;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  closure_subset;
  ASM_REWRITE_TAC[squc_closed];
  REWRITE_TAC[squc_union];
  REWRITE_TAC[SUBSET;UNION];
  ASM_MESON_TAC[];
  REWRITE_TAC[squc_union];
  REWRITE_TAC[union_subset];
  ASSUME_TAC squ_closure_hc;
  TSPEC `p` 1;
  ASSUME_TAC squ_closure_up_hc;
  TSPEC `p` 2;
  USE 1 (REWRITE_RULE[hc_edge;plus_e12;union_subset]);
  USE 2 (REWRITE_RULE[hc_edge;plus_e12;up;union_subset]);
  ASM_REWRITE_TAC [up;right;squ_closure_v;REWRITE_RULE[right  ] squ_closure_right_v  ];
  ASM_SIMP_TAC[subset_closure];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* adj_edge *)
(* ------------------------------------------------------------------ *)


let adj_edge = jordan_def `adj_edge x y <=> (~(x = y)) /\
  (?e. (edge e) /\
   (e SUBSET (closure top2 x)) /\ (e SUBSET (closure top2 y)))`;;

let adj_edge_sym = 
prove_by_refinement(
  `!x y. (adj_edge x y = adj_edge y x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[adj_edge];
  MESON_TAC[];
  ]);;
  (* }}} *)

let adj_edge_left = 
prove_by_refinement(
  `!m. (adj_edge (squ m) (squ (left  m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[adj_edge];
  REWRITE_TAC[squ_closure;squ_inj;];
  CONJ_TAC;
  REWRITE_TAC[left ;PAIR_SPLIT;];
  INT_ARITH_TAC;
  TYPE_THEN `v_edge m` EXISTS_TAC;
  REWRITE_TAC[edge;v_edge_inj;];
  CONV_TAC (dropq_conv "m'");
  REWRITE_TAC[squc_union; SUBSET;UNION ;];
  REWRITE_TAC[right_left];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let adj_edge_right = 
prove_by_refinement(
  `!m. (adj_edge (squ m) (squ (right    m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[adj_edge];
  REWRITE_TAC[squ_closure;squ_inj;];
  CONJ_TAC;
  REWRITE_TAC[right   ;PAIR_SPLIT;];
  INT_ARITH_TAC;
  TYPE_THEN `v_edge (right  m)` EXISTS_TAC;
  REWRITE_TAC[edge;v_edge_inj;];
  CONV_TAC (dropq_conv "m'");
  REWRITE_TAC[squc_union; SUBSET;UNION ;];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let adj_edge_down = 
prove_by_refinement(
  `!m. (adj_edge (squ m) (squ (down  m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[adj_edge];
  REWRITE_TAC[squ_closure;squ_inj;];
  CONJ_TAC;
  REWRITE_TAC[down ;PAIR_SPLIT;];
  INT_ARITH_TAC;
  TYPE_THEN `h_edge m` EXISTS_TAC;
  REWRITE_TAC[edge;h_edge_inj;];
  CONV_TAC (dropq_conv "m'");
  REWRITE_TAC[squc_union; SUBSET;UNION ;];
  REWRITE_TAC[right_left];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let adj_edge_right = 
prove_by_refinement(
  `!m. (adj_edge (squ m) (squ (up    m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[adj_edge];
  REWRITE_TAC[squ_closure;squ_inj;];
  CONJ_TAC;
  REWRITE_TAC[up   ;PAIR_SPLIT;];
  INT_ARITH_TAC;
  TYPE_THEN `h_edge (up  m)` EXISTS_TAC;
  REWRITE_TAC[edge;h_edge_inj;];
  CONV_TAC (dropq_conv "m'");
  REWRITE_TAC[squc_union; SUBSET;UNION ;];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* components  *)
(* ------------------------------------------------------------------ *)

let rectangle_euclid = 
prove_by_refinement(
  `!p q. (rectangle p q SUBSET (euclid 2))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectangle;SUBSET ;];
  DISCH_ALL_TAC;
  CHO 0;
  CHO 0;
  ASM_REWRITE_TAC[euclid_point];
  ]);;
  (* }}} *)

let component_unions = 
prove_by_refinement(
  `!U (x:A). (component  U x SUBSET (UNIONS U))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET; component_DEF; connected ;];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_h_rect = 
prove_by_refinement(
  `!G m x. (segment G /\
     (h_edge m SUBSET component  (ctop G) x)) ==>
   (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1)
       SUBSET component  (ctop G) x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC   convex_component;
  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
  CONJ_TAC;
  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
  REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
  DISCH_ALL_TAC;
  AND 2;
  TYPE_THEN `~(squ (down m) x') /\ ~(squ m x')` SUBGOAL_TAC;
  USE 0(MATCH_MP curve_cell_squ_inter);
  COPY 0;
  TSPEC `m` 0;
  TSPEC `down m` 4;
  UND 4;
  UND 0;
  REWRITE_TAC [EQ_EMPTY; INTER];
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  REWR 3;
  TYPE_THEN `h_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `component  (ctop G) x` EXISTS_TAC;
  ASM_REWRITE_TAC[component_unions];
  REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; h_edge_euclid; INTER;];
  ASM_MESON_TAC[];
  REWRITE_TAC[rectangle_h; EMPTY_EXISTS; UNION ; INTER;];
  USE 1 (REWRITE_RULE[SUBSET]);
  TYPE_THEN `~(h_edge m = EMPTY)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  cell_nonempty;
  REWRITE_TAC[cell_rules];
  REWRITE_TAC[EMPTY_EXISTS];
  DISCH_TAC;
  CHO 2;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_v_rect = 
prove_by_refinement(
  `!G m x. (segment G /\
     (v_edge m SUBSET component  (ctop G) x)) ==>
   (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1)
       SUBSET component  (ctop G) x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC   convex_component;
  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
  CONJ_TAC;
  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
  REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
  DISCH_ALL_TAC;
  AND 2;
  TYPE_THEN `~(squ (left   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
  USE 0(MATCH_MP curve_cell_squ_inter);
  COPY 0;
  TSPEC `m` 0;
  TSPEC `left   m` 4;
  UND 4;
  UND 0;
  REWRITE_TAC [EQ_EMPTY; INTER];
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  REWR 3;
  TYPE_THEN `v_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `component  (ctop G) x` EXISTS_TAC;
  ASM_REWRITE_TAC[component_unions];
  REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; v_edge_euclid; INTER;];
  ASM_MESON_TAC[];
  REWRITE_TAC[rectangle_v; EMPTY_EXISTS; UNION ; INTER;];
  USE 1 (REWRITE_RULE[SUBSET]);
  TYPE_THEN `~(v_edge m = EMPTY)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  cell_nonempty;
  REWRITE_TAC[cell_rules];
  REWRITE_TAC[EMPTY_EXISTS];
  DISCH_TAC;
  CHO 2;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let long_v_convex = 
prove_by_refinement(
  `!p. (convex (long_v p))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[long_v_inter];
  GEN_TAC;
  IMATCH_MP_TAC  convex_inter;
  REWRITE_TAC[line2D_F_convex];
  IMATCH_MP_TAC  convex_inter;
  REWRITE_TAC[open_half_plane2D_LTS_convex;open_half_plane2D_SLT_convex];
  ]);;
  (* }}} *)

let long_v_euclid = 
prove_by_refinement(
  `!p. (long_v p SUBSET (euclid 2))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[long_v_union;union_subset;v_edge_euclid;single_subset;pointI;euclid_point];
  ]);;
  (* }}} *)

let comp_pointI_long = 
prove_by_refinement(
  `!G m x. (segment G /\ component  (ctop G) x (pointI m)) ==>
   (long_v m SUBSET component  (ctop G) x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  convex_component;
  ASM_REWRITE_TAC[long_v_convex;ctop_unions;DIFF_SUBSET;long_v_euclid];
  CONJ_TAC;
  REWRITE_TAC[long_v_union;EQ_EMPTY;UNION;INTER];
  GEN_TAC;
  TYPE_THEN `UNIONS (ctop G) (pointI m)` SUBGOAL_TAC;
  ASSUME_TAC (ISPEC `(ctop G)` component_unions);
  ASM_MESON_TAC[ISUBSET];
  REWRITE_TAC[ctop_unions;DIFF ;];
  DISCH_ALL_TAC;
  AND 2;
  TYPE_THEN `~(curve_cell G {(pointI m)})` SUBGOAL_TAC;
  USE 4(REWRITE_RULE[UNIONS]);
  LEFT 4 "u";
  TSPEC `{(pointI m)}` 4;
  USE 4(REWRITE_RULE [INR IN_SING;]);
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[curve_cell_not_point;];
  TYPE_THEN `FINITE G` SUBGOAL_TAC;
  ASM_SIMP_TAC[segment_finite];
  ASM_SIMP_TAC[num_closure0];
  DISCH_TAC;
  UND 5;
  REP_CASES_TAC; (* cases *)
  TYPE_THEN `~(v_edge (down m) INTER  UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  ASM_MESON_TAC[];
  ASM_SIMP_TAC[curve_cell_v_inter];
  DISCH_ALL_TAC;
  TSPEC `v_edge (down m)` 5;
  UND 5;
  ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;];
  (* next case *)
  USE 7 (REWRITE_RULE[INR IN_SING]);
  ASM_MESON_TAC[];
  TYPE_THEN `~(v_edge (m) INTER  UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  ASM_MESON_TAC[];
  ASM_SIMP_TAC[curve_cell_v_inter];
  DISCH_ALL_TAC;
  TSPEC `v_edge (m)` 5;
  UND 5;
  ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;];
  (* LAST *)
  REWRITE_TAC[long_v_union;EMPTY_EXISTS;];
  TYPE_THEN `(pointI m)` EXISTS_TAC;
  ASM_REWRITE_TAC[INTER;UNION;INR IN_SING;];
  ]);;
  (* }}} *)

let comp_h_squ = 
prove_by_refinement(
  `!G x m. (segment G /\ (h_edge m SUBSET (component  (ctop G) x)) ==>
     (squ m SUBSET (component  (ctop G ) x)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
  IMATCH_MP_TAC comp_h_rect;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[rectangle_h];
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  ]);;
  (* }}} *)

let comp_v_squ = 
prove_by_refinement(
  `!G x m. (segment G /\ (v_edge m SUBSET (component  (ctop G) x)) ==>
     (squ m SUBSET (component  (ctop G ) x)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `(rectangle (FST m -: &:1 , SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
  IMATCH_MP_TAC comp_v_rect;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[rectangle_v];
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  ]);;
  (* }}} *)

let comp_p_squ = 
prove_by_refinement(
  `!G x m. (segment G /\ (component  (ctop G) x (pointI m))) ==>
     (squ m SUBSET (component  (ctop G ) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `long_v m SUBSET component  (ctop G) x` SUBGOAL_TAC;
  IMATCH_MP_TAC comp_pointI_long;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[long_v_union];
  REWRITE_TAC[union_subset];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  comp_v_squ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let comp_squ = 
prove_by_refinement(
  `!G x. (segment G /\ (~(component  (ctop G) x = EMPTY)) ==>
     (?m. (squ m SUBSET (component  (ctop G ) x))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  COPY 0;
  USE 0 (MATCH_MP unions_cell_of);
  TSPEC `x` 0;
  USE 0 (SYM);
  USE 1 (REWRITE_RULE[EMPTY_EXISTS]);
  CHO 1;
  UND 0;
  DISCH_THEN (fun t-> USE 1 (ONCE_REWRITE_RULE[t]));
  USE 0 (REWRITE_RULE[cell_of;UNIONS]);
  CHO 0;
  UND 0;
  DISCH_ALL_TAC;
  USE 0 (REWRITE_RULE[cell]);
  CHO 0;
  UND 0;
  REP_CASES_TAC;
  REWR 1;
  USE 1 (REWRITE_RULE[single_subset]);
  ASM_MESON_TAC[comp_p_squ];
  ASM_MESON_TAC[comp_h_squ];
  ASM_MESON_TAC[comp_v_squ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_squ_left_rect_v = 
prove_by_refinement(
  `!G m x. (segment G /\ ~(G (v_edge (  m))) /\
    (squ m SUBSET component (ctop G) x) ==>
   (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1) SUBSET
 component (ctop G) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  UND 1;
  ASM_SIMP_TAC[GSYM curve_cell_v];
  DISCH_TAC;
  (*  *)
  IMATCH_MP_TAC   convex_component;
  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
  CONJ_TAC;
  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
  REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
  DISCH_ALL_TAC;
  AND 3;
  TYPE_THEN `~(squ (left   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
  USE 0(MATCH_MP curve_cell_squ_inter);
  COPY 0;
  TSPEC `m` 0;
  TSPEC `left   m` 5;
  UND 5;
  UND 0;
  REWRITE_TAC [EQ_EMPTY; INTER];
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  REWR 4;
  USE 3 (REWRITE_RULE[UNIONS;]);
  CHO 3;
  TYPE_THEN `cell u` SUBGOAL_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
  DISCH_TAC;
  TYPE_THEN `u = v_edge m ` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[rectangle_v;EMPTY_EXISTS;];
  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
  USE 2(REWRITE_RULE[ISUBSET]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_squ_left_rect = 
prove_by_refinement(
  `!G m x. (segment G /\
    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
         (squ p SUBSET (component  (ctop G) x))))) /\
     (squ m SUBSET component  (ctop G) x)) ==>
   (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1)
       SUBSET component  (ctop G) x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  LEFT 1 "p";
  TSPEC `m` 1;
  LEFT 1 "e";
  TSPEC `v_edge m` 1;
  REWR 1;
  USE 1(REWRITE_RULE[squ_closure_v]);
  IMATCH_MP_TAC  comp_squ_left_rect_v;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let comp_squ_right_rect_v = 
prove_by_refinement(
  `!G m x. (segment G /\ ~(G (v_edge (right  m))) /\
    (squ m SUBSET component (ctop G) x) ==>
   (rectangle (FST m,SND m ) (FST m +: &:2,SND m +: &:1) SUBSET
 component (ctop G) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  UND 1;
  ASM_SIMP_TAC[GSYM curve_cell_v];
  DISCH_TAC;
  (*  *)
  IMATCH_MP_TAC   convex_component;
  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
  TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right  m) -: &:1, SND (right  m)) (FST (right  m) +: &:1, SND (right  m) +: &:1)` SUBGOAL_TAC;
  REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
  REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
  DISCH_ALL_TAC;
  AND 3;
  USE 4 (REWRITE_RULE[right_left]);
  TYPE_THEN `~(squ  m x') /\ ~(squ (right  m) x')` SUBGOAL_TAC;
  USE 0(MATCH_MP curve_cell_squ_inter);
  COPY 0;
  TSPEC `m` 0;
  TSPEC `right   m` 5;
  UND 5;
  UND 0;
  REWRITE_TAC [EQ_EMPTY; INTER];
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  REWR 4;
  USE 3 (REWRITE_RULE[UNIONS;]);
  CHO 3;
  TYPE_THEN `cell u` SUBGOAL_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
  DISCH_TAC;
  TYPE_THEN `u = v_edge (right  m) ` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[rectangle_v;EMPTY_EXISTS;];
  REWRITE_TAC[right_left];
  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
  USE 2(REWRITE_RULE[ISUBSET]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_squ_right_rect = 
prove_by_refinement(
  `!G m x. (segment G /\
    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
         (squ p SUBSET (component  (ctop G) x))))) /\
     (squ m SUBSET component  (ctop G) x)) ==>
   (rectangle (FST m , SND m ) (FST m +: &:2,SND m +: &:1)
       SUBSET component  (ctop G) x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  LEFT 1 "p";
  TSPEC `m` 1;
  LEFT 1 "e";
  TSPEC `v_edge (right  m)` 1;
  REWR 1;
  USE 1(REWRITE_RULE[squ_closure_right_v]);
  IMATCH_MP_TAC  comp_squ_right_rect_v;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let comp_squ_down_rect_h = 
prove_by_refinement(
  `!G m x. (segment G /\ ~(G (h_edge m)) /\
    (squ m SUBSET component (ctop G) x) ==>
   (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET
 component (ctop G) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  UND 1;
  ASM_SIMP_TAC[GSYM curve_cell_h];
  DISCH_TAC;
  (*  *)
  IMATCH_MP_TAC   convex_component;
  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
  CONJ_TAC;
  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
  REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
  DISCH_ALL_TAC;
  AND 3;
  TYPE_THEN `~(squ (down   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
  USE 0(MATCH_MP curve_cell_squ_inter);
  COPY 0;
  TSPEC `m` 0;
  TSPEC `down   m` 5;
  UND 5;
  UND 0;
  REWRITE_TAC [EQ_EMPTY; INTER];
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  REWR 4;
  USE 3 (REWRITE_RULE[UNIONS;]);
  CHO 3;
  TYPE_THEN `cell u` SUBGOAL_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
  DISCH_TAC;
  TYPE_THEN `u = h_edge m ` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[rectangle_h;EMPTY_EXISTS;];
  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
  USE 2(REWRITE_RULE[ISUBSET]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_squ_down_rect = 
prove_by_refinement(
  `!G m x. (segment G /\
    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
         (squ p SUBSET (component  (ctop G) x))))) /\
     (squ m SUBSET component  (ctop G) x)) ==>
   (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1)
       SUBSET component  (ctop G) x)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  LEFT 1 "p";
  TSPEC `m` 1;
  LEFT 1 "e";
  TSPEC `h_edge m` 1;
  REWR 1;
  USE 1(REWRITE_RULE[squ_closure_h]);
  ASM_MESON_TAC[comp_squ_down_rect_h];
  ]);;

  (* }}} *)

let comp_squ_up_rect_h = 
prove_by_refinement(
  `!G m x. (segment G /\ ~(G (h_edge (up m))) /\
    (squ m SUBSET component (ctop G) x) ==>
   (rectangle (FST m,SND m ) (FST m +: &:1,SND m +: &:2) SUBSET
 component (ctop G) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  UND 1;
  ASM_SIMP_TAC[GSYM curve_cell_h];
  DISCH_TAC;
  (*  *)
  IMATCH_MP_TAC   convex_component;
  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
  TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up  m) , SND (up  m) -: &:1) (FST (up  m) +: &:1, SND (up  m) +: &:1)` SUBGOAL_TAC;
  REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
  REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
  DISCH_ALL_TAC;
  AND 3;
  USE 4 (REWRITE_RULE[right_left]);
  TYPE_THEN `~(squ  m x') /\ ~(squ (up  m) x')` SUBGOAL_TAC;
  USE 0(MATCH_MP curve_cell_squ_inter);
  COPY 0;
  TSPEC `m` 0;
  TSPEC `up   m` 5;
  UND 5;
  UND 0;
  REWRITE_TAC [EQ_EMPTY; INTER];
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  REWR 4;
  USE 3 (REWRITE_RULE[UNIONS;]);
  CHO 3;
  TYPE_THEN `cell u` SUBGOAL_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
  DISCH_TAC;
  TYPE_THEN `u = h_edge (up  m) ` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[rectangle_h;EMPTY_EXISTS;];
  REWRITE_TAC[right_left];
  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
  USE 2(REWRITE_RULE[ISUBSET]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_squ_up_rect = 
prove_by_refinement(
  `!G m x. (segment G /\
    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
         (squ p SUBSET (component  (ctop G) x))))) /\
     (squ m SUBSET component  (ctop G) x)) ==>
   (rectangle (FST m , SND m ) (FST m +: &:1,SND m +: &:2)
       SUBSET component  (ctop G) x)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  LEFT 1 "p";
  TSPEC `m` 1;
  LEFT 1 "e";
  TSPEC `h_edge (up  m)` 1;
  REWR 1;
  USE 1(REWRITE_RULE[squ_closure_up_h]);
  IMATCH_MP_TAC  comp_squ_up_rect_h;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let comp_squ_right_left = 
prove_by_refinement(
  `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G) x))  /\
    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
         (squ p SUBSET (component  (ctop G) x)))))) ==>
     (squ (left    m) SUBSET (component  (ctop G) x))  /\
    (squ (right      m) SUBSET (component  (ctop G) x))  /\
    (squ (up  m) SUBSET (component  (ctop G) x))  /\
   (squ (down  m) SUBSET (component  (ctop G) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  JOIN 2 1;
  JOIN 0 1;
  WITH 0 (MATCH_MP comp_squ_up_rect);
  WITH 0 (MATCH_MP comp_squ_down_rect);
  WITH 0 (MATCH_MP comp_squ_left_rect);
  WITH 0 (MATCH_MP comp_squ_right_rect);
  TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up  m) , SND (up  m) -: &:1) (FST (up  m) +: &:1, SND (up  m) +: &:1)` SUBGOAL_TAC;
  REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
  DISCH_THEN (fun t-> USE 1 (REWRITE_RULE[t]));
  TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right  m) -: &:1, SND (right  m)) (FST (right  m) +: &:1, SND (right  m) +: &:1)` SUBGOAL_TAC;
  REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
  DISCH_THEN (fun t-> USE 4 (REWRITE_RULE[t]));
  RULE_ASSUM_TAC (REWRITE_RULE[rectangle_h;rectangle_v;union_subset;right_left ]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

(* move *)
let suc_sum = 
prove_by_refinement(
  `!j a b. (SUC j = a+ b) ==> (?k. (SUC k = a) \/ (SUC k = b))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  LEFT 1 "k";
  USE 1(REWRITE_RULE[DE_MORGAN_THM]);
  TYPE_THEN `a = 0 ` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  ASM_MESON_TAC[num_CASES];
  TYPE_THEN `b = 0` SUBGOAL_TAC;
  ASM_MESON_TAC[num_CASES];
  UND 0;
  ARITH_TAC;
  ]);;
  (* }}} *)

let squ_induct = 
prove_by_refinement(
  `!j m n. ?p.
    ((SUC j) = (num_abs_of_int (FST m -: FST n) +
             num_abs_of_int (SND  m -: SND  n))) ==>
    ((j = (num_abs_of_int (FST p -: FST n) +
             num_abs_of_int (SND  p -: SND  n))) /\
     ((p = left  m) \/ (p = right  m) \/ (p = up m) \/ (p = down m))) `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  RIGHT_TAC "p";
  DISCH_TAC;
  WITH  0 (MATCH_MP suc_sum);
  CHO 1;
  UND 1;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `~(num_abs_of_int (FST m -: FST n) = 0)` SUBGOAL_TAC;
  UND 1;
  ARITH_TAC;
  REWRITE_TAC[num_abs_of_int0];
  DISCH_TAC;
  TYPE_THEN `FST m <: FST n \/ FST n <: FST m` SUBGOAL_TAC;
  UND 2;
  INT_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `right  m` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[right ];
  ONCE_REWRITE_TAC[GSYM SUC_INJ];
  REWRITE_TAC[GSYM ADD];
  TYPE_THEN `(FST m +: &:1) -: FST n <=: &:0` SUBGOAL_TAC;
  UND 3;
  INT_ARITH_TAC;
  ASM_SIMP_TAC[num_abs_of_int_pre];
  TYPE_THEN `(FST m +: &:1) -: FST n -: &:1 = FST m -: FST n` SUBGOAL_TAC;
  INT_ARITH_TAC;
  DISCH_THEN_REWRITE;
  (* next *)
  TYPE_THEN `left    m` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[left   ];
  ONCE_REWRITE_TAC[GSYM SUC_INJ];
  REWRITE_TAC[GSYM ADD];
  TYPE_THEN `&:0 <=: (FST m -: &:1) -: FST n ` SUBGOAL_TAC;
  UND 3;
  INT_ARITH_TAC;
  ASM_SIMP_TAC[num_abs_of_int_suc];
  TYPE_THEN `(FST m -: &:1 -: FST n +: &:1) = FST m -: FST n` SUBGOAL_TAC;
  INT_ARITH_TAC;
  DISCH_THEN_REWRITE;
  (* next *)
  TYPE_THEN `~(num_abs_of_int (SND  m -: SND  n) = 0)` SUBGOAL_TAC;
  UND 1;
  ARITH_TAC;
  REWRITE_TAC[num_abs_of_int0];
  DISCH_TAC;
  TYPE_THEN `SND  m <: SND  n \/ SND  n <: SND  m` SUBGOAL_TAC;
  UND 2;
  INT_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  (* next *)
  TYPE_THEN `up    m` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[up  ];
  ONCE_REWRITE_TAC[GSYM SUC_INJ];
  REWRITE_TAC[GSYM ADD_SUC];
  TYPE_THEN `(SND  m +: &:1) -: SND  n <=: &:0` SUBGOAL_TAC;
  UND 3;
  INT_ARITH_TAC;
  ASM_SIMP_TAC[num_abs_of_int_pre];
  TYPE_THEN `((SND  m +: &:1) -: SND  n -: &:1) = SND  m -: SND  n` SUBGOAL_TAC;
  INT_ARITH_TAC;
  DISCH_THEN_REWRITE;
  (* final *)
  TYPE_THEN `down    m` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[down   ];
  ONCE_REWRITE_TAC[GSYM SUC_INJ];
  REWRITE_TAC[GSYM ADD_SUC];
  TYPE_THEN `&:0 <=: (SND  m -: &:1) -: SND  n ` SUBGOAL_TAC;
  UND 3;
  INT_ARITH_TAC;
  ASM_SIMP_TAC[num_abs_of_int_suc];
  TYPE_THEN `(SND  m -: &:1 -: SND  n +: &:1) = SND  m -: SND  n` SUBGOAL_TAC;
  INT_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let comp_squ_fill = 
prove_by_refinement(
  `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G ) x)) /\
  (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
         (squ p SUBSET (component  (ctop G) x)))))) ==>
  (!n. (squ n SUBSET (component  (ctop G) x)))
  `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  GEN_TAC;
  TYPE_THEN `(!j n. (j = (num_abs_of_int (FST n -: FST m) + num_abs_of_int (SND  n -: SND  m))) ==> (squ n SUBSET component (ctop G) x)) ==> (squ n SUBSET component (ctop G) x)` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  INDUCT_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  REWRITE_TAC[ADD_EQ_0;num_abs_of_int0];
  GEN_TAC;
  DISCH_TAC;
  TYPE_THEN `n = m` SUBGOAL_TAC;
  UND 3;
  REWRITE_TAC[PAIR_SPLIT];
  INT_ARITH_TAC;
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  USE 4 (MATCH_MP (CONV_RULE (quant_right_CONV "p") squ_induct));
  CHO 4;
  TSPEC `p` 3;
  REWR 3;
  AND 4;
  TYPE_THEN `(n = left p) \/ (n = right p) \/ (n = up p) \/ (n = down p)` SUBGOAL_TAC;
  UND 4;
  REP_CASES_TAC THEN (ASM_REWRITE_TAC[right_left]);
  KILL 4;
  KILL 5;
  KILL 1;
  JOIN  3 2;
  JOIN 0 1;
  USE 0 (MATCH_MP comp_squ_right_left);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let comp_squ_adj = 
prove_by_refinement(
  `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G ) x))) ==>
     (?p e. (G e /\ e SUBSET closure top2 (squ p) /\
         (squ p SUBSET (component  (ctop G) x))))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `(!n. (squ n SUBSET (component  (ctop G) x)))` SUBGOAL_TAC;
  ASM_MESON_TAC[comp_squ_fill];
  DISCH_TAC;
  TYPE_THEN `?e. (G e /\ (edge e))` SUBGOAL_TAC;
  USE 0 (REWRITE_RULE [segment;EMPTY_EXISTS;SUBSET;]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  UND 2;
  REWRITE_TAC[];
  LEFT_TAC "e";
  CHO 4;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  AND 2;
  USE 2(REWRITE_RULE[edge]);
  CHO 2;
  UND 2;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `m'` EXISTS_TAC;
  ASM_REWRITE_TAC[squ_closure_v;squ_closure_h];
  ASM_MESON_TAC[squ_closure_v;squ_closure_h];
  ]);;

  (* }}} *)

(* ------------------------------------------------------------------ *)


let along_seg = jordan_def `along_seg G e x <=> G e /\
     (?p. (e SUBSET closure top2 (squ p) /\
          squ p SUBSET (component  (ctop G) x) ))`;;

let along_lemma1 = 
prove_by_refinement(
  `!G m x.  (segment G /\ (squ m SUBSET component  (ctop G) x) /\
     (G (v_edge m)) /\ (G (h_edge m))) ==>
   (?p. (h_edge m) SUBSET closure top2 (squ p) /\
       (squ p SUBSET (component  (ctop G) x)))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_MESON_TAC[squ_closure_h];
  ]);;
  (* }}} *)

let midpoint_exclusion = 
prove_by_refinement(
  `!G m e e' e''. (segment G /\ G e /\ G e' /\ G e'' /\ (~(e = e')) /\
    (closure top2 e (pointI m)) /\ (closure top2 e' (pointI m)) /\
    (closure top2 e'' (pointI m))   ==> ((e'' = e) \/ (e'' = e')))
    `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  USE 0 (REWRITE_RULE[segment;INSERT; ]);
  UND 0;
  DISCH_ALL_TAC;
  TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC;
  TSPEC `m` 10;
  UND 10;
  REP_CASES_TAC;
  ASM_REWRITE_TAC[];
  UND 10;
  USE 0 (MATCH_MP num_closure1);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CHO 10;
  COPY 10;
  TSPEC `e` 12;
  TSPEC `e'` 10;
  ASM_MESON_TAC[];
  USE 0 (MATCH_MP num_closure0);
  TSPEC `pointI m` 0;
  REWR 0;
  TSPEC `e` 0;
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 0 (MATCH_MP num_closure_size);
  TSPEC `pointI m` 0;
  REWR 0;
  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ;
  TYPE_THEN `X e /\ X e' /\ X e''` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  UND 0;
  UND 4;
  MESON_TAC[two_exclusion];
  ]);;
  (* }}} *)

(* indexed to here *)
let along_lemma2 = 
prove_by_refinement(
  `!G m. (segment G /\ G (v_edge m) /\ G (v_edge (down m)) ==>
     ~(G (h_edge m)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = v_edge (down m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  midpoint_exclusion;
  TYPE_THEN `G` EXISTS_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[v_edge_inj;down;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;];
  INT_ARITH_TAC ;
  REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2];
  ]);;
  (* }}} *)

let along_lemma3 = 
prove_by_refinement(
  `!G m. (segment G /\ G (v_edge m) /\ G(h_edge (left  m)) ==>
     ~(G (h_edge m)) /\ ~(G (v_edge (down m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  USE 3(REWRITE_RULE[]);
  TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = h_edge (left  m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  midpoint_exclusion;
  TYPE_THEN `G` EXISTS_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[v_edge_inj;left;v_edge_cpoint;GSYM hv_edgeV2;h_edge_cpoint;PAIR_SPLIT;];
  INT_ARITH_TAC ;
  REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2;left ;h_edge_inj;PAIR_SPLIT;];
  INT_ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  USE 3(REWRITE_RULE[]);
  TYPE_THEN `(h_edge (left  m) = v_edge m) \/ (h_edge (left  m) = v_edge (down m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  midpoint_exclusion;
  TYPE_THEN `G` EXISTS_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[v_edge_inj;down;left ;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;];
  INT_ARITH_TAC ;
  REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2];
  ]);;
  (* }}} *)

let along_lemma4 = 
prove_by_refinement(
  `!G m x.  (segment G /\ (squ m SUBSET component  (ctop G) x) /\
     (G (v_edge m)) /\ (G (v_edge (down m)))) ==>
   (?p. (v_edge (down m)) SUBSET closure top2 (squ p) /\
       (squ p SUBSET (component  (ctop G) x)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `down m` EXISTS_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[squ_closure_v];
  TYPE_THEN `~(G (h_edge m))` SUBGOAL_TAC;
  ASM_MESON_TAC[along_lemma2];
  DISCH_TAC;
  TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  comp_squ_down_rect_h;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[rectangle_h; union_subset];
  MESON_TAC [];
  ]);;
  (* }}} *)

let along_lemma5 = 
prove_by_refinement(
  `!G m x. (segment G /\ (squ m SUBSET component  (ctop G) x) /\
     (G (v_edge m)) /\ (G (h_edge (left   m)))) ==>
   (?p. (h_edge (left   m)) SUBSET closure top2 (squ p) /\
       (squ p SUBSET (component  (ctop G) x)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `left  (down m)` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[GSYM right_left];
  ASM_MESON_TAC[squ_closure_down_h];
  TYPE_THEN ` ~(G (h_edge m)) /\ ~(G (v_edge (down m)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  along_lemma3;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC ;
  IMATCH_MP_TAC  comp_squ_down_rect_h;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[rectangle_h; union_subset];
  DISCH_ALL_TAC;
  TYPE_THEN `(rectangle (FST (down m) -: &:1,SND (down m)) (FST (down m) +: &:1,SND (down m) +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
  IMATCH_MP_TAC  comp_squ_left_rect_v;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[rectangle_v;union_subset;];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let along_lemma6 = 
prove_by_refinement(
  `!G m x e. (segment G /\ (squ m SUBSET component  (ctop G) x) /\
     (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==>
   (?p. e SUBSET closure top2 (squ p) /\
       (squ p SUBSET (component  (ctop G) x))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC ;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;];
  REWRITE_TAC[edge];
  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
  REWR 4;
  USE 4 (REWRITE_RULE[v_edge_cpoint]);
  UND 4;
  DISCH_TAC;
  TYPE_THEN `(m' = m) \/ (m' = (down m))` SUBGOAL_TAC;
  UND 4;
  REWRITE_TAC[down;PAIR_SPLIT];
  INT_ARITH_TAC ;
  KILL 4;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[squ_closure_v];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  along_lemma4;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  REWR 4;
  USE 4(REWRITE_RULE[h_edge_cpoint]);
  TYPE_THEN `(m' = m) \/ (m' = (left  m))` SUBGOAL_TAC;
  UND 4;
  REWRITE_TAC[left;PAIR_SPLIT];
  INT_ARITH_TAC ;
  KILL 4;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  along_lemma1;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  along_lemma5;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)

let reflAf = jordan_def
   `reflAf r (x:num->real) = point(&2 * (real_of_int r) - x 0, x 1)`;;

let reflAi = jordan_def
   `reflAi r (x:int#int) = ((&:2 *: r) -: FST x,SND x)`;;

let reflBf = jordan_def
   `reflBf r (x:num->real) = point( x 0 , &2 * (real_of_int r) - x 1)`;;

let reflBi = jordan_def
   `reflBi r (x:int#int) = (FST x, (&:2 *: r) -: SND x)`;;

let reflCf = jordan_def
   `reflCf  (x:num->real) = point (x 1, x 0)`;;

let reflCi = jordan_def
   `reflCi  (x:int#int) = (SND  x, FST  x)`;;

let reflAf_inv = 
prove_by_refinement(
  `!r m.  (reflAf r (reflAf r (point m)) = (point m))`,

  (* {{{ proof *)

  [
  REP_GEN_TAC;
  REWRITE_TAC[reflAf;coord01;PAIR_SPLIT ;point_inj ;];
  REAL_ARITH_TAC ;
  ]);;
  (* }}} *)

let reflBf_inv = 
prove_by_refinement(
  `!r m.  (reflBf r (reflBf r (point m)) = (point m))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[reflBf;coord01;PAIR_SPLIT ;point_inj ;];
  REAL_ARITH_TAC ;
  ]);;
  (* }}} *)

let reflCf_inv = 
prove_by_refinement(
  `!m.  (reflCf  (reflCf  (point m)) = (point m))`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[reflCf;coord01;PAIR_SPLIT ;point_inj ;];
  ]);;
  (* }}} *)

let reflAi_inv = 
prove_by_refinement(
  `!r x.  (reflAi r (reflAi r x) = x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[reflAi;PAIR_SPLIT;];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let reflBi_inv = 
prove_by_refinement(
  `!r x.  (reflBi r (reflBi r x) = x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[reflBi;PAIR_SPLIT;];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let reflCi_inv = 
prove_by_refinement(
  `!x.  (reflCi  (reflCi  x) = x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[reflCi;PAIR_SPLIT;];
  ]);;
  (* }}} *)

let invo_BIJ = 
prove_by_refinement(
  `!f. (!m . (f (f (point m)) = (point m))) /\
        (!x. (euclid 2 (f x))) ==>
             (BIJ f (euclid 2) (euclid 2))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[BIJ;INJ;SURJ;];
  SUBCONJ_TAC;
  CONJ_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 2 (MATCH_MP (point_onto));
  USE 3 (MATCH_MP (point_onto));
  CHO 2;
  CHO 3;
  REWR 4;
  TYPE_THEN `f` (USE 4 o AP_TERM );
  REWR 4;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 4(MATCH_MP point_onto);
  CHO 4;
  ASM_REWRITE_TAC[];
  TYPE_THEN ` f (point p)` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let reflA_BIJ = 
prove_by_refinement(
  `!r. (BIJ (reflAf r) (euclid 2) (euclid 2))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  invo_BIJ;
  REWRITE_TAC[reflAf_inv];
  REWRITE_TAC[reflAf;euclid_point;];
  ]);;
  (* }}} *)

let reflB_BIJ = 
prove_by_refinement(
  `!r. (BIJ (reflBf r) (euclid 2) (euclid 2))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  invo_BIJ;
  REWRITE_TAC[reflBf_inv];
  REWRITE_TAC[reflBf;euclid_point;];
  ]);;
  (* }}} *)

let reflC_BIJ = 
prove_by_refinement(
  `(BIJ (reflCf ) (euclid 2) (euclid 2))`,

  (* {{{ proof *)
  [
  IMATCH_MP_TAC  invo_BIJ;
  REWRITE_TAC[reflCf_inv];
  REWRITE_TAC[reflCf;euclid_point;];
  ]);;
  (* }}} *)

let invo_homeo = 
prove_by_refinement(
  `!U (f:A->A). (continuous f U U) /\ (BIJ f (UNIONS U) (UNIONS U)) /\
    (!x. (UNIONS U x ==> (f (f x ) = x))) ==> (homeomorphism f U U)`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  bicont_homeomorphism;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!x. (UNIONS U x) ==> (INV f (UNIONS U) (UNIONS U) x = f x)` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  TYPE_THEN `UNIONS U (f x)` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[BIJ;SURJ];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_SIMP_TAC [(INR INVERSE_XY)];
  DISCH_ALL_TAC;
  UND 0;
  REWRITE_TAC[continuous];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  TSPEC `v` 0;
  REWR 0;
  UND 0;
  REWRITE_TAC[preimage];
  TYPE_THEN `{x | UNIONS U x /\ v (INV f (UNIONS U) (UNIONS U) x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  IMATCH_MP_TAC  (TAUT `(C ==> (A <=> B)) ==> ( C /\ A <=> C /\ B)`);
  DISCH_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let d_euclid_point = 
prove_by_refinement(
  `!r s. (d_euclid (point r) (point s) =
       sqrt ((FST r - FST s) pow 2 + ((SND r - SND s) pow 2)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `euclid 2 (point r) /\ euclid 2 (point s)` SUBGOAL_TAC;
  REWRITE_TAC[euclid_point];
  DISCH_TAC ;
  USE 0(MATCH_MP d_euclid_n);
  ASM_REWRITE_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[ARITH_RULE `2 = SUC 1`];
  REWRITE_TAC[sum_DEF];
  REDUCE_TAC;
  REWRITE_TAC[ARITH_RULE `1 = SUC 0`];
  REWRITE_TAC[sum_DEF];
  REDUCE_TAC;
  REWRITE_TAC[ARITH_RULE `(SUC 0  =1) /\ (SUC (SUC 0) = 2)`];
  REWRITE_TAC[coord01];
  REWRITE_TAC[POW_2];
  ]);;
  (* }}} *)

let reflA_cont = 
prove_by_refinement(
  `!r. continuous (reflAf r) top2 top2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[top2];
  GEN_TAC;
  TYPE_THEN `(IMAGE (reflAf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_SIMP_TAC[metric_euclid];
  CONV_TAC (dropq_conv "x");
  REWRITE_TAC[reflAf;euclid_point];
  DISCH_TAC;
  ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
  DISCH_ALL_TAC;
  TYPE_THEN `epsilon` EXISTS_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 2(MATCH_MP point_onto);
  CHO 2;
  USE 3(MATCH_MP point_onto);
  CHO 3;
  UND 4;
  ASM_REWRITE_TAC[reflAf;d_euclid_point;coord01;];
  TYPE_THEN `(&2 * real_of_int r - FST p - (&2 * real_of_int r - FST p'))  = --. (FST p - FST p') ` SUBGOAL_TAC;
  REAL_ARITH_TAC ;
  DISCH_THEN_REWRITE;
  ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS];
  REWRITE_TAC[ABS_NEG];
  ]);;
  (* }}} *)

let reflB_cont = 
prove_by_refinement(
  `!r. continuous (reflBf r) top2 top2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[top2];
  GEN_TAC;
  TYPE_THEN `(IMAGE (reflBf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_SIMP_TAC[metric_euclid];
  CONV_TAC (dropq_conv "x");
  REWRITE_TAC[reflBf;euclid_point];
  DISCH_TAC;
  ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
  DISCH_ALL_TAC;
  TYPE_THEN `epsilon` EXISTS_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 2(MATCH_MP point_onto);
  CHO 2;
  USE 3(MATCH_MP point_onto);
  CHO 3;
  UND 4;
  ASM_REWRITE_TAC[reflBf;d_euclid_point;coord01;];
  TYPE_THEN `(&2 * real_of_int r - SND  p - (&2 * real_of_int r - SND  p'))  = --. (SND  p - SND  p') ` SUBGOAL_TAC;
  REAL_ARITH_TAC ;
  DISCH_THEN_REWRITE;
  ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS];
  REWRITE_TAC[ABS_NEG];
  ]);;
  (* }}} *)

let reflC_cont = 
prove_by_refinement(
  ` continuous (reflCf) top2 top2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[top2];
  TYPE_THEN `(IMAGE (reflCf) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_SIMP_TAC[metric_euclid];
  CONV_TAC (dropq_conv "x");
  REWRITE_TAC[reflCf;euclid_point];
  DISCH_TAC;
  ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
  DISCH_ALL_TAC;
  TYPE_THEN `epsilon` EXISTS_TAC;
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 2(MATCH_MP point_onto);
  CHO 2;
  USE 3(MATCH_MP point_onto);
  CHO 3;
  UND 4;
  ASM_REWRITE_TAC[reflCf;d_euclid_point;coord01;];
  REWRITE_TAC[REAL_ADD_AC];
  ]);;
  (* }}} *)

let reflA_homeo = 
prove_by_refinement(
  `!r. (homeomorphism (reflAf r) top2 top2)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  ASSUME_TAC reflA_BIJ;
  ASSUME_TAC top2_unions;
  IMATCH_MP_TAC  invo_homeo;
  REWRITE_TAC[reflA_cont];
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 2(MATCH_MP   point_onto);
  CHO 2;
  ASM_REWRITE_TAC[reflAf_inv];
  ]);;
  (* }}} *)

let reflB_homeo = 
prove_by_refinement(
  `!r. (homeomorphism (reflBf r) top2 top2)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  ASSUME_TAC reflB_BIJ;
  ASSUME_TAC top2_unions;
  IMATCH_MP_TAC  invo_homeo;
  REWRITE_TAC[reflB_cont];
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 2(MATCH_MP   point_onto);
  CHO 2;
  ASM_REWRITE_TAC[reflBf_inv];
  ]);;
  (* }}} *)

let reflC_homeo = 
prove_by_refinement(
  ` (homeomorphism (reflCf ) top2 top2)`,

  (* {{{ proof *)
  [
  ASSUME_TAC reflC_BIJ;
  ASSUME_TAC top2_unions;
  IMATCH_MP_TAC  invo_homeo;
  REWRITE_TAC[reflC_cont];
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 2(MATCH_MP   point_onto);
  CHO 2;
  ASM_REWRITE_TAC[reflCf_inv];
  ]);;
  (* }}} *)

let IMAGE2 = new_definition
   `IMAGE2 (f:A->B) U = IMAGE (IMAGE (f:A->B)) U`;;
let reflA_h_edge = 
prove_by_refinement(
  `!m r.  IMAGE (reflAf r) (h_edge m) = h_edge (left  (reflAi r m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[h_edge];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "v");
  REWRITE_TAC[coord01];
  EQ_TAC;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 0;
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  DISCH_ALL_TAC;
  UND 0;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
  UND 0;
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  DISCH_ALL_TAC;
  UND 2;
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let reflA_v_edge = 
prove_by_refinement(
  `!m r.  IMAGE (reflAf r) (v_edge m) = v_edge (  (reflAi r m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[v_edge];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[coord01];
  REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let reflA_edge = 
prove_by_refinement(
  `!r e. (edge e ==> edge (IMAGE (reflAf r) e))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  DISCH_ALL_TAC;
  CHO 0;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  MESON_TAC[reflA_v_edge];
  ASM_REWRITE_TAC[];
  MESON_TAC[reflA_h_edge];
  ]);;
  (* }}} *)

let reflB_v_edge = 
prove_by_refinement(
  `!m r.  IMAGE (reflBf r) (v_edge m) = v_edge (down  (reflBi r m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[v_edge];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[coord01];
  EQ_TAC;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 0;
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  DISCH_ALL_TAC;
  UND 0;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN CHOOSE_TAC;
  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
  UND 0;
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  DISCH_ALL_TAC;
  UND 2;
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let reflB_h_edge = 
prove_by_refinement(
  `!m r.  IMAGE (reflBf r) (h_edge m) = h_edge (  (reflBi r m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[h_edge];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "v");
  REWRITE_TAC[coord01];
  REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let reflB_edge = 
prove_by_refinement(
  `!r e. (edge e ==> edge (IMAGE (reflBf r) e))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  DISCH_ALL_TAC;
  CHO 0;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  MESON_TAC[reflB_v_edge];
  ASM_REWRITE_TAC[];
  MESON_TAC[reflB_h_edge];
  ]);;
  (* }}} *)

let reflC_vh_edge = 
prove_by_refinement(
  `!m .  IMAGE (reflCf) (v_edge m) = h_edge ( (reflCi m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[v_edge;h_edge];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REWRITE_TAC[coord01];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let reflC_hv_edge = 
prove_by_refinement(
  `!m .  IMAGE (reflCf) (h_edge m) = v_edge ( (reflCi m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[v_edge;h_edge];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  REWRITE_TAC[coord01];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let reflC_edge = 
prove_by_refinement(
  `!e. (edge e ==> edge (IMAGE (reflCf ) e))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  DISCH_ALL_TAC;
  CHO 0;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  MESON_TAC[reflC_vh_edge];
  ASM_REWRITE_TAC[];
  MESON_TAC[reflC_hv_edge];
  ]);;
  (* }}} *)

let homeo_bij = 
prove_by_refinement(
  `!(f:A->B) U V. (homeomorphism f U V) ==> (BIJ (IMAGE f) U V)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;homeomorphism;continuous;preimage;];
  DISCH_ALL_TAC;
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  ASM_REWRITE_TAC[IMAGE;];
  DISCH_ALL_TAC;
  TAPP `u:B` 6;
  USE 6 (REWRITE_RULE[]);
  USE 6(CONV_RULE NAME_CONFLICT_CONV);
  IMATCH_MP_TAC  EQ_EXT;
  USE 6 (GEN `u:B`);
  GEN_TAC;
  COPY 6;
  EQ_TAC;
  DISCH_TAC;
  TSPEC `f x'` 7;
  TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  UND 7;
  KILL 6;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CHO 6;
  CHO 9;
  TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC;
  REWRITE_TAC[UNIONS;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC;
  REWRITE_TAC[UNIONS;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `x' = x'''` SUBGOAL_TAC;
  USE 0(REWRITE_RULE[INJ]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `x' = x''` SUBGOAL_TAC;
  USE 0(REWRITE_RULE[INJ]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_MESON_TAC[];
  (* mm *)
  DISCH_TAC;
  TSPEC `f x'` 7;
  TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  UND 7;
  KILL 6;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CHO 6;
  CHO 9;
  TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC;
  REWRITE_TAC[UNIONS;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC;
  REWRITE_TAC[UNIONS;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `x' = x'''` SUBGOAL_TAC;
  USE 0(REWRITE_RULE[INJ]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `x' = x''` SUBGOAL_TAC;
  USE 0(REWRITE_RULE[INJ]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[INJ;SURJ];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  TYPE_THEN `{z | UNIONS U z /\ x (f z)}` EXISTS_TAC;
  CONJ_TAC;
  UND 2;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET ;];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  MESON_TAC[];
  REWRITE_TAC[SUBSET;IMAGE];
  DISCH_ALL_TAC;
  NAME_CONFLICT_TAC;
  UND 1;
  REWRITE_TAC[SURJ];
  DISCH_ALL_TAC;
  TSPEC `x'` 8;
  TYPE_THEN `UNIONS V x'` SUBGOAL_TAC;
  REWRITE_TAC[UNIONS;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 8;
  CHO 8;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let homeo_unions = 
prove_by_refinement(
  `!(f:A->B) U V. (homeomorphism f U V) ==>
      (IMAGE f (UNIONS U) = (UNIONS V))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[homeomorphism;BIJ;SURJ;IMAGE;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  GEN_TAC;
  NAME_CONFLICT_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 5;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TSPEC `x` 2;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let homeo_closed = 
prove_by_refinement(
  `!(f:A->B) U V A. (homeomorphism f U V /\ (A SUBSET (UNIONS U)) ==>
    (closed_ V (IMAGE f A) = closed_ U A))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
   TYPE_THEN `BIJ f (UNIONS U) (UNIONS V)` SUBGOAL_TAC;
  ASM_MESON_TAC[homeomorphism];
  DISCH_TAC;
  USE 2(MATCH_MP DIFF_SURJ);
  TSPEC `A` 2;
  REWR 2;
  ASM_REWRITE_TAC[closed;open_DEF];
  EQ_TAC;
  DISCH_ALL_TAC;
  USE 0(REWRITE_RULE[homeomorphism;continuous]);
  UND 0;
  DISCH_ALL_TAC;
  USE 2 SYM;
  REWR 4;
  TSPEC `IMAGE f (UNIONS U DIFF A)` 5;
  REWR 5;
  TYPE_THEN `preimage (UNIONS U) f (IMAGE f (UNIONS U DIFF A)) = UNIONS U DIFF A` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT ;
  GEN_TAC;
  REWRITE_TAC[INR in_preimage;IMAGE;DIFF;];
  USE 0(REWRITE_RULE[BIJ;INJ]);
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 8;
  ASM_MESON_TAC[];
  MESON_TAC[];
  DISCH_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  GEN_TAC;
  NAME_CONFLICT_TAC;
  UND 1;
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  USE 0(REWRITE_RULE[homeomorphism]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* SECTION G *)
(* ------------------------------------------------------------------ *)


let IMAGE_INTERS = 
prove_by_refinement(
  `!(f:A->B) A X . (INJ f X UNIV) /\ (UNIONS A SUBSET X) /\
     ~(A = EMPTY) ==>
   ((IMAGE f) (INTERS A) = (INTERS (IMAGE2 f A)))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  REWRITE_TAC[IMAGE2;INTERS;IMAGE;];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  EQ_TAC;
  DISCH_ALL_TAC;
  CHO 3;
  AND 3;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  CHO 5;
  AND 5;
  ASM_REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_MESON_TAC[];
  DISCH_ALL_TAC;
  USE 3 (CONV_RULE (dropq_conv "u'"));
  USE 3 (CONV_RULE (dropq_conv "y'"));
  USE 2(REWRITE_RULE[EMPTY_EXISTS]);
  CHO 2;
  COPY 3;
  TSPEC `u` 3;
  CHO 3;
  REWR 3;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  USE 0(REWRITE_RULE[INJ]);
  TSPEC `u'` 4;
  CHO 4;
  REWR 4;
  TYPEL_THEN [`x'`;`x''`] (USE 0 o ISPECL);
  USE 1(REWRITE_RULE[UNIONS;ISUBSET]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let homeo_closure = 
prove_by_refinement(
  `!(f:A->B) U V A. (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) /\
     (topology_ U)  ==>
     (IMAGE f (closure U A) = closure V (IMAGE f A))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  REWRITE_TAC[closure];
  TYPE_THEN `INJ f (UNIONS U) (UNIV)` SUBGOAL_TAC;
  USE 0(REWRITE_RULE[homeomorphism;BIJ;INJ;]);
  ASM_REWRITE_TAC[INJ];
  DISCH_TAC;
  TYPE_THEN `C = {B | closed_ U B /\ A SUBSET B}` ABBREV_TAC ;
  TYPE_THEN `(UNIONS C SUBSET UNIONS U)` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET;];
  EXPAND_TAC "C";
  REWRITE_TAC[closed];
  TYPE_THEN `X = UNIONS U` ABBREV_TAC ;
  REWRITE_TAC[UNIONS];
  MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `~(C = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `UNIONS U` EXISTS_TAC;
  EXPAND_TAC "C";
  ASM_REWRITE_TAC[closed; ISUBSET; DIFF_EQ_EMPTY;];
  ASM_SIMP_TAC[INR open_EMPTY];
  DISCH_TAC;
  JOIN 5 6;
  JOIN 3 5;
  USE 3 (MATCH_MP IMAGE_INTERS);
  ASM_REWRITE_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[IMAGE2];
  EXPAND_TAC "C";
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  EQ_TAC;
  DISCH_THEN CHOOSE_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "g";
  KILL 5;
  TYPE_THEN `x' SUBSET (UNIONS U)` SUBGOAL_TAC;
  USE 6(REWRITE_RULE[closed]);
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[homeo_closed];
  DISCH_TAC;
  REWRITE_TAC[ISUBSET;IMAGE];
  NAME_CONFLICT_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_ALL_TAC;
  TYPE_THEN `preimage (UNIONS U) f x` EXISTS_TAC;
  TYPE_THEN `x = g (preimage (UNIONS U) f x)` SUBGOAL_TAC;
  REWRITE_TAC[preimage];
  EXPAND_TAC "g";
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  EQ_TAC;
  DISCH_TAC;
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]);
  UND 0;
  DISCH_ALL_TAC;
  TSPEC `x'` 10;
  TYPE_THEN `UNIONS V x'` SUBGOAL_TAC;
  USE 6(REWRITE_RULE[closed]);
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  REWR 10;
  ASM_MESON_TAC[];
  REWRITE_TAC[IMAGE];
  DISCH_THEN CHOOSE_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  USE 8 (SYM);
  ONCE_ASM_REWRITE_TAC[];
  REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `preimage (UNIONS U) f x SUBSET (UNIONS U)` SUBGOAL_TAC;
  REWRITE_TAC[preimage;SUBSET;];
  MESON_TAC[];
  ASM_SIMP_TAC[GSYM homeo_closed];
  REWRITE_TAC[preimage;SUBSET];
  DISCH_ALL_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[ISUBSET];
  UND 7;
  EXPAND_TAC "g";
  REWRITE_TAC[IMAGE;ISUBSET;];
  UND 9;
  MESON_TAC[];
  ]);;

  (* }}} *)

let INJ_IMAGE = 
prove_by_refinement(
  `!(f :A->B) A B X . (A SUBSET X) /\ (B SUBSET X) /\
     (INJ f X UNIV) ==> ((IMAGE f A = IMAGE f B) <=> (A = B))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  EQ_TAC;
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
  TAPP `y:B` 3;
  RULE_ASSUM_TAC  (REWRITE_RULE[]);
  USE 3(GEN `y:B`);
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  USE 4(REWRITE_RULE [DE_MORGAN_THM]);
  FIRST_ASSUM (DISJ_CASES_TAC);

  LEFT  5 "x";
  REP_BASIC_TAC;
  TSPEC `f x ` 3;
  TYPE_THEN `A x` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REP_BASIC_TAC;
  USE 0(REWRITE_RULE[BIJ;INJ]);
  TYPE_THEN `x = x'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];

  LEFT  5 "x";
  REP_BASIC_TAC;
  TSPEC `f x ` 3;
  TYPE_THEN `B x` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REP_BASIC_TAC;
  USE 0(REWRITE_RULE[BIJ;INJ]);
  TYPE_THEN `x = x'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let INJ_UNIV = 
prove_by_refinement(
  `!(f: A->B) X Y. (INJ f X Y) ==> (INJ f X UNIV)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  ASM_MESON_TAC [];
  ]);;
  (* }}} *)

let homeo_adj = 
prove_by_refinement(
  `!f X Y.  (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\
       (Y SUBSET euclid 2)
       ==> (adj X Y ==> (adj (IMAGE f X) (IMAGE f Y)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[adj;INTER;EMPTY_EXISTS];
  REP_BASIC_TAC;
  ASSUME_TAC top2_top;
  ASSUME_TAC top2_unions;
  TYPE_THEN `X SUBSET (UNIONS top2) /\ Y SUBSET (UNIONS (top2))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `closure top2 (IMAGE f X) = IMAGE f (closure top2 X)` SUBGOAL_TAC;
  ASM_MESON_TAC[GSYM homeo_closure];
  DISCH_THEN_REWRITE;
  TYPE_THEN `closure top2 (IMAGE f Y) = IMAGE f (closure top2 Y)` SUBGOAL_TAC;
  ASM_MESON_TAC[GSYM homeo_closure];
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[]);
  UND 2;
  REWRITE_TAC[];
  UND 10;
  TYPE_THEN `INJ f (euclid 2) UNIV` SUBGOAL_TAC;
  IMATCH_MP_TAC  INJ_UNIV;
  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ]);
  REP_BASIC_TAC;
  REWR 11;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  ASM_MESON_TAC[INJ_IMAGE];
  (* done WITH both *)
  TYPE_THEN `f u` EXISTS_TAC;
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  (* converse *)
  ]);;
  (* }}} *)

let homeomorphism_inv = 
prove_by_refinement(
  `!(f:A->B) U V. homeomorphism f U V ==>
    (homeomorphism (INV f (UNIONS U) (UNIONS V)) V U)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[homeomorphism];
  ASM_SIMP_TAC[INV_homeomorphism];
  USE 0(REWRITE_RULE [homeomorphism;continuous;]);
  REP_BASIC_TAC;
  ASM_SIMP_TAC[INVERSE_BIJ];
  REP_BASIC_TAC;
  TSPEC `A` 1;
  REWR 1;
  TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ;
  TYPE_THEN `BIJ g (UNIONS V) (UNIONS U)` SUBGOAL_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!x'. (A x' ==> (f (g x') = x'))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPEL_THEN  [`f`;`UNIONS U`;`UNIONS V`] (fun t->  ASSUME_TAC (ISPECL  t (INR INVERSE_DEF)));
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
  REWR 6;
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC  ;
  REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  DISCH_TAC;
  DISCH_TAC;
  (* branch *)
  TYPE_THEN `(IMAGE g A) = preimage (UNIONS U) f A` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE;preimage];
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[];
  EXPAND_TAC "g";
  USE 2(MATCH_MP   INVERSE_BIJ);
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC [UNIONS];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `f x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `f x = f (g (f x))` SUBGOAL_TAC;
  ASM_SIMP_TAC[];
  DISCH_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  USE 9 SYM;
  ASM_REWRITE_TAC[];
  TYPE_THEN `UNIONS V (f x)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let inv_comp_left = 
prove_by_refinement(
  `!(f:A->B) X Y x.  (BIJ f X Y /\ X x) ==> (INV f X Y (f x) = x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `Y (f x)` SUBGOAL_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[INR INVERSE_XY];
  ]);;
  (* }}} *)

let inv_comp_right = 
prove_by_refinement(
  `!(f:A->B) X Y y. (BIJ f X Y /\ Y y) ==> (f (INV f X Y y) = y)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
  ASM_MESON_TAC[INR INVERSE_DEF;];
  ]);;
  (* }}} *)

let image_inv_image = 
prove_by_refinement(
  `!(f:A->B) A X Y. (BIJ f X Y) /\ (A SUBSET X) ==>
    (IMAGE (INV f X Y) (IMAGE f A) = A)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `x = x'` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC [inv_comp_left;ISUBSET;];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  inv_comp_left;
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let homeo_adj_eq = 
prove_by_refinement(
  `!f X Y. (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\
       (Y SUBSET euclid 2)
       ==> (adj X Y = (adj (IMAGE f X) (IMAGE f Y)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  EQ_TAC;
  ASM_MESON_TAC[homeo_adj];
  TYPEL_THEN  [`INV f (euclid 2) (euclid 2)`;`IMAGE f X`;`IMAGE f Y`] (fun t-> MP_TAC (ISPECL t homeo_adj));
  ASSUME_TAC top2_unions;
  TYPE_THEN `homeomorphism (INV f (euclid 2) (euclid 2)) top2 top2` SUBGOAL_TAC;
  ASM_MESON_TAC[homeomorphism_inv];
  DISCH_THEN_REWRITE;
  TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[homeomorphism];
  DISCH_TAC;
  ASM_SIMP_TAC[image_inv_image];
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f X SUBSET euclid 2 /\ IMAGE f Y SUBSET euclid 2` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  NAME_CONFLICT_TAC;
  CONJ_TAC THEN (CONV_TAC (dropq_conv "x''")) THEN (RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]));
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let finite_num_closure = 
prove_by_refinement(
  `!G top (x:A). FINITE G ==> (FINITE {C | G C /\ closure top C x})`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let image_powerset = 
prove_by_refinement(
  `!(f:A->B) X Y. (BIJ f X Y ==>
     (BIJ (IMAGE f) {z | z SUBSET X} { z | z SUBSET Y}))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  CONJ_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC ;
  REWRITE_TAC[IMAGE;SUBSET;];
  ASM_MESON_TAC[ISUBSET ;];
  REWRITE_TAC[IMAGE;SUBSET;];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;

  TAPP `z:B` 1;
  USE 1(REWRITE_RULE[]);
  USE 1(GEN `z:B`);
  EQ_TAC;
  TSPEC `f x'` 1;
  REP_BASIC_TAC;
  UND 1;
  NAME_CONFLICT_TAC;
  TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  TYPE_THEN `x' = x''` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* 2 *)
  TSPEC `f x'` 1;
  REP_BASIC_TAC;
  UND 1;
  NAME_CONFLICT_TAC;
  TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  TYPE_THEN `x' = x''` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[INJ;SURJ];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `{z | X z /\ x (f z) }` EXISTS_TAC;
  SUBCONJ_TAC;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT ;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  TSPEC `x'` 0;
  USE 3(REWRITE_RULE[SUBSET]);
  TSPEC  `x'` 3;
  REWR 3;
  REWR 0;
  REP_BASIC_TAC;
  TYPE_THEN `y` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let image_power_inj = 
prove_by_refinement(
  `!(f:A->B) X Y A B. (BIJ f X Y /\ A SUBSET X /\ B SUBSET X ==>
     ((IMAGE f A = IMAGE f B) <=> (A = B)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPEL_THEN [`f`;`X`;`Y`]  (fun t -> ASSUME_TAC (ISPECL t image_powerset ));
  REWR 3;
  USE 3(REWRITE_RULE[BIJ;INJ;]);
  REP_BASIC_TAC;
  EQ_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let image_power_surj = 
prove_by_refinement(
  `!(f:A->B) X Y B. (BIJ f X Y /\ B SUBSET Y ==>
    (?A. (A SUBSET X /\ (IMAGE f A = B))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPEL_THEN [`f`;`X`;`Y`]  (fun t -> ASSUME_TAC (ISPECL t image_powerset ));
  REWR 2;
  USE 2(REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_euclid = 
prove_by_refinement(
  `!G e. (segment G /\ G e) ==> (e SUBSET (euclid 2))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  REP_BASIC_TAC;
  USE 3(REWRITE_RULE[SUBSET]);
  TSPEC `e` 3;
  REWR 3;
  USE 3(REWRITE_RULE[edge]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[h_edge_euclid;v_edge_euclid];
  ]);;
  (* }}} *)

let image_app = 
prove_by_refinement(
  `!(f:A->B) X Y x t. INJ f X Y /\ x SUBSET X /\ (X t) ==>
   (IMAGE f x (f t) = x t)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;IMAGE;SUBSET ;];
  REP_BASIC_TAC;
  EQ_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let homeo_num_closure = 
prove_by_refinement(
  `!G f m. (homeomorphism f top2 top2 /\ segment G) ==>
   (num_closure G (pointI m) =
           (num_closure (IMAGE2 f G) (f (pointI m))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC top2_unions;
  ASSUME_TAC top2_top;
  TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
  ASM_MESON_TAC [];
  DISCH_TAC;
  TYPE_THEN `G` (fun t-> ASSUME_TAC (ISPEC t segment_euclid));
  REWRITE_TAC[num_closure];
  IMATCH_MP_TAC  BIJ_CARD;
  TYPE_THEN `IMAGE f` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  finite_num_closure;
  ASM_MESON_TAC[segment_finite];
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  CONJ_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE2];
  CONJ_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `x SUBSET (UNIONS top2)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `IMAGE f (closure top2 x) = closure top2 (IMAGE f x)` SUBGOAL_TAC;
  ASM_MESON_TAC [homeo_closure];
  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x SUBSET (euclid 2) /\ y SUBSET (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_MESON_TAC[image_power_inj];
  REWRITE_TAC[INJ;SURJ];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2]);
  UND 9;
  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  EXPAND_TAC "g";
  REP_BASIC_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWR 8;
  UND 8;
  TYPE_THEN `x' SUBSET (UNIONS top2)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `closure top2 (g x') = IMAGE f (closure top2 x')` SUBGOAL_TAC;
  ASM_MESON_TAC [GSYM homeo_closure];
  DISCH_THEN_REWRITE;
  (* m3 *)
  TYPE_THEN `INJ f (euclid 2) (euclid 2) /\ (closure top2 x' SUBSET (euclid 2)) /\ (euclid 2 (pointI m))` SUBGOAL_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
   ASM_REWRITE_TAC[pointI;euclid_point];
  IMATCH_MP_TAC  c_edge_euclid;
  ASM_MESON_TAC[segment;ISUBSET];
  DISCH_TAC;
  USE 12 (MATCH_MP image_app);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION H *)
(* ------------------------------------------------------------------ *)

let reflA_pointI = 
prove_by_refinement(
  `!r m. (reflAf r (pointI m) = pointI (reflAi r m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[reflAi;reflAf;pointI];
  REWRITE_TAC[point_inj;PAIR_SPLIT;];
  REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
  ]);;
  (* }}} *)

let reflB_pointI = 
prove_by_refinement(
  `!r m. (reflBf r (pointI m) = pointI (reflBi r m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[reflBi;reflBf;pointI];
  REWRITE_TAC[point_inj;PAIR_SPLIT;];
  REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
  ]);;
  (* }}} *)

let reflC_pointI = 
prove_by_refinement(
  `!m. (reflCf  (pointI m) = pointI (reflCi m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[reflCi;reflCf;pointI];
  REWRITE_TAC[point_inj;PAIR_SPLIT;];
  REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
  ]);;
  (* }}} *)

let edge_euclid2 = 
prove_by_refinement(
  `!e. (edge e ==> e SUBSET (euclid 2))`,

  (* {{{ proof *)
  [
  MESON_TAC [edge;h_edge_euclid;v_edge_euclid;];
  ]);;
  (* }}} *)

let reflA_segment = 
prove_by_refinement(
  `!G r. (segment G ==> (segment (IMAGE2 (reflAf r) G)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[segment];
  COPY 0;
  USE 0(REWRITE_RULE[segment]);
  REP_BASIC_TAC;
  TYPE_THEN `homeomorphism (reflAf r) top2 top2` SUBGOAL_TAC;
  REWRITE_TAC[reflA_homeo];
  DISCH_TAC;
  ASSUME_TAC top2_top;
  ASSUME_TAC top2_unions;
  TYPE_THEN `BIJ (reflAf r) (euclid 2) (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[homeomorphism];
  DISCH_TAC;
  TYPE_THEN `INJ (IMAGE (reflAf r)) edge edge` SUBGOAL_TAC;
  REWRITE_TAC[INJ;reflA_edge;];
  REP_BASIC_TAC;
  TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[edge_euclid2];
  DISCH_TAC;
  ASM_MESON_TAC[image_power_inj];
  DISCH_TAC;
  (* start cases *)
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  SUBCONJ_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
  TSPEC `IMAGE (reflAf r) u` 4;
  UND 4;
  REWRITE_TAC[];
  TYPE_THEN `IMAGE (IMAGE (reflAf r)) G (IMAGE (reflAf r) u) = G u` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  EXISTS_TAC `edge`;
  EXISTS_TAC `edge`;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (*
  ASM_MESON_TAC[image_power_inj];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  *)
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2;SUBSET];
  GEN_TAC;
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  reflA_edge;
  ASM_MESON_TAC[ISUBSET;];
  DISCH_TAC;
  (* num closure clause *)
  CONJ_TAC;
  GEN_TAC;
  TYPE_THEN `pointI m = reflAf r (pointI (reflAi r m))` SUBGOAL_TAC;
  REWRITE_TAC[reflA_pointI;reflAi_inv];
  DISCH_THEN_REWRITE;
  TYPE_THEN `num_closure (IMAGE2 (reflAf r) G) (reflAf r (pointI (reflAi r m))) = num_closure G (pointI (reflAi r m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_num_closure);
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[];
  (* inductive_set clause *)
  REP_BASIC_TAC;
  (* isc *)
  USE 16(REWRITE_RULE[IMAGE2]);
  USE 16 (MATCH_MP SUBSET_PREIMAGE);
  REP_BASIC_TAC;
  TSPEC `Z` 0;
  TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[]);
  REWR 16;
  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `D = IMAGE (reflAf r) C` ABBREV_TAC ;
  TYPE_THEN `D' = IMAGE (reflAf r) C'` ABBREV_TAC ;
  TSPEC `D` 14; (* *)
  TSPEC `D'` 14;
  TYPE_THEN `S D /\ IMAGE2 (reflAf r) G D' /\ adj D D'` SUBGOAL_TAC;
  SUBCONJ_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "D";
  TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C) = Z C` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `edge` EXISTS_TAC;
  TYPE_THEN `edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* fh1 *)
  SUBCONJ_TAC;
  EXPAND_TAC "D'";
  REWRITE_TAC[IMAGE2;IMAGE];
  NAME_CONFLICT_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  EXPAND_TAC "D";
  EXPAND_TAC "D'";
  TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;edge_euclid2];
  DISCH_TAC;
  TYPE_THEN `(adj C C' ==> adj (IMAGE (reflAf r) C) (IMAGE (reflAf r) C'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeo_adj;
  ASM_REWRITE_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 14;
  UND 14;
  EXPAND_TAC "D'";
  TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C') = Z C'` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `edge` EXISTS_TAC;
  TYPE_THEN `edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  UND 3;
  UND 19;
  ASM_MESON_TAC[ISUBSET];
  MESON_TAC[];
  DISCH_TAC;
  REWR 0;
  ASM_REWRITE_TAC[IMAGE2];
  ]);;
  (* }}} *)

let reflB_segment = 
prove_by_refinement(
  `!G r. (segment G ==> (segment (IMAGE2 (reflBf r) G)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[segment];
  COPY 0;
  USE 0(REWRITE_RULE[segment]);
  REP_BASIC_TAC;
  TYPE_THEN `homeomorphism (reflBf r) top2 top2` SUBGOAL_TAC;
  REWRITE_TAC[reflB_homeo];
  DISCH_TAC;
  ASSUME_TAC top2_top;
  ASSUME_TAC top2_unions;
  TYPE_THEN `BIJ (reflBf r) (euclid 2) (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[homeomorphism];
  DISCH_TAC;
  TYPE_THEN `INJ (IMAGE (reflBf r)) edge edge` SUBGOAL_TAC;
  REWRITE_TAC[INJ;reflB_edge;];
  REP_BASIC_TAC;
  TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[edge_euclid2];
  DISCH_TAC;
  ASM_MESON_TAC[image_power_inj];
  DISCH_TAC;
  (* start cases *)
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  SUBCONJ_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
  TSPEC `IMAGE (reflBf r) u` 4;
  UND 4;
  REWRITE_TAC[];
  TYPE_THEN `IMAGE (IMAGE (reflBf r)) G (IMAGE (reflBf r) u) = G u` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  EXISTS_TAC `edge`;
  EXISTS_TAC `edge`;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (*
  ASM_MESON_TAC[image_power_inj];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  *)
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2;SUBSET];
  GEN_TAC;
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  reflB_edge;
  ASM_MESON_TAC[ISUBSET;];
  DISCH_TAC;
  (* num closure clause *)
  CONJ_TAC;
  GEN_TAC;
  TYPE_THEN `pointI m = reflBf r (pointI (reflBi r m))` SUBGOAL_TAC;
  REWRITE_TAC[reflB_pointI;reflBi_inv];
  DISCH_THEN_REWRITE;
  TYPE_THEN `num_closure (IMAGE2 (reflBf r) G) (reflBf r (pointI (reflBi r m))) = num_closure G (pointI (reflBi r m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_num_closure);
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[];
  (* inductive_set clause *)
  REP_BASIC_TAC;
  (* isc *)
  USE 16(REWRITE_RULE[IMAGE2]);
  USE 16 (MATCH_MP SUBSET_PREIMAGE);
  REP_BASIC_TAC;
  TSPEC `Z` 0;
  TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[]);
  REWR 16;
  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `D = IMAGE (reflBf r) C` ABBREV_TAC ;
  TYPE_THEN `D' = IMAGE (reflBf r) C'` ABBREV_TAC ;
  TSPEC `D` 14; (* *)
  TSPEC `D'` 14;
  TYPE_THEN `S D /\ IMAGE2 (reflBf r) G D' /\ adj D D'` SUBGOAL_TAC;
  SUBCONJ_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "D";
  TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C) = Z C` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `edge` EXISTS_TAC;
  TYPE_THEN `edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* fh1 *)
  SUBCONJ_TAC;
  EXPAND_TAC "D'";
  REWRITE_TAC[IMAGE2;IMAGE];
  NAME_CONFLICT_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  EXPAND_TAC "D";
  EXPAND_TAC "D'";
  TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;edge_euclid2];
  DISCH_TAC;
  TYPE_THEN `(adj C C' ==> adj (IMAGE (reflBf r) C) (IMAGE (reflBf r) C'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeo_adj;
  ASM_REWRITE_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 14;
  UND 14;
  EXPAND_TAC "D'";
  TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C') = Z C'` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `edge` EXISTS_TAC;
  TYPE_THEN `edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  UND 3;
  UND 19;
  ASM_MESON_TAC[ISUBSET];
  MESON_TAC[];
  DISCH_TAC;
  REWR 0;
  ASM_REWRITE_TAC[IMAGE2];
  ]);;
  (* }}} *)

let reflC_segment = 
prove_by_refinement(
  `!G . (segment G ==> (segment (IMAGE2 (reflCf) G)))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  REWRITE_TAC[segment];
  COPY 0;
  USE 0(REWRITE_RULE[segment]);
  REP_BASIC_TAC;
  TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC;
  REWRITE_TAC[reflC_homeo];
  DISCH_TAC;
  ASSUME_TAC top2_top;
  ASSUME_TAC top2_unions;
  TYPE_THEN `BIJ (reflCf) (euclid 2) (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[homeomorphism];
  DISCH_TAC;
  TYPE_THEN `INJ (IMAGE (reflCf)) edge edge` SUBGOAL_TAC;
  REWRITE_TAC[INJ;reflC_edge;];
  REP_BASIC_TAC;
  TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
  ASM_MESON_TAC[edge_euclid2];
  DISCH_TAC;
  ASM_MESON_TAC[image_power_inj];
  DISCH_TAC;
  (* start cases *)
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  SUBCONJ_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
  TSPEC `IMAGE (reflCf) u` 4;
  UND 4;
  REWRITE_TAC[];
  TYPE_THEN `IMAGE (IMAGE (reflCf)) G (IMAGE (reflCf) u) = G u` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  EXISTS_TAC `edge`;
  EXISTS_TAC `edge`;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (*
  ASM_MESON_TAC[image_power_inj];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  *)
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2;SUBSET];
  GEN_TAC;
  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  reflC_edge;
  ASM_MESON_TAC[ISUBSET;];
  DISCH_TAC;
  (* num closure clause *)
  CONJ_TAC;
  GEN_TAC;
  TYPE_THEN `pointI m = reflCf (pointI (reflCi m))` SUBGOAL_TAC;
  REWRITE_TAC[reflC_pointI;reflCi_inv];
  DISCH_THEN_REWRITE;
  TYPE_THEN `num_closure (IMAGE2 (reflCf) G) (reflCf (pointI (reflCi m))) = num_closure G (pointI (reflCi m))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_num_closure);
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[];
  (* inductive_set clause *)
  REP_BASIC_TAC;
  (* isc *)
  USE 16(REWRITE_RULE[IMAGE2]);
  USE 16 (MATCH_MP SUBSET_PREIMAGE);
  REP_BASIC_TAC;
  TSPEC `Z` 0;
  TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[]);
  REWR 16;
  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `D = IMAGE (reflCf) C` ABBREV_TAC ;
  TYPE_THEN `D' = IMAGE (reflCf) C'` ABBREV_TAC ;
  TSPEC `D` 14; (* *)
  TSPEC `D'` 14;
  TYPE_THEN `S D /\ IMAGE2 (reflCf) G D' /\ adj D D'` SUBGOAL_TAC;
  SUBCONJ_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "D";
  TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C) = Z C` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `edge` EXISTS_TAC;
  TYPE_THEN `edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* fh1 *)
  SUBCONJ_TAC;
  EXPAND_TAC "D'";
  REWRITE_TAC[IMAGE2;IMAGE];
  NAME_CONFLICT_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  EXPAND_TAC "D";
  EXPAND_TAC "D'";
  TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET;edge_euclid2];
  DISCH_TAC;
  TYPE_THEN `(adj C C' ==> adj (IMAGE (reflCf) C) (IMAGE (reflCf) C'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeo_adj;
  ASM_REWRITE_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 14;
  UND 14;
  EXPAND_TAC "D'";
  TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C') = Z C'` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `edge` EXISTS_TAC;
  TYPE_THEN `edge` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  UND 3;
  UND 19;
  ASM_MESON_TAC[ISUBSET];
  MESON_TAC[];
  DISCH_TAC;
  REWR 0;
  ASM_REWRITE_TAC[IMAGE2];
  ]);;

  (* }}} *)

let point_x = 
prove_by_refinement(
  `!x m. (x = point m) <=> (euclid 2 x /\ (FST m = x 0) /\ (SND m = x 1))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  EQ_TAC ;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[coord01;euclid_point];
  REP_BASIC_TAC;
  USE 2 (MATCH_MP   point_onto );
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[point_inj];
  REWRITE_TAC[PAIR_SPLIT];
  ASM_REWRITE_TAC[coord01];
  ]);;
  (* }}} *)

(* next IMAGE of square *)

let reflA_squ = 
prove_by_refinement(
  `!m r.  IMAGE (reflAf r) (squ m) = squ (left  (reflAi r m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[squ;reflAf;reflAi;IMAGE ;left  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  REWRITE_TAC[coord01;];
  REWRITE_TAC[point_x];
  CONV_TAC (dropq_conv "v");
  EQ_TAC ;
  REP_BASIC_TAC;
  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 4;
  UND 5;
  USE 0 (GSYM );
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  REAL_ARITH_TAC;
  (* 2 *)
  REP_BASIC_TAC;
  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
  UND 2;
  UND 3;
  USE 4 (GSYM);
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let reflB_squ = 
prove_by_refinement(
  `!m r.  IMAGE (reflBf r) (squ m) = squ (down  (reflBi r m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[squ;reflBf;reflBi;IMAGE ;down  ;];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  REWRITE_TAC[coord01;];
  REWRITE_TAC[point_x];
  CONV_TAC (dropq_conv "u");
  EQ_TAC ;
  REP_BASIC_TAC;
  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 2;
  UND 3;
  USE 0 (GSYM );
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  REAL_ARITH_TAC;
  (* 2 *)
  REP_BASIC_TAC;
  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
  UND 0;
  UND 1;
  USE 4 (GSYM);
  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let reflC_squ = 
prove_by_refinement(
  `!m.  IMAGE (reflCf) (squ m) = squ (  (reflCi m))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[squ;reflCf;reflCi;IMAGE ; ];
  DISCH_ALL_TAC;
  IMATCH_MP_TAC EQ_EXT;
  REWRITE_TAC[];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "x'");
  REWRITE_TAC[coord01;];
  REWRITE_TAC[point_x];
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "v");
  MESON_TAC[];
  ]);;
  (* }}} *)

(* move to sets *)
let powerset = jordan_def `powerset (X:A->bool) = { z | z SUBSET X }`;;

let image_sing = 
prove_by_refinement(
  `!(f:A -> B) x. (IMAGE f {x} = {(f x)})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[IMAGE;INSERT];
  CONV_TAC (dropq_conv "x'");
  ]);;
  (* }}} *)

let image_unions = 
prove_by_refinement(
  `!(f:A->B)  U.
     (IMAGE f (UNIONS U) = UNIONS (IMAGE (IMAGE f) U))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[IMAGE;UNIONS;];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  EQ_TAC;
  REP_BASIC_TAC;
  CONV_TAC (dropq_conv "u");
  ASM_REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  NAME_CONFLICT_TAC;
  REWR 0;
  KILL 1;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

(* move *)
let segment_euclid = 
prove_by_refinement(
  `!G. (segment G) ==> (closure top2 (UNIONS G) SUBSET euclid 2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  closure_subset;
  ASM_REWRITE_TAC[top2_top;GSYM top2_unions];
  CONJ_TAC;
  IMATCH_MP_TAC  closed_UNIV;
  REWRITE_TAC[top2_top];
  REWRITE_TAC[top2_unions;SUBSET;UNIONS;];
  REP_BASIC_TAC;
  TYPE_THEN `edge u` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET];
  ASM_MESON_TAC[edge_euclid2;ISUBSET];
  ]);;
  (* }}} *)

let image_curve_cell_reflA  = 
prove_by_refinement(
  `!G r. (segment G) ==>
    (curve_cell (IMAGE2 (reflAf r) G) =
           IMAGE2 (reflAf r) (curve_cell G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[curve_cell];
  REWRITE_TAC[IMAGE2;IMAGE_UNION;];
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET;UNIONS;];
  REP_BASIC_TAC;
  TYPE_THEN `edge u` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET;];
  ASM_MESON_TAC[edge_euclid2;ISUBSET];
  DISCH_TAC;
  ASSUME_TAC top2_top;
  ASSUME_TAC top2_unions;
  (*  *)
  TYPE_THEN `UNIONS (IMAGE (IMAGE (reflAf r)) G) = IMAGE (reflAf r) (UNIONS G)` SUBGOAL_TAC;
  REWRITE_TAC[GSYM image_unions];
  DISCH_THEN_REWRITE ;
  (*  *)
  TYPE_THEN `closure top2 (IMAGE (reflAf r) (UNIONS G)) = IMAGE (reflAf r) (closure top2 (UNIONS G))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;];
  DISCH_THEN_REWRITE;
  (*  *)
  TYPE_THEN `!n. IMAGE (reflAf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflAi r n))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN  `n' = reflAi r n` ABBREV_TAC ;
  TYPE_THEN `pointI n = reflAf r (pointI n')` SUBGOAL_TAC;
  EXPAND_TAC "n'";
  KILL 4;
  ASM_REWRITE_TAC[reflA_pointI;reflAi_inv];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
 TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC[pointI;euclid_point];
  ASSUME_TAC reflA_homeo;
  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  segment_euclid;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (*  *)
  REWRITE_TAC[IMAGE;];
  CONV_TAC (dropq_conv "x'");
(**** Modified by JRH to avoid GSPEC
  REWRITE_TAC[INR IN_SING;GSPEC;];
 ****)
  REWRITE_TAC[INR IN_SING; UNWIND_THM2];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "y'");
(**** Removed by JRH
  REWRITE_TAC[GSPEC];
 ****)
  (*  *)
  EQ_TAC ;
  REP_BASIC_TAC;
  TYPE_THEN `reflAi r n'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING; reflA_pointI; reflAi_inv;];
(*** Removed by JRH
  MESON_TAC[];
 ****)
  (*   *)
  REP_BASIC_TAC;
  TYPE_THEN `reflAi r n'` EXISTS_TAC;
  ASM_REWRITE_TAC[reflAi_inv;];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING;reflA_pointI;];
(*** Removed by JRH
  MESON_TAC[];
 ****)
  ]);;
  (* }}} *)

let image_curve_cell_reflB  = 
prove_by_refinement(
  `!G r. (segment G) ==>
    (curve_cell (IMAGE2 (reflBf r) G) =
           IMAGE2 (reflBf r) (curve_cell G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[curve_cell];
  REWRITE_TAC[IMAGE2;IMAGE_UNION;];
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET;UNIONS;];
  REP_BASIC_TAC;
  TYPE_THEN `edge u` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET;];
  ASM_MESON_TAC[edge_euclid2;ISUBSET];
  DISCH_TAC;
  ASSUME_TAC top2_top;
  ASSUME_TAC top2_unions;
  (*  *)
  TYPE_THEN `UNIONS (IMAGE (IMAGE (reflBf r)) G) = IMAGE (reflBf r) (UNIONS G)` SUBGOAL_TAC;
  REWRITE_TAC[GSYM image_unions];
  DISCH_THEN_REWRITE ;
  (*  *)
  TYPE_THEN `closure top2 (IMAGE (reflBf r) (UNIONS G)) = IMAGE (reflBf r) (closure top2 (UNIONS G))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;];
  DISCH_THEN_REWRITE;
  (*  *)
  TYPE_THEN `!n. IMAGE (reflBf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflBi r n))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN  `n' = reflBi r n` ABBREV_TAC ;
  TYPE_THEN `pointI n = reflBf r (pointI n')` SUBGOAL_TAC;
  EXPAND_TAC "n'";
  KILL 4;
  ASM_REWRITE_TAC[reflB_pointI;reflBi_inv];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
 TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC[pointI;euclid_point];
  ASSUME_TAC reflB_homeo;
  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  segment_euclid;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (*  *)
  REWRITE_TAC[IMAGE;];
  CONV_TAC (dropq_conv "x'");

(*** JRH changed this line to avoid GSPEC
  REWRITE_TAC[INR IN_SING;GSPEC;];
 ***)
  REWRITE_TAC[INR IN_SING; UNWIND_THM2];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "y'");
(*** JRH removed this to avoid GSPEC
  REWRITE_TAC[GSPEC];
 ***)
  (*  *)
  EQ_TAC ;
  REP_BASIC_TAC;
  TYPE_THEN `reflBi r n'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING; reflB_pointI; reflBi_inv;];
(*** Removed by JRH
  MESON_TAC[];
 ****)
  (*   *)
  REP_BASIC_TAC;
  TYPE_THEN `reflBi r n'` EXISTS_TAC;
  ASM_REWRITE_TAC[reflBi_inv;];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING;reflB_pointI;];
(*** Removed by JRH
  MESON_TAC[];
 ****)
  ]);;
  (* }}} *)

let image_curve_cell_reflC  = 
prove_by_refinement(
  `!G . (segment G) ==>
    (curve_cell (IMAGE2 (reflCf ) G) =
           IMAGE2 (reflCf) (curve_cell G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[curve_cell];
  REWRITE_TAC[IMAGE2;IMAGE_UNION;];
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET;UNIONS;];
  REP_BASIC_TAC;
  TYPE_THEN `edge u` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET;];
  ASM_MESON_TAC[edge_euclid2;ISUBSET];
  DISCH_TAC;
  ASSUME_TAC top2_top;
  ASSUME_TAC top2_unions;
  (*  *)
  TYPE_THEN `UNIONS (IMAGE (IMAGE (reflCf)) G) = IMAGE (reflCf) (UNIONS G)` SUBGOAL_TAC;
  REWRITE_TAC[GSYM image_unions];
  DISCH_THEN_REWRITE ;
  (*  *)
  TYPE_THEN `closure top2 (IMAGE (reflCf) (UNIONS G)) = IMAGE (reflCf) (closure top2 (UNIONS G))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;];
  DISCH_THEN_REWRITE;
  (*  *)
  TYPE_THEN `!n. IMAGE (reflCf) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflCi n))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN  `n' = reflCi n` ABBREV_TAC ;
  TYPE_THEN `pointI n = reflCf (pointI n')` SUBGOAL_TAC;
  EXPAND_TAC "n'";
  KILL 4;
  ASM_REWRITE_TAC[reflC_pointI;reflCi_inv];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  image_app;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
 TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC[pointI;euclid_point];
  ASSUME_TAC reflC_homeo;
  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  segment_euclid;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (*  *)
  REWRITE_TAC[IMAGE;];
  CONV_TAC (dropq_conv "x'");
(*** This line changed by JRH to avoid GSPEC
  REWRITE_TAC[INR IN_SING;GSPEC;];
 ***)
  REWRITE_TAC[INR IN_SING; UNWIND_THM2];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x'");
  CONV_TAC (dropq_conv "y'");
 (*** Removed by JRH to avoid GSPEC
  REWRITE_TAC[GSPEC];
 ***)
  (*  *)
  EQ_TAC ;
  REP_BASIC_TAC;
  TYPE_THEN `reflCi n'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING; reflC_pointI; reflCi_inv;];
(*** Removed by JRH
  MESON_TAC[];
 ****)
  (*   *)
  REP_BASIC_TAC;
  TYPE_THEN `reflCi n'` EXISTS_TAC;
  ASM_REWRITE_TAC[reflCi_inv;];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING;reflC_pointI;];
(*** Removed by JRH
  MESON_TAC[];
 ****)
  ]);;
  (* }}} *)

let inj_inter = 
prove_by_refinement(
  `!(f:A->B) X Y A B. (INJ f X Y) /\ (A SUBSET X) /\ (B SUBSET X) ==>
     (IMAGE f (A INTER B) = (IMAGE f A) INTER (IMAGE f B))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE;INTER ];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_MESON_TAC[ISUBSET;];
  REP_BASIC_TAC;
  TYPE_THEN `x' = x''` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[ISUBSET;];
  REP_BASIC_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let homeomorphism_induced_top = 
prove_by_refinement(
  `!(f:A->B) U V A.  (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) ==>
      (IMAGE2 f (induced_top U A) = induced_top V (IMAGE f A))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[induced_top;];
  COPY 1;
  USE 1 (MATCH_MP homeo_bij);
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[IMAGE2];
  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  (*  *)
  TYPE_THEN `!t. U t ==> (g (t INTER A)  = g t INTER g A)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  inj_inter;
  TYPE_THEN `(UNIONS U)` EXISTS_TAC;
  TYPE_THEN `(UNIONS V)` EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  sub_union;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (*   *)
  EQ_TAC;
  REP_BASIC_TAC;
  TSPEC `x'` 4;
  REWR 4;
  ASM_REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  TYPE_THEN `g x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  (*  *)
  REP_BASIC_TAC;
  TYPE_THEN `?t. U t /\ (g t = x')` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TSPEC `t` 4;
  REWR 4;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let ctop_reflA = 
prove_by_refinement(
  `!G r. (segment G) ==>
      (IMAGE2 (reflAf r) (ctop G) = ctop (IMAGE2 (reflAf r) G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[ctop];
  ASSUME_TAC reflA_homeo;
  TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
  REWRITE_TAC[top2_unions;DIFF;SUBSET;];
  MESON_TAC[];
  DISCH_TAC ;
  (*   *)
  TYPE_THEN `IMAGE2 (reflAf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflAf r) (euclid 2 DIFF  (UNIONS (curve_cell G))))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeomorphism_induced_top;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  AP_TERM_TAC;
  TSPEC `r` 1;
  (*  *)
  TYPE_THEN `IMAGE (reflAf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflAf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
  REP_BASIC_TAC;
  USE 4 (MATCH_MP DIFF_SURJ);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[UNIONS;SUBSET;];
  REP_BASIC_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  TYPE_THEN `cell u` SUBGOAL_TAC;
  USE 7 (MATCH_MP curve_cell_cell);
  ASM_MESON_TAC[ISUBSET;];
  ASM_MESON_TAC[ISUBSET;cell_euclid];
  DISCH_THEN_REWRITE;
  AP_TERM_TAC;
  REWRITE_TAC[image_unions];
  AP_TERM_TAC;
  ASM_SIMP_TAC[image_curve_cell_reflA];
  REWRITE_TAC[IMAGE2];
  ]);;
  (* }}} *)

let ctop_reflB = 
prove_by_refinement(
  `!G r. (segment G) ==>
      (IMAGE2 (reflBf r) (ctop G) = ctop (IMAGE2 (reflBf r) G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[ctop];
  ASSUME_TAC reflB_homeo;
  TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
  REWRITE_TAC[top2_unions;DIFF;SUBSET;];
  MESON_TAC[];
  DISCH_TAC ;
  (*   *)
  TYPE_THEN `IMAGE2 (reflBf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflBf r) (euclid 2 DIFF  (UNIONS (curve_cell G))))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeomorphism_induced_top;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  AP_TERM_TAC;
  TSPEC `r` 1;
  (*  *)
  TYPE_THEN `IMAGE (reflBf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflBf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
  REP_BASIC_TAC;
  USE 4 (MATCH_MP DIFF_SURJ);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[UNIONS;SUBSET;];
  REP_BASIC_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  TYPE_THEN `cell u` SUBGOAL_TAC;
  USE 7 (MATCH_MP curve_cell_cell);
  ASM_MESON_TAC[ISUBSET;];
  ASM_MESON_TAC[ISUBSET;cell_euclid];
  DISCH_THEN_REWRITE;
  AP_TERM_TAC;
  REWRITE_TAC[image_unions];
  AP_TERM_TAC;
  ASM_SIMP_TAC[image_curve_cell_reflB];
  REWRITE_TAC[IMAGE2];
  ]);;
  (* }}} *)

let ctop_reflC = 
prove_by_refinement(
  `!G . (segment G) ==>
      (IMAGE2 (reflCf) (ctop G) = ctop (IMAGE2 (reflCf) G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[ctop];
  ASSUME_TAC reflC_homeo;
  TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
  REWRITE_TAC[top2_unions;DIFF;SUBSET;];
  MESON_TAC[];
  DISCH_TAC ;
  (*   *)
  TYPE_THEN `IMAGE2 (reflCf) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflCf) (euclid 2 DIFF  (UNIONS (curve_cell G))))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeomorphism_induced_top;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  AP_TERM_TAC;
  (*  *)
  TYPE_THEN `IMAGE (reflCf) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflCf) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
  REP_BASIC_TAC;
  USE 4 (MATCH_MP DIFF_SURJ);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[UNIONS;SUBSET;];
  REP_BASIC_TAC;
  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
  ASM_MESON_TAC[segment];
  DISCH_TAC;
  TYPE_THEN `cell u` SUBGOAL_TAC;
  USE 7 (MATCH_MP curve_cell_cell);
  ASM_MESON_TAC[ISUBSET;];
  ASM_MESON_TAC[ISUBSET;cell_euclid];
  DISCH_THEN_REWRITE;
  AP_TERM_TAC;
  REWRITE_TAC[image_unions];
  AP_TERM_TAC;
  ASM_SIMP_TAC[image_curve_cell_reflC];
  REWRITE_TAC[IMAGE2];
  ]);;
  (* }}} *)

let connected_homeo = 
prove_by_refinement(
  `!(f:A->B) U V Z. (homeomorphism f U V /\ (Z SUBSET UNIONS U) ==>
       (connected V (IMAGE f Z) = connected U Z))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ;
  TYPE_THEN `Z = IMAGE g (IMAGE f Z)` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[IMAGE];
  EXPAND_TAC "g";
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
  REP_BASIC_TAC;
  TYPE_THEN `!x'. (UNIONS U x') ==> (INV f (UNIONS U) (UNIONS V) (f x') = x')` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  inv_comp_left;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (*  *)
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN ` x` EXISTS_TAC;
  KILL 2;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET;];
  REP_BASIC_TAC;
  TSPEC `x'` 5;
  TYPE_THEN `UNIONS U x'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  REWR 5;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  UND 3;
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  IMATCH_MP_TAC  connect_image;
  TYPE_THEN `V` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  INV_homeomorphism;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE;SUBSET;];
  REP_BASIC_TAC;
  UND 3;
  EXPAND_TAC "g";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `UNIONS U x''` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
  TYPE_THEN `x = x''` SUBGOAL_TAC;
  ASM_MESON_TAC[inv_comp_left];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  connect_image;
  TYPE_THEN `U` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]);
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[SUBSET;IMAGE;];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  ASM_MESON_TAC[ISUBSET;];
  ]);;
  (* }}} *)

(* start here , Tues Jun 8 , 2004 *)

let component = 
prove_by_refinement(
  `!U (x:A) . (component  U x = {y | ?Z. connected U Z /\ Z x /\ Z y})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[component_DEF ;];
  ]);;
  (* }}} *)

let component_homeo = 
prove_by_refinement(
  `!(f:A->B) U V x. (homeomorphism f U V) /\ (UNIONS U x) ==>
     (IMAGE f (component U x) = (component  V (f x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[component ;IMAGE ; ];
  IMATCH_MP_TAC  EQ_EXT ;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  CONV_TAC (dropq_conv "x'");
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f Z` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `Z SUBSET UNIONS U` SUBGOAL_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[connected]);
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[connected_homeo];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  (*  *)
  REP_BASIC_TAC;
  (* *)
  TYPE_THEN `?A. A SUBSET (UNIONS U) /\ (IMAGE f A = Z)` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_power_surj;
  TYPE_THEN `UNIONS V` EXISTS_TAC;
  ASM_MESON_TAC[connected;homeomorphism];
  REP_BASIC_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  NAME_CONFLICT_TAC;
  WITH 5 (REWRITE_RULE[IMAGE]);
  USE 7 (GSYM);
  REWR 2;
  REP_BASIC_TAC;
  TYPE_THEN `x''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWR 3;
  REP_BASIC_TAC;
  TYPE_THEN ` x = x'''` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC  ;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  KILL 7;
  ASM_SIMP_TAC[GSYM connected_homeo];
  ]);;
  (* }}} *)

let bij_homeo = 
prove_by_refinement(
  `!(f:A->B) U V. (BIJ f (UNIONS U) (UNIONS V)) /\
    (BIJ (IMAGE f) U V) ==> (homeomorphism f U V)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[homeomorphism;continuous;];
  ASM_REWRITE_TAC[preimage;];
  CONJ_TAC;
  REP_BASIC_TAC;
  COPY 1;
  UND 3;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ;SURJ]);
  REP_BASIC_TAC;
  TSPEC  `v` 1;
  REWR 1;
  REP_BASIC_TAC;
  EXPAND_TAC "v";
  TYPE_THEN `{x | UNIONS U x /\ IMAGE f y (f x)} = y` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  GEN_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f y (f x) = y x` SUBGOAL_TAC;
  IMATCH_MP_TAC image_app ;
  TYPE_THEN `(UNIONS U)` EXISTS_TAC;
  TYPE_THEN `(UNIONS V)` EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[sub_union];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[sub_union;ISUBSET];
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  (* *)
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let homeomorphism_subset = 
prove_by_refinement(
  `!(f:A->B) U V C. (homeomorphism f U V) /\ (C SUBSET U) ==>
   (homeomorphism f C (IMAGE2 f C))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  bij_homeo;
  SUBCONJ_TAC;
  TYPE_THEN `UNIONS C SUBSET UNIONS U` SUBGOAL_TAC;
  IMATCH_MP_TAC  UNIONS_UNIONS ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWRITE_TAC[IMAGE2 ;GSYM  image_unions;];
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]);
  REP_BASIC_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
    SUBCONJ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f (UNIONS C) (f x) = (UNIONS C) x` SUBGOAL_TAC;
  IMATCH_MP_TAC  (image_app);
  TYPE_THEN `(UNIONS U)` EXISTS_TAC;
  TYPE_THEN `(UNIONS V)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC [ISUBSET];
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  REWRITE_TAC[SURJ];
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWRITE_TAC[BIJ];
  WITH_FIRST (MATCH_MP homeo_bij);
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE2;];
  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  REWRITE_TAC[INJ;SURJ];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2]);
  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
  UND 6;
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let component_reflA = 
prove_by_refinement(
  `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==>
    (IMAGE (reflAf r) (component  (ctop G) x) =
         (component  (ctop (IMAGE2 (reflAf r) G)) (reflAf r x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  component_homeo;
  ASM_REWRITE_TAC[];
  TYPE_THEN `ctop (IMAGE2 (reflAf r) G) = IMAGE2 (reflAf r) (ctop G)` SUBGOAL_TAC ;
  ASM_MESON_TAC[ctop_reflA];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  homeomorphism_subset;
  TYPE_THEN `top2` EXISTS_TAC;
  TYPE_THEN `top2` EXISTS_TAC;
  REWRITE_TAC[reflA_homeo];
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[ctop_top2];
  ]);;
  (* }}} *)

let component_reflB = 
prove_by_refinement(
  `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==>
    (IMAGE (reflBf r) (component  (ctop G) x) =
         (component  (ctop (IMAGE2 (reflBf r) G)) (reflBf r x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  component_homeo;
  ASM_REWRITE_TAC[];
  TYPE_THEN `ctop (IMAGE2 (reflBf r) G) = IMAGE2 (reflBf r) (ctop G)` SUBGOAL_TAC ;
  ASM_MESON_TAC[ctop_reflB];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  homeomorphism_subset;
  TYPE_THEN `top2` EXISTS_TAC;
  TYPE_THEN `top2` EXISTS_TAC;
  REWRITE_TAC[reflB_homeo];
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[ctop_top2];
  ]);;
  (* }}} *)

let component_reflC = 
prove_by_refinement(
  `!(f:A->B) G x. (segment G) /\ (UNIONS (ctop G) x) ==>
    (IMAGE (reflCf) (component  (ctop G) x) =
         (component  (ctop (IMAGE2 (reflCf) G)) (reflCf x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  component_homeo;
  ASM_REWRITE_TAC[];
  TYPE_THEN `ctop (IMAGE2 (reflCf) G) = IMAGE2 (reflCf) (ctop G)` SUBGOAL_TAC ;
  ASM_MESON_TAC[ctop_reflC];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  homeomorphism_subset;
  TYPE_THEN `top2` EXISTS_TAC;
  TYPE_THEN `top2` EXISTS_TAC;
  REWRITE_TAC[reflC_homeo];
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[ctop_top2];
  ]);;
  (* }}} *)

let subset_union_inter = 
prove_by_refinement(
  `!(X:A->bool) A B. (X SUBSET (A UNION B)   ==>
      (~(X INTER A = EMPTY )) \/ (~(X INTER B = EMPTY)) \/ (X = EMPTY ))`,

  (* {{{ proof *)
  [
  (REWRITE_TAC [EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ; ]);
  MESON_TAC[];
  ]);;
  (* }}} *)

let squ_disj = 
prove_by_refinement(
  `!m n. ((squ m INTER squ n = {}) <=> ~(m = n))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
    EQ_TAC;
  DISCH_ALL_TAC;
  REWR 1;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER_IDEMPOT;]);
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `squ m = squ n` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  ASM_MESON_TAC[cell_rules];
  ASM_REWRITE_TAC[squ_inj];
  ]);;
  (* }}} *)

(* move way up *)
let cell_clauses = 
prove_by_refinement(
  `(!m. (~(v_edge m = EMPTY ) /\ ~(h_edge m = EMPTY )
       /\ ~(squ m = EMPTY ) /\ ~({(pointI m)} = EMPTY ))) /\
   (!m n. (v_edge m INTER {(pointI n)} = EMPTY ) /\
         ({(pointI n)} INTER v_edge m = EMPTY ) /\
  (h_edge m INTER {(pointI n)} = EMPTY ) /\
         ({(pointI n)} INTER h_edge m = EMPTY ) /\
  (squ m INTER {(pointI n)} = EMPTY ) /\
         ({(pointI n)} INTER squ m = EMPTY ) /\
       ((v_edge m INTER v_edge n  = EMPTY ) <=> ~(m = n) ) /\
   ((h_edge m INTER h_edge n  = EMPTY ) <=> ~(m = n) ) /\
  ((squ m INTER squ n  = EMPTY ) <=> ~(m = n) ) /\
  (squ m INTER h_edge n = EMPTY ) /\
         (h_edge n INTER squ m = EMPTY ) /\
  (squ m INTER v_edge n = EMPTY ) /\
        ( v_edge n INTER squ m = EMPTY ) /\
   (h_edge m INTER v_edge n = EMPTY ) /\
        ( v_edge n INTER h_edge m = EMPTY ) /\
   (({(pointI n)} INTER {(pointI m)} = EMPTY ) <=> ~(n = m)) /\
   (({(pointI n)} = {(pointI m)}  ) <=> (n = m)) /\
   ~(h_edge n = {(pointI m)}) /\
   ~(v_edge n = {(pointI m)}) /\
   ~(squ n = {(pointI m)}) /\
   ~( {(pointI m)} = h_edge n) /\
~( {(pointI m)} = v_edge n) /\
~( {(pointI m)} = squ n) /\
~(h_edge m = v_edge n) /\
((h_edge m = h_edge n) <=> (m = n)) /\
~(h_edge m = squ n) /\
~(v_edge m = h_edge n) /\
((v_edge m = v_edge n) <=> (m = n)) /\
~(v_edge m = squ n) /\
~(squ m = h_edge n) /\
((squ m = squ n) <=> (m = n)) /\
~(squ m = v_edge n) /\
~(squ m (pointI n)) /\
~(v_edge m (pointI n)) /\
~(h_edge m (pointI n)) /\
((pointI n = pointI m) <=> (n = m)))  `,


  (* {{{ proof *)
  (let notrr = REWRITE_RULE[not_eq] in
  let interc = ONCE_REWRITE_RULE[INTER_COMM] in
  ([
  CONJ_TAC ;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[INTER_ACI;notrr v_edge_disj;notrr h_edge_disj;interc square_h_edge;square_h_edge;interc square_v_edge;square_v_edge;square_disj;single_inter;h_edge_inj;v_edge_inj;notrr squ_inj;INR IN_SING;hv_edgeV2; square_h_edgeV2; square_v_edgeV2;hv_edge;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2;notrr single_inter;v_edge_pointI;h_edge_pointI;square_pointI;pointI_inj;squ_disj];
  REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;];
  CONV_TAC (dropq_conv "u");
  ASM_MESON_TAC[pointI_inj];
  ])));;
  (* }}} *)

let inter_union = 
prove_by_refinement(
  `!X A (B:A->bool). ~(X INTER (A UNION B) = EMPTY) ==>
    ~(X INTER A = EMPTY) \/ ~(X INTER B = EMPTY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INTER;UNION;EMPTY_EXISTS;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let squc_v = 
prove_by_refinement(
  `!m n. (v_edge m SUBSET squc n) ==> (n = m) \/ (n = left  m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[squc_union;];
  REP_BASIC_TAC;
  USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
  REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  KILL 0;
  USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
  ASM_REWRITE_TAC[right_left];
  (*   *)
  ]);;
  (* }}} *)

let squc_h = 
prove_by_refinement(
  `!m n. (h_edge m SUBSET squc n) ==> (n = m) \/ (n = down  m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[squc_union;];
  REP_BASIC_TAC;
  USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
  REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  KILL 0;
  USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[right_left];
  KILL 0;
  REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
  ASM_MESON_TAC [];
  (*   *)
  ]);;
  (* }}} *)

let component_empty = 
prove_by_refinement(
  `!U (x:A). (topology_ U) ==> ((component  U x = EMPTY) = ~(UNIONS U x))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[component ;EQ_EMPTY;];
  EQ_TAC;
  REP_BASIC_TAC;
  TSPEC `x` 2;
  ASM_MESON_TAC[connected_sing;INR IN_SING;];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[connected]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let image_imp = 
prove_by_refinement(
  `!(f:A->B) X t. X t ==> (IMAGE f X) (f t)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let image_inj = 
prove_by_refinement(
  `!(f:A->B) X A B. (INJ f X UNIV) /\ (A SUBSET X ) /\ (B SUBSET X) /\
     (IMAGE f A SUBSET IMAGE f B) ==> (A SUBSET B)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;IMAGE;SUBSET;];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let closure_euclid = 
prove_by_refinement(
  `closure (top2) (euclid 2) = euclid 2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closure;top2];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  INTERS_SUBSET;
  REWRITE_TAC[SUBSET_REFL;];
  ASM_MESON_TAC[closed_UNIV;top_of_metric_top;metric_euclid;top_of_metric_unions;];
  REWRITE_TAC[INTERS;SUBSET];
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let closure_euclid = 
prove_by_refinement(
  `!A. (A SUBSET (euclid 2) ==> (closure top2 A SUBSET (euclid 2)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC [GSYM closure_euclid];
  IMATCH_MP_TAC  subset_of_closure;
  ASM_REWRITE_TAC[top2_top];
  ]);;
  (* }}} *)

let along_lemma7 = 
prove_by_refinement(
  `!G m n x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
     (v_edge m SUBSET squc n) /\
     (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==>
   (?p. e SUBSET closure top2 (squ p) /\
       (squ p SUBSET (component  (ctop G) x))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  WITH_FIRST (MATCH_MP squc_v);
  FIRST_ASSUM (DISJ_CASES_TAC);
  REWR 3;
  IMATCH_MP_TAC  along_lemma6;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWR 4;
  (* 2nd side *)
  REWR 4;
  REWR 3;
  KILL 6;
  KILL 7;
  TYPE_THEN `e' = IMAGE (reflAf (&:0)) e ` ABBREV_TAC ;
  TYPE_THEN `G' = IMAGE2 (reflAf (&:0)) G` ABBREV_TAC ;
  TYPE_THEN `x' = reflAf (&:0) x` ABBREV_TAC ;
  TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
  USE 4(REWRITE_RULE[SUBSET]);
  TYPE_THEN `~(squ (left  m) = EMPTY)` SUBGOAL_TAC;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  TSPEC `u` 4;
  REWR 4;
  ASM_MESON_TAC[];
  TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
  ASM_MESON_TAC[ctop_top];
  ASM_SIMP_TAC [component_empty];
  DISCH_TAC;
  TYPE_THEN `component  (ctop G') x' = IMAGE (reflAf (&:0)) (component  (ctop G) x)` SUBGOAL_TAC;
  ASM_MESON_TAC[component_reflA;];
  DISCH_TAC;
  (*  *)
  TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  along_lemma6;
  TYPE_THEN `reflAi (&:0) m` EXISTS_TAC;
  (SUBCONJ_TAC);
  (* 1st claus *)
  EXPAND_TAC "G'";
  IMATCH_MP_TAC reflA_segment;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  (* 2nd clause *)
  ASM_REWRITE_TAC[];
  (* goal 2c *)
  USE 4(MATCH_MP (ISPEC `reflAf (&:0)` IMAGE_SUBSET ));
  TYPE_THEN `squ(reflAi (&:0) m) = IMAGE (reflAf (&:0)) (squ (left  m))` SUBGOAL_TAC;
  REWRITE_TAC[reflA_squ];
  AP_TERM_TAC;
  REWRITE_TAC[reflAi;left ;PAIR_SPLIT; ];
  INT_ARITH_TAC;
  ASM_MESON_TAC[];
  (* 3 *)
  CONJ_TAC;
  REWRITE_TAC[GSYM reflA_v_edge];
  EXPAND_TAC "G'";
  REWRITE_TAC[IMAGE2];
  UND 2;
  (* goal 3c *)
  MESON_TAC[image_imp];
  (* <2> *)
  CONJ_TAC;
  EXPAND_TAC "G'";
  EXPAND_TAC "e'";
  REWRITE_TAC[IMAGE2];
  ASM_MESON_TAC[image_imp];
  EXPAND_TAC "e'";
  TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) e) = IMAGE (reflAf (&:0)) (closure top2 e)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;];
  TYPE_THEN `edge e ` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET];
  MESON_TAC[ISUBSET;edge_euclid2;];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM reflA_pointI];
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* <1> *)
  TYPE_THEN `p = left  (reflAi (&:0) p')` ABBREV_TAC ;
  TYPE_THEN `squ p' = IMAGE (reflAf (&:0) ) (squ p)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[reflA_squ;];
  AP_TERM_TAC;
  EXPAND_TAC "p";
  REWRITE_TAC[left ;reflAi;PAIR_SPLIT;];
  INT_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  (* LAST *)
  ASSUME_TAC top2_top;
  TYPE_THEN `homeomorphism (reflAf (&:0)) top2 top2` SUBGOAL_TAC;
  ASM_MESON_TAC[reflA_homeo];
  DISCH_TAC;
  ASSUME_TAC top2_unions;
  TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
  MESON_TAC[squ_euclid;top2_unions];
  DISCH_TAC;
  CONJ_TAC; (* split *)
  UND 12;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "e'";
  TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) (squ p)) = IMAGE (reflAf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (* x *)
  DISCH_TAC;
  IMATCH_MP_TAC  (ISPEC `reflAf (&:0)` image_inj);
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  INJ_UNIV;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;];
  CONJ_TAC;
    TYPE_THEN `edge e ` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET];
  MESON_TAC[ISUBSET;edge_euclid2;];
  IMATCH_MP_TAC  closure_euclid;
  REWRITE_TAC[squ_euclid];
  (* last'' *)
  IMATCH_MP_TAC  (ISPEC `reflAf (&:0)` image_inj);
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  INJ_UNIV;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;];
  CONJ_TAC;
  REWRITE_TAC[squ_euclid];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
  ASM_REWRITE_TAC[component_unions;ctop_unions];
  REWRITE_TAC[DIFF;SUBSET];
  MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let v_edge_cases = 
prove_by_refinement(
  `!j m. closure top2 (v_edge j) (pointI m) ==> (j = m) \/ (j = down m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[v_edge_closure;vc_edge];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[UNION;cell_clauses;INR IN_SING;plus_e12]);
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  DISJ2_TAC;
  ASM_REWRITE_TAC[down;PAIR_SPLIT;];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let squ_squc = 
prove_by_refinement(
  `!r n m. (IMAGE (reflBf r) (squ n) = squ m) ==>
    (IMAGE (reflBf r) (squc n) = squc m)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[GSYM squ_closure];
  TYPE_THEN `IMAGE (reflBf r) (closure top2 (squ n)) = closure top2 (IMAGE (reflBf r) (squ n))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeo_closure;
  ASM_REWRITE_TAC[top2_top;top2_unions;reflB_homeo;squ_euclid;];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let squ_squc_C = 
prove_by_refinement(
  `!n m. (IMAGE (reflCf) (squ n) = squ m) ==>
    (IMAGE (reflCf) (squc n) = squc m)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[GSYM squ_closure];
  TYPE_THEN `IMAGE (reflCf) (closure top2 (squ n)) = closure top2 (IMAGE (reflCf) (squ n))` SUBGOAL_TAC;
  IMATCH_MP_TAC  homeo_closure;
  ASM_REWRITE_TAC[top2_top;top2_unions;reflC_homeo;squ_euclid;];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let along_lemma8 = 
prove_by_refinement(
  `!G m n j x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
     (v_edge j SUBSET squc n) /\ (closure top2 (v_edge j) (pointI m)) /\
    (G (v_edge j)) /\ G e /\ (closure top2 e (pointI m)) ==>
   (?p. e SUBSET closure top2 (squ p) /\
       (squ p SUBSET (component  (ctop G) x))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE_FIRST (MATCH_MP v_edge_cases);
  FIRST_ASSUM (DISJ_CASES_TAC);
  IMATCH_MP_TAC  along_lemma7;
  ASM_MESON_TAC[];
  KILL 3;
  REWR 4;
  REWR 2;
  KILL 7;
  (* INSERT lemmas here *)
  TYPE_THEN `e' = IMAGE (reflBf (&:0)) e ` ABBREV_TAC ;
  TYPE_THEN `G' = IMAGE2 (reflBf (&:0)) G` ABBREV_TAC ;
  TYPE_THEN `x' = reflBf (&:0) x` ABBREV_TAC ;
  TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
  USE 5(REWRITE_RULE[SUBSET]);
  TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
  ASM_MESON_TAC[ctop_top];
  ASM_SIMP_TAC [component_empty];
  DISCH_TAC;
  TYPE_THEN `component  (ctop G') x' = IMAGE (reflBf (&:0)) (component  (ctop G) x)` SUBGOAL_TAC;
  ASM_MESON_TAC[component_reflB;];
  DISCH_TAC;
  (*  gok to here *)
  TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  along_lemma7;
  TYPE_THEN `(reflBi (&:0))  m` EXISTS_TAC;
  TYPE_THEN `down (reflBi (&:0) n)` EXISTS_TAC;
  (SUBCONJ_TAC);
  (* 1st claus *)
  EXPAND_TAC "G'";
  IMATCH_MP_TAC reflB_segment;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  (* 2nd clause *)
  ASM_REWRITE_TAC[GSYM reflB_squ];
  (* goal 2c *)
  IMATCH_MP_TAC   (ISPEC `reflBf (&:0)` IMAGE_SUBSET );
  ASM_REWRITE_TAC[];
  (* 3 *)
  TYPE_THEN `squc (down (reflBi (&:0) n)) = IMAGE (reflBf (&:0)) (squc n)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM squ_squc);
  REWRITE_TAC[reflB_squ];
  DISCH_THEN_REWRITE;  (* end *)
  TYPE_THEN `v_edge (reflBi (&:0) m) = IMAGE (reflBf (&:0)) (v_edge (down m))` SUBGOAL_TAC;
  REWRITE_TAC[reflB_v_edge];
  AP_TERM_TAC ;
  REWRITE_TAC[reflBi;down;PAIR_SPLIT ];
  INT_ARITH_TAC;
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  ASM_REWRITE_TAC[];
  (* gok2 *)
  CONJ_TAC;
  EXPAND_TAC "G'";
  REWRITE_TAC[IMAGE2];
  UND 2;
  (* goal 3c *)
  MESON_TAC[image_imp];
  (* <2> gok1 *)
  CONJ_TAC;
  EXPAND_TAC "G'";
  EXPAND_TAC "e'";
  REWRITE_TAC[IMAGE2];
  ASM_MESON_TAC[image_imp];
  EXPAND_TAC "e'";
  (* 2 total *)
  TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) e) = IMAGE (reflBf (&:0)) (closure top2 e)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;];
  TYPE_THEN `edge e ` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET];
  MESON_TAC[ISUBSET;edge_euclid2;];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM reflB_pointI];
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* <1> *)
  TYPE_THEN `p = down  (reflBi (&:0) p')` ABBREV_TAC ;
  TYPE_THEN `squ p' = IMAGE (reflBf (&:0) ) (squ p)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[reflB_squ;];
  AP_TERM_TAC;
  EXPAND_TAC "p";
  REWRITE_TAC[down ;reflBi;PAIR_SPLIT;];
  INT_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  (* LAST *)
  ASSUME_TAC top2_top;
  TYPE_THEN `homeomorphism (reflBf (&:0)) top2 top2` SUBGOAL_TAC;
  ASM_MESON_TAC[reflB_homeo];
  DISCH_TAC;
  ASSUME_TAC top2_unions;
  TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
  MESON_TAC[squ_euclid;top2_unions];
  DISCH_TAC;
  CONJ_TAC; (* split *)
  UND 12;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "e'";
  TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) (squ p)) = IMAGE (reflBf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (* x *)
  DISCH_TAC;
  IMATCH_MP_TAC  (ISPEC `reflBf (&:0)` image_inj);
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  INJ_UNIV;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;];
  CONJ_TAC;
    TYPE_THEN `edge e ` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET];
  MESON_TAC[ISUBSET;edge_euclid2;];
  IMATCH_MP_TAC  closure_euclid;
  REWRITE_TAC[squ_euclid];
  (* last'' *)
  IMATCH_MP_TAC  (ISPEC `reflBf (&:0)` image_inj);
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  INJ_UNIV;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;];
  CONJ_TAC;
  REWRITE_TAC[squ_euclid];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
  ASM_REWRITE_TAC[component_unions;ctop_unions];
  REWRITE_TAC[DIFF;SUBSET];
  MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let along_lemma9 = 
prove_by_refinement(
  `!G m n e' x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
     (e' SUBSET squc n) /\ (closure top2 e' (pointI m)) /\ (edge e') /\
    (G e') /\ G e /\ (closure top2 e (pointI m)) ==>
   (?p. e SUBSET closure top2 (squ p) /\
       (squ p SUBSET (component  (ctop G) x))))`,

  (* {{{ proof *)
  [
    REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[edge]);
  REP_BASIC_TAC;
  FIRST_ASSUM (DISJ_CASES_TAC);
  IMATCH_MP_TAC  along_lemma8;
  ASM_MESON_TAC[];
  TYPE_THEN `edge e` SUBGOAL_TAC;
  ASM_MESON_TAC[segment;ISUBSET];
  ASM_SIMP_TAC[];
  DISCH_TAC;
  KILL 3;
  REWR 4;
  REWR 2;
  REWR 5;
  KILL 8;
  (* INSERT lemmas here *)
  TYPE_THEN `e' = IMAGE (reflCf) e ` ABBREV_TAC ;
  TYPE_THEN `G' = IMAGE2 (reflCf) G` ABBREV_TAC ;
  TYPE_THEN `x' = reflCf x` ABBREV_TAC ;
  TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
  USE 6(REWRITE_RULE[SUBSET]);
  TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC;
  ASM_MESON_TAC[cell_nonempty;cell_rules];
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
  ASM_MESON_TAC[ctop_top];
  ASM_SIMP_TAC [component_empty];
  DISCH_TAC;
  TYPE_THEN `component  (ctop G') x' = IMAGE (reflCf) (component  (ctop G) x)` SUBGOAL_TAC;
  ASM_MESON_TAC[component_reflC;];
  DISCH_TAC;
  (*  gok to here *)
  TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  along_lemma8;
  TYPE_THEN `(reflCi)  m` EXISTS_TAC;
  TYPE_THEN `(reflCi n)` EXISTS_TAC;
  TYPE_THEN `reflCi m'` EXISTS_TAC;
  (SUBCONJ_TAC);
  (* 1st claus *)
  EXPAND_TAC "G'";
  IMATCH_MP_TAC reflC_segment;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  (* 2nd clause *)
  ASM_REWRITE_TAC[GSYM reflC_squ];
  (* goal 2c *)
  IMATCH_MP_TAC   (ISPEC `reflCf` IMAGE_SUBSET );
  ASM_REWRITE_TAC[];
  (* 3 *)
  TYPE_THEN `squc ( (reflCi n)) = IMAGE (reflCf) (squc n)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM squ_squc_C);
  REWRITE_TAC[reflC_squ];
  DISCH_THEN_REWRITE;  (* end *)
  TYPE_THEN `v_edge (reflCi  m') = IMAGE (reflCf ) (h_edge ( m'))` SUBGOAL_TAC;
  REWRITE_TAC[reflC_hv_edge];
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  ASM_REWRITE_TAC[];
  (* gok2 *)
  (* INSERT *)
  TYPE_THEN `!e. (edge e) ==> (closure top2 (IMAGE (reflCf ) e) = IMAGE (reflCf) (closure top2 e))` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;];
  IMATCH_MP_TAC  edge_euclid2;
  ASM_REWRITE_TAC[];
  DISCH_TAC ;
  TYPE_THEN `edge (h_edge m')` SUBGOAL_TAC;
  ASM_MESON_TAC[edge];
  DISCH_TAC;
  ASM_SIMP_TAC[];
  REWRITE_TAC[GSYM reflC_pointI];
  CONJ_TAC;
  ASM_MESON_TAC[image_imp];
  (* to here *)
  CONJ_TAC;
  EXPAND_TAC "G'";
  REWRITE_TAC[IMAGE2];
  UND 2;
  (* goal 3c *)
  MESON_TAC[image_imp];
  (* <2> gok1 *)
  CONJ_TAC;
  EXPAND_TAC "G'";
  EXPAND_TAC "e'";
  REWRITE_TAC[IMAGE2];
  ASM_MESON_TAC[image_imp];
  EXPAND_TAC "e'";
  (* 2 total *)
  ASM_SIMP_TAC[];
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* <1> *)
  TYPE_THEN `p = reflCi p'` ABBREV_TAC ;
  TYPE_THEN `squ p' = IMAGE (reflCf ) (squ p)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[reflC_squ;];
  AP_TERM_TAC;
  EXPAND_TAC "p";
  REWRITE_TAC[reflCi_inv;PAIR_SPLIT;];
  DISCH_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  (* LAST *)
  ASSUME_TAC top2_top;
  TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC;
  ASM_MESON_TAC[reflC_homeo];
  DISCH_TAC;
  ASSUME_TAC top2_unions;
  TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
  MESON_TAC[squ_euclid;top2_unions];
  DISCH_TAC;
  TYPE_THEN `closure top2 (IMAGE (reflCf) (squ p)) = IMAGE (reflCf) (closure top2 (squ p))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM homeo_closure);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CONJ_TAC; (* split *)
  IMATCH_MP_TAC  (ISPEC `reflCf` image_inj);
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  INJ_UNIV;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;];
  CONJ_TAC;
  ASM_MESON_TAC[edge_euclid2];
  CONJ_TAC;
  IMATCH_MP_TAC  closure_euclid;
  REWRITE_TAC[squ_euclid];
  UND 21;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  REWRITE_TAC[reflC_squ];
  TYPE_THEN `reflCi p = p'` SUBGOAL_TAC;
  EXPAND_TAC "p";
  REWRITE_TAC[reflCi_inv];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  (* last'' *)
  UND 13;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  (ISPEC `reflCf` image_inj);
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  INJ_UNIV;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;];
  CONJ_TAC;
  REWRITE_TAC[squ_euclid];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
  ASM_REWRITE_TAC[component_unions;ctop_unions];
  REWRITE_TAC[DIFF;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let along_lemma10 = 
prove_by_refinement(
  `!G x. (segment G /\ ~(component  (ctop G) x  = EMPTY) ) ==>
    inductive_set G
        { e | (G e /\ (?p. (e SUBSET squc p) /\
              (squ p SUBSET component  (ctop G) x)) ) } `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `S = { e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x)) ) } ` ABBREV_TAC ;
  REWRITE_TAC[inductive_set];
  CONJ_TAC;
  EXPAND_TAC "S";
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  CONJ_TAC;
  TYPE_THEN `(?m. squ m SUBSET (component  (ctop G) x))` SUBGOAL_TAC;
  IMATCH_MP_TAC  comp_squ;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(?p e. G e /\ e SUBSET closure top2 (squ p) /\ squ p SUBSET component (ctop G) x)` SUBGOAL_TAC;
  IMATCH_MP_TAC  comp_squ_adj;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  UND 3;
  REWRITE_TAC[EMPTY_EXISTS ];
  EXPAND_TAC "S";
  REWRITE_TAC[];
  REWRITE_TAC [squ_closure];
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[GSYM squ_closure];
  REP_BASIC_TAC;
  UND 5;
  EXPAND_TAC "S";
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC;
  IMATCH_MP_TAC  edge_inter;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  REWRITE_TAC[GSYM squ_closure];
  IMATCH_MP_TAC  along_lemma9;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing;]);
  TYPE_THEN `m` EXISTS_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let along_lemma11 = 
prove_by_refinement(
  `!G  x e .  (segment G /\ ~(component  (ctop G) x  = EMPTY)  /\
     (G e)) ==>
   (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `S = {e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x)) ) }` ABBREV_TAC ;
  TYPE_THEN ` S = G` SUBGOAL_TAC;
  COPY  2;
  UND 4;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `inductive_set G S` SUBGOAL_TAC;
  EXPAND_TAC "S";
  IMATCH_MP_TAC  along_lemma10;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[inductive_set];
  EXPAND_TAC "S";
  DISCH_TAC;
  USE 4 GSYM;
  PROOF_BY_CONTR_TAC;
  UND 0;
  REWRITE_TAC[];
  ONCE_ASM_REWRITE_TAC[];
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)


(* along_lemma11
   is essentially the proof that there are only two connected
   components (because there are only two possible instantiations of p
   Come back and finish the proof  of the Jordan curve.  *)


(* ------------------------------------------------------------------ *)
(* SECTION I *)
(* ------------------------------------------------------------------ *)

(* ALL about graphs *)

(*** JRH systematically changed (Y,X)graph to (X,Y)graph for all X and Y,
     and made corresponding changes to other type annotations.
     The core now alphabetically sorts the type variables in a definition.
 ***)

let (mk_graph_t,dest_graph_t) = abbrev_type
   `:(A->bool)#(B->bool)#(B->(A->bool))` "graph_t";;

let graph_vertex = jordan_def
   `graph_vertex (G:(A,B)graph_t) = FST (dest_graph_t G)`;;

let graph_edge = jordan_def
   `graph_edge (G:(A,B)graph_t) = part1 (dest_graph_t G)`;;

let graph_inc = jordan_def
   `graph_inc (G:(A,B)graph_t) = drop1 (dest_graph_t G)`;;

let graph = jordan_def `graph (G:(A,B)graph_t) <=>
   (IMAGE (graph_inc G) (graph_edge G)) SUBSET
   { s | (s SUBSET (graph_vertex G)) /\ (s HAS_SIZE 2) }`;;

let graph_incident = jordan_def `graph_incident
   (G:(A,B)graph_t) e x <=>
   (graph_edge G e) /\ (graph_inc G e x)`;;

let graph_iso = jordan_def
   `graph_iso f (G:(A,B)graph_t) (H:(A',B')graph_t) <=>
   (?u v. (f = (u,v)) /\ (BIJ u (graph_vertex G) (graph_vertex H)) /\
   (BIJ v (graph_edge G) (graph_edge H)) /\
   (!e. (graph_edge G e) ==>
      (graph_inc H (v e) = IMAGE u (graph_inc G e))))`;;

(* specify a graph by
   { {a,b}, .... } of endpoints of edges.  *)

let mk_simple_graph = jordan_def `mk_simple_graph (E:(A->bool)->bool) =
  mk_graph_t
  (UNIONS E, (E:(A->bool)->bool),
   (\ (x:A->bool) (y:A). (x y)))`;;

let K33 = jordan_def `K33 = mk_simple_graph
   { {1,10}, {2,10}, {3,10},
     {1,20}, {2,20}, {3,20},
     {1,30}, {2,30}, {3,30} }`;;

let graph_del = jordan_def `graph_del (G:(A,B)graph_t) V E =
  mk_graph_t
   ((graph_vertex G DIFF V),
    (graph_edge G DIFF
        (E UNION { (e:B) | ?(v:A). (V v /\ graph_incident G e v ) })),
    (graph_inc G))`;;

let graph_path = jordan_def `graph_path (G:(A,B)graph_t) f n <=>
   (?v e . (f = (v,e)) /\ (INJ v { m | m <=| n } (graph_vertex G)) /\
   (INJ e { m | m <| n } (graph_edge G)) /\
   (!i. (i <| n )  ==>
         (graph_inc G (e i) = {(v  i), (v (SUC i))})))`;;

let graph_cycle = jordan_def `graph_cycle (G:(A,B)graph_t) f n <=>
   (?v e . (f = (v,e)) /\ (INJ v { m | m <| n } (graph_vertex G)) /\
   (INJ e { m | m <| n } (graph_edge G)) /\
   (!i. (i <| n )  ==>
         (graph_inc G (e i) = {(v  i), (v ((SUC i) %| (n)))})))`;;

let graph_connected = jordan_def `graph_connected (G:(A,B)graph_t) <=>
  !v v'. (graph_vertex G v) /\ (graph_vertex G v') /\ ~(v = v') ==>
   (?f n. (graph_path G f n) /\ (FST f 0 = v) /\ (FST f n = v'))`;;

let graph_2_connected = jordan_def `graph_2_connected (G:(A,B)graph_t) <=>
  (graph_connected G) /\
  (!v. (graph_vertex G v) ==> (graph_connected
     (graph_del G {v} EMPTY)))`;;

let simple_arc = jordan_def `simple_arc (U:(A->bool)->bool) C <=>
   (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\
   (continuous f (top_of_metric(UNIV,d_real)) U) /\
   (INJ f { x | &.0 <= x /\ x <= &.1} (UNIONS U)))`;;

let simple_closed_curve = jordan_def
   `simple_closed_curve (U:(A->bool)->bool) C <=>
   (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\
   (continuous f (top_of_metric(UNIV,d_real)) U) /\
   (INJ f { x | &.0 <= x /\ x < &.1} (UNIONS U)) /\
   (f (&.0) = f (&.1)))`;;

let simple_polygonal_arc = jordan_def
   `simple_polygonal_arc PE C <=>
    (simple_arc (top_of_metric(euclid 2,d_euclid)) C) /\
    (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;;

let simple_polygonal_curve = jordan_def
   `simple_polygonal_curve PE C <=>
    (simple_closed_curve (top_of_metric(euclid 2,d_euclid)) C) /\
    (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;;

let hv_line = jordan_def
   `hv_line E <=> (!e. (E e) ==> (?x y. (e = mk_line (point x) (point y)) /\
      ((FST x = FST y) \/ (SND x = SND y))))`;;

let p_conn = jordan_def
   `p_conn A x y <=> (?C. (simple_polygonal_arc hv_line C) /\
     (C SUBSET A) /\ (C x) /\ (C y))`;;

let subf = jordan_def
   `subf A (f:A->B) g x = if (A x) then (f x) else (g x)`;;

let min_real_le = 
prove_by_refinement(
  `!x y. (min_real x y <= x) /\ (min_real x y <= y)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  UND 0;
  REAL_ARITH_TAC;
  UND 0;
  REAL_ARITH_TAC ;
  ]);;
  (* }}} *)

let subf_lemma = 
prove_by_refinement(
  `!X dX B (x:A).
     (metric_space (X,dX)) /\ (closed_ (top_of_metric(X,dX)) B) /\
     (~(B x)) /\ (X x) ==>
     (?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[closed;open_DEF ];
  REP_BASIC_TAC;
  UND 2;
  UND 3;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  REP_BASIC_TAC;
  TYPE_THEN `(X DIFF B) x` SUBGOAL_TAC;
  REWRITE_TAC[DIFF];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPEL_THEN [`X`;`dX`;`(X DIFF B)`;`x`] (fun t-> ASSUME_TAC (ISPECL t open_ball_nbd)); (* // *)
  REP_BASIC_TAC;
  REWR 6;
  TYPE_THEN `e` EXISTS_TAC;
  UND 6;
  REWRITE_TAC[open_ball;SUBSET;DIFF;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_MESON_TAC[ISUBSET ;];
  ]);;
  (* }}} *)

let subf_cont = 
prove_by_refinement(
  `!X dX Y dY A B (f:A->B) g.
     ((metric_space (X,dX)) /\ (metric_space (Y,dY)) /\
     (closed_ (top_of_metric(X,dX)) A ) /\
     (closed_ (top_of_metric(X,dX)) B ) /\
     (metric_continuous f (A,dX) (Y,dY)) /\
     (metric_continuous g (B,dX) (Y,dY)) /\
     (!x. (A x /\ B x) ==> (f x = g x))) ==>
     (metric_continuous (subf A f g) (A UNION B,dX) (Y,dY))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  DISCH_ALL_TAC;
  DISCH_ALL_TAC;
  RIGHT_TAC "delta";
  DISCH_TAC;
  REWRITE_TAC[UNION];
  TYPE_THEN `(A x \/ ~(A x)) /\ (B x \/ (~(B x)))` (fun t-> MP_TAC (TAUT  t ));
  DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[GSYM DISJ_ASSOC;RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR] t));
  REP_CASES_TAC;
  TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL);
  TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL);
  REP_BASIC_TAC;
  REWR 8;
  REWR 9;
  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `A y \/ (~(A y) /\ B y)` SUBGOAL_TAC;
  UND 9;
  MESON_TAC[];
  DISCH_THEN DISJ_CASES_TAC;
  REWRITE_TAC[subf];
  ASM_REWRITE_TAC[];
  UND 12;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 8;
  (* save_goal "ss" *)
  TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
  REWRITE_TAC[min_real_le];
  REAL_ARITH_TAC;
  (* 1b case *)
  REWRITE_TAC[subf];
  ASM_REWRITE_TAC[];
  TYPE_THEN `f x = g x` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  UND 10;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 8;
  TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
  REWRITE_TAC[min_real_le];
  REAL_ARITH_TAC ;
  (* 2nd case *)
  TYPE_THEN `X x` SUBGOAL_TAC;
  UND 2;
  REWRITE_TAC[closed;open_DEF;SUBSET ;];
  REP_BASIC_TAC;
  TSPEC  `x` 8;
  UND 8;
  ASM_REWRITE_TAC[];
  UND 0;
  SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))` SUBGOAL_TAC;
  IMATCH_MP_TAC  subf_lemma;
  TYPE_THEN `X` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL);
  REP_BASIC_TAC;
  REWR 4;
  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `A y` SUBGOAL_TAC;
  TYPE_THEN `~(B y) ==> A y` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 4;
  TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
  REWRITE_TAC[min_real_le];
  REAL_ARITH_TAC;
  REWRITE_TAC[subf];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 4;
  TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
  REWRITE_TAC[min_real_le];
  REAL_ARITH_TAC;
  (* 2 LEFT *)
  TYPE_THEN `X x` SUBGOAL_TAC;
  UND 3;
  REWRITE_TAC[closed;open_DEF;SUBSET ;];
  REP_BASIC_TAC;
  TSPEC  `x` 8;
  UND 8;
  ASM_REWRITE_TAC[];
  UND 0;
  SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(A y))))` SUBGOAL_TAC;
  IMATCH_MP_TAC  subf_lemma;
  TYPE_THEN `X` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL);
  REP_BASIC_TAC;
  REWR 5;
  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `~(A y)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 5;
  TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
  REWRITE_TAC[min_real_le];
  REAL_ARITH_TAC;
  REWRITE_TAC[subf];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `B y` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  UND 5;
  TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
  REWRITE_TAC[min_real_le];
  REAL_ARITH_TAC;
  (* 1 LEFT *)
  TYPE_THEN `&1` EXISTS_TAC;
  ASM_MESON_TAC [REAL_ARITH `&0 < &1`];
  ]);;
  (* }}} *)

let p_conn_subset = 
prove_by_refinement(
  `!A B x y. (A SUBSET B) /\ (p_conn A x y) ==> (p_conn B x y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[p_conn];
  REP_BASIC_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let mk_line_symm = 
prove_by_refinement(
  `!x y. mk_line x y = mk_line y x`,

  (* {{{ proof *)
  [
  REWRITE_TAC[mk_line];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `(&1 - t)` EXISTS_TAC;
  ONCE_REWRITE_TAC [euclid_add_comm];
  ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`];
  REP_BASIC_TAC;
  TYPE_THEN `(&1 - t)` EXISTS_TAC;
  ONCE_REWRITE_TAC [euclid_add_comm];
  ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`];
  ]);;
  (* }}} *)

let mk_line_sub = 
prove_by_refinement(
  `!x y z. ( ~(x = z) /\ (mk_line x y z)) ==>
        (mk_line x y = mk_line x z)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[mk_line];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `~(t = &1)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWR 0;
  UND 0;
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `s = (&1 /(&1 - t))` ABBREV_TAC;
  TYPE_THEN `(t' - t)*s` EXISTS_TAC;
  ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;];
  TYPE_THEN `(&1 - t) * s = &1` SUBGOAL_TAC;
  EXPAND_TAC "s";
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `(t' - t) * s + (&1 - (t' - t) * s) * t = (t' - t) *((&1- t)* s) + t ` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(&1 - (t' - t) * s)*(&1 - t) = (&1 - t) - (t' - t)*(&1-t)*s` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_ARITH  `((t' - t)* &1 + t = t') /\ (&1 - t - (t' - t)* &1 = (&1 - t'))`];
  (* 2nd half *)
  REP_BASIC_TAC;
  UND 2;
  ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;];
  DISCH_THEN_REWRITE;
  TYPE_THEN `t' + (&1 - t')*t` EXISTS_TAC;
  TYPE_THEN `(&1 - (t' + (&1 - t') * t)) = ((&1 - t') * (&1 - t))` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let mk_line_2 = 
prove_by_refinement(
  `!x y p q. (mk_line x y p) /\ (mk_line x y q) /\ (~(p = q)) ==>
    (mk_line x y = mk_line p q)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `x = p`  ASM_CASES_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  mk_line_sub;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[mk_line_sub;mk_line_symm];
  ]);;
  (* }}} *)

let mk_line_inter = 
prove_by_refinement(
  `!x y p q. ~(mk_line x y = mk_line p q) ==>
    (?z. (mk_line x y INTER mk_line p q) SUBSET {z} )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?z. (mk_line x y INTER mk_line p q) z)` ASM_CASES_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
  REP_BASIC_TAC;
  UND 1;
  REWRITE_TAC[INTER];
  REP_BASIC_TAC;
  ASM_MESON_TAC[mk_line_2];
  REWRITE_TAC[SUBSET;INR IN_SING];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let mk_line_fin_inter = 
prove_by_refinement(
  `!E. (FINITE E) /\ (!e. (E e) ==> (?x y. e = mk_line x y)) ==>
    (?X. (FINITE X) /\
    (!e f z. (E e) /\ (E f) /\ ~(e = f) /\ e z /\ f z ==> (X z)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `E2 = { (e,f) | (E e) /\ (E f) /\ (~(e = f)) }` ABBREV_TAC;
  TYPE_THEN `EE = { (e,f) | (E e) /\ (E f) }` ABBREV_TAC;
  (*   *)
  TYPE_THEN `FINITE EE` SUBGOAL_TAC;
  EXPAND_TAC "EE";
  IMATCH_MP_TAC  (INR FINITE_PRODUCT);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (*   *)
  TYPE_THEN `FINITE E2` SUBGOAL_TAC;
  EXPAND_TAC "E2";
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `EE` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "EE";
  EXPAND_TAC "E2";
  REWRITE_TAC[SUBSET;];
  MESON_TAC[];
  DISCH_TAC;
  (*  *)
  TYPE_THEN `E3 = IMAGE (\u. (FST u INTER SND u)) E2` ABBREV_TAC;
  TYPE_THEN `FINITE E3` SUBGOAL_TAC;
  EXPAND_TAC "E3";
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (*  *)
  TYPE_THEN `UNIONS E3` EXISTS_TAC;
  CONJ_TAC;
  ASM_SIMP_TAC[FINITE_FINITE_UNIONS];
  GEN_TAC;
  EXPAND_TAC "E3";
  EXPAND_TAC "E2";
  REWRITE_TAC[IMAGE];
  CONV_TAC (dropq_conv "x");
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `e` (WITH 0 o ISPEC);
  TYPE_THEN `f` (USE 0 o ISPEC);
  UND 0;
  UND 12;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  (*  *)
  TYPE_THEN `(?z. (mk_line x y INTER mk_line x' y') SUBSET {z} )` SUBGOAL_TAC;
  IMATCH_MP_TAC mk_line_inter;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `{z}` EXISTS_TAC;
  ASM_REWRITE_TAC[FINITE_SING ];
  REP_BASIC_TAC;
  EXPAND_TAC "E3";
  EXPAND_TAC "E2";
  REWRITE_TAC[IMAGE];
  REWRITE_TAC[UNIONS];
  CONV_TAC (dropq_conv "x");
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[INTER];
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let euclid_euclid0 = 
prove_by_refinement(
  `!n. (euclid n (euclid0))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[euclid0;euclid];
  ]);;
  (* }}} *)

let euclid0_point = 
prove_by_refinement(
  `euclid0 = point(&0,&0)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[point_split;euclid_euclid0];
  REWRITE_TAC[euclid0];
  ]);;
  (* }}} *)

let EVEN2 = 
prove_by_refinement(
  `EVEN 0 /\ ~(EVEN 1) /\ (EVEN 2) /\ ~(EVEN 3) /\
  (EVEN 4) /\ ~(EVEN 5)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[EVEN; ARITH_RULE `(1 = SUC 0) /\ (2 = SUC 1) /\ (3 = SUC 2) /\ (4 = SUC 3) /\ (5 = SUC 4)`];
  ]);;
  (* }}} *)

let h_seg_openball = 
prove_by_refinement(
  `!x e e'. (&0 < e) /\ (&0 <= e') /\ (e' < e) /\ (euclid 2 x) ==>
     (mk_segment x (x + e' *# e1) SUBSET
              (open_ball(euclid 2,d_euclid)) x e)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[open_ball;mk_segment;SUBSET;];
  REP_BASIC_TAC;
  USE 4 (SYM);
  UND 4;
  REWRITE_TAC[GSYM euclid_add_assoc;euclid_ldistrib;GSYM euclid_rdistrib];
  REWRITE_TAC[REAL_ARITH `a + &1 - a = &1`;euclid_scale_one;euclid_scale_act];
  TYPE_THEN  `x'' = (((&1 - a) * e') *# e1)` ABBREV_TAC ;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `euclid 2 x''` SUBGOAL_TAC;
  EXPAND_TAC "x''";
  IMATCH_MP_TAC  euclid_scale_closure;
  REWRITE_TAC[e1;euclid_point];
  DISCH_TAC;
  SUBCONJ_TAC;
  EXPAND_TAC "x'";
  IMATCH_MP_TAC  euclid_add_closure;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `!x y.  d_euclid x y = d_euclid (x+euclid0) y ` SUBGOAL_TAC;
  REWRITE_TAC[euclid_rzero];
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  EXPAND_TAC "x'";
  ASSUME_TAC euclid_euclid0;
  KILL 7;
  TYPE_THEN `d_euclid (euclid_plus x euclid0) (euclid_plus x x'') = d_euclid euclid0 x''` SUBGOAL_TAC;
  ASM_MESON_TAC[metric_translate_LEFT];
  DISCH_THEN_REWRITE;
  EXPAND_TAC "x''";
  REWRITE_TAC[e1;point_scale];
  REDUCE_TAC;
  REWRITE_TAC[euclid0_point;d_euclid_point;];
  REDUCE_TAC;
  REWRITE_TAC[EXP_2;ARITH_RULE `0 *| 0 = 0`];
  REDUCE_TAC;
  REWRITE_TAC[REAL_ARITH `&0 - x = --x`;REAL_POW_NEG;EVEN2];
  TYPE_THEN `&0 <= (&1 - a) * e'` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_MUL;
  ASM_REWRITE_TAC[];
  UND 5;
  REAL_ARITH_TAC;
  ASM_SIMP_TAC[POW_2_SQRT;];
  DISCH_TAC;
  ASM_CASES_TAC `a = &0`;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(&1 - a) * e' < &1 * e ==> (&1 - a) * e' <  e` SUBGOAL_TAC;
  REAL_ARITH_TAC;
  DISCH_THEN IMATCH_MP_TAC ;
  IMATCH_MP_TAC  REAL_LT_MUL2;
  ASM_REWRITE_TAC[];
  UND 5;
  UND 6;
  UND 11;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let openball_convex = 
prove_by_refinement(
  `!x e n. (convex (open_ball (euclid n,d_euclid) x e))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[convex;open_ball;SUBSET;mk_segment;];
  REP_BASIC_TAC;
  USE 0 SYM;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  EXPAND_TAC "x''";
  IMATCH_MP_TAC  (euclid_add_closure);
  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
  DISCH_TAC;
  TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC;
  REWRITE_TAC[trivial_lin_combo];
  DISCH_THEN_REWRITE;
  EXPAND_TAC "x''";
  (* special case *)
  ASM_CASES_TAC `a = &0` ;
  UND 10;
  DISCH_THEN_REWRITE;
  REDUCE_TAC;
  ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;];
  TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u < a*e) /\ (v <= (&1- a)*e))  ==> (d < e))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `u + v < (a*e) + (&1 - a)*e` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_LTE_ADD2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`];
  UND 13;
  REAL_ARITH_TAC ;
  DISCH_THEN IMATCH_MP_TAC ;
  TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC;
  TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC;
  TYPE_THEN `d_euclid z x''` EXISTS_TAC;
  TYPE_THEN `euclid n z` SUBGOAL_TAC;
  EXPAND_TAC "z";
  IMATCH_MP_TAC  (euclid_add_closure);
  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
  DISCH_TAC;
  CONJ_TAC;
  EXPAND_TAC "x''";
  IMATCH_MP_TAC  metric_space_triangle;
  TYPE_THEN `euclid n` EXISTS_TAC;
  REWRITE_TAC[metric_euclid];
  ASM_REWRITE_TAC[trivial_lin_combo];
  CONJ_TAC;
  EXPAND_TAC "z";
  TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid  (a *# x) (a *# x') ` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_translate;
  TYPE_THEN `n` EXISTS_TAC;
  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
  DISCH_THEN_REWRITE;
  TYPE_THEN `d_euclid (a *# x) (a *# x')  = abs  (a) * d_euclid x x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  norm_scale_vec;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `abs  a = a` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ABS_REFL];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  REAL_PROP_LT_LMUL;
  ASM_REWRITE_TAC[];
  UND 10;
  UND 2;
  REAL_ARITH_TAC;
  (* LAST case *)
  EXPAND_TAC "z";
  EXPAND_TAC "x''";
  TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_translate_LEFT;
  TYPE_THEN `n` EXISTS_TAC;
  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
  DISCH_THEN_REWRITE;
  TYPE_THEN `!b. d_euclid (b *# x) (b *# y)  = abs  (b) * d_euclid x y` SUBGOAL_TAC;
  GEN_TAC;
  IMATCH_MP_TAC  norm_scale_vec;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
  REWRITE_TAC [REAL_ABS_REFL];
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 1;
  REAL_ARITH_TAC;
  UND 3;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let openball_mk_segment_end = 
prove_by_refinement(
  `!x e n u v.
     (open_ball(euclid n,d_euclid) x e u) /\
     (open_ball(euclid n,d_euclid) x e v) ==>
     (mk_segment u v SUBSET (open_ball(euclid n,d_euclid) x e))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC openball_convex;
  TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL);
  USE 2 (REWRITE_RULE[convex]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let euclid_eq_minus = 
prove_by_refinement(
  `!x y. (x = y) <=> (euclid_minus x y = euclid0)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[euclid_minus;euclid0];
  REP_BASIC_TAC;
  EQ_TAC ;
  DISCH_THEN_REWRITE;
  REDUCE_TAC;
  DISCH_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  ONCE_REWRITE_TAC [REAL_ARITH `(a = b) <=> (a - b = &0)`];
  GEN_TAC;
  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `x':num`));
  BETA_TAC ;
  MESON_TAC[];
  ]);;
  (* }}} *)

let euclid_plus_pair = 
prove_by_refinement(
  `!x y u v. (euclid_plus (x + y) (u + v) = (x + u) + (y + v))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[euclid_plus];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  BETA_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let euclid_minus_scale = 
prove_by_refinement(
  `!x y. (euclid_minus x y = euclid_plus x ((-- &.1) *# y))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  BETA_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let euclid_scale_cancel = 
prove_by_refinement(
  `!t x y . (~(t = &0)) /\ (t *# x = t *# y) ==> (x = y)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  FIRST_ASSUM  (fun t -> MP_TAC (AP_THM t `x':num`));
  REWRITE_TAC[euclid_scale;];
  ASM_MESON_TAC[REAL_MUL_LTIMES];
  ]);;
  (* }}} *)

let mk_segment_inj_image = 
prove_by_refinement(
  `!x y n. (euclid n x) /\ (euclid n y) /\ ~(x = y) ==> (?f.
     (continuous f
        (top_of_metric(UNIV,d_real))
        (top_of_metric (euclid n,d_euclid))) /\
      (INJ f {x | &0 <= x /\ x <= &1} (euclid n)) /\
     (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y))`,

  (* {{{ proof *)

  [
  DISCH_ALL_TAC;
  TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  cont_mk_segment;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[joinf;IMAGE ];
  REWRITE_TAC[mk_segment];
  CONJ_TAC;
  (* new stuff *)
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
  UND 4;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_CASES_TAC `x' < &1`;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  euclid_add_closure;
  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UND 3;
  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `~(y' < &0)` SUBGOAL_TAC;
  UND 5;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC;
 TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC;
  UND 6;
  REAL_ARITH_TAC;
  DISCH_THEN   DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(x' < &1)` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
  DISCH_THEN_REWRITE;

  TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC;
 TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC;
  UND 4;
  REAL_ARITH_TAC;
  DISCH_THEN   DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(y' < &1)` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
  DISCH_THEN_REWRITE;
  (* th *)
  ONCE_REWRITE_TAC [euclid_eq_minus];
  REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act];
  ONCE_REWRITE_TAC [euclid_plus_pair];
  REWRITE_TAC[GSYM euclid_rdistrib];
  REDUCE_TAC;
  REWRITE_TAC[REAL_ARITH  `x' + -- &1 * y' = x' - y'`];
  REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`];
  REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus];
  (* th1 *)
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  UND 2;
  REWRITE_TAC[];
  IMATCH_MP_TAC  euclid_scale_cancel;
  TYPE_THEN `(x' - y')` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 8;
  REAL_ARITH_TAC;
  KILL 2;
  (* old stuff *)
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  ASM_REWRITE_TAC[];
  EQ_TAC;
  DISCH_TAC;
  CHO 2;
  UND 2;
  COND_CASES_TAC;
  DISCH_ALL_TAC;
  JOIN 3 2;
  ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
  DISCH_ALL_TAC;
  UND 5;
  COND_CASES_TAC;
  DISCH_TAC;
  TYPE_THEN `&1 - x''` EXISTS_TAC;
  SUBCONJ_TAC;
  UND 5;
  REAL_ARITH_TAC ;
  DISCH_TAC;
  CONJ_TAC;
  UND 3;
  REAL_ARITH_TAC ;
  ONCE_REWRITE_TAC [euclid_add_comm];
  REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  CONJ_TAC;
  REAL_ARITH_TAC ;
  CONJ_TAC;
  REAL_ARITH_TAC ;
  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
  (* 2nd half *)
  DISCH_TAC;
  CHO 2;
  TYPE_THEN `&1 - a` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  AND 2;
  AND 2;
  UND 3;
  UND 4;
  REAL_ARITH_TAC ;
  COND_CASES_TAC;
  ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
  COND_CASES_TAC;
  REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
  ASM_MESON_TAC [euclid_add_comm];
  TYPE_THEN `a = &.0` SUBGOAL_TAC;
  UND 4;
  UND 3;
  AND 2;
  UND 3;
  REAL_ARITH_TAC ;
  DISCH_TAC;
  REWR 2;
  REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
  ]);;
  (* }}} *)

let h_simple_polygonal = 
prove_by_refinement(
  `!x e. (euclid 2 x) /\ (~(e = &0)) ==>
    (simple_polygonal_arc hv_line (mk_segment x (x + e *# e1)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ];
  REP_BASIC_TAC;
  CONJ_TAC;
  ASSUME_TAC mk_segment_inj_image;
  TYPEL_THEN [`x`;`x + (e *# e1)`;`2`] (USE 2 o ISPECL);
  TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e1)) /\ ~(x = euclid_plus x (e *# e1))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  euclid_add_closure;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  euclid_scale_closure;
  REWRITE_TAC [e1;euclid_point];
  REP_BASIC_TAC;
  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `0`));
  REWRITE_TAC[euclid_plus;euclid_scale;e1;coord01];
  UND 0;
  REAL_ARITH_TAC;
  DISCH_TAC;
  REWR 2;
  REP_BASIC_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SIMP_TAC  [GSYM top_of_metric_unions;metric_euclid];
  ASM_REWRITE_TAC[];
  (* E *)
  USE 1 (MATCH_MP point_onto);
  REP_BASIC_TAC;
  TYPE_THEN `{(mk_line (point p) (point p + (e *# e1)))}` EXISTS_TAC;
  REWRITE_TAC[INR IN_SING];
  CONJ_TAC;
  REWRITE_TAC[e1;ISUBSET;mk_segment;mk_line];
  REP_BASIC_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[FINITE_SING];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  TYPE_THEN `(FST p + e, SND p)` EXISTS_TAC;
  REWRITE_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[e1;point_scale];
  REDUCE_TAC;
  TYPE_THEN `euclid_plus (point p) (point (e,&0)) = euclid_plus (point (FST p,SND p)) (point (e,&0))` SUBGOAL_TAC;
  REWRITE_TAC[];
  DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]);
  REWRITE_TAC[point_add];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let pconn_refl = 
prove_by_refinement(
  `!A x. (top2 A) /\ (A x) ==> (p_conn A x x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[p_conn;top2];
  REP_BASIC_TAC;
  TYPE_THEN `?e. (&0 < e) /\ (open_ball(euclid 2,d_euclid) x e SUBSET A)` SUBGOAL_TAC;
  ASM_MESON_TAC[open_ball_nbd;metric_euclid];
  REP_BASIC_TAC;
  TYPE_THEN `mk_segment x (x + (e/(&2))*# e1)` EXISTS_TAC;
  TYPE_THEN `euclid 2 x` SUBGOAL_TAC;
  USE 1(MATCH_MP sub_union);
  UND 1;
  ASM_MESON_TAC [top_of_metric_unions;metric_euclid;ISUBSET];
  DISCH_TAC;
  TYPE_THEN `~(e/(&2) = &0)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `(&0 < x) ==> (~(x = &0))` );
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  DISCH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  h_simple_polygonal;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `open_ball (euclid 2,d_euclid) x e ` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  h_seg_openball;
  ASM_REWRITE_TAC[];
  UND 3;
  MESON_TAC[half_pos;REAL_ARITH `&0 < x ==> &0 <= x`];
  REWRITE_TAC[mk_segment];
  TYPE_THEN `&1` EXISTS_TAC;
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale_one ;euclid_scale0;euclid_rzero;];
  ARITH_TAC;
  ]);;
  (* }}} *)

let pconn_symm = 
prove_by_refinement(
  `!A x y. (p_conn A x y ==> p_conn A y x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[p_conn;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let compose_cont = 
prove_by_refinement(
  `!(f:A->B) (g:B->C) X dX Y dY Z dZ.
    (metric_continuous f (X,dX) (Y,dY)) /\
    (metric_continuous g (Y,dY) (Z,dZ)) /\
    (IMAGE f X SUBSET Y) ==>
    (metric_continuous (compose g f) (X,dX) (Z,dZ))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  REP_BASIC_TAC;
  RIGHT_TAC "delta";
  DISCH_TAC;
  REWRITE_TAC[compose];
  TYPEL_THEN [`f x`;`epsilon`] (USE 1 o ISPECL);
  REP_BASIC_TAC;
  REWR 1;
  REP_BASIC_TAC;
  TYPEL_THEN [`x`;`delta`] (USE 2 o ISPECL);
  REP_BASIC_TAC;
  REWR 2;
  REP_BASIC_TAC;
  TYPE_THEN `delta'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 0 (REWRITE_RULE[IMAGE;SUBSET]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let compose_image = 
prove_by_refinement(
  `!(f:A->B) (g:B->C) X.
   (IMAGE (compose g f) X) =
    (IMAGE g (IMAGE f X))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  GEN_TAC;
  NAME_CONFLICT_TAC;
  REWRITE_TAC[compose];
  CONV_TAC (dropq_conv "x''");
  ]);;
  (* }}} *)

let linear_cont = 
prove_by_refinement(
  `!a b. metric_continuous (\t. t * a + (&1 - t)* b)
     (UNIV,d_real) (UNIV,d_real)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  REP_BASIC_TAC;
  RIGHT_TAC "delta";
  DISCH_TAC;
  TYPE_THEN `a = b` ASM_CASES_TAC;
  ASM_REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `!u. u + &1 - u = &1`];
  REDUCE_TAC;
  ASM_REWRITE_TAC[d_real;REAL_ARITH `b - b = &0`;ABS_0;];
  TYPE_THEN `epsilon` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* snd *)
  TYPE_THEN `delta = epsilon/(abs  (a-b))` ABBREV_TAC;
  TYPE_THEN `delta` EXISTS_TAC;
  SUBCONJ_TAC;
  EXPAND_TAC "delta";
  IMATCH_MP_TAC  REAL_LT_DIV;
  ASM_REWRITE_TAC[];
  UND 1;
  REAL_ARITH_TAC;
  DISCH_TAC;
  REWRITE_TAC[d_real];
  REP_BASIC_TAC;
  TYPE_THEN `((x * a + (&1 - x) * b) - (y * a + (&1 - y) * b))  = (x - y)*(a - b)` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  TYPE_THEN `epsilon = delta * (abs  (a - b))` SUBGOAL_TAC;
  EXPAND_TAC "delta";
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  IMATCH_MP_TAC  REAL_DIV_RMUL;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[ABS_MUL];
  IMATCH_MP_TAC  REAL_PROP_LT_RMUL;
  ASM_REWRITE_TAC[];
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let linear_image_gen = 
prove_by_refinement(
  `!a b c d. (a < b) /\ (c < d) ==>
     (IMAGE (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b )
         {x | c <= x /\ x <= d } =
            {y | a <= y /\ y <= b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC;
  UND 1;
  REAL_ARITH_TAC;
  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  ABBREV_TAC   `e = &1/(d-c)`;
  TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC;
  GEN_TAC;
  EXPAND_TAC "e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC;
  EXPAND_TAC "e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  REWRITE_TAC[GSYM real_div];
  IMATCH_MP_TAC  REAL_DIV_REFL;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `&0 < e` SUBGOAL_TAC;
  EXPAND_TAC "e";
  IMATCH_MP_TAC  REAL_LT_DIV;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (*   *)
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * a + ((d - x') * e) * b) ==> (a <= ((x' - c) * e) * a + ((d - x') * e) * b)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_MUL_ASSOC];
  REDUCE_TAC;
  DISCH_THEN IMATCH_MP_TAC ;
  ineq_le_tac `(d-c)*e*a + (d - x')*(b - a)*e = ((x' - c) * e) * a + ((d - x') * e) * b`;
  TYPE_THEN `(((x' - c) * e) * a + ((d - x') * e) * b <= b*((d- c)*e)) ==> (((x' - c) * e) * a + ((d - x') * e) * b <= b)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`];
  DISCH_THEN IMATCH_MP_TAC ;
  ineq_le_tac `(((x' - c) * e) * a + ((d - x') * e) * b) + (x'-c )*(b-a)*e = b * (d - c) * e`;
  (* 2nd direction *)
  REP_BASIC_TAC;
  TYPE_THEN `x' = ((d*b - a*c) - (d -c)*x)/(b - a)` ABBREV_TAC ;
  TYPE_THEN `x'` EXISTS_TAC;
  TYPE_THEN `x'*(b - a) = ((d*b - a*c) - (d -c)*x)` SUBGOAL_TAC;
  EXPAND_TAC "x'";
  IMATCH_MP_TAC  REAL_DIV_RMUL;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* sv *)
  SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`;
  MESON_TAC[REAL_PROP_LE_RCANCEL];
  DISCH_TAC;
  CONJ_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `(b - a)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ineq_le_tac `c * (b - a) + (d-c)*(b-x) = d * b - a * c - (d - c) * x`;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `(b - a)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ineq_le_tac `(d * b - a * c - (d - c) * x) + (d-c)*(x-a) = d * (b - a)`;
  TYPE_THEN `((x' - c) * e) * a + ((d - x') * e) * b = (d*b - c*a - x'*(b-a))*e` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(d * b - c * a - (d * b - a * c - (d - c) * x)) = x*(d-c)` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM REAL_MUL_ASSOC];
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let linear_image_rev = 
prove_by_refinement(
  `!a b c d. (a < b) /\ (c < d) ==>
     (IMAGE (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a )
         {x | c <= x /\ x <= d } =
            {y | a <= y /\ y <= b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC;
  UND 1;
  REAL_ARITH_TAC;
  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  ABBREV_TAC   `e = &1/(d-c)`;
  TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC;
  GEN_TAC;
  EXPAND_TAC "e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC;
  EXPAND_TAC "e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  REWRITE_TAC[GSYM real_div];
  IMATCH_MP_TAC  REAL_DIV_REFL;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `&0 < e` SUBGOAL_TAC;
  EXPAND_TAC "e";
  IMATCH_MP_TAC  REAL_LT_DIV;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (*   *)
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * b + ((d - x') * e) * a) ==> (a <= ((x' - c) * e) * b + ((d - x') * e) * a)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_MUL_ASSOC];
  REDUCE_TAC;
  DISCH_THEN IMATCH_MP_TAC ;
  ineq_le_tac `(d-c)*e*a + (x' - c)*(b - a)*e = ((x' - c) * e) * b + ((d - x') * e) * a`;
  TYPE_THEN `(((x' - c) * e) * b + ((d - x') * e) * a <= b*((d- c)*e)) ==> (((x' - c) * e) * b + ((d - x') * e) * a <= b)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`];
  DISCH_THEN IMATCH_MP_TAC ;
  ineq_le_tac `(((x' - c) * e) * b + ((d - x') * e) * a) + (d - x' )*(b-a)*e = b * (d - c) * e`;
  (* 2nd direction *)
  REP_BASIC_TAC;
  TYPE_THEN `x' = ((b*c  - a*d) + (d -c)*x)/(b - a)` ABBREV_TAC ;
  TYPE_THEN `x'` EXISTS_TAC;
  TYPE_THEN `x'*(b - a) = ((b*c - a*d ) + (d -c)*x)` SUBGOAL_TAC;
  EXPAND_TAC "x'";
  IMATCH_MP_TAC  REAL_DIV_RMUL;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* sv *)
  SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`;
  MESON_TAC[REAL_PROP_LE_RCANCEL];
  DISCH_TAC;
  CONJ_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `(b - a)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ineq_le_tac `c * (b - a) + (d-c)*(x-a) = b*c  - a*d + (d - c) * x`;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `(b - a)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ineq_le_tac `(b*c - a*d + (d - c) * x) + (d-c)*(b - x) = d * (b - a)`;
  TYPE_THEN `((x' - c) * e) * b + ((d - x') * e) * a = (d*a - c*b + x'*(b-a))*e` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(d * a - c * b + b * c - a * d + (d - c) * x) = x*(d-c)` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM REAL_MUL_ASSOC];
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let linear_inj = 
prove_by_refinement(
  `!a b c d. (a < b) /\ (c < d) ==>
     (INJ (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b )
         {x | c <= x /\ x <= d }
            {y | a <= y /\ y <= b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REP_BASIC_TAC;
  ASSUME_TAC linear_image_gen;
  TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL);
  REWR 4;
  UND 4;
  REWRITE_TAC[IMAGE];
  DISCH_TAC;
  FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * a + (d - x) / (d - c) * b`));
  UND 5;
  REWRITE_TAC[];
  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* INJ proper *)
  REP_BASIC_TAC;
  UND 2;
  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ;
  TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC"e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]);
  UND 8;
  TYPE_THEN `(((x - c) * e) * a + ((d - x) * e) * b) - (((y - c) * e) * a + ((d - y) * e) * b) = e*(b-a)*(y - x)` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[REAL_ENTIRE];
  TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `~(e = &0)` SUBGOAL_TAC;
  EXPAND_TAC"e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  REWRITE_TAC[REAL_INV_EQ_0];
  UND 0;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let linear_inj_rev = 
prove_by_refinement(
  `!a b c d. (a < b) /\ (c < d) ==>
     (INJ (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a )
         {x | c <= x /\ x <= d }
            {y | a <= y /\ y <= b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REP_BASIC_TAC;
  ASSUME_TAC linear_image_rev;
  TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL);
  REWR 4;
  UND 4;
  REWRITE_TAC[IMAGE];
  DISCH_TAC;
  FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * b + (d - x) / (d - c) * a`));
  UND 5;
  REWRITE_TAC[];
  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* INJ proper *)
  REP_BASIC_TAC;
  UND 2;
  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ;
  TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC"e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]);
  UND 8;
  TYPE_THEN `(((x - c) * e) * b + ((d - x) * e) * a) - (((y - c) * e) * b + ((d - y) * e) * a) = e*(a-b)*(y - x)` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[REAL_ENTIRE];
  TYPE_THEN `~(a-b = &0)` SUBGOAL_TAC;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `~(e = &0)` SUBGOAL_TAC;
  EXPAND_TAC"e";
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  REWRITE_TAC[REAL_INV_EQ_0];
  UND 0;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let comp_comp = 
prove_by_refinement(
  `(o) = (compose:(B->C) -> ((A->B)-> (A->C))) `,

  (* {{{ proof *)
  [
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[o_DEF;compose];
  ]);;
  (* }}} *)

let arc_reparameter_rev = 
prove_by_refinement(
  `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\
           INJ f {x | c <= x /\ x <= d} (euclid 2) /\
         (a < b) /\ (c < d)  ==>
           (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\
           INJ g {x | a <= x /\ x <= b} (euclid 2) /\
         (f d  = g a) /\ (f c = g b) /\
      (!x y x' y'. (f x = g x') /\ (f y = g y') /\
         (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\
         (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==>
           ((x < y) = (y' < x'))) /\
      (IMAGE f { x | c <= x /\ x <= d } =
         IMAGE g { x | a <= x /\ x <= b } )))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (c) + (b - t)/(b - a) *(d) )` ABBREV_TAC ;
  TYPE_THEN `g = (f o f2)` ABBREV_TAC ;
  TYPE_THEN `g` EXISTS_TAC;
  (* general facts *)
  TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC;
  MESON_TAC[metric_real;top_of_metric_unions];
  DISCH_TAC;
  (* continuity *)
  CONJ_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[top2];
  ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
  TYPE_THEN `f2 = (\t. t* (c - d + d*b - c*a)/(b - a) + (&1 - t)*(d*b-c*a)/(b - a))` SUBGOAL_TAC;
  EXPAND_TAC "f2";
  IMATCH_MP_TAC  EQ_EXT;
  BETA_TAC;
  GEN_TAC;
  REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`];
  REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL];
  DISJ1_TAC ;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[linear_cont];
  (* IMAGE *)
  TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC;
  REWRITE_TAC[];
  EXPAND_TAC "f2";
  ASM_SIMP_TAC[linear_image_gen];
  DISCH_TAC;
  TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC;
  EXPAND_TAC "g";
  REWRITE_TAC[comp_comp;compose_image;];
  AP_TERM_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* INJ *)
  EXPAND_TAC "g";
  REWRITE_TAC[comp_comp];
  (* XXX *)
  CONJ_TAC;
  IMATCH_MP_TAC  (COMP_INJ);
  TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
  UND 2;
  DISCH_THEN_REWRITE;
  KILL 7;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "f2";
  IMATCH_MP_TAC  linear_inj;
  ASM_REWRITE_TAC[];
  (* ends   *)
  IMATCH_MP_TAC  (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`);
  CONJ_TAC;
  EXPAND_TAC "f2";
  REWRITE_TAC[compose];
  REDUCE_TAC;
  REWRITE_TAC[real_div;REAL_MUL_ASSOC;];
  REDUCE_TAC;
  TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_MUL_RINV;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REDUCE_TAC;
  (* monotone *)
  REWRITE_TAC[compose];
  REP_BASIC_TAC;
  TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC;
  USE 7 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `y'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC;
  USE 7 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x = f2 x'` SUBGOAL_TAC;
  USE 2 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `y = f2 y'` SUBGOAL_TAC;
  USE 2 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "f2";
  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`];
  REWRITE_TAC[real_div];
  TYPE_THEN `e = inv(b-a)` ABBREV_TAC ;
  TYPE_THEN `(((y' - a) * e) * c + ((b - y') * e) * d) - (((x' - a) * e) * c + ((b - x') * e) * d) = (x' - y')*e*(d-c)` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  TYPE_THEN `&0 < e` SUBGOAL_TAC;
  EXPAND_TAC"e";
  IMATCH_MP_TAC  REAL_PROP_POS_INV;
  UND 1;
  REAL_ARITH_TAC;
  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  REWRITE_TAC[REAL_MUL_ASSOC];
  ASM_SIMP_TAC[REAL_PROP_POS_RMUL];
  ]);;
  (* }}} *)

let arc_reparameter_gen = 
prove_by_refinement(
  `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\
           INJ f {x | c <= x /\ x <= d} (euclid 2) /\
         (a < b) /\ (c < d)  ==>
           (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\
           INJ g {x | a <= x /\ x <= b} (euclid 2) /\
         (f c  = g a) /\ (f d = g b) /\
      (!x y x' y'. (f x = g x') /\ (f y = g y') /\
         (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\
         (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==>
           ((x < y) = (x' < y'))) /\
      (IMAGE f { x | c <= x /\ x <= d } =
         IMAGE g { x | a <= x /\ x <= b } )))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (d) + (b - t)/(b - a) *(c) )` ABBREV_TAC ;
  TYPE_THEN `g = (f o f2)` ABBREV_TAC ;
  TYPE_THEN `g` EXISTS_TAC;
  (* general facts *)
  TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC;
  MESON_TAC[metric_real;top_of_metric_unions];
  DISCH_TAC;
  (* continuity *)
  CONJ_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[top2];
  ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
  TYPE_THEN `f2 = (\t. t* (d - c + c*b - d*a)/(b - a) + (&1 - t)*(c*b-d*a)/(b - a))` SUBGOAL_TAC;
  EXPAND_TAC "f2";
  IMATCH_MP_TAC  EQ_EXT;
  BETA_TAC;
  GEN_TAC;
  REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`];
  REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL];
  DISJ1_TAC ;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[linear_cont];
  (* IMAGE *)
  TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC;
  REWRITE_TAC[];
  EXPAND_TAC "f2";
  ASM_SIMP_TAC[linear_image_rev];
  DISCH_TAC;
  TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC;
  EXPAND_TAC "g";
  REWRITE_TAC[comp_comp;compose_image;];
  AP_TERM_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* INJ *)
  EXPAND_TAC "g";
  REWRITE_TAC[comp_comp];
  (* XXX *)
  CONJ_TAC;
  IMATCH_MP_TAC  (COMP_INJ);
  TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
  UND 2;
  DISCH_THEN_REWRITE;
  KILL 7;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "f2";
  IMATCH_MP_TAC  linear_inj_rev;
  ASM_REWRITE_TAC[];
  (* ends   *)
  IMATCH_MP_TAC  (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`);
  CONJ_TAC;
  EXPAND_TAC "f2";
  REWRITE_TAC[compose];
  REDUCE_TAC;
  REWRITE_TAC[real_div;REAL_MUL_ASSOC;];
  REDUCE_TAC;
  TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_MUL_RINV;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REDUCE_TAC;
  (* monotone *)
  REWRITE_TAC[compose];
  REP_BASIC_TAC;
  TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC;
  USE 7 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `y'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC;
  USE 7 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x = f2 x'` SUBGOAL_TAC;
  USE 2 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `y = f2 y'` SUBGOAL_TAC;
  USE 2 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "f2";
  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`];
  REWRITE_TAC[real_div];
  TYPE_THEN `e = inv(b-a)` ABBREV_TAC ;
  TYPE_THEN `(((y' - a) * e) * d + ((b - y') * e) * c) - (((x' - a) * e) * d + ((b - x') * e) * c) = (y' - x')*e*(d-c)` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  TYPE_THEN `&0 < e` SUBGOAL_TAC;
  EXPAND_TAC"e";
  IMATCH_MP_TAC  REAL_PROP_POS_INV;
  UND 1;
  REAL_ARITH_TAC;
  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  REWRITE_TAC[REAL_MUL_ASSOC];
  ASM_SIMP_TAC[REAL_PROP_POS_RMUL];
  ]);;
  (* }}} *)

let image_preimage = 
prove_by_refinement(
  `!(f:A->B) X Y. IMAGE f (preimage X f Y) SUBSET Y`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE;SUBSET;INR in_preimage ;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let preimage_union2 = 
prove_by_refinement(
  `!(f:A->B) A B X. (preimage X f (A UNION B)) =
    (preimage X f A UNION preimage X f B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[preimage_union;image_preimage;];
  REWRITE_TAC[preimage;SUBSET;];
  MESON_TAC[];
  REWRITE_TAC[union_subset];
  REWRITE_TAC[preimage;SUBSET;UNION];
  MESON_TAC[];
  ]);;
  (* }}} *)

let union_diff  = 
prove_by_refinement(
  `!(X:A->bool) A B. (X = A UNION B) /\ (A INTER B = EMPTY) ==>
     (X DIFF B = A)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  SET_TAC[];
  ]);;
  (* }}} *)

let preimage_closed = 
prove_by_refinement(
  `!U V C (f:A->B). (continuous f U V) /\ (closed_ V C) /\
       (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==>
           (closed_ U (preimage (UNIONS U) f C))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  REWRITE_TAC[closed;open_DEF;];
  TYPE_THEN `(UNIONS U DIFF (preimage (UNIONS U) f C)) = preimage (UNIONS U) f (UNIONS V DIFF C)` SUBGOAL_TAC;
  IMATCH_MP_TAC  union_diff;
  REWRITE_TAC[GSYM preimage_union2];
  CONJ_TAC;
  TYPE_THEN `UNIONS V DIFF C UNION C = UNIONS V` SUBGOAL_TAC;
  TYPE_THEN `!P. C SUBSET P ==> (P DIFF C UNION C = P)` SUBGOAL_TAC;
  SET_TAC[];
  TYPE_THEN `C SUBSET UNIONS V` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[closed;open_DEF;];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  DISCH_THEN (fun t-> ASM_SIMP_TAC[t]);
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  ASM_REWRITE_TAC [  subset_preimage;];
  REWRITE_TAC[preimage;SUBSET];
  MESON_TAC[];
  IMATCH_MP_TAC  preimage_disjoint;
  SET_TAC[];
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;preimage];
  MESON_TAC[];
  UND 2;
  REWRITE_TAC[continuous];
  DISCH_THEN IMATCH_MP_TAC ;
  UND 1;
  REWRITE_TAC[closed;open_DEF;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let preimage_restrict = 
prove_by_refinement(
  `!(f:A->B) Z A B.  (A SUBSET B) ==>
      (preimage A f Z = A INTER preimage B f Z)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[preimage;INTER;];
  TYPE_THEN `!y. (A SUBSET B ==> (A y /\ B y <=> A y))` SUBGOAL_TAC;
  MESON_TAC[ISUBSET];
  ASM_SIMP_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let continuous_delta = 
prove_by_refinement(
  `continuous (\x. (x *# dirac_delta 0)) (top_of_metric(UNIV,d_real))
     (top_of_metric(euclid 1,d_euclid)) `,

  (* {{{ proof *)
  [
  TYPE_THEN `IMAGE (\x. (x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  MESON_TAC[euclid_dirac];
  ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real];
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  REP_BASIC_TAC;
  RIGHT_TAC "delta";
  REP_BASIC_TAC;
  TYPE_THEN `epsilon` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_SIMP_TAC[euclid_dirac;euclid1_abs];
  REWRITE_TAC[dirac_0];
  USE 2 (REWRITE_RULE [d_real]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let continuous_neg_delta = 
prove_by_refinement(
  `continuous (\x. ((-- x) *# dirac_delta 0))
   (top_of_metric(UNIV,d_real))
     (top_of_metric(euclid 1,d_euclid)) `,

  (* {{{ proof *)
  [
  TYPE_THEN `IMAGE (\x. (-- x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  MESON_TAC[euclid_dirac];
  ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real];
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  REP_BASIC_TAC;
  RIGHT_TAC "delta";
  REP_BASIC_TAC;
  TYPE_THEN `epsilon` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_SIMP_TAC[euclid_dirac;euclid1_abs];
  REWRITE_TAC[dirac_0];
  USE 2 (REWRITE_RULE [d_real]);
  UND 2;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let compact_max_real = 
prove_by_refinement(
  `!(f:A->real) U K.
    continuous f U (top_of_metric (UNIV,d_real)) /\
          compact U K /\
          ~(K = {})
          ==> (?x. K x /\ (!y. K y ==> f y  <= f x ))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `g = (\x. (x *# dirac_delta 0)) o f` ABBREV_TAC ;
  TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC;
  IMATCH_MP_TAC  compact_max;
  TYPE_THEN `U` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "g";
  REWRITE_TAC[IMAGE_o];
  TYPE_THEN `X = IMAGE f K` ABBREV_TAC ;
  REWRITE_TAC[IMAGE ;SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
  ASM_REWRITE_TAC[continuous_delta];
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
  MESON_TAC[euclid_dirac];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UND 4;
  EXPAND_TAC "g";
  REWRITE_TAC[o_DEF;dirac_0];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let compact_min_real = 
prove_by_refinement(
  `!(f:A->real) U K.
    continuous f U (top_of_metric (UNIV,d_real)) /\
          compact U K /\
          ~(K = {})
          ==> (?x. K x /\ (!y. K y ==> f x  <= f y ))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `g = (\x. (-- x *# dirac_delta 0)) o f` ABBREV_TAC ;
  TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC;
  IMATCH_MP_TAC  compact_max;
  TYPE_THEN `U` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "g";
  REWRITE_TAC[IMAGE_o];
  TYPE_THEN `X = IMAGE f K` ABBREV_TAC ;
  REWRITE_TAC[IMAGE ;SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
  ASM_REWRITE_TAC[continuous_neg_delta];
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
  MESON_TAC[euclid_dirac];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UND 4;
  EXPAND_TAC "g";
  REWRITE_TAC[o_DEF;dirac_0];
  ASM_MESON_TAC[REAL_ARITH `!u v. (-- u <= --v) <=> (v <= u)`];
  ]);;
  (* }}} *)

let continuous_I = 
prove_by_refinement(
  `continuous I (top_of_metric(UNIV,d_real))
     (top_of_metric(UNIV,d_real))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[continuous];
  REP_BASIC_TAC;
  REWRITE_TAC[preimage];
  SIMP_TAC [GSYM top_of_metric_unions;metric_real];
  REWRITE_TAC[I_DEF];
  TYPE_THEN `{x | v x} = v` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let compact_sup = 
prove_by_refinement(
  `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==>
    (?x. (X x) /\ (!y. (X y) ==> (y <= x)))`,

  (* {{{ proof *)
  [
  TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC;
  REWRITE_TAC[I_DEF];
  DISCH_TAC;
  TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t ->  ONCE_REWRITE_TAC [t]);
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_max_real;
  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
  ASM_REWRITE_TAC[continuous_I];
  ]);;
  (* }}} *)

let compact_inf = 
prove_by_refinement(
  `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==>
    (?x. (X x) /\ (!y. (X y) ==> (x <= y)))`,

  (* {{{ proof *)
  [
  TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC;
  REWRITE_TAC[I_DEF];
  DISCH_TAC;
  TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t ->  ONCE_REWRITE_TAC [t]);
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_min_real;
  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
  ASM_REWRITE_TAC[continuous_I];
  ]);;
  (* }}} *)

let preimage_compact = 
prove_by_refinement(
  `!C (f:A->B) Y dY Z dZ Y0.
   metric_space (Y,dY) /\ metric_space (Z,dZ) /\
  (compact (top_of_metric(Y,dY)) Y0) /\
  (continuous f (top_of_metric(Y0,dY))
            (top_of_metric(Z,dZ))) /\
  (IMAGE f Y0 SUBSET Z) /\
  (closed_ (top_of_metric(Z,dZ)) C) /\
  ~(IMAGE f Y0 INTER C = EMPTY) ==>
  (compact (top_of_metric(Y,dY)) (preimage Y0 f C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `X = preimage Y0 f C` ABBREV_TAC ;
  TYPE_THEN `(UNIONS (top_of_metric(Y,dY)) = Y) /\ (UNIONS(top_of_metric(Z,dZ)) = Z)` SUBGOAL_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  REP_BASIC_TAC;
  TYPE_THEN `Y0 SUBSET Y` SUBGOAL_TAC;
  ASM_MESON_TAC [compact;];
  DISCH_TAC;
  WITH 10 (MATCH_MP preimage_restrict);
  TYPEL_THEN [`f`;`C`] (USE 11 o ISPECL);
  TYPE_THEN `metric_space (Y0,dY)` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_subspace;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `closed_ (top_of_metric(Y0,dY)) X` SUBGOAL_TAC;
  EXPAND_TAC "X";
  TYPE_THEN `preimage Y0 f C = preimage (UNIONS (top_of_metric(Y0,dY))) f C` SUBGOAL_TAC;
  AP_THM_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  preimage_closed;
  TYPE_THEN `(top_of_metric (Z,dZ))` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  TYPE_THEN `~(X = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS;];
  UND 0;
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  UND 0;
  REWRITE_TAC[IMAGE;INTER];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  EXPAND_TAC "X";
  REWRITE_TAC[preimage];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* next X compact in the reals , take inf X, *)
  TYPE_THEN `U = top_of_metric(Y,dY)` ABBREV_TAC ;
  TYPE_THEN `U0 = top_of_metric(Y0,dY)` ABBREV_TAC ;
  TYPE_THEN `U00 = top_of_metric (X,dY)` ABBREV_TAC ;
  TYPE_THEN `X SUBSET Y0` SUBGOAL_TAC;
  EXPAND_TAC "X";
  KILL 7;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER;SUBSET;];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `induced_top U Y0 = U0` SUBGOAL_TAC;
  EXPAND_TAC "U";
  EXPAND_TAC "U0";
  IMATCH_MP_TAC  top_of_metric_induced;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `UNIONS U = Y` SUBGOAL_TAC;
  EXPAND_TAC "U";
  ASM_SIMP_TAC [GSYM top_of_metric_unions];
  DISCH_TAC;
  TYPE_THEN `compact U0 Y0` SUBGOAL_TAC;
  KILL 16;
  EXPAND_TAC "U0";
  ASM_SIMP_TAC[GSYM induced_compact;];
  REP_BASIC_TAC;
  (* ok to here *)
  TYPE_THEN `compact U0 X` SUBGOAL_TAC;
  IMATCH_MP_TAC  closed_compact;
  TYPE_THEN `Y0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  KILL 19;
  EXPAND_TAC "U0";
  IMATCH_MP_TAC  top_of_metric_top;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* done WITH compac U0 X *)
  TYPE_THEN `induced_top U0 X = U00` SUBGOAL_TAC;
  KILL 19;
  EXPAND_TAC "U0";
  EXPAND_TAC "U00";
  IMATCH_MP_TAC  top_of_metric_induced;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `compact U00 X` SUBGOAL_TAC;
  EXPAND_TAC "U00";
  TYPE_THEN `X SUBSET UNIONS U0` SUBGOAL_TAC;
  KILL 19;
  EXPAND_TAC "U0";
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  ASM_SIMP_TAC[GSYM induced_compact];
  DISCH_TAC;
  TYPE_THEN `induced_top U X = U00` SUBGOAL_TAC;
  KILL 19;
  EXPAND_TAC "U";
  KILL 23;
  EXPAND_TAC "U00";
  IMATCH_MP_TAC  top_of_metric_induced;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  DISCH_TAC;
  UND 24;
  EXPAND_TAC "U00";
  TYPE_THEN `compact (induced_top U X) X = compact U X` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM induced_compact);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  MESON_TAC[];
  ]);;
  (* }}} *)

let preimage_compact_interval = 
prove_by_refinement(
  `!C n f a b.
  (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
            (top_of_metric(euclid n,d_euclid)) /\
  (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\
  (closed_ (top_of_metric(euclid n,d_euclid)) C) /\
  ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==>
  (compact (top_of_metric(UNIV,d_real))
         (preimage {x | a <= x /\ x <= b} f C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  preimage_compact;
  TYPE_THEN `(euclid n)` EXISTS_TAC;
  TYPE_THEN `d_euclid` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_real;metric_euclid;interval_compact;];
  ]);;
  (* }}} *)

let preimage_first = 
prove_by_refinement(
  `!C n f a b.
  (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
            (top_of_metric(euclid n,d_euclid)) /\
  (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\
  (closed_ (top_of_metric(euclid n,d_euclid)) C) /\
  ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==>
  (?t. (a <= t /\ t <= b) /\ (C (f t)) /\
    (!s. (a <=s /\ s < t) ==> ~(C (f s))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(compact (top_of_metric(UNIV,d_real)) (preimage {x | a <= x /\ x <= b} f C))` SUBGOAL_TAC;
  IMATCH_MP_TAC preimage_compact_interval;
  TYPE_THEN `n` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(preimage {x | a <= x /\ x <= b} f C = EMPTY)` SUBGOAL_TAC;
  UND 0;
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[IMAGE ;INTER;preimage];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `X = preimage {x | a <= x /\ x <= b } f C` ABBREV_TAC ;
  TYPE_THEN `(?x. (X x) /\ (!y. (X y) ==> (x <= y)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  compact_inf;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  UND 8;
  UND 7;
  EXPAND_TAC "X";
  REWRITE_TAC[preimage];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TSPEC `s` 10;
  REWR 10;
  UND 10;
  UND 12;
  UND 8;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let inj_subset_domain = 
prove_by_refinement(
  `!s s' t (f:A->B). INJ f s t /\ (s' SUBSET s) ==> INJ f s' t`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;SUBSET;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let arc_restrict = 
prove_by_refinement(
  `!a b c d C f t t'. (c <= t /\ t < t' /\ t' <= d) /\ (a < b) /\
     (C = IMAGE f { x | c <= x /\ x <= d }) /\
     INJ f {x | c <= x /\ x <= d} (euclid 2) /\
     continuous f (top_of_metric(UNIV,d_real))
            (top_of_metric(euclid 2,d_euclid)) ==>
    (?g.
  (IMAGE g {x | a <= x /\ x <= b} = IMAGE f {x | t <= x /\ x <= t'})  /\
     (g a = f t) /\ (g b = f t') /\
       INJ g { x | a <= x /\ x <= b} (euclid 2) /\
       continuous g (top_of_metric(UNIV,d_real))
            (top_of_metric(euclid 2,d_euclid)))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN ` continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (a < b) /\ (t < t')` SUBGOAL_TAC;
  ASM_REWRITE_TAC[top2];
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;];
  UND 4;
  UND 5;
  UND 6;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
  REP_BASIC_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[top2];
  ]);;
  (* }}} *)

let continuous_induced_domain = 
prove_by_refinement(
  `!(f:A->B) U V K. (continuous f U V) /\ (K SUBSET (UNIONS U)) ==>
    (continuous f (induced_top U K) V)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[continuous;induced_top_support;];
  REWRITE_TAC[preimage;induced_top];
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `{x | UNIONS U x /\ v (f x)}` EXISTS_TAC;
  ASM_SIMP_TAC[];
  REWRITE_TAC[INTER];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  MESON_TAC[];
  ]);;
  (* }}} *)

let inj_split = 
prove_by_refinement(
  `!A B Z (f:A->B). (INJ f A Z) /\ (INJ f B Z) /\
     (IMAGE f A INTER IMAGE f B = EMPTY) ==> (INJ f (A UNION B) Z)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;INTER;IMAGE;UNION;];
  REP_BASIC_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[];
  REP_GEN_TAC;
  REP_BASIC_TAC;
  UND 7;
  UND 6;
  REP_CASES_TAC;
  KILL 1;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 0;
  REWRITE_TAC[EQ_EMPTY];
  NAME_CONFLICT_TAC;
  DISCH_TAC;
  TSPEC `f y` 0;
  USE 0 (REWRITE_RULE[DE_MORGAN_THM]);
  ASM_MESON_TAC[];
  USE 0 (REWRITE_RULE[EQ_EMPTY]);
  TSPEC `f x` 0;
  ASM_MESON_TAC[];
  KILL 3;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let joinf_inj_below = 
prove_by_refinement(
  `!(f:real->B) g a A.
    (A SUBSET {x | x < a}) ==> (INJ (joinf f g a) A = INJ f A)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  IMATCH_MP_TAC EQ_EXT;
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[joinf];
  TSPEC `z` 0;
  REWR 0;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let joinf_inj_above = 
prove_by_refinement(
  `!(f:real->B) g a A.
    (A SUBSET {x | a <= x}) ==> (INJ (joinf f g a) A = INJ g A)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  IMATCH_MP_TAC EQ_EXT;
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[joinf];
  TSPEC `z` 0;
  REWR 0;
  ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let joinf_image_below = 
prove_by_refinement(
  `!(f:real->B) g a A.
    (A SUBSET {x | x < a}) ==> (IMAGE (joinf f g a) A = IMAGE f A)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  IMATCH_MP_TAC EQ_EXT;
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[joinf];
  TSPEC `z` 0;
  REWR 0;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let joinf_image_above = 
prove_by_refinement(
  `!(f:real->B) g a A.
    (A SUBSET {x | a <= x}) ==> (IMAGE (joinf f g a) A = IMAGE g A)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  IMATCH_MP_TAC EQ_EXT;
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[joinf];
  TSPEC `z` 0;
  REWR 0;
  ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let pconn_trans = 
prove_by_refinement(
  `!A x y z. (p_conn A x y /\ p_conn A y z ==> p_conn A x z)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[p_conn;simple_polygonal_arc;simple_arc;];
  REP_BASIC_TAC;
  TYPE_THEN `C' x`  ASM_CASES_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `f'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  TYPE_THEN `~(x = y)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* now ~( x= y) *)
  TYPE_THEN `C z` ASM_CASES_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  TYPE_THEN `~(z = y)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* now ~( z = y) *)
  TYPE_THEN `?tx. (&0 <= tx) /\ (tx <= &1) /\ (f tx = x)` SUBGOAL_TAC;
  UND 10;
  ASM_REWRITE_TAC[IMAGE;];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `?ty. (&0 <= ty) /\ (ty <= &1) /\ (f ty = y)` SUBGOAL_TAC;
  UND 9;
  ASM_REWRITE_TAC[IMAGE;];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `~(tx = ty)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* reparameter C *)
  TYPE_THEN `?g. (g (&0) = x) /\ (g (&1) = y) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE g { x | &0 <= x /\ x <= &1 } SUBSET C` SUBGOAL_TAC;
  TYPE_THEN `(tx < ty) \/ (ty < tx)` SUBGOAL_TAC;
  UND 28;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `(?g.   (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | tx <= x /\ x <= ty})  /\     (g (&0) = f tx) /\ (g (&1) = f ty) /\       INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\       continuous g (top_of_metric(UNIV,d_real))             (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  arc_restrict;
  TYPE_THEN `&0` EXISTS_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;];
  UND 15;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  REP_BASIC_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  GEN_TAC;
  UND 24;
  UND 26;
  REAL_ARITH_TAC;
  TYPE_THEN `(?g.   (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx})  /\     (g (&0) = f ty) /\ (g (&1) = f tx) /\       INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\       continuous g (top_of_metric(UNIV,d_real))             (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  arc_restrict;
  TYPE_THEN `&0` EXISTS_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;];
  UND 15;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  REP_BASIC_TAC;
  (* REVERSE reparameter on C XX0 *)
  TYPE_THEN `(?g'. continuous g' (top_of_metric (UNIV,d_real)) (top2) /\           INJ g' {x | (&0) <= x /\ x <= (&1)} (euclid 2) /\         (g (&1)  = g' (&0)) /\ (g (&0) = g' (&1)) /\      (!x y x' y'. (g x = g' x') /\ (g y = g' y') /\         ((&0) <= x /\ x <= (&1)) /\ ((&0) <= y /\ y <= (&1)) /\         ((&0) <= x' /\ x' <= (&1)) /\ ((&0) <= y' /\ y' <= (&1)) ==>           ((x < y) <=> (y' < x'))) /\      (IMAGE g { x | (&0) <= x /\ x <= (&1) } =          IMAGE g' { x | (&0) <= x /\ x <= (&1) } ))` SUBGOAL_TAC;
  IMATCH_MP_TAC  arc_reparameter_rev;
  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;top2;];
  REP_BASIC_TAC;
  TYPE_THEN `g'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[];  (* L80 *)
  CONJ_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[top2];
  TYPE_THEN `IMAGE g' {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx }` SUBGOAL_TAC;
  UND 34;
  UND 35;
  alpha_tac;
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  UND 23;
  UND 27;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  (* now restrict C to [x,y'] *)
  (* rC *)
  TYPE_THEN `Cg = IMAGE g {x | &0 <= x /\ x <= &1 }` ABBREV_TAC ;
  TYPE_THEN `Z = Cg INTER C'` ABBREV_TAC ;
  TYPE_THEN `?t'. (&0 <= t' /\ t' <= &1) /\ (Z (g t')) /\ (!s. (&0 <=s /\ s < t') ==> ~(Z (g s)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  preimage_first;
  EXISTS_TAC `2`;
  (* restriction conditions *)
  CONJ_TAC;
  TYPE_THEN `induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1 } = top_of_metric ({x | &0 <= x /\ x <= &1 },d_real)` SUBGOAL_TAC;
  ASM_SIMP_TAC[SUBSET_UNIV;metric_real;top_of_metric_induced];
  DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]);
  IMATCH_MP_TAC  continuous_induced_domain;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
  SUBCONJ_TAC;
  UND 31;
  REWRITE_TAC[INJ;IMAGE;SUBSET;];
  MESON_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  (* rC2 *)
  TYPE_THEN `!C. (?f a b. (continuous f (top_of_metric(UNIV,d_real)) (top2)) /\ (INJ f {x | a <= x /\ x <= b} (euclid 2)) /\ (IMAGE f {x | a <= x /\ x <= b} = C)) ==> (closed_ top2 C)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_closed;
  ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
  ASM_SIMP_TAC[top_of_metric_top;metric_euclid];
  EXPAND_TAC "C''";
  IMATCH_MP_TAC  image_compact;
  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;interval_compact];
  ASM_SIMP_TAC[GSYM top2];
  EXPAND_TAC "C''";
  UND 38;
  REWRITE_TAC[INJ;IMAGE;SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  REWRITE_TAC[GSYM top2];
  EXPAND_TAC "Z";
  IMATCH_MP_TAC  closed_inter2;
  REWRITE_TAC[top2_top];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `g` EXISTS_TAC;
  TYPE_THEN `&0` EXISTS_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  ASM_REWRITE_TAC[];  (* XX2 *)
  ASM_SIMP_TAC[top2];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `f'` EXISTS_TAC;
  TYPE_THEN `&0` EXISTS_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[top2];
  UND 6;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  EXPAND_TAC "Z";
  REWRITE_TAC[EMPTY_EXISTS;INTER;IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `&1` EXISTS_TAC;
  EXPAND_TAC "Cg";
  ASM_REWRITE_TAC[IMAGE;];
  REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC)));
  EXPAND_TAC "Cg";  (* L160 *)
  (remark "LINE 160"; ALL_TAC);
  REWRITE_TAC[IMAGE];
  TYPE_THEN `&1` EXISTS_TAC;
  REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC)));
  ASM_REWRITE_TAC[];
  UND 1;
  ASM_REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  TYPE_THEN `(t' = &0) \/ (&0 < t')` SUBGOAL_TAC;
  UND 39;
  REAL_ARITH_TAC;
  (* elim t' =0 *)
  DISCH_THEN DISJ_CASES_TAC;
  UND 37;
  EXPAND_TAC "Z";
  REWRITE_TAC[INTER];
  ASM_MESON_TAC[];
  (*  **  START ON 2nd BRANCH  ** *** ** *)
  (* 2b*)
  TYPE_THEN `?tz. (&0 <= tz) /\ (tz <= &1) /\ (f' tz = z)` SUBGOAL_TAC;
  UND 0;
  ASM_REWRITE_TAC[IMAGE;];
  DISCH_THEN (CHOOSE_THEN MP_TAC);
  LEFT_TAC "tz";
  TYPE_THEN `x'` EXISTS_TAC;
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `?t''. (&0 <= t'') /\ (t'' <= &1) /\ (f' t'' = g t')` SUBGOAL_TAC;
  UND 37;
  EXPAND_TAC "Z";
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[IMAGE;];
  DISCH_THEN (fun t-> MP_TAC (CONJUNCT2 t));
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `~(tz = t'')` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `C (g t')` SUBGOAL_TAC;
  UND 37;
  EXPAND_TAC "Z";
  REWRITE_TAC[INTER];
  UND 29;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* reparam on C' *)
  TYPE_THEN `?h. (h (&1/(&2)) = g t') /\ (h (&1) = z) /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE h { x | &1/(&2) <= x /\ x <= &1 } SUBSET C'` SUBGOAL_TAC;
  TYPE_THEN `(t'' < tz) \/ (tz < t'')` SUBGOAL_TAC;
  UND 47;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `(?h.   (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | t'' <= x /\ x <= tz})  /\     (h (&1/(&2)) = f' t'') /\ (h (&1) = f' tz) /\       INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\       continuous h (top_of_metric(UNIV,d_real))             (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  arc_restrict;
  TYPE_THEN `&0` EXISTS_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 6;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  DISCH_TAC;
  REWRITE_TAC[REAL_LT_HALF2];
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `h` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  GEN_TAC;
  UND 42;
  UND 46;
  REAL_ARITH_TAC;
  TYPE_THEN `(?h.   (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' })  /\     (h (&1/(&2)) = f' tz) /\ (h (&1) = f' t'') /\       INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\       continuous h (top_of_metric(UNIV,d_real))  (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  arc_restrict;
  TYPE_THEN `&0` EXISTS_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
  UND 6;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  REP_BASIC_TAC;  (* L240 *)
  (remark "LINE 240"; ALL_TAC);
  (* REVERSE reparameter on C *)
  TYPE_THEN `(?h'. continuous h' (top_of_metric (UNIV,d_real)) (top2) /\           INJ h' {x | (&1/(&2)) <= x /\ x <= (&1)} (euclid 2) /\         (h (&1)  = h' (&1/(&2))) /\ (h (&1/(&2)) = h' (&1)) /\      (!x y x' y'. (h x = h' x') /\ (h y = h' y') /\         ((&1/(&2)) <= x /\ x <= (&1)) /\ ((&1/(&2)) <= y /\ y <= (&1)) /\         ((&1/(&2)) <= x' /\ x' <= (&1)) /\ ((&1/(&2)) <= y' /\ y' <= (&1)) ==>           ((x < y) <=> (y' < x'))) /\      (IMAGE h { x | (&1/(&2)) <= x /\ x <= (&1) } =          IMAGE h' { x | (&1/(&2)) <= x /\ x <= (&1) } ))` SUBGOAL_TAC;
  IMATCH_MP_TAC  arc_reparameter_rev;
  ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`;top2;];
  REP_BASIC_TAC;
  TYPE_THEN `h'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[top2];
  TYPE_THEN `IMAGE h' {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' }` SUBGOAL_TAC;
  UND 53;  (* ZZZ *)
  UND 54;
  alpha_tac;
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  UND 43;
  UND 45;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  (* reparam g [0,1/2] *)
  (* rg *)
  TYPE_THEN `?g'. ((g' (&0)) = x) /\ (g' (&1/(&2)) = g t') /\ INJ g' { x | &0 <= x /\ x <= &1/(&2) } (euclid 2) /\ continuous g' (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ (IMAGE g' { x | &0 <= x /\ x <= &1/(&2) } = IMAGE g {x | &0 <= x /\ x <= t'}) ` SUBGOAL_TAC; (* was SUBSET Cg *)
  ASSUME_TAC arc_reparameter_gen;
  TYPEL_THEN [`g`;`&0`;`&1/(&2)`;`&0`;`t'`] (fun t-> FIRST_ASSUM (fun s-> (MP_TAC (ISPECL t s))));
  KILL 53;   (* ZZZ *)
  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;REAL_LT_HALF1;];
  UND 30;
  REWRITE_TAC[top2];
  DISCH_THEN_REWRITE;
  TYPE_THEN `INJ g {x | &0 <= x /\ x <= t'} (euclid 2)` SUBGOAL_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1 }` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  UND 38;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  TYPE_THEN `g'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* deleted lines here *)
  REP_BASIC_TAC;
  TYPE_THEN `fm = joinf g' h (&1/(&2))` ABBREV_TAC ;
  TYPE_THEN `Cm = IMAGE fm {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
  TYPE_THEN `Cm` EXISTS_TAC;
  (* final instantiation *)
  (* fi *)
  REPEAT (IMATCH_MP_TAC  (TAUT `A /\ B/\ C ==> (A /\ B) /\C`));
  CONJ_TAC;
  TYPE_THEN `fm` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  EXPAND_TAC "fm";
  IMATCH_MP_TAC  joinf_cont;
  ASM_REWRITE_TAC[];
  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  GEN_TAC;
  TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC;
  REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  inj_split;
  EXPAND_TAC "fm";
  TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  KILL 58;
  ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below;joinf_image_above;joinf_image_below];
  DISCH_TAC;
  (* cases *)
  CONJ_TAC;
  IMATCH_MP_TAC  inj_subset_domain;  (* L320 *)
  (remark "LINE 320"; ALL_TAC);
  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2) }` EXISTS_TAC;
  ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_euclid];
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  CONJ_TAC;
  ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_euclid];
  ASM_REWRITE_TAC[];
  TYPE_THEN `IMAGE g' { x | &0 <= x /\ x <= &1/(&2)} INTER IMAGE h {x | &1/(&2) <= x /\ x <= &1} SUBSET {(g t')}` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `IMAGE g { x | &0 <= x /\ x <= t' } SUBSET Cg` SUBGOAL_TAC;
  EXPAND_TAC "Cg";
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  UND 38;
  REAL_ARITH_TAC;
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'} INTER Z` EXISTS_TAC;
  CONJ_TAC;
  EXPAND_TAC "Z";
  UND 48;
  UND 60;
  REWRITE_TAC[SUBSET;INTER];
  (* MESON_TAC[]; *)
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  (* LINE 350 *)
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[];
  UND 36;
  REWRITE_TAC[INTER;SUBSET;IMAGE];
  UND 37;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REP_BASIC_TAC;
  REWRITE_TAC[INR IN_SING];
  UND 0;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `(x' = t') \/ (x' < t')` SUBGOAL_TAC;
  UND 2;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  USE 61 (REWRITE_RULE[EMPTY_EXISTS ]);
  REP_BASIC_TAC;
  TYPE_THEN `!B' B (u:num->real). (B' u /\ B' SUBSET B) ==> (B u)` SUBGOAL_TAC;
  MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `{(g t')} u` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x <= &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[INTER;SUBSET;IMAGE];
  MESON_TAC[REAL_ARITH `x < t ==> x <= t`];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INR IN_SING];
  REP_BASIC_TAC;
  UND 62;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER;IMAGE;DE_MORGAN_THM;];
  DISJ1_TAC;
  USE 56 SYM;
  ASM_REWRITE_TAC[];
  UND 55;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  USE 1(REWRITE_RULE [REAL_ARITH `(x < &1/(&2)) <=> (x <= &1/(&2) /\ ~(x = &1/(&2)))`]);
  TYPEL_THEN [`x`;`&1/(&2)`] (USE 3 o ISPECL);
  TYPE_THEN `&0 <= &1/ &2 /\ &1/ &2 <= &1/ (&2)` SUBGOAL_TAC;
  REWRITE_TAC[REAL_ARITH `x <= x`];
  IMATCH_MP_TAC  REAL_LE_DIV;
  REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  (* Now E *)   (* L400 *)
  (remark "LINE 400"; ALL_TAC);
  (* ne *)
  TYPE_THEN ` {x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  GEN_TAC;
  TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC;
  REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
  REAL_ARITH_TAC;
  EXPAND_TAC "Cm";
  DISCH_THEN_REWRITE;
  REWRITE_TAC[IMAGE_UNION];
  TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  EXPAND_TAC "fm";
  KILL 58;
  ASM_SIMP_TAC[joinf_image_above;joinf_image_below];
  DISCH_TAC;
  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION  IMAGE h {x | &1 / &2 <= x /\ x <= &1}) z` SUBGOAL_TAC;
  UND 51;
  REWRITE_TAC[UNION;IMAGE];
  POP_ASSUM_LIST (fun t->ALL_TAC);
  REP_BASIC_TAC;
  DISJ2_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_ARITH `&1 <= &1`];
  IMATCH_MP_TAC  REAL_LE_LDIV;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION  IMAGE h {x | &1 / &2 <= x /\ x <= &1}) x` SUBGOAL_TAC;
  UND 57;
  REWRITE_TAC[UNION;IMAGE];
  POP_ASSUM_LIST (fun t->ALL_TAC);
  REP_BASIC_TAC;
  DISJ1_TAC;
  TYPE_THEN `&0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_ARITH `&0 <= &0`];
  REWRITE_TAC[REAL_LT_HALF1];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  (* gh *)
  UND 48;
  TYPE_THEN `IMAGE g' {x | &0 <= x /\ x < &1/ &2} SUBSET C` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Cg ` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  EXPAND_TAC "Cg";
  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'}` EXISTS_TAC;
  CONJ_TAC;
  USE 53 SYM;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[REAL_ARITH `x < t ==> x <= t`];
  REWRITE_TAC[IMAGE;SUBSET];
  UND 38;
  MESON_TAC[REAL_ARITH `t' <= &1 ==> (x <= t' ==> x<= &1)`];
  TYPE_THEN `GCG = IMAGE g' {x | &0 <= x /\ x < &1 / &2}` ABBREV_TAC ;
  TYPE_THEN `HCH = IMAGE h {x | &1 / &2 <= x /\ x <= &1}` ABBREV_TAC ;
  UND 11;
  UND 2;
  UND 4;
  UND 5;
  UND 13;
  UND 14;
  UND 12;
  UND 3;
  POP_ASSUM_LIST (fun t->ALL_TAC);
  REP_BASIC_TAC;
  CONJ_TAC;
  TYPE_THEN `E UNION E'` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[UNIONS_UNION];
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  UND 1;
  UND 7;
  REWRITE_TAC[UNION;SUBSET];  (* L480 *)
  (remark "LINE 480"; ALL_TAC);
  MESON_TAC[];
  UND 0;
  UND 5;
  REWRITE_TAC[UNION;SUBSET];
  MESON_TAC[];
  CONJ_TAC;
  ASM_REWRITE_TAC[FINITE_UNION];
  UND 8;
  UND 9;
  REWRITE_TAC[hv_line;UNION;];
  MESON_TAC[];
  UND 1;
  UND 0;
  UND 2;
  UND 3;
  REWRITE_TAC[SUBSET;UNION;];
  MESON_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION J *)
(* ------------------------------------------------------------------ *)


(* Conclusion of Jordan Curve, page 1 *)

let v_simple_polygonal = 
prove_by_refinement(
  `!x e. (euclid 2 x) /\ (~(e = &0)) ==>
    (simple_polygonal_arc hv_line (mk_segment x (x + e *# e2)))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ];
  REP_BASIC_TAC;
  CONJ_TAC;
  ASSUME_TAC mk_segment_inj_image;
  TYPEL_THEN [`x`;`x + (e *# e2)`;`2`] (USE 2 o ISPECL);
  TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e2)) /\ ~(x = euclid_plus x (e *# e2))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  euclid_add_closure;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  euclid_scale_closure;
  REWRITE_TAC [e2;euclid_point];
  REP_BASIC_TAC;
  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `1`));
  REWRITE_TAC[euclid_plus;euclid_scale;e2;coord01];
  UND 0;
  REAL_ARITH_TAC;
  DISCH_TAC;
  REWR 2;
  REP_BASIC_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SIMP_TAC  [GSYM top_of_metric_unions;metric_euclid];
  ASM_REWRITE_TAC[];
  (* E *)
  USE 1 (MATCH_MP point_onto);
  REP_BASIC_TAC;
  TYPE_THEN `{(mk_line (point p) (point p + (e *# e2)))}` EXISTS_TAC;
  REWRITE_TAC[INR IN_SING];
  CONJ_TAC;
  REWRITE_TAC[e2;ISUBSET;mk_segment;mk_line];
  REP_BASIC_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[FINITE_SING];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  TYPE_THEN `(FST p , SND p + e)` EXISTS_TAC;
  REWRITE_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[e2;point_scale];
  REDUCE_TAC;
  TYPE_THEN `euclid_plus (point p) (point (&0,e)) = euclid_plus (point (FST p,SND p)) (point (&0,e))` SUBGOAL_TAC;
  REWRITE_TAC[];
  DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]);
  REWRITE_TAC[point_add];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let p_conn_ball = 
prove_by_refinement(
  `! x y r. (open_ball(euclid 2,d_euclid) x r y) ==>
      (p_conn (open_ball(euclid 2,d_euclid) x r) x y)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `open_ball (euclid 2,d_euclid) x r x` SUBGOAL_TAC;
  SIMP_TAC [metric_euclid;INR open_ball_nonempty_center];
  REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[];
  DISCH_TAC;

  TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[open_ball]);
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  RULE_ASSUM_TAC  (fun t -> try (MATCH_MP point_onto t) with  Failure _ -> t);
  REP_BASIC_TAC;

  TYPE_THEN `y' = point(FST p,SND p')` ABBREV_TAC ;
  TYPE_THEN `A = open_ball(euclid 2,d_euclid) x r` ABBREV_TAC ;

  TYPE_THEN `y' = euclid_plus x ((SND  p' - SND  p) *# e2)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "y'";
  REWRITE_TAC[e2];
  REWRITE_TAC[point_add;point_scale;];
  REDUCE_TAC;
  PURE_ONCE_REWRITE_TAC [GSYM PAIR];
  PURE_REWRITE_TAC [point_add];
  REWRITE_TAC[];
  REDUCE_TAC;
  AP_TERM_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  REAL_ARITH_TAC;
  DISCH_TAC;

  TYPE_THEN `A y'` SUBGOAL_TAC;
  UND 0;
  EXPAND_TAC "y'";
  KILL 4;
  EXPAND_TAC "A";
  KILL 5;
  ASM_REWRITE_TAC[open_ball;euclid_point;d_euclid_point;];
  REWRITE_TAC[REAL_ARITH `(x - x = &0)`;POW_0;ARITH_RULE  `2 = SUC 1`];
  IMATCH_MP_TAC  (REAL_ARITH `(x <= y) ==> (y < r ==> x < r)`);
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REWRITE_TAC[REAL_ARITH `&0 + x = x`;ARITH_RULE `SUC 1 = 2`;REAL_PROP_NN_SQUARE];
  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x ==> (y <= x + y)`);
  REWRITE_TAC[REAL_PROP_NN_SQUARE];
  DISCH_TAC;

  TYPE_THEN `p_conn A x y'` SUBGOAL_TAC;
  TYPE_THEN `x = y'` ASM_CASES_TAC;
  EXPAND_TAC "y'";
  IMATCH_MP_TAC  pconn_refl;
  REWRITE_TAC[p_conn];
  CONJ_TAC;
  EXPAND_TAC "A";
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  open_ball_open;
  MESON_TAC[metric_euclid];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[p_conn];
  TYPE_THEN `mk_segment x y'` EXISTS_TAC;
  CONJ_TAC;
  UND 6;
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  v_simple_polygonal;
  ASM_REWRITE_TAC[euclid_point];
  REWRITE_TAC[REAL_SUB_0];
  DISCH_ALL_TAC;
  UND 8;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "y'";
  AP_TERM_TAC;
  ASM_MESON_TAC[PAIR];
  CONJ_TAC;
  EXPAND_TAC "A";
  IMATCH_MP_TAC  openball_mk_segment_end;
  ASM_MESON_TAC[];
  REWRITE_TAC[mk_segment_end];
  DISCH_TAC;

  TYPE_THEN `y' = euclid_plus y ((FST   p - FST   p') *# e1)` SUBGOAL_TAC;
  KILL 6;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "y'";
  REWRITE_TAC[e1];
  REWRITE_TAC[point_add;point_scale;];
  REDUCE_TAC;
  PURE_ONCE_REWRITE_TAC [GSYM PAIR];
  PURE_REWRITE_TAC [point_add];
  REWRITE_TAC[];
  REDUCE_TAC;
  AP_TERM_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  REAL_ARITH_TAC;
  DISCH_TAC;

  TYPE_THEN `p_conn A y y'` SUBGOAL_TAC;
  TYPE_THEN `y = y'` ASM_CASES_TAC;
  EXPAND_TAC "y'";
  IMATCH_MP_TAC  pconn_refl;
  CONJ_TAC;
  EXPAND_TAC "A";
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  open_ball_open;
  MESON_TAC[metric_euclid];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[p_conn];
  TYPE_THEN `mk_segment y y'` EXISTS_TAC;
  CONJ_TAC;
  UND 9;
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  h_simple_polygonal;
  ASM_REWRITE_TAC[euclid_point];
  REWRITE_TAC[REAL_SUB_0];
  DISCH_ALL_TAC;
  UND 10;
  KILL 6;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "y'";
  AP_TERM_TAC;
  ASM_MESON_TAC[PAIR];
  CONJ_TAC;
  EXPAND_TAC "A";
  IMATCH_MP_TAC  openball_mk_segment_end;
  ASM_MESON_TAC[];
  REWRITE_TAC[mk_segment_end];
  DISCH_TAC;
  IMATCH_MP_TAC  pconn_trans;
  TYPE_THEN `y'` EXISTS_TAC;
  UND 8;
  DISCH_THEN_REWRITE;
  UND 10;
  MESON_TAC[pconn_symm];
  (* Wed Aug  4 10:40:05 EDT 2004 *)

  ]);;

  (* }}} *)

let p_conn_euclid = 
prove_by_refinement(
  `!A x. p_conn A x SUBSET (euclid 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;p_conn;simple_polygonal_arc;simple_arc;];
  REP_BASIC_TAC;
  UND 0;
  ASM_REWRITE_TAC[];
  UND 6;
  SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  REWRITE_TAC[INJ;IMAGE];
  MESON_TAC[];
  (* Wed Aug  4 10:55:53 EDT 2004 *)
  ]);;
  (* }}} *)

let p_connA = 
prove_by_refinement(
  `!A x. p_conn A x SUBSET A`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[p_conn;SUBSET;];
  ASM_MESON_TAC[];
  (* Wed Aug  4 11:11:21 EDT 2004 *)
  ]);;
  (* }}} *)

let p_conn_open = 
prove_by_refinement(
  `!A x. top2 A ==> (top2 (p_conn A x))`,

  (* {{{ proof *)
  [
  (* Wed Aug  4 10:43:29 EDT 2004 *)
  REP_BASIC_TAC;
  ASM_SIMP_TAC[top2;top_of_metric_nbd;metric_euclid;p_conn_euclid];
  REP_BASIC_TAC;

  TYPE_THEN `A a` SUBGOAL_TAC;
  ASM_MESON_TAC[p_connA;ISUBSET];
  DISCH_TAC;

  TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC;
  ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;];
  REP_BASIC_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET;];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  pconn_trans;
  TYPE_THEN `a` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  p_conn_subset;
  TYPE_THEN `open_ball (euclid 2,d_euclid) a r` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  p_conn_ball;
  ASM_REWRITE_TAC[];
  (* Wed Aug  4 11:21:18 EDT 2004 *)
  ]);;
  (* }}} *)

let p_conn_diff = 
prove_by_refinement(
  `!A x.  top2 A ==> (top2 (A DIFF (p_conn A x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  SIMP_TAC[top2;metric_euclid;top_of_metric_nbd];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `A` EXISTS_TAC;
  REWRITE_TAC[SUBSET_DIFF];
  UND 0;
  REWRITE_TAC[top2;];
  DISCH_TAC;
  FIRST_ASSUM (fun t-> ASSUME_TAC (MATCH_MP sub_union t));
  UND 1;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[DIFF]);
  REP_BASIC_TAC;

  TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC;
  ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;];
  REP_BASIC_TAC;

  TYPE_THEN `r` EXISTS_TAC;
  ASM_REWRITE_TAC[DIFF_SUBSET];
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  REP_BASIC_TAC;
  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP  p_conn_ball t));
  TYPE_THEN `p_conn A a u` SUBGOAL_TAC;
  IMATCH_MP_TAC  p_conn_subset;
  ASM_MESON_TAC[];
  DISCH_TAC;
  UND 1;
  REWRITE_TAC[];
  IMATCH_MP_TAC  pconn_trans;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[pconn_symm];
  (* Wed Aug  4 12:00:13 EDT 2004 *)
  ]);;
  (* }}} *)

let p_conn_conn = 
prove_by_refinement(
  `!A x y. (top2 A /\ connected top2 A /\ A x /\ A y) ==>
     (p_conn A x y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[connected];
  REP_BASIC_TAC;
  TYPEL_THEN [`p_conn A x`;`A DIFF (p_conn A x)`] (USE 2 o ISPECL);
  UND 2;
  ASM_SIMP_TAC[p_conn_open;p_conn_diff];

  TYPE_THEN `!(w:(num->real)->bool) z. (w INTER (z DIFF w) = EMPTY)` SUBGOAL_TAC;
  SET_TAC[INTER;DIFF];
  DISCH_THEN_REWRITE;

  TYPE_THEN `!(x:(num->real)->bool) y. (x SUBSET (y UNION (x DIFF y)))` SUBGOAL_TAC;
  SET_TAC[SUBSET;UNION;DIFF];
  DISCH_THEN_REWRITE;

  DISCH_THEN (DISJ_CASES_TAC);
  ASM_MESON_TAC[ISUBSET];
  UND 2;
  REWRITE_TAC[SUBSET;DIFF];
  ASM_MESON_TAC[pconn_refl];
  (* Wed Aug  4 12:42:12 EDT 2004 *)
  ]);;
  (* }}} *)

let plane_graph = jordan_def
  `plane_graph G <=>
     graph_vertex G SUBSET (euclid 2) /\
     graph G /\
     graph_edge G SUBSET (simple_arc top2) /\
     (!e. (graph_edge G e ==>
        (graph_inc G e = e INTER (graph_vertex G)))) /\
     (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e')) ==>
        (e INTER e' SUBSET (graph_vertex G)))`;;

let graph_isomorphic = jordan_def
  `graph_isomorphic (G:(A,B)graph_t) (H:(A',B')graph_t) <=>
     ?f. (graph_iso f G H)`;;

let I_BIJ = 
prove_by_refinement(
  `!(x:A->bool). BIJ I x x`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;INJ;SURJ;I_THM;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let graph_isomorphic_refl = 
prove_by_refinement(
  `!(G:(A,B)graph_t). graph_isomorphic G G`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_isomorphic;graph_iso;];
  REP_BASIC_TAC;
  RIGHT_TAC  "f";
  RIGHT_TAC  "f";
  TYPE_THEN `I:A->A` EXISTS_TAC;
  TYPE_THEN `I:B->B` EXISTS_TAC;
  TYPE_THEN `(I:A->A,I:B->B)` EXISTS_TAC;
  ASM_REWRITE_TAC[I_THM;IMAGE_I;I_BIJ];
  (* Wed Aug  4 13:08:32 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_inc_subset = 
prove_by_refinement(
  `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e) ==>
       (graph_inc G e SUBSET graph_vertex G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph;IMAGE;SUBSET;];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  USE 2 (CONV_RULE (dropq_conv "x''"));
  TSPEC  `e'` 2;
  REWR 2;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let graph_isomorphic_symm = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (H:(A',B')graph_t).
     graph G /\ graph_isomorphic G H ==> graph_isomorphic H G`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_isomorphic;graph_iso];
  REP_BASIC_TAC;
  RIGHT_TAC "f";
  RIGHT_TAC "f";
  TYPE_THEN `u' = INV u (graph_vertex G) (graph_vertex H)` ABBREV_TAC  ;
  TYPE_THEN `v' = INV v (graph_edge G) (graph_edge H)` ABBREV_TAC ;
  TYPE_THEN `u'` EXISTS_TAC;
  TYPE_THEN `v'` EXISTS_TAC;
  TYPE_THEN `(u',v')` EXISTS_TAC;
  REWRITE_TAC[];
  CONJ_TAC;
  EXPAND_TAC "u'";
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  EXPAND_TAC "v'";
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  (* LAST step *)
  REP_BASIC_TAC;
  TYPE_THEN `e' = v' e` ABBREV_TAC ;

  TYPE_THEN `e = v e'` SUBGOAL_TAC;
  ASM_MESON_TAC [inv_comp_right];
  DISCH_TAC;
  ASM_REWRITE_TAC[];

  TYPE_THEN `BIJ v' (graph_edge H) (graph_edge G)` SUBGOAL_TAC;
  ASM_MESON_TAC[INVERSE_BIJ];
  DISCH_TAC;

  TYPE_THEN `graph_edge G e'` SUBGOAL_TAC;
  EXPAND_TAC "e'";
  UND 10;
  REWRITE_TAC[BIJ;SURJ;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_SIMP_TAC[];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  EXPAND_TAC "u'";
  IMATCH_MP_TAC  image_inv_image;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  graph_inc_subset;
  ASM_MESON_TAC[];
  (* Wed Aug  4 13:53:24 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_isomorphic_trans = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (H:(A',B')graph_t) (J:(A'',B'')graph_t).
    graph_isomorphic G H /\ graph_isomorphic H J ==>
     graph_isomorphic G J`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_isomorphic;graph_iso;];
  REP_BASIC_TAC;
  KILL 3;
  KILL 7;
  RIGHT_TAC "f";
  RIGHT_TAC "f";
  TYPE_THEN `u' o u` EXISTS_TAC;
  TYPE_THEN `v' o v` EXISTS_TAC;
  TYPE_THEN `(u' o u, v' o v)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  REWRITE_TAC[comp_comp];
  IMATCH_MP_TAC  COMP_BIJ;
  ASM_MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[comp_comp];
  IMATCH_MP_TAC  COMP_BIJ;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE_o];
  REWRITE_TAC[o_DEF];

  TYPE_THEN `graph_edge H (v e)` SUBGOAL_TAC;
  UND 5;
  REWRITE_TAC[BIJ;SURJ];
  UND 3;
  MESON_TAC[];
  ASM_SIMP_TAC[];
  (* Wed Aug  4 14:13:25 EDT 2004 *)
  ]);;
  (* }}} *)

let graph_isomorphic_graph = 
prove_by_refinement(
  `!(G:(A,B)graph_t) H.
     graph G /\ graph_isomorphic G (H:(A',B')graph_t) ==> graph H`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `!z. (graph_edge G z ==> graph_inc G z SUBSET graph_vertex G)` SUBGOAL_TAC;
  ASM_MESON_TAC[graph_inc_subset];
  DISCH_TAC;
  UND 0;
  UND 1;
  REWRITE_TAC[graph;graph_isomorphic;graph_iso];
  REP_BASIC_TAC;
  REWRITE_TAC[SUBSET;IMAGE;];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  REP_BASIC_TAC;
  TYPE_THEN `?y'. (graph_edge G y' /\ (v y' = x'))` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[BIJ;SURJ];
  UND 6;
  MESON_TAC[];
  REP_BASIC_TAC;

  TYPE_THEN `graph_inc H x' = IMAGE u (graph_inc G y')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;

  TYPE_THEN `graph_inc G y' SUBSET graph_vertex G` SUBGOAL_TAC;
  ASM_SIMP_TAC[];
  DISCH_TAC;
  KILL 2;

  SUBCONJ_TAC;
  ASM_REWRITE_TAC[IMAGE];
  UND 10;
  UND 3;
  REWRITE_TAC[BIJ;SURJ];
  MESON_TAC[ISUBSET];
  DISCH_TAC;

  (* has size *)
  TYPE_THEN `(graph_inc G y') HAS_SIZE 2` SUBGOAL_TAC;
  UND 5;
  REWRITE_TAC[SUBSET;IMAGE];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  UND 8;
  MESON_TAC[];
  DISCH_TAC;


  ASM_REWRITE_TAC[];
  REWRITE_TAC[HAS_SIZE];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_MESON_TAC[HAS_SIZE];
  DISCH_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[HAS_SIZE]);
  REP_BASIC_TAC;
  UND 11;
  DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]);
  IMATCH_MP_TAC  CARD_IMAGE_INJ;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UND 3;
  REWRITE_TAC[BIJ;INJ];
  REP_BASIC_TAC;
  ASM_MESON_TAC[ISUBSET];
  (* Wed Aug  4 15:18:06 EDT 2004 *)
  ]);;
  (* }}} *)

let planar_graph = jordan_def
  `planar_graph (G:(A,B)graph_t) <=>
      (?H. (plane_graph H) /\ (graph_isomorphic H G))`;;

let plane_planar = 
prove_by_refinement(
  `!G. (plane_graph G) ==> (planar_graph G)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[planar_graph];
  REP_BASIC_TAC;
  ASM_MESON_TAC[graph_isomorphic_refl];
  ]);;
  (* }}} *)

let planar_is_graph = 
prove_by_refinement(
  `!(G:(A,B)graph_t). (planar_graph G ==> graph G)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[planar_graph;plane_graph];
  REP_BASIC_TAC;
  ASM_MESON_TAC[graph_isomorphic_graph];
  ]);;
  (* }}} *)

let planar_iso = 
prove_by_refinement(
  `!G H. (planar_graph (G:(A,B)graph_t)) /\ (graph_isomorphic G H) ==>
    (planar_graph (H:(A',B')graph_t))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[planar_graph];
  REP_BASIC_TAC;
  TYPE_THEN `H'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  JOIN 1 0;
  USE 0 (MATCH_MP graph_isomorphic_trans);
  ASM_REWRITE_TAC[];
  (* Wed Aug  4 15:41:05 EDT 2004 *)

  ]);;
  (* }}} *)

(* almost the same ans num_MAX .  The minimization is num_WOP. *)
let select_num_max = 
prove_by_refinement(
  `!Y. FINITE Y /\ (~(Y= EMPTY)) ==>
        (?z. (Y z /\ (!y. Y y ==> y <=| z)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `f = \ (t:num). --. (&. t)` ABBREV_TAC ;
  TYPE_THEN `Z = IMAGE f Y` ABBREV_TAC ;
  TYPE_THEN `FINITE Z /\ ~(Z = {})` SUBGOAL_TAC;
  EXPAND_TAC "Z";
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  UND 0;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `f u` EXISTS_TAC;
  REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 4 (MATCH_MP   min_finite);
  REP_BASIC_TAC;
  TYPE_THEN `?z. Y z /\ (f z = delta)` SUBGOAL_TAC;
  UND 5;
  EXPAND_TAC "Z";
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(f z <= f y) ==> (y <=| z)` SUBGOAL_TAC;
  EXPAND_TAC "f";
  REDUCE_TAC;
  DISCH_THEN IMATCH_MP_TAC ;
  TYPE_THEN `Z (f y)` SUBGOAL_TAC;
  EXPAND_TAC "Z";
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let select_image_num_max = 
prove_by_refinement(
  `!(X:A->bool) f.  (?N. (!x. (X x ==> f x <| N))) /\ ~(X = EMPTY)  ==>
      (?z. (X z /\ (!x. (X x ==> f x <=| f z))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ;
  TYPE_THEN `Y SUBSET {n | n <| N}` SUBGOAL_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE;SUBSET;];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `FINITE Y /\ (~(Y= EMPTY))` SUBGOAL_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `{n | n <| N}` EXISTS_TAC;
  ASM_REWRITE_TAC[FINITE_NUMSEG_LT];
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  TYPE_THEN `f u` EXISTS_TAC;
  UND 2;
  UND 0;
  REWRITE_TAC[IMAGE;SUBSET];
  DISCH_TAC;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 4 (MATCH_MP   select_num_max);
  REP_BASIC_TAC;
  TYPE_THEN `?r. X r /\ (f r = z)` SUBGOAL_TAC;
  UND 5;
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TSPEC `f x` 4;
  TYPE_THEN `Y (f x)` SUBGOAL_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* Wed Aug  4 16:41:51 EDT 2004 *)

  ]);;
  (* }}} *)

let select_image_num_min = 
prove_by_refinement(
  `!(X:A->bool) f. (~(X = EMPTY)) ==>
     (?z. (X z  /\ (!x. (X x ==> f z <=| f x))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ;
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  TYPE_THEN `(?n. Y n)` SUBGOAL_TAC;
  TYPE_THEN `f u` EXISTS_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[];
  DISCH_TAC;
  RULE_ASSUM_TAC (ONCE_REWRITE_RULE[num_WOP]);
  REP_BASIC_TAC;
  TYPE_THEN `?z. (X z) /\ (f z = n)` SUBGOAL_TAC;
  UND 3;
  EXPAND_TAC "Y";
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TSPEC `f x` 2;
  IMATCH_MP_TAC  (ARITH_RULE `~(f x <| n) ==> (n <=| f x)`);
  DISCH_ALL_TAC;
  UND 2;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "Y";
  KILL 1;
  ASM_REWRITE_TAC[IMAGE;SUBSET];
   ASM_MESON_TAC[];
  (* Wed Aug  4 19:37:29 EDT 2004 *)

  ]);;
  (* }}} *)

let select_card_max = 
prove_by_refinement(
  `!(X:(A->bool)->bool).  (~(X = EMPTY) /\ (FINITE (UNIONS X))) ==>
    (?z. (X z /\ (!x. (X x ==> (CARD x <= CARD z)))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  select_image_num_max;
  ASM_REWRITE_TAC[];
  TYPE_THEN `SUC (CARD (UNIONS X))` EXISTS_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `x SUBSET (UNIONS X)` SUBGOAL_TAC;
  IMATCH_MP_TAC  sub_union;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
   REWRITE_TAC[ARITH_RULE `(a <| SUC b) <=> (a <=| b)`];
  IMATCH_MP_TAC  CARD_SUBSET;
  ASM_REWRITE_TAC[];
  (* Thu Aug  5 10:50:37 EDT 2004 *)

  ]);;
  (* }}} *)

let select_card_min = 
prove_by_refinement(
  `!(X:(A->bool)->bool).  ~(X = EMPTY) ==>
    (?z. (X z /\ (!x. (X x ==> (CARD z <= CARD x)))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  select_image_num_min;
  ASM_REWRITE_TAC[];
  (* Thu Aug  5 10:52:02 EDT 2004 *)
  ]);;
  (* }}} *)

(* D embeddings of planar graphs *)

let induced_top_interval = 
prove_by_refinement(
  `!a b. induced_top (top_of_metric(UNIV,d_real))
       {x | a <= x /\ x <= b } =
     top_of_metric ({x | a <= x /\ x <= b}, d_real)
      `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  top_of_metric_induced;
  ASM_REWRITE_TAC[SUBSET_UNIV;metric_real];
  ]);;
  (* }}} *)

let continuous_interval = 
prove_by_refinement(
  `!f a b. (continuous f (top_of_metric(UNIV,d_real)) top2) ==>
     (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) top2)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[GSYM induced_top_interval];
  IMATCH_MP_TAC  continuous_induced_domain;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV ];
  ]);;
  (* }}} *)

let inj_image_subset  = 
prove_by_refinement(
  `!(f:A->B) X Y. (INJ f X Y ==> IMAGE f X SUBSET Y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;IMAGE;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let subset_contain = 
prove_by_refinement(
  `!a b c d. (c <= a) /\ (b <= d) ==>
        {x | a <= x /\ x <= b} SUBSET {x | c <= x /\ x <= d}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let curve_restriction = 
prove_by_refinement(
  `!C K K' a b.
       simple_arc top2 C /\
       closed_ top2 K /\ closed_ top2 K' /\
       (C INTER K INTER K' = EMPTY) /\
       ~(C INTER K = EMPTY) /\
       ~(C INTER K' = EMPTY) /\
        (a <. b) ==>
       (?C' f. (C' = IMAGE f {x | a <= x /\ x <= b}) /\ (C' SUBSET C) /\
            continuous f (top_of_metric(UNIV,d_real)) top2 /\
            INJ f {x | a <= x /\ x <= b} (euclid 2) /\
            (C' INTER K = {(f a)}) /\
            (C' INTER K' = {(f b)})
       )
       `,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc];
  REP_BASIC_TAC;
  ASSUME_TAC top2_unions;
  (* K parameter *)
  TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K (f s)))` SUBGOAL_TAC;
  ASSUME_TAC preimage_first ;
  TYPEL_THEN [`K`;`2`] (USE 10 o ISPECL);
  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
  KILL 10;
  ASM_REWRITE_TAC[GSYM top2;];
  ASM_SIMP_TAC[continuous_interval];
  UND 2;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  REWR 6;
  IMATCH_MP_TAC  inj_image_subset;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* K' parameter *)
  TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K' (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K' (f s)))` SUBGOAL_TAC;
  ASSUME_TAC preimage_first ;
  TYPEL_THEN [`K'`;`2`] (USE 14 o ISPECL);
  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
  KILL 14;
  ASM_REWRITE_TAC[GSYM top2;];
  ASM_SIMP_TAC[continuous_interval];
  UND 1;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  REWR 6;
  IMATCH_MP_TAC  inj_image_subset;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(t < t' \/ t' < t)` SUBGOAL_TAC;
  REWRITE_TAC[(REAL_ARITH `(t < t' \/ t' < t) <=> ~( t = t')`)];
  DISCH_ALL_TAC;
  UND 3;
  REWRITE_TAC[EMPTY_EXISTS;INTER;];
  TYPE_THEN `(f t)` EXISTS_TAC;
  REWR 11;
  REWRITE_TAC[IMAGE;SUBSET];
  CONJ_TAC;
  TYPE_THEN `t'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* main cases split [main] *)
  ASSUME_TAC (REAL_ARITH `&0 < &1`);
  DISCH_THEN (DISJ_CASES_TAC);
  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\  INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (&0 < &1) /\ (t < t')  ` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
  REWR 6;
  ASM_REWRITE_TAC[SUBSET ];
   UND 19;
  UND 16;
  UND 13;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
  REP_BASIC_TAC;
  TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
  TYPE_THEN `Ca INTER K' = {(g (&0))}` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
  KILL 26;
  EXPAND_TAC "Ca";
  REWRITE_TAC[IMAGE;SUBSET];
  REP_BASIC_TAC;
  TYPE_THEN `x' < t' \/ (x' = t')` SUBGOAL_TAC;
  UND 28;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  UND 26;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 29;
  UND 13;
  REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET;INTER;INR IN_SING;];
  KILL 26;
  EXPAND_TAC "Ca";
  REWRITE_TAC[IMAGE;SUBSET];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  CONJ_TAC;
  TYPE_THEN `t'` EXISTS_TAC;
  ASM_MESON_TAC[REAL_ARITH `(t < t' ==> t<= t') /\ (t' <= t')`];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(Ca INTER K = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `f t` EXISTS_TAC;
  KILL 26;
  EXPAND_TAC "Ca";
  REWRITE_TAC[IMAGE;SUBSET;];
  ASM_REWRITE_TAC[];
  TYPE_THEN `t` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `t <= t`];
  ASM_SIMP_TAC[REAL_ARITH `(t < t') ==> (t <= t')`];
  DISCH_TAC;
  KILL 21;
  (* ADD Ca SUBSET C *)
  TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC;
  KILL 26;
  EXPAND_TAC "Ca";
  KILL 20;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE;SUBSET];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 21;
  UND 26;
  UND 13;
  UND 19;
  UND 16;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* t'' parameter for g and K *)
  TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K (g s)))` SUBGOAL_TAC;
  ASSUME_TAC preimage_first ;
  TYPEL_THEN [`K`;`2`] (USE 29 o ISPECL);
  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
  KILL 29;
  ASM_REWRITE_TAC[GSYM top2;];
  ASM_SIMP_TAC[continuous_interval];
  EXPAND_TAC "Ca";
  IMATCH_MP_TAC  inj_image_subset;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* set up for arc_reparameter_rev *)
  TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\  INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'')  ` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC;
  UND 32;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET ];
  UND 31;
  REAL_ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  UND 3;
  REWRITE_TAC[EMPTY_EXISTS;INTER;];
  TYPE_THEN `g (&0)` EXISTS_TAC;
  TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC;
  TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC;
  ASM_MESON_TAC[INTER_SUBSET];
  REWRITE_TAC[SUBSET;INR IN_SING];
  MESON_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  UND 3;
  UND 21;
  MESON_TAC[ISUBSET];
  REWR 30;
  ASM_REWRITE_TAC[];
  UND 15;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
  REP_BASIC_TAC;
  TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ;
  (* now finally go after the goal in the FIRST case *)
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `g'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* now finish off the three conditions *)
  KILL 34;
  TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC;
  KILL 43;
  EXPAND_TAC "C'";
  EXPAND_TAC "Ca";
  IMATCH_MP_TAC  IMAGE_SUBSET;
  IMATCH_MP_TAC subset_contain;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  CONJ_TAC; (* 1*)
  ASM_REWRITE_TAC[];
  USE 8 GSYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Ca` EXISTS_TAC ;
  ASM_MESON_TAC[];
  CONJ_TAC; (* 2 *)
  KILL 43;
  EXPAND_TAC "C'";
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[INTER;IMAGE;SUBSET];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[INR IN_SING];
  TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC;
  UND 45;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TSPEC `x'` 14;
  UND 43;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `t''` EXISTS_TAC;
  ASM_MESON_TAC[REAL_ARITH `t'' <= t''`];
  ASM_MESON_TAC[];
  (* 3 *)
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Ca INTER K'` EXISTS_TAC;
  CONJ_TAC;
  UND 34;
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;INR IN_SING];
  REWRITE_TAC[SUBSET;INTER;INR IN_SING ];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  EXPAND_TAC "C'";
  REWRITE_TAC[IMAGE;SUBSET];
  TYPE_THEN `b` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 40;
  REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  (* sh *)
  (*  *******************  START THE SECOND HALF ************  *)

  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\  INJ f {x | t' <= x /\ x <= t} (euclid 2) /\ (&0 < &1) /\ (t' < t)  ` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
  REWR 6;
  ASM_REWRITE_TAC[SUBSET ];
   UND 19;
  UND 12;
  UND 17;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
  REP_BASIC_TAC;
  TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
  TYPE_THEN `Ca INTER K = {(g (&0))}` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
  KILL 26;
  EXPAND_TAC "Ca";
  REWRITE_TAC[IMAGE;SUBSET];
  REP_BASIC_TAC;
  TYPE_THEN `x' < t \/ (x' = t)` SUBGOAL_TAC;
  UND 28;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  UND 26;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 29;
  UND 17;
  REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET;INTER;INR IN_SING;];
  KILL 26;
  EXPAND_TAC "Ca";
  REWRITE_TAC[IMAGE;SUBSET];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  CONJ_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  ASM_MESON_TAC[REAL_ARITH `(t' < t ==> t'<= t) /\ (t <= t)`];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(Ca INTER K' = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `f t'` EXISTS_TAC;
  KILL 26;
  EXPAND_TAC "Ca";
  REWRITE_TAC[IMAGE;SUBSET;];
  ASM_REWRITE_TAC[];
  TYPE_THEN `t'` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `t' <= t'`];
  ASM_SIMP_TAC[REAL_ARITH `(t' < t) ==> (t' <= t)`];
  DISCH_TAC;
  KILL 21;
  (* ADD Ca SUBSET C *)
  TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC;
  KILL 26;
  EXPAND_TAC "Ca";
  KILL 20;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE;SUBSET];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 21;
  UND 26;
  UND 17;
  UND 19;
  UND 12;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* gK *)
  (* t'' parameter for g and K *)
  TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K' (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K' (g s)))` SUBGOAL_TAC;
  ASSUME_TAC preimage_first ;
  TYPEL_THEN [`K'`;`2`] (USE 29 o ISPECL);
  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
  KILL 29;
  ASM_REWRITE_TAC[GSYM top2;];
  ASM_SIMP_TAC[continuous_interval];
  EXPAND_TAC "Ca";
  IMATCH_MP_TAC  inj_image_subset;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* set up for arc_reparameter_gen *)
  TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\  INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'')  ` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC;
  UND 32;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET ];
  UND 31;
  REAL_ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  UND 3;
  REWRITE_TAC[EMPTY_EXISTS;INTER;];
  TYPE_THEN `g (&0)` EXISTS_TAC;
  TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC;
  TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC;
  ASM_MESON_TAC[INTER_SUBSET];
  REWRITE_TAC[SUBSET;INR IN_SING];
  MESON_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  UND 3;
  UND 21;
  MESON_TAC[ISUBSET];
  REWR 30;
  ASM_REWRITE_TAC[];
  UND 11;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
  REP_BASIC_TAC;
  TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ;
  (* now finally go after the goal in the FIRST case *)
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `g'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* nfo *)
  (* now finish off the three conditions *)
  KILL 34;
  TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC;
  KILL 43;
  EXPAND_TAC "C'";
  EXPAND_TAC "Ca";
  IMATCH_MP_TAC  IMAGE_SUBSET;
  IMATCH_MP_TAC subset_contain;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  CONJ_TAC; (* 1*)
  ASM_REWRITE_TAC[];
  USE 8 GSYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Ca` EXISTS_TAC ;
  ASM_MESON_TAC[];
  (* s2 *)
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC ; (* 2 *)
  KILL 43;
  EXPAND_TAC "C'";
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[INTER;IMAGE;SUBSET];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[INR IN_SING];
  TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC;
  UND 45;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TSPEC `x'` 14;
  UND 43;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING];
  NAME_CONFLICT_TAC;
  REP_BASIC_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `t''` EXISTS_TAC;
  ASM_MESON_TAC[REAL_ARITH `t'' <= t''`];
  ASM_MESON_TAC[];
  (* s3 *)
  (* 3 *)
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Ca INTER K` EXISTS_TAC;
  CONJ_TAC;
  UND 34;
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;INR IN_SING];
  REWRITE_TAC[SUBSET;INTER;INR IN_SING ];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  EXPAND_TAC "C'";
  REWRITE_TAC[IMAGE;SUBSET];
  TYPE_THEN `a` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 40;
  REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  (* Thu Aug  5 08:09:38 EDT 2004  *)

  ]);;
  (* }}} *)

let simple_arc_end = jordan_def
  `simple_arc_end C v v' <=>
    (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1 }) /\
       continuous f (top_of_metric(UNIV,d_real)) top2 /\
       INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
       (f (&0) = v) /\ (f(&1) = v'))`;;

let good_plane_graph = jordan_def
   `good_plane_graph G <=> plane_graph G /\
      (!e v v'. (graph_edge G e /\ ~(v = v') /\
           (graph_inc G e v) /\ (graph_inc G e v') ==>
           (simple_arc_end e v v')))`;;

let graph_edge_mod  = jordan_def
  `graph_edge_mod (G:(A,B)graph_t) (f:B->B') =
     mk_graph_t (graph_vertex G,IMAGE f (graph_edge G),
       (\ e' v. (?e. graph_edge G e /\ graph_inc G e v /\ (f e = e'))))`;;

let graph_edge_mod_v = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (f:B->B').
     graph_vertex (graph_edge_mod G f) = graph_vertex G `,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_edge_mod;graph_vertex;dest_graph_t;];
  ]);;
  (* }}} *)

let graph_edge_mod_e = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (f:B->B').
     graph_edge (graph_edge_mod G f) = IMAGE f (graph_edge G )`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_edge_mod;graph_edge;dest_graph_t;part1;drop0];
  ]);;
  (* }}} *)

let graph_edge_mod_i = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (f:B->B') e v.
     graph_inc (graph_edge_mod G f) e v <=>
         (?e'. (graph_edge G e' /\ graph_inc G e' v /\ (f e' = e)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_edge_mod;graph_inc;dest_graph_t;part1;drop1];
  ]);;
  (* }}} *)

let inj_bij = 
prove_by_refinement(
  `!(f:A->B) X. (INJ f X UNIV) ==> (BIJ f X (IMAGE f X))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ];
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE_SURJ];
  UND 0;
  REWRITE_TAC[INJ;IMAGE;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let graph_edge_iso = 
prove_by_refinement(
  `! f (G:(A,B)graph_t). (INJ (f:B->B') (graph_edge G) (UNIV)) ==>
    (graph_isomorphic G (graph_edge_mod G f))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[graph_isomorphic;graph_iso];
  REP_BASIC_TAC;
  RIGHT_TAC "f";
  RIGHT_TAC "f";
  TYPE_THEN `I:A->A` EXISTS_TAC ;
  TYPE_THEN `f` EXISTS_TAC;
  NAME_CONFLICT_TAC;
  EXISTS_TAC `(I:A->A,f:B->B')` ;
  REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e];
  CONJ_TAC;
  REWRITE_TAC[I_DEF;BIJ;INJ;SURJ;];
  MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  inj_bij;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[graph_edge_mod_i;IMAGE_I;];
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `e'' = e'` SUBGOAL_TAC;
  RULE_ASSUM_TAC(REWRITE_RULE  [INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;

  (* }}} *)

let graph_edge_graph = 
prove_by_refinement(
  `!f (G:(A,B)graph_t). (graph G) /\
      (INJ (f:B->B') (graph_edge G) (UNIV)) ==>
    (graph (graph_edge_mod G f)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC    graph_isomorphic_graph;
  TYPE_THEN `G` EXISTS_TAC;
  ASM_MESON_TAC[graph_edge_iso];
  ]);;
  (* }}} *)

let plane_graph_mod = 
prove_by_refinement(
  `!G f. (plane_graph G) /\ (INJ f (graph_edge G) UNIV) /\
      (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
        (f e INTER f e' SUBSET e INTER e') )) /\
      (!e. (graph_edge G e ==> (simple_arc top2 (f e)))) /\
      (!e. (graph_edge G e) ==>
         (e INTER graph_vertex G = (f e) INTER graph_vertex G)) ==>
      (plane_graph (graph_edge_mod G f))
  `,

  (* {{{ proof *)

  [
  REWRITE_TAC[plane_graph];
  REP_BASIC_TAC;
  REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e;];
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[graph_edge_graph];
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER];
  REP_BASIC_TAC;
  REWRITE_TAC[graph_edge_mod_i];
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `e' = x` SUBGOAL_TAC;
   RULE_ASSUM_TAC  (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TSPEC `e'` 5;
  TSPEC `e'` 0;
  UND 0;
  UND 5;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  TYPE_THEN `(f x INTER graph_vertex G) x'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[INTER;SUBSET];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TSPEC `x` 5;
  TSPEC `x` 0;
  UND 0;
  REWR 5;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  ASM_SIMP_TAC[];
  REWRITE_TAC[INTER;SUBSET];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  UND 10;
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  UND 11;
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  TYPE_THEN `~(x = x')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `x' INTER x` EXISTS_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Thu Aug  5 10:17:38 EDT 2004 *)

  ]);;
  (* }}} *)

let compact_point = 
prove_by_refinement(
  `!U (x:A). (UNIONS U x) ==> (compact U {x})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[compact];
  REP_BASIC_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC [single_subset];
  REP_BASIC_TAC;
  TYPE_THEN `?u. V u /\ u x` SUBGOAL_TAC;
  UND 2;
  REWRITE_TAC[SUBSET;UNIONS;INR IN_SING];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `{u}` EXISTS_TAC;
  ASM_REWRITE_TAC [single_subset;FINITE_SING];
  (* Thu Aug  5 12:02:40 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_select = 
prove_by_refinement(
  `!C v v'. (simple_arc top2 C) /\ (C v) /\ (C v') /\ ~(v = v') ==>
    (?C'. (C' SUBSET C) /\ (simple_arc_end C' v v'))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  (* A *)
  TYPE_THEN `!v. (C v) ==> (closed_ top2 {v})` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_closed;
  ASM_SIMP_TAC[top2_top;metric_hausdorff;top2;metric_euclid;compact_point];
  IMATCH_MP_TAC  compact_point;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
  UND 3;
  REWRITE_TAC[simple_arc];
  REP_BASIC_TAC;
  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_image_subset;
  RULE_ASSUM_TAC (REWRITE_RULE [top2_unions]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  (* B hypotheses of curve_restriction *)
  TYPE_THEN `simple_arc top2 C /\ closed_ top2 {v} /\ closed_ top2 {v'} /\      (C INTER {v} INTER { v' } = EMPTY) /\ ~(C INTER {v} = EMPTY) /\       ~(C INTER {v'} = EMPTY) /\        (&0 < &1)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_ARITH `&0 < &1`];
  REWRITE_TAC[INTER;INR IN_SING;EMPTY_EXISTS ];
  REWRITE_TAC[EQ_EMPTY];
  ASM_MESON_TAC[];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP curve_restriction t));
  REP_BASIC_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!A u v. (A INTER {u} = {v}) ==> ( (v:num->real)=u)` SUBGOAL_TAC;
  REWRITE_TAC[eq_sing;INTER;INR IN_SING;];
  MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let graph_edge2 = 
prove_by_refinement(
  `!(G:(A,B)graph_t) e.
      (graph G /\ graph_edge G e) ==> (graph_inc G e HAS_SIZE 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph];
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let simple_arc_end_symm = 
prove_by_refinement(
  `!C' v v'. (simple_arc_end C' v v' ==> simple_arc_end C' v' v)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  TYPE_THEN `( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (&0 < &1) /\ (&0 < &1))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`];
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
  REP_BASIC_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let simple_arc_end_plane_select = 
prove_by_refinement(
  `!G e. (plane_graph G /\ graph_edge G e) ==> (?e'.
     (e' SUBSET e /\
     (!v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==>
        simple_arc_end e' v v')))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]);
  IMATCH_MP_TAC graph_edge2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  TYPE_THEN `(?e'. (e' SUBSET e) /\ (simple_arc_end e' a b))` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_select;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC  (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  CONJ_TAC;
  UND 5;
  ASM_MESON_TAC [ISUBSET];
  TYPE_THEN `graph_inc G e a /\ graph_inc G e b` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[in_pair];
  KILL 3;
  ASM_SIMP_TAC[];
  REWRITE_TAC[INTER;SUBSET];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `e'` EXISTS_TAC;
  ASM_REWRITE_TAC[in_pair];
  REP_BASIC_TAC;
  TYPE_THEN `((v = a) /\ (v' = b)) \/ ((v = b) /\ (v' =a ))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  (* Thu Aug  5 14:10:17 EDT 2004 *)

  ]);;
  (* }}} *)

let plane_graph_contain = 
prove_by_refinement(
  `!G e e'. (plane_graph G /\ graph_edge G e /\ graph_edge G e' /\
      (e SUBSET e') ==> (e = e'))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `e INTER e' SUBSET graph_vertex G` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `e INTER e' SUBSET e' INTER graph_vertex G` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET_INTER];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER;SUBSET];
  MESON_TAC[];
  TYPE_THEN `e' INTER graph_vertex G = graph_inc G e'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `graph_inc G e' HAS_SIZE 2` SUBGOAL_TAC;
  ASM_MESON_TAC[graph_edge2];
  TYPE_THEN `e INTER e' = e` SUBGOAL_TAC;
  UND 0;
  REWRITE_TAC[SUBSET_INTER_ABSORPTION];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  REWR 10;
  TYPE_THEN `simple_arc top2 e` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  REWRITE_TAC[simple_arc];
  REP_BASIC_TAC;
  TYPE_THEN `!x. (&0 <= x /\ x <= &1) ==> {a,b} (f x)` SUBGOAL_TAC;
  REWR 10;
  UND 10;
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  TYPE_THEN `(f (&0) = f(&1))` SUBGOAL_TAC;
  IMATCH_MP_TAC  two_exclusion;
  TYPE_THEN `{a,b}` EXISTS_TAC;
  TYPE_THEN `?t. (&0 < t /\ t < &1)` SUBGOAL_TAC;
  TYPE_THEN `&1/ (&2)` EXISTS_TAC;
  IMATCH_MP_TAC  half_pos;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `f t` EXISTS_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[pair_size_2];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REAL_ARITH_TAC;
  CONJ_TAC;
  FIRST_ASSUM  IMATCH_MP_TAC ;
  REAL_ARITH_TAC;
  CONJ_TAC;
  FIRST_ASSUM  IMATCH_MP_TAC ;
  UND 18;
  UND 19;
  REAL_ARITH_TAC;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `~(&0 = t)` SUBGOAL_TAC;
  UND 19;
  REAL_ARITH_TAC;
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWR 20;
  ASM_REWRITE_TAC[];
  UND 18;
  UND 19;
  REAL_ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `~(&1 = t)` SUBGOAL_TAC;
  UND 18;
  REAL_ARITH_TAC;
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWR 20;
  ASM_REWRITE_TAC[];
  UND 18;
  UND 19;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `~(&0 = &1)` SUBGOAL_TAC;
  REAL_ARITH_TAC;
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* Thu Aug  5 15:11:20 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_edge_end_select = 
prove_by_refinement(
  `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e ==>
     (?v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v')))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_edge2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_REWRITE_TAC[in_pair];
  (* Thu Aug  5 19:26:02 EDT 2004 *)

  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* SECTION K *)
(* ------------------------------------------------------------------ *)

(* Thu Aug  5 21:17:36 EDT 2004 *)

(* Tweaked slightly now that there is an "inf" constant. JRH, 4 Dec 2011 *)

let inf =
  let inf_def =
    `inf (X:real->bool) =
      @s. ((!x. X x ==> s <= x) /\ (!y. (!x. X x ==> y <= x) ==> (y <= s)))` in
  let def =
    subst [mk_var("inf",`:(real->bool)->real`),mk_const("inf",[])] inf_def in
  jordan_def def;;

let interval_closed = 
prove_by_refinement(
  `!a b. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x /\ x <= b}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_closed;
  ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real];
  ASM_SIMP_TAC[metric_hausdorff;metric_real;];
  ]);;
  (* }}} *)

let half_closed = 
prove_by_refinement(
  `!a. closed_ (top_of_metric(UNIV,d_real)) {x | x <= a}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed];
  REP_BASIC_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
  TYPE_THEN `UNIV DIFF {x | x <= a } = {x | a < x}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[DIFF;UNIV];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC [open_DEF;half_open_above];
  ]);;
  (* }}} *)

let half_closed_above = 
prove_by_refinement(
  `!a. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed];
  REP_BASIC_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
  TYPE_THEN `UNIV DIFF {x | a <= x } = {x | x < a}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[DIFF;UNIV];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC [open_DEF;half_open];
  ]);;
  (* }}} *)

let inf_LB = 
prove_by_refinement(
  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==>
     (!x. X x ==> inf X <= x) /\
          (!y. (!x. X x ==> y <= x) ==> (y <= inf X))`,

  (* {{{ proof *)
  [
  GEN_TAC;
  TYPE_THEN `topology_ (top_of_metric(UNIV,d_real))` SUBGOAL_TAC;
  ASM_SIMP_TAC[top_of_metric_top;metric_real];
  DISCH_TAC;
  (*  *)
  TYPE_THEN `X SUBSET closure (top_of_metric(UNIV,d_real)) X` SUBGOAL_TAC;
  ASM_SIMP_TAC[subset_closure];
  DISCH_TAC;
  (*  *)
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  REWRITE_TAC[inf];
  SELECT_TAC;
  ASM_MESON_TAC[];
  PROOF_BY_CONTR_TAC;
  UND 4;
  KILL 5;
  REWRITE_TAC[];
  TYPE_THEN `XC = closure (top_of_metric(UNIV,d_real)) X INTER {x | t <= x /\ x <= u}` ABBREV_TAC ;
  TYPE_THEN `compact (top_of_metric(UNIV,d_real)) XC` SUBGOAL_TAC;
  IMATCH_MP_TAC  closed_compact;
  TYPE_THEN `{x | t <= x /\ x <= u}` EXISTS_TAC;
  ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real];
  EXPAND_TAC "XC";
  CONJ_TAC;
  IMATCH_MP_TAC  closed_inter2;
  ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real];
  IMATCH_MP_TAC  closure_closed;
  ASM_SIMP_TAC[top_of_metric_top;metric_real;GSYM top_of_metric_unions;];
  ASM_REWRITE_TAC[INTER_SUBSET];
  DISCH_TAC;
  (*   *)
  TYPE_THEN `(?z. (XC z /\ (!y. XC y ==> z <= y)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  compact_inf;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  EXPAND_TAC "XC";
  REWRITE_TAC[INTER;SUBSET];
  CONJ_TAC;
  UND 1;
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[REAL_ARITH `u <= u`];
  REP_BASIC_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  CONJ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `(x <= u) \/ (u < x)` SUBGOAL_TAC;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `XC x` SUBGOAL_TAC;
  EXPAND_TAC "XC";
  REWRITE_TAC[INTER;SUBSET];
  CONJ_TAC;
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  UND 7;
  EXPAND_TAC "XC";
  REWRITE_TAC[INTER;SUBSET];
  REP_BASIC_TAC;
  ASM_MESON_TAC[REAL_ARITH `z <= u /\ u < x ==> z <= x`];
  REP_BASIC_TAC;
  TYPE_THEN `closed_ (top_of_metric (UNIV,d_real)) {x | y' <= x }` SUBGOAL_TAC;
  REWRITE_TAC[half_closed_above];
  DISCH_TAC;
  TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X SUBSET {x | y' <= x }` SUBGOAL_TAC;
  IMATCH_MP_TAC  closure_subset;
  ASM_REWRITE_TAC[SUBSET ];
  DISCH_TAC;
  TYPE_THEN `XC SUBSET {x | y' <= x}` SUBGOAL_TAC;
  EXPAND_TAC "XC";
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X ` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "XC";
  REWRITE_TAC[INTER_SUBSET];
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* Fri Aug  6 05:51:24 EDT 2004 *)

  ]);;
  (* }}} *)

let inf_eps = 
prove_by_refinement(
  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==>
       (!epsilon. (&0 < epsilon) ==> (?x. X x /\ (x < inf X + epsilon)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(!y. (!x. X x ==> y <= x) ==> (y <= inf X))` SUBGOAL_TAC;
  ASM_MESON_TAC[inf_LB];
  DISCH_TAC;
  TSPEC `inf X + epsilon` 3;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `(!x. X x ==> inf X + epsilon <= x)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~(v < u)  ==> u <= v`);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[REAL_ARITH `(x + y <= x ==> ~(&0 < y))`];
  ]);;
  (* }}} *)

let supm = jordan_def `supm (X:real->bool) =
   --. (inf ({x | ?z. X z /\ (x = --. z)}))`;;

let supm_UB = 
prove_by_refinement(
  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==>
     (!x. X x ==> x <= supm X ) /\
          (!y. (!x. X x ==> x <= y) ==> (supm X <= y))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[supm];
  TYPE_THEN `Y = {x | ?z. X z /\ (x = --z)}` ABBREV_TAC ;
  TYPE_THEN `!u. (Y u = X (-- u)) /\ (Y (--u ) = X u)` SUBGOAL_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  MESON_TAC[REAL_ARITH `(-- (-- u) = u)`];
  DISCH_TAC;
  TYPE_THEN `(~(Y = EMPTY) /\ (?t. !x. (Y x ==> t <= x)))` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  CONJ_TAC;
  TYPE_THEN `-- u` EXISTS_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `-- t` EXISTS_TAC;
  REP_BASIC_TAC;
  ASM_MESON_TAC[REAL_ARITH `--t <= x <=> (-- x <= t)`];
  DISCH_THEN ( ASSUME_TAC o (MATCH_MP inf_LB));
  CONJ_TAC;
  REP_BASIC_TAC;
  ASM_MESON_TAC[REAL_ARITH `y <= --x <=> x <= --y`];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `--y <= inf Y ==> -- inf Y <= y`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REP_BASIC_TAC;
  ASM_MESON_TAC[ REAL_ARITH `--x <= y <=> --y <= x`];
  (* Fri Aug  6 06:42:14 EDT 2004 *)

  ]);;
  (* }}} *)

let supm_eps = 
prove_by_refinement(
  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==>
       (!epsilon.(&0 < epsilon) ==> (?x. X x /\ (supm X - epsilon < x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC;
  ASM_MESON_TAC[supm_UB];
  DISCH_TAC;
  TSPEC `supm X - epsilon` 3;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `(!x. X x ==> x <= supm X - epsilon)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~(v < u)  ==> u <= v`);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[REAL_ARITH `(x <= x - y  ==> ~(&0 < y))`];
  (* Fri Aug  6 06:47:22 EDT 2004 *)

  ]);;
  (* }}} *)

let compact_subset = 
prove_by_refinement(
  `!(X:A->bool) K d. (K SUBSET X /\ metric_space(X,d)) ==>
        (compact(top_of_metric(X,d)) K = compact(top_of_metric(K,d))K) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_induced];
  ASM_MESON_TAC[induced_compact;top_of_metric_unions];
  ]);;
  (* }}} *)

let exp_gt1 = 
prove_by_refinement(
  `!n. (0 < n) ==> (1 < 2 **| n)`,

  (* {{{ proof *)
  [
  TYPE_THEN `1 = 2 **| 0` SUBGOAL_TAC;
  REWRITE_TAC[EXP];
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  REP_BASIC_TAC;
  REWRITE_TAC[LT_EXP];
  UND 0;
  ARITH_TAC;
  ]);;
  (* }}} *)

let twopow_lt = 
prove_by_refinement(
  `!a b. (a < b) ==> (twopow a < twopow b)`,

  (* {{{ proof *)
  [
  ONCE_REWRITE_TAC [INT_ARITH `(a <: b) <=> (&:0 <: b -: a)`];
  ASSUME_TAC twopow_pos;
  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> &1*x < y`];
  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ];
  REWRITE_TAC[real_div];
  REWRITE_TAC[GSYM TWOPOW_INV;GSYM TWOPOW_ADD_INT;GSYM INT_SUB];
  REP_GEN_TAC;
  TYPE_THEN `C = b -: a` ABBREV_TAC ;
  ASSUME_TAC INT_REP2 ;
  TSPEC `C` 2;
  REP_BASIC_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  UND 2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[TWOPOW_POS];
  REDUCE_TAC;
  REWRITE_TAC[INT_OF_NUM_LT;exp_gt1];
  PROOF_BY_CONTR_TAC;
  UND 2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INT_ARITH `(~(&:0 <: --: y) <=> (&:0 <=: y))`];
  REWRITE_TAC[INT_OF_NUM_LE];
  ARITH_TAC;
  ]);;
  (* }}} *)

let compact_distance = 
prove_by_refinement(
  `!(X:A->bool) d K K'. (metric_space(X,d) /\
   ~(K=EMPTY) /\ ~(K' = EMPTY) /\
   (compact (top_of_metric(X,d)) K) /\ (compact(top_of_metric(X,d))K'))
   ==> (?p p'. (K p /\ K' p' /\ (!q q'. (K q /\ K' q') ==>
              (d p p' <= d q q'))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `UNIONS (top_of_metric(X,d)) = X` SUBGOAL_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  TYPE_THEN `K SUBSET X /\ K' SUBSET X` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[compact]);
  REWR 0;
  REWR 1;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `Y = { z | ?q q'. (K q /\ K' q' /\ (z = d q q'))}` ABBREV_TAC ;
  TYPE_THEN `!y. (Y y) ==> (&0 <= y)` SUBGOAL_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
  TYPEL_THEN [`q`;`q'`;`q'`] (USE 4 o ISPECL);
  ASM_MESON_TAC[metric_space;ISUBSET];
  REP_BASIC_TAC;
  (*  *)
  TYPE_THEN `~(Y= EMPTY)` SUBGOAL_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  UND 2;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `d u' u` EXISTS_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* inf Y *)
  TYPE_THEN `(!epsilon. (&0 < epsilon) ==> (?x. Y x /\ (x < inf Y + epsilon)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  inf_eps;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  ASSUME_TAC twopow_pos;
  TYPE_THEN `(!n. ?p. ?p'. K p /\ K' p' /\ (d p p' < inf Y + twopow( -- (&:n))))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `(?x. Y x /\ x < inf Y + twopow (--: (&:n)))` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UND 14;
  EXPAND_TAC "Y";
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  RIGHT 13 "n";
  REP_BASIC_TAC;
  (* compact,complete,totally bounded *)
  TYPE_THEN `metric_space (K,d) /\ metric_space(K',d)` SUBGOAL_TAC;
  ASM_MESON_TAC[metric_subspace];
  REP_BASIC_TAC;
  TYPE_THEN `compact (top_of_metric(K,d)) K /\ compact (top_of_metric(K',d)) K'` SUBGOAL_TAC;
  ASM_MESON_TAC[compact_subset];
  REP_BASIC_TAC;
  TYPE_THEN `complete (K,d)  /\ complete (K',d) ` SUBGOAL_TAC;
  ASM_MESON_TAC[compact_complete];
  REP_BASIC_TAC;
  TYPE_THEN `totally_bounded(K,d) /\ totally_bounded(K',d)` SUBGOAL_TAC;
  ASM_MESON_TAC[compact_totally_bounded;];
  REP_BASIC_TAC;
  (* construct subseq of p *)
  TYPE_THEN `(?ss. subseq ss /\ converge (K,d) (p o ss))` SUBGOAL_TAC;
  IMATCH_MP_TAC  convergent_subseq;
  ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  RIGHT 13 "p'";
  ASM_MESON_TAC[];
  REWRITE_TAC[converge];
  REP_BASIC_TAC;
  (* construct q *)
  TYPE_THEN `!n. ?p'. K' p' /\ d x p' < inf Y + twopow(--: (&:n))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TSPEC `twopow (--: (&:(SUC(n))))` 22;
  REP_BASIC_TAC;
  REWR 22;
  TSPEC  `SUC(n') + SUC (n)` 22;
  RULE_ASSUM_TAC (REWRITE_RULE[ARITH_RULE `x <=| SUC x +| y`]);
  TSPEC `ss (SUC n' +| SUC n)` 13;
  REP_BASIC_TAC;
  TYPE_THEN `twopow (--: (&:(ss(SUC n'+SUC n)))) < twopow(--: (&:(SUC n)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  twopow_lt;
  REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT;];
  IMATCH_MP_TAC (ARITH_RULE `(?t. (a <= t /\ t <| b)) ==> (a <| b)`);
  TYPE_THEN `ss (SUC n)` EXISTS_TAC;
  ASM_SIMP_TAC[SEQ_SUBLE;subseq];
  RULE_ASSUM_TAC (REWRITE_RULE[subseq]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `p'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC  (REWRITE_RULE[metric_space]);
  REP_BASIC_TAC;
  TYPEL_THEN [`x`;`p (ss (SUC n' +| SUC n))`;`p'`] (USE 4 o ISPECL);
  REP_BASIC_TAC;
  TYPE_THEN `X x /\ X (p (ss (SUC n' +| SUC n))) /\ X p'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  REWR 4;
  REP_BASIC_TAC;
  TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC;
  REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double];
  UND 4;
  UND 13;
  UND 27;
  UND 22;
  REWRITE_TAC[o_DEF];
  REAL_ARITH_TAC;
  DISCH_TAC;
  RIGHT 25 "n" ;
  REP_BASIC_TAC;
  (* take subseq of p' *)
  TYPE_THEN `(?ss'. subseq ss' /\ converge (K',d) (p' o ss'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  convergent_subseq;
  ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  ASM_MESON_TAC[];
  REWRITE_TAC[converge];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* now go in for the KILL.  *)
  (*   Show d x x' <= inf Y because d x x' < inf Y + eps *)
  (* [K] *)
  IMATCH_MP_TAC  (REAL_ARITH `(?t. (t <= y) /\ (x <= t)) ==> (x <= y)`);
  TYPE_THEN `inf Y` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `(!y. Y y ==> inf Y <= y)` SUBGOAL_TAC;
  ASM_MESON_TAC[inf_LB];
  DISCH_THEN IMATCH_MP_TAC ;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  TYPE_THEN `q` EXISTS_TAC;
  TYPE_THEN `q'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBGOAL_TAC  `!x y. (!e. (&0 <e) ==> (x < y + e)) ==> (x <= y)`;
  REP_GEN_TAC;
  DISCH_THEN (fun t -> MP_TAC (SPEC `x'' - y` t));
  REAL_ARITH_TAC;
  DISCH_THEN IMATCH_MP_TAC ;
  REP_BASIC_TAC;
  KILL 15;
  KILL 14;
  KILL 17;
  KILL 16;
  KILL 18;
  KILL 19;
  KILL 20;
  KILL 21;
  KILL 2;
  KILL 3;
  KILL 0;
  KILL 1;
  KILL 8;
  KILL 29;
  KILL 30;
  (* GEN needed inequalities *)
  (* [L] *)
  TYPE_THEN `?n. (&1)* twopow(--: (&:n)) < e` SUBGOAL_TAC;
  ASM_MESON_TAC[twopow_eps;REAL_ARITH `&0 < &1`];
  REDUCE_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC;
  REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double];
  REP_BASIC_TAC;
  TSPEC `twopow(--: (&:(SUC n)))` 26;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[twopow_pos]);

  TSPEC `SUC (n) + SUC n'` 2;
  USE 2(REWRITE_RULE[ARITH_RULE `a <=| b + SUC a`]);
  TSPEC `ss' (SUC n + SUC n')` 25;
  TYPE_THEN `twopow (--: (&:(ss' (SUC  n +| SUC n')))) < twopow (--: (&:(SUC n)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  twopow_lt;
  REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT ];
  IMATCH_MP_TAC  (ARITH_RULE  `(?t. (a <=| t /\ (t <| b)))    ==> (a <| b)`);
  TYPE_THEN `(ss' (SUC n) )` EXISTS_TAC;
  ASM_SIMP_TAC[SEQ_SUBLE];
  RULE_ASSUM_TAC (REWRITE_RULE[subseq]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ARITH_TAC;
  DISCH_TAC;
  REP_BASIC_TAC;
  (* metric space ineq *)
  TYPE_THEN `X x /\ X x' /\ X (p' (ss' (SUC n +| SUC n')))` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[o_DEF]);
  TYPE_THEN `r = p' (ss' (SUC n +| SUC n'))` ABBREV_TAC ;
  TYPE_THEN `d x' r = d r x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_symm;
  ASM_MESON_TAC[];
  TYPE_THEN `d x x' <= d x r + d r x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_triangle;
  ASM_MESON_TAC[];
  UND 0;
  UND 1;
  UND 2;
  UND 3;
  UND 8;
  REAL_ARITH_TAC;
  (* Fri Aug  6 11:54:33 EDT 2004 *)
  ]);;
  (* }}} *)

let max_real_le = 
prove_by_refinement(
  `!x y. x <= max_real x y  /\ y <= max_real x y `,

  (* {{{ proof *)
  [
  REWRITE_TAC[max_real];
  REP_GEN_TAC;
  COND_CASES_TAC;
  UND 0;
  REAL_ARITH_TAC;
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let min_real_le = 
prove_by_refinement(
  `!x y.  min_real x y <= x /\ min_real x y <= y`,

  (* {{{ proof *)
  [
  REWRITE_TAC[min_real];
  REP_GEN_TAC;
  COND_CASES_TAC;
  UND 0;
  REAL_ARITH_TAC;
  UND 0;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let finite_UB = 
prove_by_refinement(
  `!X. (FINITE X) ==> (?t. (!x. X x ==> x <=. t))`,

  (* {{{ proof *)
  [
  TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> x <= t))` SUBGOAL_TAC;
  INDUCT_TAC ;
  REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;];
  MESON_TAC[];
  REWRITE_TAC[HAS_SIZE_SUC];
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  TSPEC `X DELETE u` 0;
  TYPE_THEN `(?t. !x. (X DELETE u) x ==> x <= t)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `max_real t u` EXISTS_TAC;
  GEN_TAC;
  DISCH_TAC;
  TYPE_THEN `x = u` ASM_CASES_TAC;
  ASM_MESON_TAC[max_real_le];
  TSPEC `x` 3;
  RULE_ASSUM_TAC (REWRITE_RULE[DELETE]);
  ASM_MESON_TAC[max_real_le;REAL_LE_TRANS];
  REWRITE_TAC[HAS_SIZE];
  ASM_MESON_TAC[];
  (* Fri Aug  6 12:50:04 EDT 2004 *)
  ]);;
  (* }}} *)

let finite_LB = 
prove_by_refinement(
  `!X. (FINITE X) ==> (?t. (!x. X x ==> t <=. x))`,

  (* {{{ proof *)
  [
  TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> t <= x))` SUBGOAL_TAC;
  INDUCT_TAC ;
  REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;];
  MESON_TAC[];
  REWRITE_TAC[HAS_SIZE_SUC];
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  TSPEC `X DELETE u` 0;
  TYPE_THEN `(?t. !x. (X DELETE u) x ==> t <= x)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `min_real t u` EXISTS_TAC;
  GEN_TAC;
  DISCH_TAC;
  TYPE_THEN `x = u` ASM_CASES_TAC;
  ASM_MESON_TAC[min_real_le];
  TSPEC `x` 3;
  RULE_ASSUM_TAC (REWRITE_RULE[DELETE]);
  ASM_MESON_TAC[min_real_le;REAL_LE_TRANS];
  REWRITE_TAC[HAS_SIZE];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let finite_compact = 
prove_by_refinement(
  `!(X:A->bool) U. (FINITE X) /\ (X SUBSET UNIONS U) ==> (compact U X)`,

  (* {{{ proof *)
  [
  TYPE_THEN `!n (X:A->bool) U. (X HAS_SIZE n) /\ (X SUBSET UNIONS U) ==> (compact U X)` SUBGOAL_TAC;
  INDUCT_TAC;
  REWRITE_TAC[HAS_SIZE_0];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[compact];
  REP_BASIC_TAC;
  TYPE_THEN `EMPTY:(A->bool)->bool` EXISTS_TAC;
  REWRITE_TAC[FINITE_RULES];
  REWRITE_TAC[HAS_SIZE_SUC;EMPTY_EXISTS;compact ;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `X DELETE u HAS_SIZE n` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPEL_THEN [`X DELETE u`;`U`] (USE 0 o ISPECL);
  REP_BASIC_TAC;
  REWR 0;
  TYPE_THEN `X DELETE u SUBSET UNIONS U` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[SUBSET;DELETE];
  MESON_TAC[];
  DISCH_TAC;
  REWR 0;
  RULE_ASSUM_TAC (REWRITE_RULE[compact]);
  REP_BASIC_TAC;
  TSPEC `V` 0;
  REWR 0;
  TYPE_THEN `X DELETE u SUBSET UNIONS V` SUBGOAL_TAC;
  UND 6;
  REWRITE_TAC[SUBSET;DELETE];
  MESON_TAC[];
  DISCH_TAC;
  REWR 0;
  REP_BASIC_TAC;
  USE 6 (REWRITE_RULE[SUBSET;UNIONS]);
  TSPEC `u` 6;
  REWR 6;
  REP_BASIC_TAC;
  TYPE_THEN `u' INSERT W` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[INSERT_SUBSET];
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[FINITE_INSERT];
  REWRITE_TAC[UNIONS_INSERT];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `u' UNION (X DELETE u)` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;DELETE;UNION];
  ASM_MESON_TAC[];
  UND 0;
  REWRITE_TAC[UNION;SUBSET];
  MESON_TAC[];
  REWRITE_TAC[HAS_SIZE];
  MESON_TAC[];
  ]);;
  (* }}} *)

let compact_supm = 
prove_by_refinement(
  `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==>
          X (supm X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?x. X x /\ (!y. X y ==> y <= x))` SUBGOAL_TAC;
  IMATCH_MP_TAC  compact_sup;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(!x. X x ==> x <= supm X ) /\ (!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC;
  IMATCH_MP_TAC  supm_UB;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x = supm X` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `x <= supm X /\ supm X <= x ==> (x = supm X)`);
  TSPEC `x` 4;
  REWR 4;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];

  ]);;
  (* }}} *)

let compact_infm = 
prove_by_refinement(
  `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==>
          X (inf X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?x. X x /\ (!y. X y ==> x <= y))` SUBGOAL_TAC;
  IMATCH_MP_TAC  compact_inf;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(!x. X x ==> inf X <= x ) /\ (!y. (!x. X x ==> y <= x) ==> ( y <= inf X))` SUBGOAL_TAC;
  IMATCH_MP_TAC  inf_LB;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x = inf X` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `x <= inf X /\ inf X <= x ==> (x = inf X)`);
  TSPEC `x` 4;
  REWR 4;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* Fri Aug  6 13:45:50 EDT 2004 *)

  ]);;
  (* }}} *)

let finite_supm = 
prove_by_refinement(
  `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (supm X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_supm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  finite_compact;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;];
  ]);;
  (* }}} *)

let finite_inf = 
prove_by_refinement(
  `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (inf X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_infm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  finite_compact;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;];
  (* Fri Aug  6 13:49:38 EDT 2004 *)
  ]);;
  (* }}} *)

let finite_supm_max = 
prove_by_refinement(
  `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> x <= supm X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?t. !x. (X x ==> x <= t))` SUBGOAL_TAC;
  ASM_MESON_TAC[finite_UB];
  ASM_MESON_TAC[supm_UB];
  ]);;
  (* }}} *)

let finite_inf_min = 
prove_by_refinement(
  `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> inf X <= x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?t. !x. (X x ==> t <= x))` SUBGOAL_TAC;
  ASM_MESON_TAC[finite_LB];
  ASM_MESON_TAC[inf_LB];
  ]);;
  (* }}} *)

let bij_inj_image = 
prove_by_refinement(
  `!(f:A->B) X Y. (INJ f X Y /\ Y SUBSET IMAGE f X) ==>
      (BIJ f X Y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;BIJ;SURJ;SUBSET;IMAGE];
  MESON_TAC[];
  ]);;
  (* }}} *)

let suc_interval = 
prove_by_refinement(
  `!n. {x | x <| SUC n} = {x | x <| n} UNION {n}`,

  (* {{{ proof *)
  [
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[UNION;INR IN_SING;];
  ARITH_TAC;
  ]);;
  (* }}} *)

let inj_domain_sub = 
prove_by_refinement(
  `!(f:A->B) g X Y. (!x. (X x ==> (f x = g x))) ==> (INJ f X Y = INJ g X Y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let image_domain_sub = 
prove_by_refinement(
  `!(f:A->B) g X . (!x. (X x ==> (f x = g x))) ==> (IMAGE f X  = IMAGE g X)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let real_finite_increase = 
prove_by_refinement(
  `!X. ( (FINITE X) ==>
     (? u. (BIJ u {x | x <| CARD X} X) /\
        (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==>
         (u i <. u j)))))`,

  (* {{{ proof *)
  [
  TYPE_THEN `!n X. ( (X HAS_SIZE  n) ==> (? u. (BIJ u {x | x <| CARD X} X) /\  (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==> (u i <. u j)))))` SUBGOAL_TAC;
  INDUCT_TAC;
  REWRITE_TAC[HAS_SIZE_0];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[CARD_CLAUSES;BIJ;INJ;SURJ];
  REWRITE_TAC[ARITH_RULE `~(j <| 0)`];
  REP_BASIC_TAC;
  COPY 1;
  UND 1;
  REWRITE_TAC[HAS_SIZE_SUC;];
  REP_BASIC_TAC;
  TYPE_THEN `X (supm X)` SUBGOAL_TAC;
  IMATCH_MP_TAC  finite_supm;
  ASM_REWRITE_TAC[];
  KILL 0;
  USE 3(REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  TSPEC `u` 1;
  ASM_MESON_TAC[FINITE_DELETE;HAS_SIZE;];
  DISCH_TAC;
  TSPEC `supm X` 1;
  REWR 1;
  TSPEC `X DELETE supm X` 0;
  REWR 0;
  REP_BASIC_TAC;
  TYPE_THEN `v = (\j. if (j = n) then supm X else u j)` ABBREV_TAC ;
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `CARD (X DELETE supm X) = n` SUBGOAL_TAC;
  ASM_MESON_TAC[HAS_SIZE];
  DISCH_TAC;
  (* [th] *)
  TYPE_THEN `!x. ({x | x <| n} x ==> (v x = u x))` SUBGOAL_TAC;
  REWRITE_TAC[];
  EXPAND_TAC "v";
  GEN_TAC;
  COND_CASES_TAC;
  ASM_REWRITE_TAC[ARITH_RULE `~(n <| n)`];
  REWRITE_TAC[];
  DISCH_TAC;
    TYPE_THEN `INJ v {x | x <| n} X = INJ u {x | x <| n} X` SUBGOAL_TAC;
  IMATCH_MP_TAC  inj_domain_sub;
  UND 8;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `v n = supm X` SUBGOAL_TAC;
  EXPAND_TAC "v";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
    TYPE_THEN `IMAGE v {x | x <| n} = IMAGE u {x | x <| n}` SUBGOAL_TAC;
  IMATCH_MP_TAC  image_domain_sub;
  UND 8;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `IMAGE v {x | x <| n} = X DELETE supm X` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  UND 5;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[BIJ];
  alpha_tac;
  MESON_TAC[SURJ_IMAGE];
  DISCH_TAC;
  (* obligations *)
  CONJ_TAC;
  IMATCH_MP_TAC  bij_inj_image;
  CONJ_TAC;
  TYPE_THEN `{x | x <| CARD X} = {x | x <| n} UNION {n}` SUBGOAL_TAC;
  USE 2(REWRITE_RULE[HAS_SIZE]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[suc_interval];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  inj_split;
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;DELETE]);
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  UND 13;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INJ;SUBSET];
  MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[INJ;SUBSET;INR IN_SING];
  ASM_MESON_TAC[];
  REWRITE_TAC[EQ_EMPTY;INTER;image_sing;INR IN_SING;];
  KILL 11;
  ASM_REWRITE_TAC[DELETE;SUBSET;];
  MESON_TAC[];
  TYPE_THEN `X = supm X INSERT (X DELETE supm X)` SUBGOAL_TAC;
  ASM_SIMP_TAC[INR INSERT_DELETE];
  USE 2 (REWRITE_RULE[HAS_SIZE]);
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  REWRITE_TAC[INSERT_SUBSET];
  KILL 11;
  CONJ_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `n` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ARITH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `IMAGE v {x| x <| n}` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL];
  USE 12 GSYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  ARITH_TAC;
  REP_GEN_TAC;
  (* monotonicity [m] *)
  USE 2 (REWRITE_RULE[HAS_SIZE]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `(!x. X x ==> x <= supm X)` SUBGOAL_TAC;
  ASM_MESON_TAC[finite_supm_max];
  DISCH_TAC;
  TYPE_THEN `j = n` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `(v:num->real) i`));
  REWRITE_TAC[IMAGE;DELETE;];
  TSPEC  `(v i)` 13;
  UND 13;
  MESON_TAC[REAL_ARITH `a < b <=> (a<= b /\ ~(a = b))`];
  KILL 3;
  KILL 4;
  KILL 5;
  REP_BASIC_TAC;
  TYPE_THEN `~(i = n)` SUBGOAL_TAC;
  UND 2;
  UND 3;
  ARITH_TAC;
  REWR 0;
  DISCH_TAC;
  TYPE_THEN `i <| n /\ j <| n` SUBGOAL_TAC;
  UND 3;
  UND 4;
  UND 14;
  UND 16;
  ARITH_TAC;
  REP_BASIC_TAC;
  REWR 8;
  ASM_SIMP_TAC[];
  (* end *)
  REWRITE_TAC[HAS_SIZE];
  REP_BASIC_TAC;
  RIGHT 1 "n" ;
  TSPEC `X` 1;
  TSPEC `CARD X` 1;
  alpha_tac;
  ASM_MESON_TAC[];
  (* Fri Aug  6 19:51:16 EDT 2004 *)
  ]);;
  (* }}} *)

let connected_nogap = 
prove_by_refinement(
  `!A a b. connected (top_of_metric(UNIV,d_real)) A /\
          A a /\ A b ==>
       {x | a <= x /\ x <= b } SUBSET A`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(a = b) \/ (b < a) \/ (a < b)` SUBGOAL_TAC;
  REAL_ARITH_TAC;
  REP_CASES_TAC;
  ASM_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= b ==> (x = b)`];
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[REAL_ARITH `a <=x /\ x <= b ==> ~(b < a)`];
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `a < x` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `(a <= x /\ ~(a = x)) ==> a < x`);
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `x < b` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `(x <= b /\ ~(b = x)) ==> x < b`);
  ASM_MESON_TAC[];
  DISCH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[connected]);
  REP_BASIC_TAC;
  TYPEL_THEN [` {t | t < x}`;` {t | x < t}`] (USE 2 o SPECL);
  UND 2;
  REWRITE_TAC[half_open;half_open_above];
  TYPE_THEN `({t | t < x} INTER {t | x < t} = {}) /\ A SUBSET {t | t < x} UNION {t | x < t}` SUBGOAL_TAC;
  REWRITE_TAC[INTER;EQ_EMPTY;UNION;SUBSET;];
  REWRITE_TAC[REAL_ARITH `x' < x \/ x < x' <=> ~(x' = x)`];
  CONJ_TAC;
  REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[SUBSET;];
  ASM_MESON_TAC[REAL_ARITH `x < b ==> ~(b < x)`];
  (* Fri Aug  6 20:24:45 EDT 2004 *)

  ]);;
  (* }}} *)

let connected_open = 
prove_by_refinement(
  `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\
       (top_of_metric(UNIV,d_real) A) /\
       (~(A = EMPTY)) /\
       A SUBSET {x | a <= x /\ x <= b}) ==>
         ( A = {x | inf A < x /\ x < supm A})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ supm A - epsilon < x))` SUBGOAL_TAC;
  IMATCH_MP_TAC  supm_eps;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ x < inf A + epsilon))` SUBGOAL_TAC;
  IMATCH_MP_TAC  inf_eps;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(!x. A x ==> x <= supm A)` SUBGOAL_TAC;
  ASM_MESON_TAC[supm_UB];
  DISCH_TAC;
  TYPE_THEN `(!x. A x ==> inf A <= x)` SUBGOAL_TAC;
  ASM_MESON_TAC[inf_LB];
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  TYPE_THEN `!x. (A x  ==> ?e. &0 < e /\ open_ball(UNIV,d_real) x e SUBSET A)` SUBGOAL_TAC;
  UND 2;
  MP_TAC metric_real;
  MESON_TAC[open_ball_nbd];
  REWRITE_TAC[open_ball;d_real];
  DISCH_TAC;
  (*  *)
  TYPE_THEN `!x. A x ==> (?y. A y /\ ~(x <= y))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TSPEC  `x` 8;
  REWR 8;
  REP_BASIC_TAC;
  USE 8(REWRITE_RULE[SUBSET]);
  TYPE_THEN `x - e/(&2)` EXISTS_TAC;
  REWRITE_TAC[REAL_ARITH `~(x <= x - e/(&2)) <=> (&0 < e/(&2))`];
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[REAL_ARITH `(x - (x - t)) = t`];
  TYPE_THEN `abs  (e/(&2)) = (e/(&2))` SUBGOAL_TAC;
  REWRITE_TAC[REAL_ABS_REFL];
  IMATCH_MP_TAC  (REAL_ARITH `(a < b) ==> (a <= b)`);
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[REAL_LT_HALF2];
  DISCH_TAC;
  (*  *)
  TYPE_THEN `!x. A x ==> (?y. A y /\ ~(y <= x))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TSPEC  `x` 8;
  REWR 8;
  REP_BASIC_TAC;
  USE 8(REWRITE_RULE[SUBSET]);
  TYPE_THEN `x + e/(&2)` EXISTS_TAC;
  REWRITE_TAC[REAL_ARITH `~( x + e/(&2) <= x) <=> (&0 < e/(&2))`];
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[REAL_ARITH `(x - (x + t)) = --. t`];
  TYPE_THEN `abs (--. (e/(&2))) = (e/(&2))` SUBGOAL_TAC;
  REWRITE_TAC[REAL_ABS_REFL;ABS_NEG;];
  IMATCH_MP_TAC  (REAL_ARITH `(a < b) ==> (a <= b)`);
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[REAL_LT_HALF2];
  DISCH_TAC;
  (* FIRST direction *)
  CONJ_TAC;
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  REWRITE_TAC[REAL_ARITH `u < v  <=> (u <= v /\ ~(u = v))`];
  CONJ_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* 2 *)
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  TYPE_THEN `?a'. A a' /\ (a' < x)` SUBGOAL_TAC;
  TSPEC `x - inf A` 5;
  USE 5 (REWRITE_RULE[REAL_ARITH `&0 < x - y <=> (y < x)`;REAL_ARITH `t + x - t = x`]);
  REWR 5;
  DISCH_TAC;
  TSPEC `supm A - x` 4;
  USE 4(REWRITE_RULE[REAL_ARITH `&0 < y - x <=> (x < y)`;REAL_ARITH `t - (t -x) = x`]);
  REWR 4;
  REP_BASIC_TAC;
  TYPE_THEN `{t | a' <= t /\ t <= x'} SUBSET A` SUBGOAL_TAC;
  IMATCH_MP_TAC  connected_nogap;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_TAC;
  TSPEC `x` 16;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 4;
  UND 14;
  REAL_ARITH_TAC;
  (* Fri Aug  6 21:34:56 EDT 2004 *)

  ]);;
  (* }}} *)

let closure_real_set = 
prove_by_refinement(
  `!Z a.
     (closure(top_of_metric(UNIV,d_real)) Z a <=>
       (!e. (&0 < e) ==> (?z. Z z /\ (abs  (a - z) <= e))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `metric_space (UNIV,d_real) /\ Z SUBSET UNIV` SUBGOAL_TAC;
  REWRITE_TAC[metric_real;SUBSET_UNIV];
  DISCH_THEN (fun t -> MP_TAC (MATCH_MP closure_open_ball t));
  DISCH_THEN (fun t -> MP_TAC (AP_THM t `a:real`));
  REWRITE_TAC[];
  DISCH_THEN (fun t ->  REWRITE_TAC[GSYM t]);
  REWRITE_TAC[open_ball;d_real;];
  EQ_TAC;
  ASM_MESON_TAC[REAL_ARITH `a < b ==> a <= b`];
  REP_BASIC_TAC;
  TSPEC `r/(&2)` 1;
  RULE_ASSUM_TAC (REWRITE_RULE[REAL_LT_HALF1]);
  REWR 1;
  REP_BASIC_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  (REAL_ARITH `(a <= b/(&2)) /\ (b/(&2) < b)   ==> (a < b)`);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[half_pos];
  (* Sat Aug  7 08:14:28 EDT 2004 *)

  ]);;
  (* }}} *)

let real_div_assoc = 
prove_by_refinement(
  `!a b c. (a*b)/c = a*(b/c)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[real_div;REAL_MUL_AC;];
  ]);;
  (* }}} *)

let real_middle1_lt = 
prove_by_refinement(
  `!a b. (a < b) ==> a < (a + b)/(&2) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(&2*a)/(&2) < (a+b)/(&2)` SUBGOAL_TAC;
  ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`];
  REWRITE_TAC[REAL_MUL_2];
  UND 0;
  REAL_ARITH_TAC;
  REWRITE_TAC[real_div_assoc];
  ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`];
  ]);;
  (* }}} *)

let real_middle2_lt = 
prove_by_refinement(
  `!a b. (a < b) ==>  (a + b)/(&2) < b `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN ` (a+b)/(&2) < (&2*b)/(&2)` SUBGOAL_TAC;
  ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`];
  REWRITE_TAC[REAL_MUL_2];
  UND 0;
  REAL_ARITH_TAC;
  REWRITE_TAC[real_div_assoc];
  ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`];
  ]);;
  (* }}} *)

let real_sub_half = 
prove_by_refinement(
  `!a b. (a - (a + b)/(&2) = (a - b)/(&2))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `((&2*a)/(&2) - (a+b)/(&2) = (a - b)/(&2))` SUBGOAL_TAC;
  REWRITE_TAC[real_div;GSYM REAL_SUB_RDISTRIB];
  REWRITE_TAC[REAL_EQ_RMUL_IMP];
  AP_THM_TAC;
  AP_TERM_TAC;
  REWRITE_TAC[REAL_MUL_2];
  REAL_ARITH_TAC;
  ASM_SIMP_TAC[REAL_ARITH `~(&2 = &0)`;REAL_DIV_LMUL;real_div_assoc];
  ]);;
  (* }}} *)

let closure_open_interval = 
prove_by_refinement(
  `!a b. (a < b) ==>
      (closure (top_of_metric(UNIV,d_real)) {x | a < x /\ x < b} =
       {x | a <= x /\ x <= b}) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  closure_subset;
  ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real];
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  (* 2 *)
  TYPE_THEN `{x | a <= x /\ x <= b} = a INSERT (b INSERT {x | a < x /\ x < b})` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INSERT];
  GEN_TAC;
  UND 0;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[INSERT_SUBSET];
  ASM_SIMP_TAC[top_of_metric_top;metric_real;subset_closure;];
  (* USE closure_real_set *)
  REWRITE_TAC[closure_real_set];
  TYPE_THEN `!e. (&0 < e) ==> (a + e < b) \/ ((b - a)/(&2) < e)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  ASM_CASES_TAC `(a + e < b)`;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  (REAL_ARITH `(x <= y/(&2) /\ y/(&2) < y)  ==> (x < y)`);
  ASM_SIMP_TAC [half_pos];
  ASM_SIMP_TAC[REAL_LE_DIV2_EQ;REAL_ARITH `&0 < &2`];
  UND 2;
  REAL_ARITH_TAC;
  DISCH_ALL_TAC;
  (* 1 *)
  CONJ_TAC;
  REP_BASIC_TAC;
  TSPEC `e` 1;
  REWR 1;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `a + e` EXISTS_TAC;
  REWRITE_TAC[REAL_ARITH `(a < a + e <=> &0 < e) /\ (a - (a + e) = --. e)`];
  ASM_REWRITE_TAC[ABS_NEG;];
  IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
  REWRITE_TAC[REAL_ABS_REFL];
  UND 2;
  REAL_ARITH_TAC;
  (* 2 *)
  REP_BASIC_TAC;
  TYPE_THEN `(a + b)/(&2)` EXISTS_TAC;
  ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
  UND 3;
  UND 0;
  REWRITE_TAC[real_div;ABS_MUL];
  ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(a - b) = (b-a))`];
  TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC;
  REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REAL_ARITH_TAC;
  (* 3 *)
  REP_BASIC_TAC;
  TSPEC `e` 1;
  REWR 1;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `b - e` EXISTS_TAC;
  REWRITE_TAC[REAL_ARITH `(b - e < b <=> &0 < e) /\ (b - (b - e) =  e)`];
  REWRITE_TAC[REAL_ARITH `(a < b - e) <=> (a + e < b)`];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
  REWRITE_TAC[REAL_ABS_REFL];
  UND 2;
  REAL_ARITH_TAC;
  (* 4 *)
  REP_BASIC_TAC;
  TYPE_THEN `(b + a)/(&2)` EXISTS_TAC;
  ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
  ONCE_REWRITE_TAC [REAL_ARITH `(a + b) = (b + a)`];
  ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
  UND 3;
  UND 0;
  REWRITE_TAC[real_div;ABS_MUL];
  ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(b - a) = (b-a))`];
  TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC;
  REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REAL_ARITH_TAC;
  (* Sat Aug  7 09:45:29 EDT 2004 *)
  ]);;
  (* }}} *)

let interval_subset  = 
prove_by_refinement(
  `!a b c d. {x | a <= x /\ x <= b} SUBSET  {x | c <= x /\ x <= d} <=>
      (b < a) \/ ((c <= a ) /\ (b <= d))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET ];
  REP_BASIC_TAC;
  ASM_CASES_TAC `b < a` ;
  ASM_REWRITE_TAC[];
  UND 0;
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `a` (WITH 1 o SPEC);
  TYPE_THEN `b` (USE 1 o SPEC);
  UND 0;
  UND 1;
  UND 2;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let subset_antisym_eq = 
prove_by_refinement(
  `!(A:A->bool) B. (A = B) <=> (A SUBSET B /\ B SUBSET A) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;FUN_EQ_THM ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let interval_eq = prove_by_refinement(
(**** Parens added by JRH for real right associativity of =
  `!a b c d. {x | a <= x /\ x <= b} =  {x | c <= x /\ x <= d} =
      ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`,
 ****)
  `!a b c d. ({x | a <= x /\ x <= b} =  {x | c <= x /\ x <= d}) <=>
      ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`,
  (* {{{ proof *)
  [
  REWRITE_TAC[subset_antisym_eq;interval_subset;];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let connected_open_closure = 
prove_by_refinement(
  `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\
       (top_of_metric(UNIV,d_real) A) /\
    (closure (top_of_metric(UNIV,d_real)) A = {x | a <= x /\ x <= b}) ==>
    (A = { x | a < x /\ x < b }))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* deal WITH emptyset *)
  TYPE_THEN `A = EMPTY` ASM_CASES_TAC;
  REWR 0;
  UND 0;
  ASM_SIMP_TAC[top_of_metric_top;metric_real;closure_empty;];
  DISCH_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  GEN_TAC;
  FIRST_ASSUM (fun t -> MP_TAC (AP_THM t `x:real`));
  REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* deal WITH containment *)
  TYPE_THEN `A SUBSET {x | a <= x /\ x <= b}` SUBGOAL_TAC;
  USE 0 SYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_closure;
  ASM_SIMP_TAC[top_of_metric_top;metric_real];
  DISCH_TAC;
  (* quote previous result *)
  TYPE_THEN `( A = {x | inf A < x /\ x < supm A})` SUBGOAL_TAC;
  IMATCH_MP_TAC  connected_open;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* now USE the closure of an open interval is the closed interval *)

  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  UND 3;
  REWRITE_TAC[];
  ASM ONCE_REWRITE_TAC [];
  REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `inf A < supm A` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_TAC;
  USE 7(MATCH_MP closure_open_interval);
  UND 6;
  UND 0;
  REWRITE_TAC[];
  ASM ONCE_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  USE 0(REWRITE_RULE[interval_eq]);
  FIRST_ASSUM DISJ_CASES_TAC;
  UND 8;
  UND 3;
  UND 6;
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  (* Sat Aug  7 10:38:12 EDT 2004 *)

  ]);;
  (* }}} *)

(* Sat Aug  7 11:01:27 EDT 2004 *)

let closed_ball_empty = 
prove_by_refinement(
  `!n a r. (r < &0) ==> (closed_ball(euclid n,d_euclid) a r = EMPTY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed_ball;EQ_EMPTY;];
  ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> ~(r < &0)`];
  ]);;
  (* }}} *)

let closed_ball_pt = 
prove_by_refinement(
  `!n a. (closed_ball(euclid n,d_euclid) a (&0) SUBSET {a})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed_ball;SUBSET;INR IN_SING;];
  ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;REAL_ARITH `(x <= &0 /\ &0 <= x) ==> (x = &0)`];
  ]);;
  (* }}} *)

let closed_ball_subset_open = 
prove_by_refinement(
  `!n a r. ?r'. closed_ball(euclid n,d_euclid) a r SUBSET
      open_ball(euclid n,d_euclid) a r'`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[closed_ball;open_ball;SUBSET ];
  TYPE_THEN `r + &1` EXISTS_TAC;
  MESON_TAC[ REAL_ARITH `(u <= r) ==> (u < r + &1)`];
  ]);;
  (* }}} *)

let closed_ball_compact = 
prove_by_refinement(
  `!n a r.  (compact (top_of_metric(euclid n,d_euclid))
        (closed_ball(euclid n,d_euclid) a r)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `closed_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC;
  REWRITE_TAC[closed_ball;SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `open_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC;
  REWRITE_TAC[open_ball;SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  ASM_SIMP_TAC[compact_euclid;closed_ball_closed;metric_euclid;];
  REWRITE_TAC[metric_bounded];
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `r + &1`EXISTS_TAC;
  REWRITE_TAC[open_ball;SUBSET;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  UND 2;
  REWRITE_TAC[closed_ball];
  REP_BASIC_TAC;
  TYPE_THEN `d_euclid a a = &0` SUBGOAL_TAC;
  ASM_MESON_TAC[d_euclid_zero];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> &0 <= r`;REAL_ARITH `u <= r ==> (u < r + &1)`];
  (* Sat Aug  7 12:15:05 EDT 2004 *)

  ]);;
  (* }}} *)

let set_dist = jordan_def
  `set_dist d (K:A->bool) (K':B->bool) =
       inf { z | (?p p'. (K p /\ K' p' /\ (z = d p p')))}`;;

let set_dist_inf = 
prove_by_refinement(
  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
      (K' SUBSET X) ==>
    (!p p'. (K p /\ K' p' ==> (set_dist d K K' <= d p p')))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[set_dist];
  REP_BASIC_TAC;
  TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
  TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
  GEN_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `Y (d p p')` SUBGOAL_TAC;

  EXPAND_TAC "Y";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;

  TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
  CONJ_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `d p p'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let set_dist_nn = 
prove_by_refinement(
  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
     ~(K = EMPTY) /\      ~(K' = EMPTY) /\
      (K' SUBSET X) ==> (&0 <= set_dist d K K')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[set_dist];
  REP_BASIC_TAC;
  TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
  TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
  REP_BASIC_TAC;
  UND 6;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `~(Y = {})` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  TYPE_THEN `d u' u` EXISTS_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let set_dist_eq = 
prove_by_refinement(
  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
     ~(K = EMPTY) /\      ~(K' = EMPTY) /\
    (compact (top_of_metric(X,d)) K) /\
    (compact (top_of_metric (X,d)) K') /\
      (K' SUBSET X) ==>
    (?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[set_dist];
  REP_BASIC_TAC;
  TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
  TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
  REP_BASIC_TAC;
  UND 8;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  TYPE_THEN `~(Y = {})` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  TYPE_THEN `d u' u` EXISTS_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
  TYPE_THEN `(?p p'. K p /\ K' p' /\ (!q q'. K q /\ K' q' ==> d p p' <= d q q'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  compact_distance;
  TYPE_THEN `X` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  TYPE_THEN `p'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* 1 *)
  TYPE_THEN `Y (d p p')` SUBGOAL_TAC;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `a <= b /\ b <= a ==> (a = b)`);
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  EXPAND_TAC "Y";
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Sat Aug  7 13:19:01 EDT 2004 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION L *)
(* ------------------------------------------------------------------ *)


let simple_arc_compact = 
prove_by_refinement(
  `!C. simple_arc top2 C ==> compact top2 C`,

  (* {{{ proof *)

  [
  REWRITE_TAC[simple_arc];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  image_compact;
  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[inj_image_subset;interval_compact;];
  (* Sat Aug  7 12:24:22 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_nonempty = 
prove_by_refinement(
  `!C. simple_arc top2 C ==> ~(C = EMPTY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc;EMPTY_EXISTS;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[IMAGE;];
  TYPE_THEN `f (&0)` EXISTS_TAC;
  TYPE_THEN `&0` EXISTS_TAC;
  REWRITE_TAC[];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let graph_edge_compact = 
prove_by_refinement(
  `!G e. (plane_graph G) /\ (graph_edge G e) ==>
      (compact top2 e)`,

  (* {{{ proof *)
  [
  REWRITE_TAC [plane_graph];
  REP_BASIC_TAC;
  USE 3 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[simple_arc_compact];
  ]);;
  (* }}} *)

let graph_vertex_exist = 
prove_by_refinement(
  `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==>
   (?v. graph_vertex G v)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC;
  ASM_SIMP_TAC[graph_inc_subset];
  DISCH_TAC;
  TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC;
  ASM_SIMP_TAC[graph_edge2;];
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  REWR 2;
  UND 2;
  REWRITE_TAC[SUBSET ;INR in_pair ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let graph_vertex_2 = 
prove_by_refinement(
  `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==>
   (?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[EMPTY_EXISTS];
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC;
  ASM_SIMP_TAC[graph_inc_subset];
  DISCH_TAC;
  TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC;
  ASM_SIMP_TAC[graph_edge2;];
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  REWR 2;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC ;
  UND 2;
  REWRITE_TAC[SUBSET ;INR in_pair ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let graph_disk_lemma1 = 
prove_by_refinement(
  `!G. plane_graph G /\ FINITE (graph_vertex G) /\ FINITE (graph_edge G)
       ==>
    FINITE {z | (?e v. graph_edge G e /\ graph_vertex G v /\
              ~(graph_inc G e v) /\ (z = (e,v)))}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `Y = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) /\ (z = (e,v)))}` ABBREV_TAC ;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `{(e,v) | graph_edge G e /\ graph_vertex G v}` EXISTS_TAC;
  TYPEL_THEN [`graph_edge G `;`graph_vertex G `] (fun t -> ASSUME_TAC (ISPECL t FINITE_PRODUCT));
  REWR 4;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "Y";
  REWRITE_TAC[SUBSET];
 MESON_TAC[];
  (* Sat Aug  7 14:21:19 EDT 2004 *)

    ]);;
  (* }}} *)

let image_empty = 
prove_by_refinement(
  `!(A:A->bool) (f:A->B). (IMAGE f A = EMPTY) <=> (A = EMPTY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[IMAGE;FUN_EQ_THM;];
  MESON_TAC[];
  ]);;
  (* }}} *)

(* not used *)
let pair_apply = 
prove_by_refinement(
  `!P. (!x. P x) <=> ! (u:A) (v:B) . P (u,v)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  TSPEC `(u,v)` 0;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPEL_THEN [`FST x`;`SND x`] (USE 0 o ISPECL);
  USE 0(REWRITE_RULE[]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let set_dist_pos = 
prove_by_refinement(
  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
     ~(K = EMPTY) /\      ~(K' = EMPTY) /\
    (compact (top_of_metric(X,d)) K) /\
    (compact (top_of_metric (X,d)) K') /\ (K INTER K' = EMPTY) /\
      (K' SUBSET X) ==>
    (&0 < (set_dist d K K' ))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  (REAL_ARITH  `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`);
  CONJ_TAC;
  TYPE_THEN `(?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  set_dist_eq;
  TYPE_THEN `X` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `p = p'` SUBGOAL_TAC;
  REWR 9;
  TYPE_THEN `X p /\ X p'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  USE 9 SYM;
  REP_BASIC_TAC;
  UND 9;
  ASM_MESON_TAC  [metric_space_zero2];
  UND 1;
  UND 10;
  UND 11;
  REWRITE_TAC[EQ_EMPTY;INTER;];
  MESON_TAC[];
  IMATCH_MP_TAC  set_dist_nn;
  TYPE_THEN `X` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let closed_ball_inter = 
prove_by_refinement(
  `!(x:A) y r r' X d. (metric_space(X,d) /\
    ~(closed_ball(X,d) x r INTER closed_ball(X,d) y r' = EMPTY) ==>
   (d x y <= r + r'))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[closed_ball;EMPTY_EXISTS;INTER];
  REP_BASIC_TAC;
  TYPE_THEN `d x y <= d x u + d u y` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_triangle;
  ASM_MESON_TAC[];
  TYPE_THEN `d u y = d y u` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_symm;
  ASM_MESON_TAC[];
  UND 0;
  UND 3;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let graph_disk = 
prove_by_refinement(
  `!G. plane_graph G /\
       FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
     ~(graph_edge G = EMPTY)
      ==> (?r. (&0 < r ) /\
     (!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==>
        (closed_ball (euclid 2,d_euclid) v r INTER
            closed_ball (euclid 2,d_euclid) v' r = EMPTY)) /\
     (!e v. (graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) ==>
           (e INTER closed_ball (euclid 2,d_euclid) v r = EMPTY) )))`,

  (* {{{ proof *)

  [
    REP_BASIC_TAC;
  (* A' *)
  TYPE_THEN `A = { (v,v') |  (graph_vertex G v) /\ graph_vertex G v' /\ ~(v = v') }` ABBREV_TAC ;
  TYPE_THEN `FINITE A` SUBGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `{ (v,v') | (graph_vertex G v) /\ graph_vertex G v'}` EXISTS_TAC;
  TYPEL_THEN  [`graph_vertex G`;`graph_vertex G`] (fun t-> ASSUME_TAC (ISPECL   t FINITE_PRODUCT));
  REWR 5;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "A";
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `A' = IMAGE  (\ (v,v'). (d_euclid v v')/(&2)) A` ABBREV_TAC ;
  TYPE_THEN `FINITE A'` SUBGOAL_TAC;
  EXPAND_TAC "A'";
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* [B] *)
  TYPE_THEN `B = { (e,v) | graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) }` ABBREV_TAC ;
  TYPE_THEN `B' = IMAGE (\ (e,v). (set_dist d_euclid {v} e)) B`  ABBREV_TAC ;
  TYPE_THEN `FINITE B'` SUBGOAL_TAC;
  EXPAND_TAC "B'";
  IMATCH_MP_TAC  FINITE_IMAGE;
  TYPE_THEN `B = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~( graph_inc G e v) /\ (z = (e,v)))}` SUBGOAL_TAC;
  EXPAND_TAC "B";
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  graph_disk_lemma1;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* [C] : A' B' C nonempty *)
  TYPE_THEN `C' = A' UNION B'` ABBREV_TAC ;
  TYPE_THEN `FINITE C' /\ ~(C' = EMPTY)` SUBGOAL_TAC;
  EXPAND_TAC "C'";
  ASM_REWRITE_TAC[FINITE_UNION];
  EXPAND_TAC "C'";
  REWRITE_TAC[EMPTY_EXISTS;UNION;];
  TYPE_THEN `~(A' = EMPTY)` SUBGOAL_TAC;
  EXPAND_TAC "A'";
  REWRITE_TAC[image_empty; ];
  TYPE_THEN `(?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))` SUBGOAL_TAC;
  IMATCH_MP_TAC graph_vertex_2;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[plane_graph];
  REP_BASIC_TAC;
  UND 12;
  REWRITE_TAC[];
  EXPAND_TAC "A";
  REWRITE_TAC[EMPTY_EXISTS];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `v'` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  MESON_TAC[];
  DISCH_TAC;
  (* [D]:  C(inf C) *)
  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
  UND 3;
  REWRITE_TAC[plane_graph];
  MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `C'(inf C')` SUBGOAL_TAC;
  IMATCH_MP_TAC  finite_inf;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!x. C' x ==> (inf C' <= x)` SUBGOAL_TAC;
  IMATCH_MP_TAC  finite_inf_min;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!v. (graph_vertex G v ==> compact top2 {v})` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_point;
  UND 13;
  REWRITE_TAC[SUBSET;top2_unions];
  UND 12;
  MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!e. (graph_edge G e ==> compact top2 e)` SUBGOAL_TAC;
  ASM_MESON_TAC[graph_edge_compact];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!x. A' x <=> (?v' v''. graph_vertex G v' /\ graph_vertex G v'' /\  ~(v' = v'') /\ (x = d_euclid v' v'' / &2))` SUBGOAL_TAC;
  EXPAND_TAC "A'";
  EXPAND_TAC "A";
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x'");
(*** Next steps removed by JRH: now paired beta-conversion automatic ***)
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!x. B' x <=> (?e' v'. graph_edge G e' /\ graph_vertex G v' /\  ~(graph_inc G e' v') /\ (x = set_dist d_euclid {  v' } e'))`
  SUBGOAL_TAC;
  EXPAND_TAC "B'";
  EXPAND_TAC "B";
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x'");
(*** Next steps removed by JRH: now paired beta-conversion automatic ***)
  DISCH_TAC;
  (* -- [temp] *)
  TYPE_THEN `!x. C' x ==> (&0 < x)` SUBGOAL_TAC;
  EXPAND_TAC "C'";
  REWRITE_TAC[UNION];
  GEN_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  UND 20;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  IMATCH_MP_TAC  (REAL_ARITH `(&0 <= y /\ ~(y = &0) ) ==> &0 < y `);
  TYPE_THEN `euclid 2 v' /\ euclid 2 v''` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  UND 20;
  ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;];
  (* -2-  *)
  UND 20;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  set_dist_pos;
  TYPE_THEN `euclid 2` EXISTS_TAC ;
  REWRITE_TAC[metric_euclid;single_subset];
  CONJ_TAC;
  UND 13;
  REWRITE_TAC[SUBSET];
  UND 21;
  MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[EMPTY_EXISTS;INR IN_SING;];
  MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_nonempty;
  UND 3;
  UND 22;
  REWRITE_TAC[plane_graph;SUBSET;];
  MESON_TAC[];
  REWRITE_TAC[GSYM top2];
  ASM_SIMP_TAC[];
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TSPEC `e'` 25;
  REWR 25;
  TYPE_THEN `v'` (fun u -> FIRST_ASSUM (fun t-> (MP_TAC (AP_THM t u))));
  ASM_REWRITE_TAC[EQ_EMPTY;];
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[INR IN_SING;];
  MESON_TAC[];
  UND 22;
  UND 17;
  REWRITE_TAC[compact;top2_unions];
  MESON_TAC[];
  DISCH_TAC;
  (* [E] r good for A' *)
  TYPE_THEN `?r. (&0 < r /\ r < inf C')` SUBGOAL_TAC;
  TYPE_THEN `inf C' /(&2)` EXISTS_TAC;
  IMATCH_MP_TAC  half_pos;
  UND 20;
  UND 14;
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `A' ((d_euclid v v')/(&2))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -2- *)
  TYPE_THEN `r < ((d_euclid v v')/(&2))` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `(?t . (r < t /\ t <= u)) ==> (r < u)`);
  TYPE_THEN `inf C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  EXPAND_TAC "C'";
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWRITE_TAC[EQ_EMPTY ;INTER;];
  REP_BASIC_TAC;
  (* -2- triangle ineq *)
  UND 29;
  UND 30;
  UND 28;
  UND 21;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REP_BASIC_TAC;
  (* [* temp] *)
  TYPE_THEN `d_euclid v v' <= r + r` SUBGOAL_TAC;
  IMATCH_MP_TAC  closed_ball_inter;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  REWRITE_TAC[INTER;EMPTY_EXISTS ;metric_euclid;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `d_euclid v v' < d_euclid v v'/(&2) + d_euclid v v'/(&2)` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `(?t. (d <= t + t /\ t < u)) ==> (d < u + u)`);
  TYPE_THEN `r` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_HALF_DOUBLE];
  REAL_ARITH_TAC;
  (* [F] good for B' *)
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER;]);
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `B' (set_dist d_euclid {v} e)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `r < set_dist d_euclid {v} e` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `(?t. (r < t /\ t <= q)) ==> (r < q)`);
  TYPE_THEN `inf C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  EXPAND_TAC "C'";
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `(!p p'. ({v} p /\ e p' ==> (set_dist d_euclid {v} e <= d_euclid p p')))` SUBGOAL_TAC;
  IMATCH_MP_TAC  set_dist_inf;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_euclid;single_subset;];
  CONJ_TAC;
  UND 13;
  UND 25;
  MESON_TAC[ISUBSET];
  UND 17;
  UND 26;
  REWRITE_TAC[compact;top2_unions;];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `set_dist d_euclid {v} e <= d_euclid v u` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[INR IN_SING];
  TYPE_THEN `d_euclid v u <= r` SUBGOAL_TAC;
  UND 27;
  REWRITE_TAC[closed_ball];
  MESON_TAC[];
  UND 30;
  REAL_ARITH_TAC;
  (* Sat Aug  7 21:33:13 EDT 2004 *)

  ]);;

  (* }}} *)

let norm2 = jordan_def `norm2 x = d_euclid x euclid0`;;

let cis = jordan_def `cis x = point(cos(x),sin(x))`;;

let norm2_cis = 
prove_by_refinement(
  `!x. norm2(cis(x)) = &1`,

  (* {{{ proof *)
  [
  REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point];
  REDUCE_TAC;
  ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`];
  REWRITE_TAC[SIN_CIRCLE;SQRT_1];
  (* Sat Aug  7 21:47:16 EDT 2004 *)
  ]);;
  (* }}} *)

let norm2_nn = 
prove_by_refinement(
  `!x . (euclid 2 x) ==> &0 <= norm2 x`,

  (* {{{ proof *)
  [
  REWRITE_TAC[norm2;euclid0_point];
  ASM_MESON_TAC[d_euclid_pos;euclid_point];
  (* Sat Aug  7 21:52:31 EDT 2004 *)

  ]);;
  (* }}} *)

let norm2_0 = 
prove_by_refinement(
  `!x. (euclid 2 x) /\ (norm2 x = &0) <=> (x = euclid0)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  EQ_TAC;
  REWRITE_TAC[norm2;euclid0_point;];
  MESON_TAC[d_euclid_zero;euclid_point];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[euclid0_point;euclid_point;norm2;];
  ASM_MESON_TAC[d_euclid_zero;euclid_point];
  (* Sat Aug  7 21:59:11 EDT 2004 *)
  ]);;
  (* }}} *)

let cis_inj = 
prove_by_refinement(
  `!t t'. (&0 <= t /\ t < &2*pi) /\ (&0 <= t' /\ t' < &2*pi) ==>
      ((cis t = cis t') <=> (t = t'))`,

  (* {{{ proof *)
  [
  (* A trivial direction *)
  REP_BASIC_TAC;
  REWRITE_TAC[cis;point_inj;PAIR_SPLIT ];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  EQ_TAC;
  DISCH_THEN_REWRITE;
  (* B  range of s *)
  REP_BASIC_TAC;
  TYPE_THEN `s = (\t. (if (t < pi) then t else ((&2)*pi - t)))` ABBREV_TAC ;
  TYPE_THEN `!t. (&0 <= t /\ t < (&2 * pi)) ==> (&0 <= s t /\ s t <= pi)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "s";
  COND_CASES_TAC;
  UND 9;
  UND 8;
  REAL_ARITH_TAC;
  CONJ_TAC;
  UND 7;
  REAL_ARITH_TAC;
  REWRITE_TAC[REAL_MUL_2;];
  UND 9;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* [C] : cos (s t) *)
  TYPE_THEN `!t. cos (s t) = cos t` SUBGOAL_TAC;
  EXPAND_TAC "s";
  GEN_TAC;
  COND_CASES_TAC;
  REWRITE_TAC[];
  REWRITE_TAC  [REAL_ARITH `x - t = (--. t + x)`;COS_PERIODIC;COS_NEG];
  DISCH_TAC;
  (* D : (s t) = (s t') *)
  TYPE_THEN `(s t= s t') ==> ((t = t') \/ (t' = (&2 * pi - t)))` SUBGOAL_TAC;
  EXPAND_TAC "s";
  COND_CASES_TAC;
  COND_CASES_TAC;
  MESON_TAC[];
  REAL_ARITH_TAC;
  COND_CASES_TAC;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* E : show s t = s t' *)
  USE 8 GSYM;
  UND 5;
  (ASM ONCE_REWRITE_TAC []);
  DISCH_THEN (fun t -> MP_TAC (AP_TERM `acs` t));
  DISCH_TAC;
  TYPE_THEN `s t = s t'` SUBGOAL_TAC;
  TYPE_THEN `acs (cos (s t)) = s t` SUBGOAL_TAC;
  IMATCH_MP_TAC  COS_ACS;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `acs (cos (s t')) = s t'` SUBGOAL_TAC;
  IMATCH_MP_TAC  COS_ACS;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 9;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  UND 4;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[(REAL_ARITH `x - y = -- y + x`);SIN_PERIODIC ;SIN_NEG ;];
  REWRITE_TAC [(REAL_ARITH `(x = --x) <=> (x = &0)`)];
  REWRITE_TAC[SIN_ZERO_PI];
  PROOF_BY_CONTR_TAC;
  USE 4 (REWRITE_RULE[]);
  (* now t is a MULT of pi, finish *)
  FIRST_ASSUM DISJ_CASES_TAC;
  REP_BASIC_TAC;
  UND 2;
  ASM_REWRITE_TAC[];
  ASSUME_TAC PI_POS;
  ASM_SIMP_TAC[REAL_LT_RMUL_EQ];
  REWRITE_TAC  [REAL_LT];
  REWRITE_TAC[ARITH_RULE  `n <| 2 <=> (n = 0) \/ (n =1)`];
  DISCH_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  REWR 13;
  REWR 11;
  UND 0;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  UND 12;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  UND 3;
  ASM_REWRITE_TAC[];
  ASSUME_TAC PI_POS;
  REWRITE_TAC[REAL_ARITH (` ~(&0 <= -- x) <=> (&0 <. x) `)];
  IMATCH_MP_TAC  REAL_LT_MUL;
  ASM_REWRITE_TAC[REAL_LT ];
  REWRITE_TAC[ARITH_RULE  `0 <| n <=> ~(n = 0)`];
  DISCH_TAC;
  UND 0;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* Sun Aug  8 08:42:13 EDT 2004 *)

  ]);;
  (* }}} *)

let norm2_scale_cis = 
prove_by_refinement(
  `!x r. norm2(r *# cis(x)) = abs (r)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;];
  REDUCE_TAC;
  REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB];
  ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`];
  REWRITE_TAC[SIN_CIRCLE;REAL_MUL_RID;POW_2_SQRT_ABS];
  (* Sun Aug  8 08:46:56 EDT 2004 *)

  ]);;
  (* }}} *)

let norm2_scale = 
prove_by_refinement(
  `!x r. (euclid 2 x) ==> (norm2(r *# x) = abs (r)*norm2(x))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?u v. (x = point(u,v))` SUBGOAL_TAC;
  USE 0 (MATCH_MP point_onto);
  REP_BASIC_TAC;
  TYPE_THEN `FST p` EXISTS_TAC;
  TYPE_THEN `SND p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;];
  REDUCE_TAC;
  REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB];
  REWRITE_TAC[GSYM POW_2_SQRT_ABS];
  IMATCH_MP_TAC  SQRT_MUL;
  REWRITE_TAC[REAL_LE_SQUARE_POW];
  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`);
  REWRITE_TAC[REAL_LE_SQUARE_POW];

  ]);;
  (* }}} *)

let polar_inj = 
prove_by_refinement(
  `!x x' r r'. (&0 <= r) /\ (&0 <= r') /\ (&0 <= x) /\ (&0 <= x') /\
     (x < &2 *pi) /\ (x' < &2 * pi) /\ (r *# cis(x) = r' *# cis(x')) ==>
     ((r = &0) /\ (r' = &0)) \/ ((r = r') /\ (x = x'))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `abs  r = abs  r'` SUBGOAL_TAC;
  FIRST_ASSUM (fun t -> MP_TAC (AP_TERM `norm2` t));
  REWRITE_TAC[norm2_scale_cis];
  DISCH_TAC;
  TYPE_THEN `r' = r` SUBGOAL_TAC;
  ASM_MESON_TAC[ABS_REFL];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  ASM_CASES_TAC `(r = &0)` ;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REWR 0;
  TYPE_THEN `cis x = cis x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  euclid_scale_cancel;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[cis_inj];
  ]);;
  (* }}} *)

let norm2_bounds = 
prove_by_refinement(
  `!a b s t. (&0 < a) /\ (a < b) /\ (&0 <= t) /\ (t <= &1) ==>
    (a <= norm2((a + t*(b-a))*# cis(s))) /\
    ( norm2((a + t*(b-a))*# cis(s)) <= b) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[norm2_scale_cis];
  TYPE_THEN `a <= a + t*(b - a)` SUBGOAL_TAC;
  REWRITE_TAC[REAL_ARITH `x <= x + y <=> (&0 <= y)`];
  IMATCH_MP_TAC  REAL_LE_MUL;
  ASM_REWRITE_TAC[];
  UND 2;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `&0 <= a + t*(b-a)` SUBGOAL_TAC;
  UND 4;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `abs  (a + t*(b-a)) = a + t*(b-a)` SUBGOAL_TAC;
  REWRITE_TAC[ABS_REFL];
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  ineq_le_tac `(a + t*(b-a)) + (&1 - t)*(b - a) = b`;
  (* Sun Aug  8 09:12:18 EDT 2004  *)

  ]);;
  (* }}} *)

let norm2_point = 
prove_by_refinement(
  `!u v. norm2(point(u,v)) = sqrt(u pow 2 + v pow 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[norm2;euclid0_point;d_euclid_point;];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let cis_exist_lemma = 
prove_by_refinement(
  `!x. (euclid 2 x) /\ (norm2 x = &1) ==>
    (? t. x =  cis(t))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `? u v. x = point (u,v)` SUBGOAL_TAC;
  USE 1 (MATCH_MP point_onto);
  REP_BASIC_TAC;
  TYPE_THEN `FST p` EXISTS_TAC;
  TYPE_THEN `SND p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REWR 0;
  UND 0;
  REWRITE_TAC[norm2_point];
  DISCH_TAC;
  USE 0 (fun t -> AP_TERM `\t. t pow 2` t);
  UND 0;
  BETA_TAC;
  REDUCE_TAC;
  TYPE_THEN `(sqrt (u pow 2 + v pow 2) pow 2 = u pow 2 + v pow 2)` SUBGOAL_TAC;
  IMATCH_MP_TAC  SQRT_POW_2;
  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`);
  ASM_REWRITE_TAC[REAL_LE_POW_2];
  DISCH_THEN_REWRITE;
  DISCH_THEN (fun t -> MP_TAC (MATCH_MP CIRCLE_SINCOS t));
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[cis];
  MESON_TAC[];

  ]);;
  (* }}} *)

let cos_period = 
prove_by_refinement(
  `! j t. (cos (t + &j * &2 *pi) = cos(t))`,

  (* {{{ proof *)
  [
  INDUCT_TAC;
  REDUCE_TAC;
  REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;];
  REDUCE_TAC;
  REWRITE_TAC[COS_PERIODIC];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let sin_period = 
prove_by_refinement(
  `! j t. (sin (t + &j * &2 *pi) = sin(t))`,

  (* {{{ proof *)
  [
  INDUCT_TAC;
  REDUCE_TAC;
  REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;];
  REDUCE_TAC;
  REWRITE_TAC[SIN_PERIODIC];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let cos_period_neg = 
prove_by_refinement(
  `! j t. (cos (t - &j * &2 *pi) = cos(t))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC cos_period;
  TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL);
  RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]);
  USE 0 SYM;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let sin_period_neg = 
prove_by_refinement(
  `! j t. (sin (t - &j * &2 *pi) = sin(t))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC sin_period;
  TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL);
  RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]);
  USE 0 SYM;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let cos_period_int = 
prove_by_refinement(
  `!m t. (cos (t + real_of_int m * &2 *pi) = cos (t))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC INT_REP2 ;
  TSPEC `m` 0;
  REP_BASIC_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[int_of_num_th;cos_period];
  ASM_REWRITE_TAC[int_of_num_th;int_neg_th;cos_period_neg;GSYM real_sub;REAL_MUL_LNEG];
  ]);;
  (* }}} *)

let sin_period_int = 
prove_by_refinement(
  `!m t. (sin (t + real_of_int m * &2 *pi) = sin (t))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC INT_REP2 ;
  TSPEC `m` 0;
  REP_BASIC_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[int_of_num_th;sin_period];
  ASM_REWRITE_TAC[int_of_num_th;int_neg_th;sin_period_neg;GSYM real_sub;REAL_MUL_LNEG];
  ]);;
  (* }}} *)

let cos_sin_reduce = 
prove_by_refinement(
  `!t. ?t'. (cos t = cos t') /\
      (sin t = sin t') /\ (&0 <= t') /\ (t' < &2 * pi)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
    ASSUME_TAC floor_ineq;
  TSPEC `t/(&2 *pi)` 0;
  TYPE_THEN `f = floor (t/(&2 * pi))` ABBREV_TAC ;
  REP_BASIC_TAC;
  TYPE_THEN `t' = t - real_of_int(f)*(&2)*pi` ABBREV_TAC  ;
  TYPE_THEN `t'` EXISTS_TAC;
  TYPE_THEN `t' = t + real_of_int (--: f) *(&2)*pi` SUBGOAL_TAC;
  EXPAND_TAC "t'";
  REWRITE_TAC[REAL_ARITH `x -y = x + (-- y)`;REAL_ARITH `-- (x * y) = (-- x)*y`;GSYM int_neg_th];
  DISCH_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[cos_period_int];
  CONJ_TAC;
  ASM_REWRITE_TAC[sin_period_int];
  EXPAND_TAC "t'";
  TYPE_THEN `&0 < (&2 *pi)` SUBGOAL_TAC;
  REWRITE_TAC[REAL_MUL_2];
  MP_TAC PI_POS;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `~(&0 = &2* pi)` SUBGOAL_TAC;
  UND 5;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `t = (t/(&2 *pi))*(&2 *pi)` SUBGOAL_TAC;
  ASM_SIMP_TAC[REAL_DIV_RMUL];
  DISCH_TAC;
  USE 7 SYM ;
  TYPE_THEN `&0 <= (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi)` SUBGOAL_TAC;
  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
  IMATCH_MP_TAC  REAL_LE_MUL;
  UND 2;
  UND 5;
  REAL_ARITH_TAC;
    KILL 4;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  EXPAND_TAC "t'";
  TYPE_THEN ` (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi) < &1* &2*pi` SUBGOAL_TAC;
  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
  IMATCH_MP_TAC  REAL_LT_RMUL;
  UND 0;
  UND 5;
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  (* Tue Aug 10 09:57:36 EDT 2004 *)

  ]);;

  (* }}} *)

let cis_lemma = 
prove_by_refinement(
  `!x. (euclid 2 x) /\ (norm2 x = &1) ==>
    (?t. &0 <= t /\ t < &2 * pi /\ (x = cis t))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?t. x = cis t)` SUBGOAL_TAC;
  IMATCH_MP_TAC  cis_exist_lemma;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASSUME_TAC cos_sin_reduce;
  TSPEC `t` 3;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[cis;point_inj;PAIR_SPLIT];
  ASM_MESON_TAC[];
  (* Tue Aug 10 10:01:55 EDT 2004 *)
  ]);;
  (* }}} *)

let polar_exist = 
prove_by_refinement(
  `!x. (euclid 2 x) ==>
    (?r t. (&0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = r *# cis(t))))`,

  (* {{{ proof *)
  [
  (* A: trivial case of norm 0 *)
  REP_BASIC_TAC;
  ASM_CASES_TAC `norm2 x = &0` ;
  TYPE_THEN `x = euclid0` SUBGOAL_TAC;
  ASM_MESON_TAC[norm2_0];
  DISCH_THEN_REWRITE;
  TYPE_THEN `&0` EXISTS_TAC;
  TYPE_THEN `&0` EXISTS_TAC;
  REWRITE_TAC[euclid_scale0;REAL_MUL_2 ];
  MP_TAC PI_POS;
  REAL_ARITH_TAC;
  (* B: rescale to 1 *)
  TYPE_THEN `&0 < norm2 x` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  norm2_nn;
  ASM_REWRITE_TAC[];
  TYPE_THEN `r = norm2 x ` ABBREV_TAC ;
  DISCH_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  TYPE_THEN `y = (&1/r)*# x` ABBREV_TAC ;
  TYPE_THEN `x = r*# y` SUBGOAL_TAC;
  EXPAND_TAC "y";
  REWRITE_TAC[euclid_scale_act;GSYM real_div_assoc];
  REDUCE_TAC;
  ASM_SIMP_TAC[REAL_DIV_REFL; euclid_scale_one;];
  DISCH_TAC;
  REWR 2;
  ASM_REWRITE_TAC[];
  TYPE_THEN `euclid 2 y` SUBGOAL_TAC;
  EXPAND_TAC "y";
  IMATCH_MP_TAC  euclid_scale_closure;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  UND 2;
  ASM_SIMP_TAC[norm2_scale];
  TYPE_THEN `abs  r = r` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_ABS_REFL];
  UND 3;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  TYPE_THEN `norm2 y = &1` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_EQ_LCANCEL_IMP;
  TYPE_THEN `r` EXISTS_TAC;
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* C: invoke norm2=1 case *)
  TYPE_THEN `(?t. &0 <= t /\ t < &2 * pi /\ (y = cis t))` SUBGOAL_TAC;
  IMATCH_MP_TAC  cis_lemma;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 3;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

(*
vert r = hyperplane 2 e1 r
horz r = hyperplane 2 e2 r
cf. line2D_F..., line2D_S....
*)

let subset_union_pair = 
prove_by_refinement(
  `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==>
       (A UNION B) SUBSET (A' UNION B')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  ]);;
  (* }}} *)

let subset_inter_pair = 
prove_by_refinement(
  `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==>
       (A INTER B) SUBSET (A' INTER B')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  ]);;
  (* }}} *)

let simple_arc_end_simple = 
prove_by_refinement(
  `!C v v'. simple_arc_end C v v' ==> simple_arc top2 C`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end;simple_arc];
  REP_BASIC_TAC;
  REWRITE_TAC[top2_unions];
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Tue Aug 10 10:33:30 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_restriction = 
prove_by_refinement(
  `!C K K' . simple_arc top2 C /\ closed_ top2 K /\
      closed_ top2 K' /\ (C INTER K INTER K' = EMPTY ) /\
     ~(C INTER K = EMPTY ) /\ ~(C INTER K' = EMPTY) ==>
    (?C' v v'.   C' SUBSET C /\ simple_arc_end C' v v' /\
         (C' INTER K = {v}) /\ (C' INTER K' = {v'})) `,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `(?C' f. (C' = IMAGE f {x | &0 <= x /\ x <= &1 }) /\ C' SUBSET C /\  continuous f (top_of_metric (UNIV,d_real)) top2 /\  INJ f {x | &0 <= x /\ x <= (&1)} (euclid 2) /\  (C' INTER K = {(f (&0))}) /\  (C' INTER K' = {(f (&1))}))` SUBGOAL_TAC;
  IMATCH_MP_TAC  curve_restriction;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `f(&0)` EXISTS_TAC;
  TYPE_THEN `f(&1)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[simple_arc_end];
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let simple_arc_end_trans  = 
prove_by_refinement(
  `!C C' v v' v'' . simple_arc_end C v v' /\ simple_arc_end C' v' v'' /\
   ( C INTER C' = {v'}) ==>
    simple_arc_end (C UNION C') v v''`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\  &0 < &1/(&2) /\  &0 < &1` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  REAL_ARITH_TAC;
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
  REP_BASIC_TAC;
  KILL 12;
  TYPE_THEN `continuous f' (top_of_metric (UNIV,d_real)) top2 /\ INJ f' {x | &0 <= x /\ x <= &1} (euclid 2) /\  &1/(&2) < &1 /\  &0 < &1` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF2];
  REAL_ARITH_TAC;
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
  REP_BASIC_TAC;
  KILL 17;
  TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC;
  (* A: prelims *)
  TYPE_THEN `&0 < &1/(&2) /\ &1/(&2) < &1` SUBGOAL_TAC;
  REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM union_closed_interval);
  UND 17;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | &0 <= x /\ x < &1} SUBSET {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | &0 <= x /\ x < &1 / &2} SUBSET {x | x < &1/(&2)}` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | &1 / &2 <= x /\ x <= &1} SUBSET {x | &1/ (&2) <= x}` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)} = {x | &0 <= x /\ x < &1/(&2)} UNION {(&1 /(&2))}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING ];
  GEN_TAC;
  UND 17;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `g (&1/(&2)) = g' (&1/(&2))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  (* [B]: IMAGE *)
  SUBCONJ_TAC;
  ASM_REWRITE_TAC[IMAGE_UNION];
  ASM_SIMP_TAC[joinf_image_above;joinf_image_below];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  CONJ_TAC;
  REWRITE_TAC[SUBSET_UNION];
   REWRITE_TAC[SUBSET;UNION];
  REWRITE_TAC[IMAGE;INR IN_SING;];
  NAME_CONFLICT_TAC;
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "x''");
  GEN_TAC;
  DISCH_THEN_REWRITE;
  UND 27;
  DISCH_THEN_REWRITE;
  DISJ2_TAC ;
  TYPE_THEN `&1/(&2)` EXISTS_TAC;
  REWRITE_TAC[];
  UND 17;
  REAL_ARITH_TAC;
  REWRITE_TAC[SUBSET_UNION];
  (* --2-- *)
  USE 26 SYM;
  ASM_REWRITE_TAC[GSYM IMAGE_UNION];
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  ASM_REWRITE_TAC[SUBSET;];
  REAL_ARITH_TAC;
  REWRITE_TAC[SUBSET_UNION];
  REWRITE_TAC[SUBSET_UNION];
  DISCH_TAC;
  (* [C]: cont,INJ *)
  CONJ_TAC;
  IMATCH_MP_TAC  joinf_cont;
  ASM_REWRITE_TAC[];
  (* -- *)
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_split;
  ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below];
  CONJ_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_UNION];
  (* --2-- *)
  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
  ASM_SIMP_TAC[joinf_image_below];
  DISCH_THEN_REWRITE;
  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC;
  ASM_SIMP_TAC[joinf_image_above];
  DISCH_THEN_REWRITE;
  TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 / &2} INTER IMAGE g' {x | &1 / &2 <= x /\ x <= &1} SUBSET {v'}` SUBGOAL_TAC;
  UND 0;
  DISCH_THEN (fun t -> REWRITE_TAC[SYM t]);
  USE 26 GSYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  IMATCH_MP_TAC  IMAGE_SUBSET;
  ASM_REWRITE_TAC[SUBSET ];
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 /(&2)} INTER {v'} = EMPTY` SUBGOAL_TAC;
  REWRITE_TAC[EQ_EMPTY];
  GEN_TAC;
  REWRITE_TAC[IMAGE;INTER;INR IN_SING;DE_MORGAN_THM;];
  NAME_CONFLICT_TAC;
  LEFT_TAC  "x'";
  IMATCH_MP_TAC  (TAUT `(B ==> A)    ==> A \/ ~B`);
  DISCH_THEN_REWRITE;
  GEN_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `x' = &1/(&2)` SUBGOAL_TAC;
  USE 15 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  USE 27 GSYM;
  ASM_REWRITE_TAC[];
  TYPE_THEN `g x' = g(&1/(&2))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  UND 30;
  UND 33;
  REAL_ARITH_TAC;
  UND 30;
  REAL_ARITH_TAC;
  UND 29;
  REWRITE_TAC[SUBSET;EQ_EMPTY ;INTER;INR IN_SING;];
  POP_ASSUM_LIST (fun t -> ALL_TAC);
  REP_BASIC_TAC;
  TSPEC  `x` 3;
  REWR 3;
  TSPEC `x` 2;
  REWR 2;
  (* [D] final touches *)
  CONJ_TAC;
  REWRITE_TAC[joinf];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[joinf];
  ASM_SIMP_TAC [REAL_ARITH `&1/(&2) < &1 ==> (&1 < &1/ &2 <=> F)`];
  ASM_MESON_TAC[];
  (* Tue Aug 10 13:15:07 EDT 2004 *)

  ]);;
  (* }}} *)

let continuous_uninduced = 
prove_by_refinement(
  `!(f:A->B) U V Y.
     continuous f U (induced_top V Y) /\ IMAGE f (UNIONS U) SUBSET Y
     ==> continuous f U V`,

  (* {{{ proof *)
  [
  REWRITE_TAC[continuous;];
  REP_BASIC_TAC;
  TSPEC `v INTER Y` 2;
  TYPE_THEN `induced_top V Y (v INTER Y)` SUBGOAL_TAC;
  REWRITE_TAC[induced_top;IMAGE;];
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWR 2;
  UND 2;
  REWRITE_TAC [preimage;INTER];
  TYPE_THEN `{x | UNIONS U x /\ v (f x) /\ Y (f x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  GEN_TAC;
  TYPE_THEN `UNIONS U x ==> Y (f x)` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  (* Tue Aug 10 19:11:27 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_homeo = 
prove_by_refinement(
  `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\
        (metric_space(X,d)) ==>
    (?f. homeomorphism f
   (top_of_metric({x | &0 <= x /\ x <= &1},d_real))
            (top_of_metric(C,d)))`,

  (* {{{ proof *)

  [
  REWRITE_TAC[simple_arc];
  REP_BASIC_TAC;
  TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  REWR 1;
  (* -- *)
  TYPE_THEN `C SUBSET X` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_image_subset;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC;
  KILL 3;
  ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET_UNIV];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_subspace;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_real];
  DISCH_TAC;
  (* -- *)
  ASSUME_TAC metric_real;
  (* -- *)
  TYPE_THEN `compact (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
  TYPEL_THEN [`UNIV:real->bool`;`{x| &0 <= x /\ x <= &1}`;`d_real`] (fun t-> ASSUME_TAC (ISPECL t compact_subset));
  REWR 10;
  USE 10 SYM;
  ASM_REWRITE_TAC[interval_compact];
  DISCH_TAC;
  (* -- *)
  USE 3 GSYM ;
  (* -- *)
  (* A: show homeomorphism *)
  TYPE_THEN `f` EXISTS_TAC;
    IMATCH_MP_TAC  hausdorff_homeomorphsim;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  ASM_SIMP_TAC[top_of_metric_top;metric_subspace];
  (* -- *)
    TYPE_THEN `metric_space (C,d)` SUBGOAL_TAC;
  ASM_MESON_TAC [metric_subspace];
  DISCH_TAC;
  TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET C` SUBGOAL_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL ];
  DISCH_TAC;
  TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET X` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* B: final obligations *)
  CONJ_TAC;
  EXPAND_TAC "C";
  IMATCH_MP_TAC  inj_bij;
  UND 1;
  REWRITE_TAC[INJ];
  MESON_TAC[];
  (* -- *)
  TYPE_THEN `induced_top (top_of_metric (UNIV,d_real)) {x| &0 <= x /\ x <= &1} {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
  ASM_SIMP_TAC[top_of_metric_induced];
  TYPE_THEN `topology_ (top_of_metric ({x | &0 <= x /\ x <= &1},d_real))` SUBGOAL_TAC;
  ASM_SIMP_TAC[top_of_metric_top];
  DISCH_THEN (fun t-> MP_TAC (MATCH_MP top_univ t));
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  TYPE_THEN `continuous f (induced_top (top_of_metric (UNIV,d_real)) {x | &0 <= x /\ x <= &1}) (top_of_metric(X,d))` SUBGOAL_TAC;
  IMATCH_MP_TAC  continuous_induced_domain;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
  ASM_SIMP_TAC[metric_real;top_of_metric_induced];
  ASM_SIMP_TAC[metric_continuous_continuous;metric_subspace];
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  DISCH_THEN_REWRITE;
  ASM_SIMP_TAC[top_of_metric_top];
  IMATCH_MP_TAC  metric_hausdorff;
  ASM_REWRITE_TAC[];
  (* Tue Aug 10 20:34:30 EDT 2004 *)

  ]);;

  (* }}} *)

let continuous_metric_extend = 
prove_by_refinement(
  `!(f:A->B) U C X d. (metric_space(X,d) /\
      continuous f U (top_of_metric (C,d)) /\
          IMAGE f (UNIONS U) SUBSET C /\ C SUBSET X ==>
    continuous f U (top_of_metric(X,d)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `metric_space(C,d)` SUBGOAL_TAC;
  IMATCH_MP_TAC metric_subspace;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d)) C` SUBGOAL_TAC;
  ASM_SIMP_TAC[top_of_metric_induced];
  DISCH_TAC;
  REWR 2;
  IMATCH_MP_TAC  continuous_uninduced;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Tue Aug 10 20:47:53 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_distinct = 
prove_by_refinement(
  `!C v v'. simple_arc_end C v v' ==> ~(v = v')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end;INJ];
  REP_BASIC_TAC;
  TYPE_THEN `&0 = &1` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `f (&0)  = f(&1)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let bij_imp_image = 
prove_by_refinement(
  `!(f:A->B) X Y. BIJ f X Y ==> (IMAGE f X = Y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;SURJ];
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let homeo_inj = 
prove_by_refinement(
  `!(f:A->B) U C X d. (homeomorphism f U (top_of_metric(C,d))) /\
     (C SUBSET X) /\ (metric_space (X,d)) ==>
    ( continuous f U (top_of_metric(X,d)) /\ INJ f (UNIONS U) C /\
      (IMAGE f (UNIONS U) = C))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[homeomorphism];
  REP_BASIC_TAC;
  TYPE_THEN`metric_space(C,d)` SUBGOAL_TAC;
  ASM_MESON_TAC [metric_subspace];
  DISCH_TAC;
  (* -- *)
  UND 4;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `IMAGE f (UNIONS U)= C` SUBGOAL_TAC;
  IMATCH_MP_TAC  bij_imp_image ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  continuous_metric_extend;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL ];
  (* Tue Aug 10 20:58:37 EDT 2004 *)


  ]);;
  (* }}} *)

let simple_arc_coord = 
prove_by_refinement(
  `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\
        (metric_space(X,d)) ==>
    (?f.
  (continuous f (top_of_metric(C,d)) (top_of_metric(UNIV,d_real))) /\
  (INJ f C UNIV) /\
  (IMAGE f C = {x | &0 <= x /\ x <= &1}))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `C SUBSET X` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]);
  REP_BASIC_TAC;
  USE 4 GSYM;
  REWR 1;
  EXPAND_TAC "C";
  IMATCH_MP_TAC  inj_image_subset;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC;
  ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET_UNIV];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_subspace;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_real];
  DISCH_TAC;
  (* -- *)
  ASSUME_TAC metric_real;
  (* -- *)
  TYPE_THEN `(?f. homeomorphism f (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric(C,d)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_homeo;
  TYPE_THEN `X` EXISTS_TAC; (* // *)
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN ` g = (INV f  ({x | &0 <= x /\ x <= &1}) (C:A->bool))` ABBREV_TAC ;
  TYPE_THEN `g = INV f  (UNIONS((top_of_metric({x | &0 <= x /\ x <= &1},d_real)))) (UNIONS((top_of_metric(C,d))))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_subspace;];
  DISCH_TAC;
  (* A: *)
  TYPE_THEN `g` EXISTS_TAC;
  (* -- *)
  (* TYPE_THEN `U = top_of_metric({x | &0 <= x /\ x <= &1},d_real)` ABBREV_TAC ; *)
  TYPE_THEN `(homeomorphism g (top_of_metric(C,d)) (top_of_metric({x | &0 <= x /\ x <= &1},d_real))) /\ ({x | &0 <= x /\ x <= &1} SUBSET UNIV) /\ (metric_space (UNIV,d_real))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  TYPEL_THEN [`f`;`(top_of_metric({x | &0 <= x /\ x <= &1},d_real))`;`top_of_metric(C,d)`] (fun t-> ASSUME_TAC (ISPECL t homeomorphism_inv));
  REWR 11;
  DISCH_TAC;
    USE 11 (MATCH_MP homeo_inj);
  REP_BASIC_TAC;
  KILL 9;
  KILL 10;
  ASM_REWRITE_TAC[];
  UND 11;
  UND 12;
  ASM_REWRITE_TAC[];
  UND 5;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[INJ_UNIV];
  (* Tue Aug 10 21:49:22 EDT 2004 *)

  ]);;
  (* }}} *)

(* slow! *)
let image_interval = 
prove_by_refinement(
  `!a b f. (a < b) /\
   (continuous f (top_of_metric(UNIV,d_real))
        (top_of_metric( UNIV,d_real)))  /\
    (INJ f {x | a <= x /\ x <= b} UNIV) ==>
   (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\
    (IMAGE f {x | a <= x /\ x <= b} =
       {x | c <= x /\ x <= d})
     ) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* -- *)
  ASSUME_TAC connect_real;
  TYPE_THEN `!a b. connected (top_of_metric(UNIV,d_real)) (IMAGE f {x |  a<= x /\ x <= b})` SUBGOAL_TAC;
  REP_GEN_TAC;
  IMATCH_MP_TAC  connect_image;
  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC ;
  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `c = min_real (f a) (f b)` ABBREV_TAC ;
  TYPE_THEN `d = max_real (f a) (f b)` ABBREV_TAC ;
  TYPE_THEN `c`EXISTS_TAC;
  TYPE_THEN `d` EXISTS_TAC;
  TYPE_THEN `~(f a = f b)` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  TYPE_THEN `a = b` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 2;
  REAL_ARITH_TAC;
  UND 2;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  SUBCONJ_TAC;
  EXPAND_TAC "d";
  EXPAND_TAC "c";
  REWRITE_TAC[min_real;max_real];
  TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
  UND 8;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
  UND 8;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[in_pair];
  EXPAND_TAC "d";
  EXPAND_TAC "c";
  REWRITE_TAC[max_real;min_real];
  TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
  UND 9;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
  UND 9;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  MESON_TAC[];
  DISCH_TAC;
  (* B *)
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  SUBCONJ_TAC;
  IMATCH_MP_TAC  connected_nogap;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "c";
  EXPAND_TAC "d";
  REWRITE_TAC[max_real;min_real];
  TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
  UND 10;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`];
  TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
  UND 10;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`];
  DISCH_TAC;
  (* C set up cases *)
  REWRITE_TAC[IMAGE;SUBSET;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 14 (REWRITE_RULE[DE_MORGAN_THM]);
  USE 9 (REWRITE_RULE[FUN_EQ_THM;in_pair ]);
  TYPE_THEN `((c = f a) /\ (d = f b)) \/ ((c = f b) /\ (d = f a))` SUBGOAL_TAC;
  UND 9;
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `f x' < c \/ d < f x'` SUBGOAL_TAC;
  UND 14;
  ARITH_TAC;
  DISCH_TAC;
  KILL 9;
  KILL 14;
  KILL 11;
  (* D generic case *)
  TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (r < t) /\ (f r < f s) /\ (f s < f t) ==> (r < s /\ s < t))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPEL_THEN [`r`;`t`] (USE 4 o ISPECL);
  USE 4(REWRITE_RULE[connected]);
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f {x | r <= x /\ x <= t} SUBSET {x | x < f s} \/ IMAGE f {x | r <= x /\ x <= t} SUBSET {x | f s < x}` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;];
  CONJ_TAC;
  REAL_ARITH_TAC;
  REWRITE_TAC[IMAGE;SUBSET;UNION;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC (REAL_ARITH  `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` );
  DISCH_TAC;
  TYPE_THEN `x'' = s` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 26;
  UND 27;
  UND 22;
  UND 17;
  REAL_ARITH_TAC;
  UND 9;
  UND 11;
  UND 23;
  UND 26;
  UND 27;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REP_BASIC_TAC;
  TYPE_THEN `~(r = s)` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
  TYPE_THEN `~(s = t)` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
  KILL 1;
  KILL 2;
  UND 0;
  UND 3;
  UND 4;
  UND 5;
  REAL_ARITH_TAC;
  REWRITE_TAC[DE_MORGAN_THM ];
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  LEFT_TAC "x";
  TYPE_THEN `f t` EXISTS_TAC;
  LEFT_TAC "x'";
  REP_BASIC_TAC;
  TSPEC `t` 25;
  UND 25;
  UND 9;
  UND 14;
  REAL_ARITH_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  LEFT_TAC "x";
  TYPE_THEN `f r` EXISTS_TAC;
  REP_BASIC_TAC;
  LEFT 25 "x'" ;
  TSPEC `r` 25;
  UND 25;
  UND 14;
  UND 11;
  REAL_ARITH_TAC;
  (* D' generic case *)
  TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (t < r) /\ (f r < f s) /\ (f s < f t) ==> (t < s /\ s < r))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPEL_THEN [`t`;`r`] (USE 4 o ISPECL);
  USE 4(REWRITE_RULE[connected]);
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f {x | t <= x /\ x <= r} SUBSET {x | x < f s} \/ IMAGE f {x | t <= x /\ x <= r} SUBSET {x | f s < x}` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;];
  CONJ_TAC;
  REAL_ARITH_TAC;
  REWRITE_TAC[IMAGE;SUBSET;UNION;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC (REAL_ARITH  `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` );
  DISCH_TAC;
  TYPE_THEN `x'' = s` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 26;
  UND 27;
  UND 18;
  UND 21;
  REAL_ARITH_TAC;
  UND 9;
  UND 11;
  UND 23;
  UND 26;
  UND 27;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REP_BASIC_TAC;
  TYPE_THEN `~(r = s)` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
  TYPE_THEN `~(s = t)` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
  KILL 1;
  KILL 2;
  UND 0;
  UND 3;
  UND 4;
  UND 5;
  REAL_ARITH_TAC;
  REWRITE_TAC[DE_MORGAN_THM ];
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  LEFT_TAC "x";
  TYPE_THEN `f t` EXISTS_TAC;
  LEFT_TAC "x'";
  REP_BASIC_TAC;
  TSPEC `t` 25;
  UND 25;
  UND 9;
  UND 14;
  REAL_ARITH_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  LEFT_TAC "x";
  TYPE_THEN `f r` EXISTS_TAC;
  REP_BASIC_TAC;
  LEFT 25 "x'" ;
  TSPEC `r` 25;
  UND 25;
  UND 14;
  UND 11;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  (* end generic  *)
  KILL 4;
  KILL 3;
  KILL 0;
  KILL 1;
  KILL 10;
  KILL 6;
  KILL 5;
  (* E: actual cases *)
  UND 16;
  UND 15;
  REP_CASES_TAC;
  (* --2a-- *)
  KILL 11;
  TYPEL_THEN[`x'`;`a`;`b`] (USE 9 o ISPECL);
  TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC;
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `~(x' = b)` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  (* --2b-- *)
  KILL 11;
  TYPEL_THEN [`a`;`b`;`x'`] (USE 9 o ISPECL);
  TYPE_THEN `~(f a = f x')` SUBGOAL_TAC;
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `~(a = x')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  (* --2c-- *)
  KILL 9;
  TYPEL_THEN [`x'`;`b`;`a`] (USE 11 o ISPECL);
  TYPE_THEN `~(f x' = f a)` SUBGOAL_TAC;
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `~(a = x')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  (* --2d-- *)
  KILL 9;
  TYPEL_THEN [`b`;`a`;`x'`] (USE 11 o ISPECL);
  TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC;
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `~(b = x')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REPEAT (POP_ASSUM MP_TAC);
  REAL_ARITH_TAC;
  (* Wed Aug 11 09:36:14 EDT 2004 *)
  ]);;
  (* }}} *)

let metric_continuous_range = 
prove_by_refinement(
  `!(f:A->B) X dX Y dY Y'.
   metric_continuous f (X,dX) (Y,dY) <=>
   metric_continuous f (X,dX) (Y',dY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  ]);;
  (* }}} *)

let continuous_range = 
prove_by_refinement(
  `!(f:A->B) X dX Y dY Y'.
   metric_space(X,dX) /\ metric_space(Y,dY) /\ metric_space(Y',dY) /\
   continuous f (top_of_metric(X,dX)) (top_of_metric(Y,dY)) /\
   IMAGE f X SUBSET Y /\ IMAGE f X SUBSET Y' ==>
   continuous f (top_of_metric(X,dX)) (top_of_metric(Y',dY))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y',dY)) = metric_continuous f (X,dX) (Y',dY)`  SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_continuous_continuous;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y,dY)) = metric_continuous f (X,dX) (Y,dY)`  SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_continuous_continuous;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  REWR 2;
  ASM_MESON_TAC[metric_continuous_range];
  ]);;
  (* }}} *)

let metric_continuous_domain = 
prove_by_refinement(
  `!(f:A->B) X dX Y dY Y' A.
   metric_continuous f (X,dX) (Y,dY) /\ A SUBSET X ==>
  metric_continuous f (A,dX) (Y',dY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[metric_continuous;metric_continuous_pt;SUBSET];
  MESON_TAC[];
  ]);;
  (* }}} *)

let pair_order_endpoint = 
prove_by_refinement(
  `!a b c d . (c < d) /\ ({c , d} = {a ,b}) ==>
    (c = min_real a b) /\ (d = max_real a b)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE 0 (REWRITE_RULE[FUN_EQ_THM;in_pair]);
  TYPE_THEN `((c = a) /\ (d = b)) \/ ((c = b) /\ (d = a))` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  REWR 1;
  ASM_REWRITE_TAC[min_real;max_real];
  ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`];
  ASM_REWRITE_TAC[];
  REWR 1;
  ASM_REWRITE_TAC[min_real;max_real];
  ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`];
  ]);;
  (* }}} *)

let cont_extend_real_lemma = 
prove_by_refinement(
  `!a b (f:real->A) Y dY. (a < b) /\
   (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
     (top_of_metric(Y,dY))) /\ (metric_space(Y,dY)) /\
   IMAGE f {x | a <= x /\ x <= b} SUBSET Y ==>
  (
   ?g. (continuous g (top_of_metric(UNIV,d_real))
   (top_of_metric(Y,dY))) /\
     (!x. (a <= x /\ x <= b) ==> (f x = g x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?t. (a < t /\ t < b)` SUBGOAL_TAC;
  TYPE_THEN `(a+b)/(&2)` EXISTS_TAC;
  ASM_MESON_TAC[real_middle1_lt;real_middle2_lt];
  REP_BASIC_TAC;
  ASSUME_TAC metric_real;
  TYPE_THEN `{x | a <= x /\ x <= b} SUBSET UNIV` SUBGOAL_TAC;
  ASM_REWRITE_TAC[SUBSET_UNIV];
  DISCH_TAC;
  TYPE_THEN `metric_space ({x | a <= x /\ x <= b},d_real)` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_subspace;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `metric_continuous f ({x | a <= x /\ x <= b},d_real) (Y,dY)` SUBGOAL_TAC;
  UND 2;
  ASM_SIMP_TAC [metric_continuous_continuous];
  DISCH_TAC;
  TYPE_THEN `A = {x | x <= a}` ABBREV_TAC ;
  TYPE_THEN `B = {x | b <= x}` ABBREV_TAC ;
  TYPE_THEN `fA  = (\(t:real). f a)` ABBREV_TAC ;
  TYPE_THEN `fB = (\(t:real). f b)` ABBREV_TAC ;
  ASSUME_TAC half_closed;
  ASSUME_TAC half_closed_above;
  (* -- *)
  TYPE_THEN `!r A. (Y r) ==> (metric_continuous (\t. r) (A,d_real) (Y,dY))` SUBGOAL_TAC;
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  REP_BASIC_TAC;
  RIGHT_TAC "delta";
  REP_BASIC_TAC;
  TYPE_THEN `epsilon` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_MESON_TAC[metric_space_zero];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `metric_continuous (subf A fA fB) (A UNION B,d_real) (Y,dY)` SUBGOAL_TAC;
  IMATCH_MP_TAC  subf_cont;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "A";
  EXPAND_TAC "B";
  ASM_REWRITE_TAC[];
  EXPAND_TAC "fA";
  EXPAND_TAC "fB";
  TYPE_THEN `!x. x <= a /\ b <= x <=> F` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC ;
  DISCH_THEN_REWRITE;
  TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC;
  UND 0;
  REWRITE_TAC[IMAGE;SUBSET];
  TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  MESON_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `A' = A UNION B` ABBREV_TAC ;
  TYPE_THEN `B' = {x | a <= x /\ x <= b}` ABBREV_TAC ;
  TYPE_THEN `fA' = subf A fA fB` ABBREV_TAC ;
  TYPE_THEN `metric_continuous (subf A' fA' f) (A' UNION B',d_real) (Y,dY)` SUBGOAL_TAC;
  IMATCH_MP_TAC  subf_cont;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "A'";
  EXPAND_TAC "B'";
  CONJ_TAC;
  IMATCH_MP_TAC  closed_union;
  EXPAND_TAC "A";
  EXPAND_TAC "B";
  ASM_SIMP_TAC[top_of_metric_top];
  ASM_REWRITE_TAC[interval_closed];
  EXPAND_TAC "fA'";
  EXPAND_TAC "A'";
  EXPAND_TAC "A";
  EXPAND_TAC "B";
  REWRITE_TAC[UNION];
  GEN_TAC ;
  DISCH_TAC;
  TYPE_THEN `(x = a) \/ (x = b)` SUBGOAL_TAC;
  UND 21;
  REAL_ARITH_TAC;
  EXPAND_TAC "fA";
  EXPAND_TAC "fB";
  DISCH_THEN DISJ_CASES_TAC;
  UND 22;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[subf;REAL_ARITH `a <= a`];
  UND 22;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[subf];
  TYPE_THEN `~(b <= a)` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `A' UNION B' = UNIV` SUBGOAL_TAC;
  EXPAND_TAC "A'";
  EXPAND_TAC "A";
  EXPAND_TAC "B";
  EXPAND_TAC "B'";
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `g = subf A' fA' f` ABBREV_TAC  ;
  TYPE_THEN `!x. A x ==> (g x = f a)` SUBGOAL_TAC;
  EXPAND_TAC "g";
  REWRITE_TAC[subf];
  EXPAND_TAC "A'";
  REWRITE_TAC[UNION];
  GEN_TAC;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "fA'";
  REWRITE_TAC[subf];
  ASM_REWRITE_TAC[];
  EXPAND_TAC "fA";
  REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!x. B x ==> (g x = f b)` SUBGOAL_TAC;
  EXPAND_TAC "g";
  REWRITE_TAC[subf];
  EXPAND_TAC "A'";
  REWRITE_TAC[UNION];
  GEN_TAC;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "fA'";
  REWRITE_TAC[subf];
  TYPE_THEN `~(A x)` SUBGOAL_TAC;
  UND 25;
  EXPAND_TAC "B";
  EXPAND_TAC "A";
  REWRITE_TAC[];
  UND 3;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  EXPAND_TAC "fB";
  REWRITE_TAC[];
  DISCH_TAC;
  (* A  *)
  TYPE_THEN `!x. B' x ==> (g x = f x)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `A x` ASM_CASES_TAC;
  TYPE_THEN `A x /\ B' x ==> (x = a)` SUBGOAL_TAC;
  EXPAND_TAC "A";
  EXPAND_TAC "B'";
  REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  ASM_MESON_TAC[];
  (* --2-- *)
  TYPE_THEN `B x` ASM_CASES_TAC;
  TYPE_THEN `B x /\ B' x ==> (x = b)` SUBGOAL_TAC;
  EXPAND_TAC "B";
  EXPAND_TAC "B'";
  REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `~(A' x)` SUBGOAL_TAC;
  UND 27;
  UND 28;
  EXPAND_TAC "A'";
  REWRITE_TAC[UNION];
  MESON_TAC[];
  EXPAND_TAC "g";
  REWRITE_TAC[subf];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* B start on goal *)
  TYPE_THEN `g` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC;
  UND 26;
  EXPAND_TAC "B'";
  REWRITE_TAC[];
  MESON_TAC[];
  TYPE_THEN `IMAGE g UNIV SUBSET Y /\ metric_space (UNIV,d_real) /\ metric_space (Y,dY)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  UND 22;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  REWRITE_TAC[IMAGE_UNION;union_subset];
  CONJ_TAC;
  EXPAND_TAC "A'";
  REWRITE_TAC[IMAGE_UNION;union_subset];
  UND 24;
  UND 25;
  REWRITE_TAC[IMAGE;SUBSET];
    TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC;
  UND 0;
  EXPAND_TAC "B'";
  REWRITE_TAC[IMAGE;SUBSET];
  TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  MESON_TAC[];
  MESON_TAC[];
  UND 26;
  UND 0;
  EXPAND_TAC "B'";
  REWRITE_TAC[IMAGE;SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  COPY 27;
  (* C final KILL *)
  USE 28 (MATCH_MP metric_continuous_continuous);
  ASM_REWRITE_TAC[];
  REWR 21;
  (* Wed Aug 11 12:37:40 EDT 2004 *)

  ]);;
  (* }}} *)

let image_interval2 = 
prove_by_refinement(
  `!a b f. (a < b) /\
   (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
        (top_of_metric( UNIV,d_real)))  /\
    (INJ f {x | a <= x /\ x <= b} UNIV) ==>
   (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\
    (IMAGE f {x | a <= x /\ x <= b} =
       {x | c <= x /\ x <= d})
     )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?g. (continuous g (top_of_metric(UNIV,d_real))  (top_of_metric(UNIV,d_real))) /\ (!x. (a <= x /\ x <= b) ==> (f x = g x))` SUBGOAL_TAC;
  IMATCH_MP_TAC  cont_extend_real_lemma;
  ASM_REWRITE_TAC[metric_real];
  REP_BASIC_TAC;
  TYPE_THEN `(a < b) /\ (continuous g (top_of_metric(UNIV,d_real))  (top_of_metric( UNIV,d_real)))  /\ (INJ g {x | a <= x /\ x <= b} UNIV)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `INJ g {x | a <= x /\ x <= b} UNIV= INJ f {x | a <= x /\ x <= b} UNIV` SUBGOAL_TAC;
  IMATCH_MP_TAC  inj_domain_sub;
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP image_interval t));
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `c` EXISTS_TAC;
  TYPE_THEN `d` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `(f a = g a) /\ (f b = g b)` SUBGOAL_TAC;
  UND 3;
  UND 2;
  MESON_TAC[REAL_ARITH `(a < b) ==> (a<= a /\ a <= b /\ b <= b)`];
  DISCH_THEN_REWRITE;
  USE 5 SYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  image_domain_sub;
  ASM_REWRITE_TAC[];
  (* Wed Aug 11 12:51:52 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_euclid = 
prove_by_refinement(
  `!C. (simple_arc top2 C ==> (C SUBSET (euclid 2)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE 0 (MATCH_MP simple_arc_compact);
  RULE_ASSUM_TAC (REWRITE_RULE[compact;top2_unions]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let simple_arc_end_inj = 
prove_by_refinement(
  `!A B C v v'. (simple_arc_end A v v' /\ simple_arc_end B v v') /\
     (simple_arc top2 C) /\ (A SUBSET C) /\ (B SUBSET C) ==>
     (A = B)`,

  (* {{{ proof *)
  [
  (* A: *)
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  TYPE_THEN `simple_arc (top_of_metric(euclid 2,d_euclid)) C /\ (metric_space(euclid 2,d_euclid))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[GSYM top2;metric_euclid];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP   simple_arc_coord t));
  REP_BASIC_TAC;
  (* push to reals *)
  TYPE_THEN `(IMAGE f'' A = IMAGE f'' B) <=> (A = B)` SUBGOAL_TAC;
  IMATCH_MP_TAC  INJ_IMAGE ;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  (* -- *)
  TYPE_THEN `C SUBSET (euclid 2)` SUBGOAL_TAC;
  IMATCH_MP_TAC simple_arc_euclid;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `metric_space (C,d_euclid )` SUBGOAL_TAC;
  ASM_MESON_TAC[metric_subspace;metric_euclid];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET_UNIV];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_subspace;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
  ASM_REWRITE_TAC[metric_real];
  DISCH_TAC;
  (* -- *)
  (* -- *)
  TYPE_THEN `g = f'' o f` ABBREV_TAC ;
  TYPE_THEN `g'= f'' o f'` ABBREV_TAC ;
  TYPE_THEN `top_of_metric({x| &0 <= x /\ x <= &1},d_real) = induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  (GSYM top_of_metric_induced);
  ASM_REWRITE_TAC[metric_real];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `continuous f (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC;
  ASM_REWRITE_TAC[top2 ];
  IMATCH_MP_TAC  continuous_induced_domain;
  ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `continuous f' (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC;
  ASM_REWRITE_TAC[top2 ];
  IMATCH_MP_TAC  continuous_induced_domain;
  ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real];
  DISCH_TAC;
  KILL 11;
  KILL 6;
  (* A *)
  TYPE_THEN `(&0 < &1) /\ (continuous g (top_of_metric({x | &0 <= x /\ x <= &1},d_real))  (top_of_metric( UNIV,d_real)))  /\ (INJ g {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC;
  CONJ_TAC;
  REAL_ARITH_TAC;
  CONJ_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC;
  USE 22 GSYM;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC;
  UND 1;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  continuous_range;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[GSYM top2];
  ASM_SIMP_TAC[metric_euclid];
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  SUBCONJ_TAC;
  UND 1;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* --2-- *)
  EXPAND_TAC "g";
  IMATCH_MP_TAC  (REWRITE_RULE[GSYM comp_comp] COMP_INJ);
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_subset;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 1;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t));
  REP_BASIC_TAC;
  (* -- *)
  ASM_REWRITE_TAC[];
  REWRITE_TAC[GSYM IMAGE_o];
  ASM_REWRITE_TAC[];
  (* B *)
    TYPE_THEN `(&0 < &1) /\ (continuous g' (top_of_metric({x | &0 <= x /\ x <= &1},d_real))  (top_of_metric( UNIV,d_real)))  /\ (INJ g' {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC;
  CONJ_TAC;
  REAL_ARITH_TAC;
  CONJ_TAC;
  EXPAND_TAC "g'";
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC;
  USE 22 GSYM;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC;
  UND 0;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  continuous_range;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[GSYM top2];
  ASM_SIMP_TAC[metric_euclid];
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  SUBCONJ_TAC;
  UND 0;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* --2-- *)
  EXPAND_TAC "g'";
  IMATCH_MP_TAC  (REWRITE_RULE[GSYM comp_comp] COMP_INJ);
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_subset;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 0;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t));
  REP_BASIC_TAC;
  (* C final steps *)
  TYPE_THEN `(g (&0) = g'(&0)) /\ (g(&1) = g'(&1))` SUBGOAL_TAC;
  EXPAND_TAC "g";
  EXPAND_TAC "g'";
  REWRITE_TAC[o_DEF ];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  UND 11;
  ASM_REWRITE_TAC[];
  (* temp *)
  DISCH_TAC;
  TYPE_THEN `(c = min_real (g'(&0)) (g'(&1))) /\ (d = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  pair_order_endpoint;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `(c' = min_real (g'(&0)) (g'(&1))) /\ (d' = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  pair_order_endpoint;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (* Wed Aug 11 15:10:02 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_cut = 
prove_by_refinement(
  `!C v v' v''. simple_arc_end C v v' /\ (C v'') /\ ~(v'' = v) /\
    ~(v'' = v') ==>
    (?C' C''. (simple_arc_end C' v v'') /\ (simple_arc_end C'' v'' v') /\
     (C' INTER C'' = {v''}) /\ (C' UNION C'' = C))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  (* -- INTER *)
  TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v''))` SUBGOAL_TAC;
  UND 2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE];
   MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC;
  TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x <= &1} = IMAGE f ({x | &0 <= x /\ x <= t} INTER  {x | t <= x /\ x <= &1})` SUBGOAL_TAC;
  IMATCH_MP_TAC (GSYM inj_inter );
  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  UND 9;
  UND 10;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `{x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x <= &1} = {t}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING];
  UND 9;
  UND 10;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[image_sing];
  ASM_REWRITE_TAC[];
  (* A UNION *)
  REWRITE_TAC[GSYM IMAGE_UNION];
  TYPE_THEN `{x | &0 <= x /\ x <= t} UNION {x | t <= x /\ x <= &1} = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;];
  UND 9;
  UND 10;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  (* B FIRST piece *)
  CONJ_TAC;
  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= t} (euclid 2) /\ &0 < &1 /\ &0 < t` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  UND 9;
  REAL_ARITH_TAC;
  TYPE_THEN `~(&0 = t)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  REWR 11;
  REWR 4;
  UND 10;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
  REP_BASIC_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* C LAST piece  *)
  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | t <= x /\ x <= &1} (euclid 2) /\ &0 < &1 /\ t < &1` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  UND 10;
  REAL_ARITH_TAC;
  TYPE_THEN `~( &1 = t)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  REWR 11;
  REWR 3;
  UND 9;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
  REP_BASIC_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* Wed Aug 11 15:54:37 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_closed_curve_pt = 
prove_by_refinement(
  `!C  v. (simple_closed_curve top2 C /\ C v) ==>
    (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
               continuous f (top_of_metric (UNIV,d_real)) top2 /\
               INJ f {x | &0 <= x /\ x < &1} (UNIONS top2) /\
               (f (&0) = v) /\
               (f (&0) = f (&1)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_closed_curve];
  REP_BASIC_TAC;
  TYPE_THEN `f(&0) = v` ASM_CASES_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v))` SUBGOAL_TAC;
  UND 0;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `~(t = &0)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  REWR 9;
  REWR 6;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(t = &1)` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `{x | t <= x /\ x <= &1} = {x | t <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING];
  UND 7;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `INJ f {x | t <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  inj_split;
  CONJ_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC ;
  ASM_REWRITE_TAC[GSYM top2_unions];
  REWRITE_TAC[SUBSET];
  UND 8;
  REAL_ARITH_TAC;
  CONJ_TAC;
  REWRITE_TAC[INJ;INR IN_SING;];
  USE 2 (REWRITE_RULE[top2_unions]);
  TYPE_THEN `euclid 2 (f (&0))` SUBGOAL_TAC;
  USE 2 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  MESON_TAC[];
  REWRITE_TAC[EQ_EMPTY;IMAGE;INTER;image_sing;INR IN_SING;];
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "x''");
  REP_GEN_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `x' = &0` SUBGOAL_TAC;
  USE 2(REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 14;
  UND 8;
  REAL_ARITH_TAC;
  UND 14;
  UND 8;
  UND 9;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* [A] reparameter 1st part *)
  TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\   (INJ f {x | t <= x /\ x <= &1} (euclid 2)) /\   (&0 < &1/(&2)) /\  (t < &1)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  UND 7;
  UND 10;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP  arc_reparameter_gen t));
  REP_BASIC_TAC;
  KILL 14;
  (* B 2nd part *)
  TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\   (INJ f {x | &0 <= x /\ x <= t} (euclid 2)) /\   (&1/(&2) < &1) /\  (&0 < t)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF2];
  CONJ_TAC;
  USE 2(REWRITE_RULE[top2_unions]);
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x < &1} ` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET];
  UND 7;
  UND 10;
  REAL_ARITH_TAC;
  UND 8;
  UND 9;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP  arc_reparameter_gen t));
  REP_BASIC_TAC;
  KILL 19;
  (* [C] JOIN functions *)
  TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC;
  TYPE_THEN `&0 < &1/(&2)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `&1/(&2) < &1` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF2];
  REAL_ARITH_TAC ;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `joinf g g' (&1/(&2)) (&0) = v` SUBGOAL_TAC;
  ASM_REWRITE_TAC[joinf];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `joinf g g' (&1/(&2)) (&1) = v` SUBGOAL_TAC;
  ASM_REWRITE_TAC[joinf];
  ASM_SIMP_TAC[REAL_ARITH `(&1/ &2 < &1) ==> ~(&1 < (&1/(&2)))`];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `continuous (joinf g g' (&1 / &2)) (top_of_metric (UNIV,d_real)) top2` SUBGOAL_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  joinf_cont;
  ASM_REWRITE_TAC[GSYM top2];
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  (* [D] INJ *)
  TYPE_THEN `{x | &0 <= x /\ x < &1} = {x | &0 <= x /\ x < (&1/(&2))} UNION {x | (&1/(&2)) <= x /\ x < &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  ASM_REWRITE_TAC[UNION];
  UND 24;
  UND 19;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  (* -- *)
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  REWRITE_TAC[top2_unions];
  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
  CONJ_TAC;
  IMATCH_MP_TAC  inj_split;
  TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = INJ g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
  IMATCH_MP_TAC  joinf_inj_below;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = INJ g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  joinf_inj_above;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE ;
  CONJ_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &1/(&2) <= x /\ x <= &1}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  (* --2-- E IMAGE *)
  REWRITE_TAC[EQ_EMPTY];
  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
  IMATCH_MP_TAC  joinf_image_below;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = IMAGE g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  joinf_image_above;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[INTER];
  GEN_TAC;
  REWRITE_TAC[IMAGE;];
  DISCH_TAC;
  REP_BASIC_TAC;
  REWR 27;
  KILL 30;
  USE 13 (REWRITE_RULE[FUN_EQ_THM ]);
  TSPEC `g x'` 13;
  USE 13 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `(?x. (&0 <= x /\ x <= &1 / &2) /\ (g x' = g x))` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`];
  DISCH_TAC;
  REWR 13;
  KILL 30;
  REP_BASIC_TAC;
  USE 14 (REWRITE_RULE[FUN_EQ_THM;]);
  TSPEC `g' x''` 14;
  USE 14 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `(?x. (&1 / &2 <= x /\ x <= &1) /\ (g' x'' = g' x))` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`];
  DISCH_TAC;
  REWR 14;
  KILL 34;
  REP_BASIC_TAC;
  TYPE_THEN `(x = x''')` SUBGOAL_TAC;
  USE 2 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(x = &0)` SUBGOAL_TAC;
  DISCH_TAC;
  TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC;
  USE 17(REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 31;
  UND 24;
  UND 19;
  REAL_ARITH_TAC;
  UND 31;
  REAL_ARITH_TAC;
  TYPE_THEN `~(x = &1)` SUBGOAL_TAC;
  DISCH_TAC;
  TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC;
  USE 17(REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 31;
  UND 24;
  UND 19;
  REAL_ARITH_TAC;
  UND 31;
  REAL_ARITH_TAC;
  UND 34;
  UND 7;
  UND 10;
  UND 33;
  UND 8;
  UND 9;
  UND 30;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* --2-- *)
  TYPE_THEN `x = t` SUBGOAL_TAC;
  UND 36;
  UND 35;
  UND 34;
  UND 33;
  UND 30;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `g' (&1) = g'(x'')` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `&1 = x''` SUBGOAL_TAC;
  USE 22(REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 28;
  UND 24;
  UND 19;
  REAL_ARITH_TAC;
  UND 28;
  REAL_ARITH_TAC;
  (* F IMAGE *)
  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION ];
  UND  24;
  UND 19;
  REAL_ARITH_TAC;
  DISCH_TAC;
  TYPEL_THEN [`joinf g g' (&1/(&2))`;`{x | &0 <= x /\ x < &1/(&2)}`;`{x | &1/(&2) <= x /\ x <= &1}`] (fun t-> ASSUME_TAC (ISPECL t IMAGE_UNION ));
  ASM_REWRITE_TAC[];
  USE 27 SYM;
  ASM_REWRITE_TAC[];
  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
  IMATCH_MP_TAC  joinf_image_below;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  joinf_image_above;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  USE 14 GSYM ;
  ASM_REWRITE_TAC[];
  (* F final  *)
  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING];
  REAL_ARITH_TAC;
  DISCH_TAC ;
  (* -- *)
  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= &1} = IMAGE f {x | &0 <= x /\ x < &1}` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE_UNION;image_sing; ];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[union_subset;SUBSET_REFL];
  REWRITE_TAC[SUBSET;INR IN_SING;];
  GEN_TAC;
  DISCH_THEN_REWRITE;
  UND 1;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  REWRITE_TAC[IMAGE];
  TYPE_THEN `&0` EXISTS_TAC;
  REWRITE_TAC[];
  REAL_ARITH_TAC;
  REWRITE_TAC[SUBSET_UNION];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1/(&2)} = IMAGE f {x | t <= x /\ x < &1}` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1} DELETE (f (&1))` EXISTS_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[SUBSET_DELETE];
  CONJ_TAC;
  REWRITE_TAC[IMAGE;];
  REP_BASIC_TAC;
  TYPE_THEN `x = (&1/(&2))` SUBGOAL_TAC;
  USE 17(REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 32;
  UND 19;
  REAL_ARITH_TAC;
  UND 32;
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  REWRITE_TAC[DELETE;IMAGE;SUBSET;];
  REWRITE_TAC[REAL_ARITH `x <= &1 <=> (x < &1 \/ (x = &1))`];
  MESON_TAC[];
  (* --2--*)
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)} DELETE (g (&1/(&2)))` EXISTS_TAC;
  CONJ_TAC;
  USE 13 GSYM;
  USE 15 GSYM;
  ASM_REWRITE_TAC[SUBSET_DELETE];
  CONJ_TAC;
  REWRITE_TAC[IMAGE;];
  REP_BASIC_TAC;
  TYPE_THEN `&1 = x` SUBGOAL_TAC;
  USE 12(REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 32;
  REAL_ARITH_TAC;
  UND 32;
  REAL_ARITH_TAC;
  USE 11 SYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  IMAGE_SUBSET;
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  REWRITE_TAC[DELETE;IMAGE;SUBSET;];
  REWRITE_TAC[REAL_ARITH `x <= &1/(&2) <=> (x < &1/(&2) \/ (x = &1/(&2)))`];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  (* G *)
  REWRITE_TAC[GSYM IMAGE_UNION];
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UND 8;
  UND 7;
  UND 10;
  REAL_ARITH_TAC;
  (* -- World's worst proof *)
  (* Thu Aug 12 07:44:29 EDT 2004 *)

  ]);;

  (* }}} *)

let shift_inj = 
prove_by_refinement(
  `!(f:real->A) X t. (INJ f {x | &0 <= x /\ x < &1} X) /\
          (f (&0) = f(&1)) /\ (&0 < t) ==>
     INJ f {x | t <= x /\ x <= &1} X`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  CONJ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `x < &1` ASM_CASES_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 5;
  UND 0;
  REAL_ARITH_TAC;
  TYPE_THEN `x = &1` SUBGOAL_TAC;
  UND 4;
  UND 6;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  USE 1 GSYM;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `((x = &1) /\ (y = &1)) \/ ((x < &1) /\ (y = &1)) \/ ((x = &1) /\ (y < &1)) \/ ((x < &1) /\ (y < &1))` SUBGOAL_TAC;
  UND 5;
  UND 7;
  REAL_ARITH_TAC;
  REP_CASES_TAC;
  ASM_REWRITE_TAC[];
  USE 1 SYM ;
  REWR 4;
  TYPE_THEN `x = &0` SUBGOAL_TAC;
  FIRST_ASSUM  IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 8;
  UND 0;
  REAL_ARITH_TAC;
  UND 8;
  UND 0;
  REAL_ARITH_TAC;
  USE 1 SYM;
  REWR 4;
  TYPE_THEN `y = &0` SUBGOAL_TAC;
  FIRST_ASSUM  IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 6;
  UND 0;
  REAL_ARITH_TAC;
  UND 6;
  UND 0;
  REAL_ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 6;
  UND 8;
  UND 0;
  REAL_ARITH_TAC;
  (* Thu Aug 12 08:33:16 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_segment = 
prove_by_refinement(
  `!f u v.
          continuous f (top_of_metric (UNIV,d_real)) top2 /\
              INJ f {x | &0 <= x /\ x < &1} (euclid 2) /\
              (f (&0) = f (&1)) /\
       (&0 <= u /\ u < v /\ v <= &1 /\ (&0 < u \/ v < &1)) ==>
     simple_arc_end (IMAGE f {x | u <= x /\ x <= v}) (f u) (f v)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[simple_arc_end];
  (* -- *)
  TYPE_THEN `(&0 < u) ==> INJ f { x | u <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC ;
  DISCH_TAC;
  IMATCH_MP_TAC  shift_inj;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `INJ f { x | u <= x /\ x <= v } (euclid 2)`  SUBGOAL_TAC;
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | u <= x /\ x <= &1}` EXISTS_TAC;
  REWR 7;
  ASM_REWRITE_TAC[SUBSET ];
  UND 1;
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  UND 0;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\  INJ f {x | u <= x /\ x <= v} (euclid 2) /\  &0 < &1 /\  u < v` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
  REP_BASIC_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Thu Aug 12 08:55:11 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_closed_cut = 
prove_by_refinement(
  `!C v v'. (simple_closed_curve top2 C /\ C v /\ C v' /\ ~(v = v')
   ==> (?C' C''. simple_arc_end C' v v' /\ simple_arc_end C'' v v'
      /\ (  C' UNION C'' = C) /\ (C' INTER C'' = {v,v'})))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `simple_closed_curve top2 C /\ C v` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_closed_curve_pt t));
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f(t) = v'))` SUBGOAL_TAC;
  UND 1;
  ASM_REWRITE_TAC[IMAGE];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `t < &1` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~( t= &1) /\ (t <= &1) ==> (t  < &1)`);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 9;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `&0 < t` SUBGOAL_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~(t = &0) /\ (&0 <= t) ==> (&0 < t)`);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 9;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `C' = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ;
  TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `C''` EXISTS_TAC;
  CONJ_TAC;
  EXPAND_TAC "C'";
  EXPAND_TAC "v";
  EXPAND_TAC "v'";
  IMATCH_MP_TAC simple_arc_segment;
  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[REAL_ARITH `x <= x`];
  (* -- *)
  CONJ_TAC;
  USE 5 SYM;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "C''";
  EXPAND_TAC "v'";
  IMATCH_MP_TAC  simple_arc_end_symm;
  IMATCH_MP_TAC  simple_arc_segment;
  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* -- *)
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "C'";
  EXPAND_TAC "C''";
  REWRITE_TAC[GSYM IMAGE_UNION];
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UND 13;
  UND 12;
  REAL_ARITH_TAC;
  (* -- *)
  TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x < &1} UNION IMAGE f {(&1)}` SUBGOAL_TAC;
  REWRITE_TAC[GSYM IMAGE_UNION];
  EXPAND_TAC "C''";
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING ];
  UND 12;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  (* -- *)
  REWRITE_TAC[UNION_OVER_INTER;image_sing];
  EXPAND_TAC "C'";
  TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER  {x | t <= x /\ x < &1})) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x < &1})` SUBGOAL_TAC;
  IMATCH_MP_TAC  inj_inter;
  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
  TYPE_THEN `(UNIONS top2)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  UND 12;
  UND 13;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  (* -- *)
  TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x < &1}) = {t}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING];
  UND 13;
  UND 12;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `{(f (&1))} = IMAGE f {(&0)}` SUBGOAL_TAC;
  REWRITE_TAC[image_sing];
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER  {(&0)})  ) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {(&0)} )` SUBGOAL_TAC;
  IMATCH_MP_TAC  inj_inter;
  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
  TYPE_THEN `UNIONS top2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;INR IN_SING];
  UND 12;
  UND 13;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  (* -- *)
  TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {(&0)}) = {(&0)}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING ];
  UND 11;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[image_sing];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[in_pair];
  REWRITE_TAC[UNION;INR IN_SING];
  ASM_MESON_TAC[];
  (* Thu Aug 12 09:35:48 EDT 2004 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION M *)
(* ------------------------------------------------------------------ *)


let closed_point = 
prove_by_refinement(
  `!x. (euclid 2 x) ==> (closed_ top2 {x})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_closed;
  REWRITE_TAC[top2_top];
  ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
  IMATCH_MP_TAC  compact_point;
  ASM_REWRITE_TAC[GSYM top2;top2_unions];
  (* Fri Aug 13 08:42:22 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_closed = 
prove_by_refinement(
  `!C v v'. (simple_arc_end C v v' ==> closed_ top2 C) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  compact_closed;
  REWRITE_TAC[top2_top];
  ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
  REWRITE_TAC [GSYM top2];
  IMATCH_MP_TAC  simple_arc_compact;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  (* Fri Aug 13 09:33:35 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_end = 
prove_by_refinement(
  `!C v v'. (simple_arc_end C v v' ==> C v)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "v";
  REWRITE_TAC[IMAGE;];
  TYPE_THEN `&0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* Fri Aug 13 09:40:59 EDT 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_end2 = 
prove_by_refinement(
  `!C v v'. (simple_arc_end C v v' ==> C v')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "v'";
  REWRITE_TAC[IMAGE;];
  TYPE_THEN `&1` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* Fri Aug 13 09:42:07 EDT 2004 *)
  ]);;
  (* }}} *)

let simple_arc_end_end_closed = 
prove_by_refinement(
  `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  closed_point;
  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  TYPE_THEN `C v` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let simple_arc_end_end_closed2 = 
prove_by_refinement(
  `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v'}`,

  (* {{{ proof *)

  [
  ASM_MESON_TAC[simple_arc_end_end_closed;simple_arc_end_symm;];
  ]);;
  (* }}} *)

let simple_arc_sep3 = 
prove_by_refinement(
  `!A C1 C2 C3 x p1 p2 p3.
     (C1 UNION C2 UNION C3 SUBSET A) /\
     (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\
     (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\
     (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==>
     (?x' C1' C2' C3'.
     (C1' UNION C2' UNION C3' SUBSET A) /\
     (simple_arc_end C1' x' p1) /\
     (simple_arc_end C2' x' p2) /\
     (simple_arc_end C3' x' p3) /\
     ~(C2' p3) /\ ~(C3' p2) /\
     (C1' INTER C2' = {x'} ) /\
     (C1' INTER C3' = {x'} ))
     `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `K = C2 UNION C3` ABBREV_TAC ;
  TYPE_THEN `~((C1 INTER K) = EMPTY)` SUBGOAL_TAC;
  EXPAND_TAC "K";
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  REWRITE_TAC[UNION];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `closed_ top2 K` SUBGOAL_TAC;
  EXPAND_TAC "K";
  IMATCH_MP_TAC  closed_union;
  ASM_MESON_TAC[simple_arc_end_closed;top2_top];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `~((C1 INTER {p1}) = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[INTER;EMPTY_EXISTS;INR IN_SING];
  ASM_MESON_TAC[simple_arc_end_end2];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `(?C1' x' v'. C1' SUBSET C1 /\ simple_arc_end C1' x' v' /\ (C1' INTER K = {x'}) /\ (C1' INTER {p1} = {v'}))` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_restriction;
  ASM_REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING ];
  CONJ_TAC;
  ASM_MESON_TAC[simple_arc_end_simple];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_end_closed2;
  ASM_MESON_TAC[];
  CONV_TAC (dropq_conv "x");
  REWRITE_TAC[DE_MORGAN_THM];
  DISJ2_TAC;
  EXPAND_TAC "K";
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `v' = p1` SUBGOAL_TAC;
  USE 14 (REWRITE_RULE[FUN_EQ_THM]);
  USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_MESON_TAC[];
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  KILL 14;
  (* -- *)
  (* [A] case x' = x *)
  TYPE_THEN `x' = x` ASM_CASES_TAC;
  UND 14;
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  TYPE_THEN `x` EXISTS_TAC;
  TYPE_THEN `C1` EXISTS_TAC;
  TYPE_THEN `C2` EXISTS_TAC;
  TYPE_THEN `C3` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C1' = C1` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `C1` EXISTS_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  TYPE_THEN `p1` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL ];
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  (* --2-- *)
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER;INR IN_SING];
  EQ_TAC;
  USE 15 (REWRITE_RULE[FUN_EQ_THM;]);
  USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
  UND 14;
  EXPAND_TAC "K";
  REWRITE_TAC[UNION];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[simple_arc_end_end];
  (* --2'-- *)
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER;INR IN_SING];
  EQ_TAC;
  USE 15 (REWRITE_RULE[FUN_EQ_THM;]);
  USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
  UND 14;
  EXPAND_TAC "K";
  REWRITE_TAC[UNION];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[simple_arc_end_end];
  (* B cut C1 at- x'  *)
  TYPE_THEN `~(x' = p1)` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_distinct];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `C1' x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `simple_arc_end C1 x p1 /\ C1 x' /\ ~(x' = x) /\ ~(x' = p1)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  UND 17;
  UND 19;
  MESON_TAC[ISUBSET];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `C'' = C1'` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `C1` EXISTS_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  TYPE_THEN `p1` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  UND 20;
  SET_TAC[UNION;SUBSET];
  DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  (* -- *)
  TYPE_THEN `C1 x'` SUBGOAL_TAC;
  UND 19;
  UND 17;
  MESON_TAC[ISUBSET];
  DISCH_TAC;
  (* -- *)
    TYPE_THEN `x'` EXISTS_TAC;
  TYPE_THEN `C1'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[union_subset];
  TYPE_THEN `C1' SUBSET A` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1 UNION K ` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_UNION];
  DISCH_THEN_REWRITE;
  (* [C] C2 x'  *)
  (* ------- *)
  TYPE_THEN `C2 x'` ASM_CASES_TAC;
  TYPE_THEN `simple_arc_end C2 x p2 /\ C2 x' /\ ~(x' = x) /\ ~(x' = p2)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
    ASM_MESON_TAC[];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
  REP_BASIC_TAC;
  TYPE_THEN `C2' = C''''` ABBREV_TAC ;
  KILL 30;
  (*---- *)
  TYPE_THEN `C2'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C2' SUBSET C2` SUBGOAL_TAC;
  USE 26 ( (REWRITE_RULE[FUN_EQ_THM]));
  USE 26 (REWRITE_RULE[UNION]);
  UND 26;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~C2' p3` SUBGOAL_TAC;
  UND 30;
  UND 3;
  MESON_TAC[ISUBSET];
  DISCH_THEN_REWRITE;
  ONCE_REWRITE_TAC [union_subset];
  TYPE_THEN `C2' SUBSET A` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1 UNION K` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "K";
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `C1' INTER C2' = {x'}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING];
  GEN_TAC;
  EQ_TAC;
  UND 15;
  UND 30;
  EXPAND_TAC "K";
  REWRITE_TAC [eq_sing];
  REWRITE_TAC[INTER;UNION;SUBSET];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end];
  DISCH_THEN_REWRITE;
  (* --[C2]-- branch again for C3 x' -- *)
  TYPE_THEN `C3 x'` ASM_CASES_TAC;
  TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
  REP_BASIC_TAC;
  TYPE_THEN `C3' = C''''''` ABBREV_TAC ;
  KILL 36;
  TYPE_THEN `C3'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC;
  UND 32;
  SET_TAC[UNION;SUBSET];
  DISCH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1 UNION K` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "K";
  UND 36;
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  CONJ_TAC;
  UND 36;
  UND 0;
  MESON_TAC[ISUBSET];
  TYPE_THEN `C3' x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING];
  GEN_TAC;
  EQ_TAC;
  UND 15;
  UND 36;
  EXPAND_TAC "K";
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[UNION;SUBSET;INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  (* --[C2']-- now C3 doesn't meet x'. This will be repeated for C2 *)
  (* -- cut C' from {x'} to FIRST point on C3 -- *)
  TYPEL_THEN [`C'`;`{x'}`;`C3`] (fun t->  MP_TAC  (ISPECL t simple_arc_end_restriction));
  DISCH_THEN ANT_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_end_closed;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  ASM_MESON_TAC[];
  CONJ_TAC;
  UND 31;
  REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
  MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[INTER;INR IN_SING];
  USE 23 (MATCH_MP simple_arc_end_end2);
  UND 23;
  MESON_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[INTER;INR IN_SING];
  USE 23 (MATCH_MP simple_arc_end_end);
  UND 23;
  USE 2 (MATCH_MP simple_arc_end_end);
  UND 2;
  MESON_TAC[];
  REP_BASIC_TAC;
  (* ---[a] *)
  TYPE_THEN `C3a = C'''''` ABBREV_TAC ;
  KILL 36;
  TYPE_THEN `v = x'` SUBGOAL_TAC;
  USE 33(REWRITE_RULE[FUN_EQ_THM]);
  USE 33(REWRITE_RULE[INTER;INR IN_SING]);
  UND 33;
  MESON_TAC[];
  DISCH_THEN (fun t -> (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
  KILL 33;
  TYPE_THEN `C3a SUBSET C1` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 20;
  SET_TAC[UNION;SUBSET];
  DISCH_TAC;
  TYPE_THEN `C3a SUBSET A /\ simple_arc_end C3a x' v'' /\ ~(C3a p2) /\ (C1' INTER C3a = {(x')}) /\ (C3 INTER C3a = {(v'')}) /\ (~C3a p3)` SUBGOAL_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1 UNION K` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1` EXISTS_TAC;
  REWRITE_TAC[SUBSET_UNION];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL ];
  CONJ_TAC;
  UND 7;
  UND 33;
  MESON_TAC[ISUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INR IN_SING];
  EQ_TAC;
  UND 21;
  UND 35;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end];
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INR IN_SING];
  EQ_TAC;
  UND 32;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  UND 32;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  UND 35;
  USE 20 (REWRITE_RULE[FUN_EQ_THM]);
  USE 20 (REWRITE_RULE[UNION]);
  UND 20;
  UND 6;
  MESON_TAC  [ISUBSET];
  KILL 32;
  KILL 33;
  KILL 34;
  KILL 31;
  REP_BASIC_TAC;
  (* --[b] *)
  TYPE_THEN `(v'' = x)` ASM_CASES_TAC;
  FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  TYPE_THEN `C3 UNION C3a` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  ONCE_REWRITE_TAC[union_subset];
  ASM_REWRITE_TAC[];
  UND 9;
  EXPAND_TAC "K";
  REWRITE_TAC[union_subset];
  MESON_TAC[];
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  REWRITE_TAC[UNION;DE_MORGAN_THM];
  ASM_REWRITE_TAC[];
  (* --- *)
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;UNION;INR IN_SING];
  GEN_TAC;
  EQ_TAC ;
  REWRITE_TAC[LEFT_AND_OVER_OR];
  DISCH_THEN DISJ_CASES_TAC;
  UND 39;
  UND 15;
  EXPAND_TAC "K";
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER;UNION];
  MESON_TAC[];
  UND 39;
  UND 33;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  UND 33;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  (* -- *)
  (* --[c] cut off C3b at- v'' *)
  TYPEL_THEN [`C3`;`x`;`p3`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut));
  DISCH_THEN ANT_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 32;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 39 (REWRITE_RULE[]);
  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  UND 31;
  REWRITE_TAC[];
  UND 32;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `C3b = C'''''''` ABBREV_TAC ;
  KILL 43;
  TYPE_THEN `C3b SUBSET C3` SUBGOAL_TAC;
  UND 39;
  SET_TAC[UNION;SUBSET];
  DISCH_TAC;
  (* -- [d] EXISTS_TAC *)
  TYPE_THEN `C3a UNION C3b` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS ;
  TYPE_THEN `C1 UNION K` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_union_pair;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 20;
  SET_TAC[UNION;SUBSET];
  EXPAND_TAC "K";
  UND 43;
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_trans;
  (* IMATCH_MP_TAC  SUBSET_TRANS;    *)
  TYPE_THEN `v''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 43;
  UND 32;
  UND 40;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER;SUBSET];
  MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[UNION;DE_MORGAN_THM];
  ASM_REWRITE_TAC[];
  UND 43;
  UND 0;
  MESON_TAC[ISUBSET];
  IMATCH_MP_TAC  EQ_EXT ;
  REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR];
  GEN_TAC;
  EQ_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  FIRST_ASSUM MP_TAC;
  UND 21;
  UND 33;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  FIRST_ASSUM MP_TAC;
  UND 43;
  UND 15;
  EXPAND_TAC "K";
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER;UNION;SUBSET];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISJ1_TAC;
  UND 36;
  MESON_TAC[simple_arc_end_end];
  (* D *)
  TYPE_THEN `C3 x'` SUBGOAL_TAC;
  UND 25;
  UND 15;
  REWRITE_TAC[eq_sing];
  EXPAND_TAC "K";
  REWRITE_TAC[INTER;UNION];
  MESON_TAC[];
  DISCH_TAC;
  (* [E]  back to ONE goal *)
  (* TYPE_THEN `C3 x'` ASM_CASES_TAC; *)
  TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
    ASM_MESON_TAC[];
  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
  REP_BASIC_TAC;
  TYPE_THEN `C3' = C''''` ABBREV_TAC ;
  KILL 31;
  (*---- *)
  LEFT_TAC "C3'";
  USE 10 (ONCE_REWRITE_RULE[UNION_COMM]);
  TYPE_THEN `C3'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC;
  USE 27 ( (REWRITE_RULE[FUN_EQ_THM]));
  USE 27 (REWRITE_RULE[UNION]);
  UND 27;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `~C3' p2` SUBGOAL_TAC;
  UND 31;
  UND 0;
  MESON_TAC[ISUBSET];
  DISCH_THEN_REWRITE;
  ONCE_REWRITE_TAC [union_subset];
  TYPE_THEN `C3' SUBSET A` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1 UNION K` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C3` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "K";
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `C1' INTER C3' = {x'}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING];
  GEN_TAC;
  EQ_TAC;
  UND 15;
  UND 31;
  EXPAND_TAC "K";
  REWRITE_TAC [eq_sing];
  REWRITE_TAC[INTER;UNION;SUBSET];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end];
  DISCH_THEN_REWRITE;
  (* --[XC2]-- now C2 doesn't meet x'. This is repeat. *)
  (* -- cut C' from {x'} to FIRST point on C2 -- *)
  TYPEL_THEN [`C'`;`{x'}`;`C2`] (fun t->  MP_TAC  (ISPECL t simple_arc_end_restriction));
  DISCH_THEN ANT_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_end_closed;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  ASM_MESON_TAC[];
  CONJ_TAC;
  UND 25;
  REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
  MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[INTER;INR IN_SING];
  USE 23 (MATCH_MP simple_arc_end_end2);
  UND 23;
  MESON_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[INTER;INR IN_SING];
  USE 23 (MATCH_MP simple_arc_end_end);
  UND 23;
  USE 5 (MATCH_MP simple_arc_end_end);
  UND 5;
  MESON_TAC[];
  REP_BASIC_TAC;
  (* ---[Xa] *)
  TYPE_THEN `C2a = C'''''` ABBREV_TAC ;
  KILL 36;
  TYPE_THEN `v = x'` SUBGOAL_TAC;
  USE 33(REWRITE_RULE[FUN_EQ_THM]);
  USE 33(REWRITE_RULE[INTER;INR IN_SING]);
  UND 33;
  MESON_TAC[];
  DISCH_THEN (fun t -> (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
  KILL 33;
  TYPE_THEN `C2a SUBSET C1` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 20;
  SET_TAC[UNION;SUBSET];
  DISCH_TAC;
  TYPE_THEN `C2a SUBSET A /\ simple_arc_end C2a x' v'' /\ ~(C2a p3) /\ (C1' INTER C2a = {(x')}) /\ (C2 INTER C2a = {(v'')}) /\ (~C2a p2)` SUBGOAL_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1 UNION K` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1` EXISTS_TAC;
  REWRITE_TAC[SUBSET_UNION];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL ];
  CONJ_TAC;
  UND 6;
  UND 33;
  MESON_TAC[ISUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INR IN_SING];
  EQ_TAC;
  UND 21;
  UND 35;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end];
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INR IN_SING];
  EQ_TAC;
  UND 32;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  UND 32;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  UND 35;
  USE 20 (REWRITE_RULE[FUN_EQ_THM]);
  USE 20 (REWRITE_RULE[UNION]);
  UND 20;
  UND 7;
  MESON_TAC  [ISUBSET];
  KILL 32;
  KILL 33;
  KILL 34;
  KILL 35;  (*  attention *)
  REP_BASIC_TAC;
  (* --[Xb] *)
  TYPE_THEN `(v'' = x)` ASM_CASES_TAC;
  FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  TYPE_THEN `C2 UNION C2a` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  ONCE_REWRITE_TAC[union_subset];
  ASM_REWRITE_TAC[];
  UND 9;
  EXPAND_TAC "K";
  REWRITE_TAC[union_subset];
  MESON_TAC[];
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  REWRITE_TAC[UNION;DE_MORGAN_THM];
  ASM_REWRITE_TAC[];
  (* --- *)
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;UNION;INR IN_SING];
  GEN_TAC;
  EQ_TAC ;
  REWRITE_TAC[LEFT_AND_OVER_OR];
  DISCH_THEN DISJ_CASES_TAC;
  UND 39;
  UND 15;
  EXPAND_TAC "K";
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER;UNION];
  MESON_TAC[];
  UND 39;
  UND 34;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  UND 34;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  (* -- *)
  (* --[Xc] cut off C3b at- v'' *)
  TYPEL_THEN [`C2`;`x`;`p2`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut));
  DISCH_THEN ANT_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 33;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 39 (REWRITE_RULE[]);
  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  UND 32;
  REWRITE_TAC[];
  UND 33;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `C2b = C''''''` ABBREV_TAC ;
  KILL 43;
  TYPE_THEN `C2b SUBSET C2` SUBGOAL_TAC;
  UND 39;
  SET_TAC[UNION;SUBSET];
  DISCH_TAC;
  (* -- [Xd] EXISTS_TAC *)
  TYPE_THEN `C2a UNION C2b` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  REWRITE_TAC[union_subset ];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS ;
  TYPE_THEN `C1 UNION K` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "K";
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `v''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 43;
  UND 33;
  UND 40;
  REWRITE_TAC[eq_sing ];
  REWRITE_TAC[INTER;SUBSET];
  MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[UNION;DE_MORGAN_THM];
  ASM_REWRITE_TAC[];
  UND 43;
  UND 3;
  MESON_TAC[ISUBSET];
  IMATCH_MP_TAC  EQ_EXT ;
  REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR];
  GEN_TAC;
  EQ_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  FIRST_ASSUM MP_TAC;
  UND 21;
  UND 34;
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER];
  MESON_TAC[];
  FIRST_ASSUM MP_TAC;
  UND 43;
  UND 15;
  EXPAND_TAC "K";
  REWRITE_TAC[eq_sing];
  REWRITE_TAC[INTER;UNION;SUBSET];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISJ1_TAC;
  UND 36;
  MESON_TAC[simple_arc_end_end];
  (* Fri Aug 13 17:43:15 EDT 2004 *)

  ]);;

  (* }}} *)


let simple_arc_sep2 = 
prove_by_refinement(
  `!A C1 C2 C3 x p1 p2 p3.
     (
     C1 UNION C2 UNION C3 SUBSET A /\
     (simple_arc_end C1 x p1) /\
     (simple_arc_end C2 x p2) /\
     (simple_arc_end C3 x p3) /\
     (C1 INTER C2 = {x}) /\
     (C1 INTER C3 = {x}) /\
     ~(C2 p3) /\ ~(C3 p2)) ==>
     (?x' C1' C2' C3'.
     (C1' UNION C2' UNION C3' SUBSET A) /\
     (simple_arc_end C1' x' p1) /\
     (simple_arc_end C2' x' p2) /\
     (simple_arc_end C3' x' p3) /\
     (C1' INTER C2' = {x'}) /\
     (C2' INTER C3' = {x'}) /\
     (C3' INTER C1' = {x'})
     )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPEL_THEN[`C2`;`C3`;`{p2}`] (fun t -> ANT_TAC (ISPECL t simple_arc_end_restriction));
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_end_closed;
  TYPE_THEN `C2` EXISTS_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_MESON_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
  TYPE_THEN `C2 p2` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end2];
  TYPE_THEN `C2 x` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  TYPE_THEN `C3 x` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `v' = p2` SUBGOAL_TAC;
  UND 8;
  REWRITE_TAC[eq_sing; INR IN_SING;];
  REWRITE_TAC[INTER;INR IN_SING ];
  MESON_TAC[];
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  KILL 8;
  TYPE_THEN `v` EXISTS_TAC;
  LEFT_TAC "C2'";
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* A easy case *)
  TYPE_THEN `v = x` ASM_CASES_TAC;
  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]);
  TYPE_THEN `C' = C2` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `C2` EXISTS_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  TYPE_THEN `p2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET_REFL];
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]);
  TYPE_THEN `C1` EXISTS_TAC;
  TYPE_THEN `C3` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC [INTER_COMM];
  ASM_REWRITE_TAC[];
  (* [B] general case *)
  TYPEL_THEN [`C3`;`x`;`p3`;`v`] (fun t-> ANT_TAC (ISPECL t simple_arc_end_cut));
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 9;
  REWRITE_TAC[eq_sing;INTER];
  MESON_TAC[];
  DISCH_TAC;
  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  TYPE_THEN `C' p3` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  UND 1;
  UND 11;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `C1 UNION C''` EXISTS_TAC;
  TYPE_THEN `C'''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(C1 UNION C'') UNION C' UNION C''' = C1 UNION C' UNION (C'' UNION C''')` SUBGOAL_TAC;
  SET_TAC[UNION];
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C1 UNION C2 UNION C3` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC subset_union_pair ;
  REWRITE_TAC[SUBSET_REFL];
  IMATCH_MP_TAC  subset_union_pair ;
  ASM_REWRITE_TAC[SUBSET_REFL];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING ];
  GEN_TAC;
  EQ_TAC ;
  UND 2;
  TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC;
  UND 12;
  SET_TAC [SUBSET;UNION];
  REWRITE_TAC[eq_sing;INTER;SUBSET];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  (* --[a] *)
  TYPE_THEN `(C1 UNION C'') v /\ (C' v) /\ (C''' v)` SUBGOAL_TAC;
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  DISJ2_TAC;
  ASM_MESON_TAC[simple_arc_end_end2];
  ASM_MESON_TAC[simple_arc_end_end;];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `C''' SUBSET C3` SUBGOAL_TAC;
  UND 12;
  SET_TAC[UNION;SUBSET];
  DISCH_TAC;
  TYPE_THEN `C' INTER C''' = {v}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING];
  GEN_TAC;
  EQ_TAC;
  UND 17;
  UND 9;
  REWRITE_TAC[eq_sing;SUBSET;INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[INTER;];
  DISCH_THEN_REWRITE;
  (* -- *)
  TYPEL_THEN [`C2`;`p2`;`x`;`v`] (fun t-> ANT_TAC(ISPECL t simple_arc_end_cut));
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 11;
  REP_BASIC_TAC;
  UND 11;
  UND 18;
  MESON_TAC[ISUBSET];
  IMATCH_MP_TAC  simple_arc_end_distinct;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `C'''' = C'` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `C2` EXISTS_TAC;
  TYPE_THEN `p2` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  UND 16;
  SET_TAC[UNION;SUBSET];
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  (* -- *)
  TYPE_THEN `~C' x` SUBGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  REWR 24;
  TYPE_THEN `C''''' x` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end2];
  UND 8;
  UND 18;
  UND 24;
  REWRITE_TAC[eq_sing;INTER;];
  MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  KILL 7;
  KILL 6;
  KILL 5;
  KILL 4;
  TYPE_THEN `C'' x` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  DISCH_TAC;
  KILL 15;
  KILL 14;
  KILL 20;
  KILL 19;
  (* --[b] *)
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INTER;INR IN_SING];
  GEN_TAC;
  EQ_TAC;
  TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC;
  UND 12;
  SET_TAC[UNION;SUBSET];
  UND 2;
  UND 3;
  UND 11;
  UND 24;
  UND 9;
  REWRITE_TAC[SUBSET;INTER;eq_sing];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  UND 13;
  REWRITE_TAC[eq_sing;INTER];
  MESON_TAC[];
  (* -- *)
  TYPE_THEN `~ (C''' x)` SUBGOAL_TAC;
  DISCH_TAC;
  UND 13;
  UND 5;
  UND 4;
  UND 8;
  REWRITE_TAC[eq_sing;INTER;];
  MESON_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;UNION;INR IN_SING];
  GEN_TAC;
  EQ_TAC ;
  UND 13;
  UND 2;
  UND 17;
  UND 5;
  REWRITE_TAC[SUBSET;INTER;eq_sing];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  UND 23;
  REWRITE_TAC[UNION];
  (* Fri Aug 13 20:36:09 EDT 2004 *)

  ]);;

  (* }}} *)

let simple_arc_sep = 
prove_by_refinement(
  `!A C1 C2 C3 x p1 p2 p3.
     (C1 UNION C2 UNION C3 SUBSET A) /\
     (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\
     (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\
     (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==>
  (?x' C1' C2' C3'.
     (C1' UNION C2' UNION C3' SUBSET A) /\
     (simple_arc_end C1' x' p1) /\
     (simple_arc_end C2' x' p2) /\
     (simple_arc_end C3' x' p3) /\
     (C1' INTER C2' = {x'}) /\
     (C2' INTER C3' = {x'}) /\
     (C3' INTER C1' = {x'})
     )`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  DISCH_TAC;
  IMATCH_MP_TAC  simple_arc_sep2;
  USE 0 (MATCH_MP simple_arc_sep3);
  REP_BASIC_TAC;
  TYPE_THEN `C1'` EXISTS_TAC;
  TYPE_THEN `C2'` EXISTS_TAC;
  TYPE_THEN `C3'` EXISTS_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION N *)
(* ------------------------------------------------------------------ *)

(*  K33 stuff *)

let isthree = 
prove_by_refinement(
  `?x. (\t. (t < 3)) x`,

  (* {{{ proof *)

  [
  TYPE_THEN `0` EXISTS_TAC;
  BETA_TAC;
  ARITH_TAC;
  (* Sat Aug 14 11:56:32 EDT 2004 *)
  ]);;
  (* }}} *)

let three_t = new_type_definition "three_t" ("ABS3","REP3")
  isthree;;

let type_bij = 
prove_by_refinement(
  `!X (fXY:A->B) gYX.
     (!a. fXY (gYX a) = a)  /\ (!r. X r = (gYX (fXY r) = r)) ==>
    (BIJ fXY X UNIV) /\ (BIJ gYX UNIV X)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  bij_inj_image;
  REWRITE_TAC[INJ;SUBSET;IMAGE ;];
  CONJ_TAC;
  REP_BASIC_TAC;
  USE 2 (AP_TERM `gYX:B->A` );
  REWR 3;
  REWR 4;
  REWR 2;
  (* -- *)
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  GEN_TAC;
  TYPE_THEN `gYX x''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  IMATCH_MP_TAC  bij_inj_image;
  REWRITE_TAC[INJ;SUBSET;IMAGE];
  CONJ_TAC;
  REP_BASIC_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  USE 2(AP_TERM `fXY:A->B`);
  REWR 2;
  REP_BASIC_TAC;
  TYPE_THEN `fXY x` EXISTS_TAC;
  REWR 2;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let thr_bij  = 
prove_by_refinement(
  `(BIJ ABS3 {x | x < 3} UNIV) /\ (BIJ REP3 UNIV {x | x < 3})`,

  (* {{{ proof *)
  [
  IMATCH_MP_TAC  type_bij ;
  ASSUME_TAC three_t;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[three_t];
  REP_BASIC_TAC;
  UND 0;
  BETA_TAC;
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let thr_finite = 
prove_by_refinement(
  `(UNIV:three_t->bool) HAS_SIZE 3`,

  (* {{{ proof *)
  [
  REWRITE_TAC [has_size_bij2];
  TYPE_THEN `REP3` EXISTS_TAC;
  ASM_REWRITE_TAC[thr_bij];
  (* Sat Aug 14 12:28:58 EDT 2004 *)
  ]);;
  (* }}} *)

let has_size3_bij = 
prove_by_refinement(
  `!(A:A->bool).  A HAS_SIZE 3 <=> (?f. BIJ f (UNIV:three_t->bool) A)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[has_size_bij];
  REP_BASIC_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  ASSUME_TAC thr_bij;
  TYPE_THEN `compose f REP3` EXISTS_TAC;
  IMATCH_MP_TAC  COMP_BIJ;
  TYPE_THEN `{m | m < 3}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  REP_BASIC_TAC;
  TYPE_THEN `compose f ABS3` EXISTS_TAC;
  IMATCH_MP_TAC  COMP_BIJ;
  TYPE_THEN `UNIV:three_t->bool` EXISTS_TAC;
  ASM_REWRITE_TAC[thr_bij];
  (* Sat Aug 14 12:36:22 EDT 2004 *)

  ]);;
  (* }}} *)

let has_size3_bij2 = 
prove_by_refinement(
  `!(A:A->bool). A HAS_SIZE 3 <=> (?f. BIJ f A (UNIV:three_t->bool) )`,

  (* {{{ proof *)
  [
  REWRITE_TAC[has_size_bij2];
  GEN_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `compose ABS3 f` EXISTS_TAC;
  IMATCH_MP_TAC  COMP_BIJ;
  TYPE_THEN `{m | m < 3}` EXISTS_TAC;
  ASM_REWRITE_TAC[thr_bij];
  (* -- *)
  REP_BASIC_TAC;
  TYPE_THEN `compose REP3 f` EXISTS_TAC;
  IMATCH_MP_TAC  COMP_BIJ;
  TYPE_THEN `UNIV:three_t ->bool` EXISTS_TAC;
  ASM_REWRITE_TAC[thr_bij];
  (* Sat Aug 14 12:40:48 EDT 2004 *)

  ]);;
  (* }}} *)

let cartesian = jordan_def
  `cartesian (X:A->bool) (Y:B->bool) =
       { (x,y) | X x /\ Y y}`;;

let cartesian_pair = 
prove_by_refinement(
  `!X Y (x:A) (y:B).  cartesian X Y (x,y) <=> (X x) /\ (Y y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cartesian;PAIR_SPLIT ;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let cartesian_el = 
prove_by_refinement(
`!X Y (x:(A#B)).  cartesian X Y x  <=> (X (FST x)) /\ (Y (SND x))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[cartesian];
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN`FST x` EXISTS_TAC;
  TYPE_THEN `SND x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

(* ignore earlier K33 def *)

let k33_graph = jordan_def
  `k33_graph = mk_graph_t (
           cartesian (UNIV:three_t ->bool) UNIV,
           cartesian UNIV UNIV,
           (\e. { (FST e,T),  (SND e,F)} ) )`;;

let graph_edge_mk_graph = 
prove_by_refinement(
  `!(V:A->bool) (E:B->bool) C. graph_edge(mk_graph_t (V,E,C)) = E`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_edge;dest_graph_t;part1;drop0];
  ]);;
  (* }}} *)

let graph_vertex_mk_graph = 
prove_by_refinement(
 `!(V:A->bool) (E:B->bool) C. graph_vertex(mk_graph_t (V,E,C)) = V`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_vertex;dest_graph_t;];
  ]);;
  (* }}} *)

let graph_inc_mk_graph = 
prove_by_refinement(
 `!(V:A->bool) (E:B->bool) C. graph_inc(mk_graph_t (V,E,C)) = C`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_inc;dest_graph_t;drop1];
  ]);;
  (* }}} *)

let k33_isgraph = 
prove_by_refinement(
  `graph (k33_graph)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph;has_size2];
  REWRITE_TAC[IMAGE;SUBSET;];
  NAME_CONFLICT_TAC;
  REWRITE_TAC[k33_graph;graph_inc_mk_graph;graph_edge_mk_graph;graph_vertex_mk_graph;in_pair;cartesian];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[in_pair];
  CONJ_TAC;
  GEN_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  TYPE_THEN `(x,T)` EXISTS_TAC;
  TYPE_THEN `(y,F)` EXISTS_TAC;
  REWRITE_TAC[];
  REWRITE_TAC[PAIR_SPLIT];
  (* Sat Aug 14 13:18:16 EDT 2004 *)

  ]);;
  (* }}} *)

let k33_iso = 
prove_by_refinement(
  `!(A:A->bool) B (E:B->bool) f.
      A HAS_SIZE 3 /\ B HAS_SIZE 3 /\ (A INTER B = EMPTY) /\
      BIJ f E (cartesian A B) ==>
    (graph_isomorphic k33_graph
         (mk_graph_t
             (A UNION B, E,( \ e. { (FST (f e)), (SND (f e)) }))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[graph_isomorphic;graph_iso;k33_graph;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph;];
  RULE_ASSUM_TAC (REWRITE_RULE[has_size3_bij]);
  REP_BASIC_TAC;
  TYPE_THEN `u = ( \ t. (if (SND t) then (f'' (FST t)) else (f'(FST t))))` ABBREV_TAC ;
  LEFT_TAC "u";
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `g = INV f E (cartesian A B)` ABBREV_TAC ;
  TYPE_THEN `v = ( \t . (g (f'' (FST t), f' (SND t))))` ABBREV_TAC ;
  LEFT_TAC "v";
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `(u,v)` EXISTS_TAC;
  REWRITE_TAC[];
  (* A  u *)
  CONJ_TAC;
  REWRITE_TAC[BIJ;SURJ;INJ];
  SUBCONJ_TAC ;
  CONJ_TAC;
  EXPAND_TAC "u";
  REWRITE_TAC[cartesian_el];
  REWRITE_TAC[UNION;];
  GEN_TAC;
  COND_CASES_TAC;
  UND 2;
  REWRITE_TAC[BIJ;SURJ];
  MESON_TAC[];
  UND 3;
  REWRITE_TAC[BIJ;SURJ];
  MESON_TAC[];
  REWRITE_TAC[cartesian_el;];
  EXPAND_TAC "u";
  REP_GEN_TAC ;
  COND_CASES_TAC;
  COND_CASES_TAC;
  UND 2;
  REWRITE_TAC[BIJ;INJ];
  REP_BASIC_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  UND 1;
  REWRITE_TAC[EMPTY_EXISTS ];
  TYPE_THEN `f'' (FST x)` EXISTS_TAC;
  REWRITE_TAC[INTER];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  ASM_MESON_TAC[];
  COND_CASES_TAC;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  UND 1;
  REWRITE_TAC[EMPTY_EXISTS ];
  TYPE_THEN `f' (FST x)` EXISTS_TAC;
  REWRITE_TAC[INTER];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  ASM_MESON_TAC[];
  REWRITE_TAC[PAIR_SPLIT];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  USE 3(REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE ;
  REWRITE_TAC[UNION];
  GEN_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPE_THEN `( ((INV f'' UNIV A) x ), T )` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[cartesian_el];
  EXPAND_TAC "u";
  REWRITE_TAC[SND ];
  IMATCH_MP_TAC  inv_comp_right;
  ASM_REWRITE_TAC[];
  TYPE_THEN `( ((INV f' UNIV B) x ), F )` EXISTS_TAC;
  REWRITE_TAC[cartesian_el];
  EXPAND_TAC "u";
  REWRITE_TAC[SND ];
  IMATCH_MP_TAC  inv_comp_right;
  ASM_REWRITE_TAC[];
  (* B graph_inc  *)
  REWRITE_TAC[cartesian_el];
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC;
  GEN_TAC;
  EXPAND_TAC "u";
  REWRITE_TAC[IMAGE_CLAUSES];
  EXPAND_TAC "v";
  EXPAND_TAC "g";
  TYPE_THEN `cartesian A B (f'' (FST e), f' (SND e))` SUBGOAL_TAC;
  REWRITE_TAC[cartesian_el];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  ASM_MESON_TAC[];
  ASM_SIMP_TAC[inv_comp_right];
  (* C  BIJ v *)
  TYPE_THEN `BIJ g (cartesian A B) E` SUBGOAL_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  REWRITE_TAC[cartesian_el];
  EXPAND_TAC "v";
  CONJ_TAC;
  (* --- *)
  USE 7(REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[cartesian_el];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(f'' (FST x),f' (SND x)) = (f''(FST y),f' (SND y))` SUBGOAL_TAC;
  USE 7(REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC [cartesian_el];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  ASM_MESON_TAC[];
  REWRITE_TAC[PAIR_SPLIT];
  REP_BASIC_TAC;
  CONJ_TAC;
  USE 2 (REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  USE 3 (REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[INJ;SURJ];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[cartesian_el];
  EXPAND_TAC "v";
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `?u0. (f'' u0 = FST (f x))` SUBGOAL_TAC ;
  USE 2 (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 0 (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  TSPEC `x` 11;
  REWR 11;
  USE 11(REWRITE_RULE[cartesian_el]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `?u1. (f' u1 = SND (f x))` SUBGOAL_TAC ;
  USE 3 (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 0 (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  TSPEC `x` 12;
  REWR 12;
  USE 12(REWRITE_RULE[cartesian_el]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(u0,u1)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "g";
  IMATCH_MP_TAC  inv_comp_left;
  ASM_REWRITE_TAC[];
  (* Sat Aug 14 14:58:11 EDT 2004 *)

  ]);;
  (* }}} *)


(* ********************************************************* *)

let mk_segment_inj_image2 = 
prove_by_refinement(
  `!x y n.
    euclid n x /\ euclid n y /\ ~(x = y)
          ==> (?f. continuous f (top_of_metric (UNIV,d_real))
                   (top_of_metric (euclid n,d_euclid)) /\
                   INJ f {x | &0 <= x /\ x <= &1} (euclid n) /\
                   (f (&0) = x) /\ (f (&1) = y) /\
                   (IMAGE f {t | &0 <= t /\ t <= &1} = mk_segment x y))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  cont_mk_segment;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[joinf;IMAGE ];
  REWRITE_TAC[mk_segment];
  (* new new *)
  TYPE_THEN `((if &0 < &0   then x   else if &0 < &1 then euclid_plus (&0 *# y) ((&1 - &0) *# x) else y) =  x) /\ ((if &1 < &0   then x   else if &1 < &1 then euclid_plus (&1 *# y) ((&1 - &1) *# x) else y) =  y)` SUBGOAL_TAC;
  REWRITE_TAC[REAL_ARITH `~(&0 < &0) /\ ~(&1 < &0) /\ (&0 < &1) /\ ~(&1 < &1)`];
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale0; euclid_scale_one ; euclid_lzero];
  DISCH_THEN_REWRITE;
  (* end new new *)
  CONJ_TAC;
  (* new stuff *)
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
  UND 4;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_CASES_TAC `x' < &1`;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  euclid_add_closure;
  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UND 3;
  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `~(y' < &0)` SUBGOAL_TAC;
  UND 5;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC;
 TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC;
  UND 6;
  REAL_ARITH_TAC;
  DISCH_THEN   DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(x' < &1)` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
  DISCH_THEN_REWRITE;

  TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC;
 TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC;
  UND 4;
  REAL_ARITH_TAC;
  DISCH_THEN   DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(y' < &1)` SUBGOAL_TAC;
  UND 3;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
  DISCH_THEN_REWRITE;
  (* th *)
  ONCE_REWRITE_TAC [euclid_eq_minus];
  REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act];
  ONCE_REWRITE_TAC [euclid_plus_pair];
  REWRITE_TAC[GSYM euclid_rdistrib];
  REDUCE_TAC;
  REWRITE_TAC[REAL_ARITH  `x' + -- &1 * y' = x' - y'`];
  REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`];
  REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus];
  (* th1 *)
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  UND 2;
  REWRITE_TAC[];
  IMATCH_MP_TAC  euclid_scale_cancel;
  TYPE_THEN `(x' - y')` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 8;
  REAL_ARITH_TAC;
  KILL 2;
  (* old stuff *)
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  ASM_REWRITE_TAC[];
  EQ_TAC;
  DISCH_TAC;
  CHO 2;
  UND 2;
  COND_CASES_TAC;
  DISCH_ALL_TAC;
  JOIN 3 2;
  ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
  DISCH_ALL_TAC;
  UND 5;
  COND_CASES_TAC;
  DISCH_TAC;
  TYPE_THEN `&1 - x''` EXISTS_TAC;
  SUBCONJ_TAC;
  UND 5;
  REAL_ARITH_TAC ;
  DISCH_TAC;
  CONJ_TAC;
  UND 3;
  REAL_ARITH_TAC ;
  ONCE_REWRITE_TAC [euclid_add_comm];
  REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  CONJ_TAC;
  REAL_ARITH_TAC ;
  CONJ_TAC;
  REAL_ARITH_TAC ;
  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
  (* 2nd half *)
  DISCH_TAC;
  CHO 2;
  TYPE_THEN `&1 - a` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  AND 2;
  AND 2;
  UND 3;
  UND 4;
  REAL_ARITH_TAC ;
  COND_CASES_TAC;
  ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
  COND_CASES_TAC;
  REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
  ASM_MESON_TAC [euclid_add_comm];
  TYPE_THEN `a = &.0` SUBGOAL_TAC;
  UND 4;
  UND 3;
  AND 2;
  UND 3;
  REAL_ARITH_TAC ;
  DISCH_TAC;
  REWR 2;
  REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
   ]);;
  (* }}} *)

let mk_segment_simple_arc_end = 
prove_by_refinement(
  `!x y.
     (euclid 2 x) /\ (euclid 2 y) /\ ~(x = y) ==>
       simple_arc_end (mk_segment x y) x y`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  REWRITE_TAC[simple_arc_end];
  TYPEL_THEN [`x`;`y`;`2`] (fun t-> ANT_TAC (ISPECL t mk_segment_inj_image2));
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[GSYM top2 ]);
  ASM_REWRITE_TAC[];
  (* Tue Aug 17 10:10:00 EDT 2004 *)

  ]);;
  (* }}} *)

let cis0 = 
prove_by_refinement(
  `cis (&0) = e1`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cis;COS_0;SIN_0;e1;];
  ]);;
  (* }}} *)

let cispi2 = 
prove_by_refinement(
  `cis (pi/(&2)) = e2`,

  (* {{{ proof *)
  [
  REWRITE_TAC [cis;COS_PI2;SIN_PI2;e2];
  ]);;
  (* }}} *)

let neg_point = 
prove_by_refinement(
  `!x y. -- (point (x,y)) = point (--x, --y)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[euclid_neg];
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  BETA_TAC;
  MP_TAC (ARITH_RULE  `(x' = 0) \/ (x' = 1) \/ (2 <=| x')`);
  REP_CASES_TAC ;
  ASM_REWRITE_TAC[coord01];
  ASM_REWRITE_TAC[coord01];
  TYPE_THEN `euclid 2(point(x,y)) /\ euclid 2(point(--x,--y))` SUBGOAL_TAC;
  ASM_MESON_TAC[euclid_point];
  REWRITE_TAC[euclid];
  REP_BASIC_TAC;
  TSPEC `x'` 1;
  TSPEC `x'` 2;
  ASM_MESON_TAC[REAL_ARITH `-- &0 = &0`];
  (* Tue Aug 17 10:27:14 EDT 2004 *)

  ]);;
  (* }}} *)

let cispi = 
prove_by_refinement(
  `cis(pi) = -- e1`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cis;COS_PI ;SIN_PI;e1];
  REWRITE_TAC[neg_point];
  AP_TERM_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  REAL_ARITH_TAC;
  (* Tue Aug 17 10:28:55 EDT 2004 *)

  ]);;
  (* }}} *)

let cis3pi2 = 
prove_by_refinement(
  `cis(&3 *pi/(&2)) = -- e2`,

  (* {{{ proof *)
  [
  TYPE_THEN `&3 *pi/(&2) = pi/(&2) + pi` SUBGOAL_TAC;
  REWRITE_TAC[REAL_ARITH `&3 = &1 + &1 + &1`];
  REWRITE_TAC[REAL_ARITH `(x + y)*z = x*z + y*z`];
  REDUCE_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[cis;COS_PERIODIC_PI;SIN_PERIODIC_PI;GSYM neg_point;];
  AP_TERM_TAC;
  REWRITE_TAC[GSYM cis;cispi2];
  (* Tue Aug 17 10:34:32 EDT 2004 *)

  ]);;
  (* }}} *)

let closedball_convex = 
prove_by_refinement(
  `!x e n. (convex (closed_ball (euclid n,d_euclid) x e))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[convex;closed_ball;SUBSET;mk_segment;];
  REP_BASIC_TAC;
  USE 0 SYM;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  EXPAND_TAC "x''";
  IMATCH_MP_TAC  (euclid_add_closure);
  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
  DISCH_TAC;
  TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC;
  REWRITE_TAC[trivial_lin_combo];
  DISCH_THEN_REWRITE;
  EXPAND_TAC "x''";
  (* special case *)
  ASM_CASES_TAC `a = &0` ;
  UND 10;
  DISCH_THEN_REWRITE;
  REDUCE_TAC;
  ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;];
  TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u <= a*e) /\ (v <= (&1- a)*e))  ==> (d <= e))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `u + v <= (a*e) + (&1 - a)*e` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_ADD2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`];
  UND 13;
  REAL_ARITH_TAC ;
  DISCH_THEN IMATCH_MP_TAC ;
  TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC;
  TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC;
  TYPE_THEN `d_euclid z x''` EXISTS_TAC;
  TYPE_THEN `euclid n z` SUBGOAL_TAC;
  EXPAND_TAC "z";
  IMATCH_MP_TAC  (euclid_add_closure);
  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
  DISCH_TAC;
  CONJ_TAC;
  EXPAND_TAC "x''";
  IMATCH_MP_TAC  metric_space_triangle;
  TYPE_THEN `euclid n` EXISTS_TAC;
  REWRITE_TAC[metric_euclid];
  ASM_REWRITE_TAC[trivial_lin_combo];
  CONJ_TAC;
  EXPAND_TAC "z";
  TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid  (a *# x) (a *# x') ` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_translate;
  TYPE_THEN `n` EXISTS_TAC;
  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
  DISCH_THEN_REWRITE;
  TYPE_THEN `d_euclid (a *# x) (a *# x')  = abs  (a) * d_euclid x x'` SUBGOAL_TAC;
  IMATCH_MP_TAC  norm_scale_vec;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `abs  a = a` SUBGOAL_TAC;
  ASM_MESON_TAC[REAL_ABS_REFL];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
  ASM_REWRITE_TAC[];

  (* LAST case *)
  EXPAND_TAC "z";
  EXPAND_TAC "x''";
  TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_translate_LEFT;
  TYPE_THEN `n` EXISTS_TAC;
  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
  DISCH_THEN_REWRITE;
  TYPE_THEN `!b. d_euclid (b *# x) (b *# y)  = abs  (b) * d_euclid x y` SUBGOAL_TAC;
  GEN_TAC;
  IMATCH_MP_TAC  norm_scale_vec;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
  REWRITE_TAC [REAL_ABS_REFL];
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
  ASM_REWRITE_TAC[];
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let closedball_mk_segment_end = 
prove_by_refinement(
  `!x e n u v.
     (closed_ball(euclid n,d_euclid) x e u) /\
     (closed_ball(euclid n,d_euclid) x e v) ==>
     (mk_segment u v SUBSET (closed_ball(euclid n,d_euclid) x e))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC closedball_convex;
  TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL);
  USE 2 (REWRITE_RULE[convex]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let euclid2_e12 = 
prove_by_refinement(
  `euclid 2 e1 /\ euclid 2 e2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[e1;e2;euclid_point];
  ]);;
  (* }}} *)

let in_union = 
prove_by_refinement(
  `!X Y Z. (X:A->bool) SUBSET Y \/ (X SUBSET Z) ==> (X SUBSET Y UNION Z)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;UNION ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let mk_segment_hyperplane = 
prove_by_refinement(
  `!p r i. (i < 4) /\ (&0 <r) /\ (euclid 2 p) ==>
    (mk_segment p (p + r *# (cis(&i * pi/(&2))))) SUBSET
     (hyperplane 2 e2 (p 1) UNION
                     hyperplane 2 e1 (p 0))  `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?x y. p = point (x,y)` SUBGOAL_TAC;
  USE 0 (MATCH_MP point_onto);
  REP_BASIC_TAC;
  TYPE_THEN `FST p'` EXISTS_TAC;
  TYPE_THEN `SND p'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UND 3;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  REWRITE_TAC[coord01];
  (* -- *)
  TYPE_THEN `convex(hyperplane 2 e2 y)` SUBGOAL_TAC;
  IMATCH_MP_TAC  hyperplane_convex;
  REWRITE_TAC[euclid2_e12];
  TYPE_THEN `convex(hyperplane 2 e1 x)` SUBGOAL_TAC;
  IMATCH_MP_TAC  hyperplane_convex;
  REWRITE_TAC[euclid2_e12];
  REWRITE_TAC[convex];
  REP_BASIC_TAC;
  TYPE_THEN `hyperplane 2 e1 x (point(x,y)) /\ hyperplane 2 e2 y (point(x,y))` SUBGOAL_TAC;
  REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM  line2D_F];
  CONJ_TAC;
  TYPE_THEN `(x,y)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(x,y)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  USE 2 (MATCH_MP (ARITH_RULE (`(i < 4) ==> (i = 0) \/ (i = 1) \/ (i = 2) \/ (i = 3)`)));
  (* -- *)
  IMATCH_MP_TAC  in_union;
  TYPE_THEN `z = (euclid_plus (point (x,y)) (r *# cis (&i * pi / &2)))` ABBREV_TAC ;
  TYPE_THEN `hyperplane 2 e2 y z \/ hyperplane 2 e1 x z ==> mk_segment (point (x,y)) z SUBSET hyperplane 2 e2 y \/  mk_segment (point (x,y)) z SUBSET hyperplane 2 e1 x` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  (* -- *)
  TYPE_THEN `( (cis (&i *pi/(&2))) 0 = &0) ==> (hyperplane 2 e1 x z)` SUBGOAL_TAC;
  REWRITE_TAC[e1;GSYM line2D_F];
  EXPAND_TAC "z";
  REWRITE_TAC[cis;coord01];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[point_scale;point_add];
  REDUCE_TAC;
  TYPE_THEN `(x, y+ r*sin (&i *pi/(&2)))` EXISTS_TAC;
  REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `( (cis (&i *pi/(&2))) 1 = &0) ==> (hyperplane 2 e2 y z)` SUBGOAL_TAC;
  REWRITE_TAC[e2;GSYM line2D_S];
  EXPAND_TAC "z";
  REWRITE_TAC[cis;coord01];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[point_scale;point_add];
  REDUCE_TAC;
  TYPE_THEN `(x + r*cos(&i *pi/(&2)) , y)` EXISTS_TAC;
  REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(cis (&i * pi / &2) 0 = &0) \/ (cis (&i * pi / &2) 1 = &0) ==> hyperplane 2 e2 y z \/ hyperplane 2 e1 x z` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN IMATCH_MP_TAC ;
  UND 2;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  (* A -- *)
  REP_CASES_TAC;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASM_REWRITE_TAC[cis0;e1;coord01];
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  ASM_REWRITE_TAC[cispi2;e2;coord01];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_MUL_2];
  REDUCE_TAC;
  ASM_REWRITE_TAC[cispi;e1;coord01;neg_point];
  REDUCE_TAC;
  ASM_REWRITE_TAC[cis3pi2;e2;coord01;neg_point];
  REDUCE_TAC;
  (* Tue Aug 17 11:46:56 EDT 2004 *)

  ]);;
  (* }}} *)

let d_euclid_mk_segment = 
prove_by_refinement(
  `!n a p q . (&0 <= a) /\ (a <= &1) /\ (euclid n p) /\ (euclid n q) ==>
      (d_euclid p (a*#p + (&1 - a)*#q) = (&1 - a)*(d_euclid p q))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!z. d_euclid (a*# p + (&1 - a)*# p) z = d_euclid p z` SUBGOAL_TAC;
  REWRITE_TAC[trivial_lin_combo];
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
  TYPE_THEN `d_euclid (euclid_plus (a *# p) ((&1 - a) *# p)) (euclid_plus (a *# p) ((&1 - a) *# q)) = d_euclid ( ((&1 - a) *# p)) ( ((&1 - a) *# q))` SUBGOAL_TAC;
  ASM_MESON_TAC [metric_translate_LEFT;euclid_scale_closure];
  DISCH_THEN_REWRITE;
  TYPE_THEN `d_euclid ((&1 - a) *# p) ((&1 - a) *# q) = abs  (&1- a) * d_euclid p q` SUBGOAL_TAC;
  ASM_MESON_TAC[euclid_scale_closure;norm_scale_vec];
  DISCH_THEN_REWRITE;
  TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
  UND 2;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[trivial_lin_combo];
  (* Tue Aug 17 12:24:07 EDT 2004 *)

  ]);;
  (* }}} *)

let mk_segment_eq = 
prove_by_refinement(
  `! a p x y. ((a*# p + (&1 - a)*# x) = (a *# p + (&1 - a)*# y)) ==>
      (a = &1) \/ (x = y)`,

  (* {{{ proof *)
  [
  ONCE_REWRITE_TAC[euclid_eq_minus];
  REWRITE_TAC[euclid_minus;euclid_plus;euclid0;euclid_scale];
  REP_BASIC_TAC;
  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
  IMATCH_MP_TAC  (TAUT `(~A ==>B) ==> (A \/ B)`);
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  BETA_TAC;
  USE 0 (SPEC `x':num` );
  UND 0;
  REWRITE_TAC[REAL_ARITH  `(a*b + r*c ) - (a*b + r*d) = r*c - r*d`];
  REWRITE_TAC[REAL_ARITH `a*y - a*z = a*(y-z)`];
  REWRITE_TAC[REAL_ENTIRE];
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let mk_segment_endpoint = 
prove_by_refinement(
  `!p x y n . (d_euclid p x = d_euclid p y) /\ ~(x = y) /\
       (euclid n x) /\ (euclid n y) /\ (euclid n p) ==>
    (mk_segment p x INTER mk_segment p y = {p})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING];
  GEN_TAC;
  (* A -- *)
  EQ_TAC;
  REWRITE_TAC[mk_segment];
  REP_BASIC_TAC;
  UND 5;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `~(a' = &1)` SUBGOAL_TAC;
  DISCH_TAC;
  UND 11;
  DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  UND 5;
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero];
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `(&1- a')*d_euclid p y = (&1- a)*d_euclid p x` SUBGOAL_TAC;
  KILL 4;
  ASM_MESON_TAC[d_euclid_mk_segment];
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  REWR 12;
  (* -- *)
  TYPE_THEN `d_euclid p y = &0` ASM_CASES_TAC;
  TYPE_THEN `p = y` SUBGOAL_TAC;
  ASM_MESON_TAC [d_euclid_zero];
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  ASM_MESON_TAC[d_euclid_zero];
  USE 12 (REWRITE_RULE[REAL_EQ_MUL_RCANCEL]);
  REWR 12;
  TYPE_THEN `a' = a` SUBGOAL_TAC;
  UND 12;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  USE 8 (MATCH_MP mk_segment_eq);
  REWR 8;
  (* -- *)
  DISCH_THEN_REWRITE;
  REWRITE_TAC[mk_segment_end];
  (* Tue Aug 17 14:04:19 EDT 2004 *)

  ]);;
  (* }}} *)

let cases4 = 
prove_by_refinement(
  `!i j.  (i < j) /\ (j < 4) ==> ((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/
           ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/
         ((i=2)/\ (j=3))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!k. (k < 4) ==> (k = 0) \/ (k =1)\/ (k=2) \/ (k=3)` SUBGOAL_TAC;
  ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2) \/ (j = 3)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(j=0)` SUBGOAL_TAC;
  UND 1;
  ARITH_TAC;
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  TYPE_THEN `(i < 3)` SUBGOAL_TAC;
  UND 0;
  UND 1;
  ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `(i=0) \/ (i = 1) \/ (i=2)` SUBGOAL_TAC;
  UND 4;
  ARITH_TAC;
  DISCH_TAC;
  JOIN 5 3;
  USE 3 (REWRITE_RULE [RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]);
  TYPE_THEN `!k. ~((i = k) /\ (j = k))` SUBGOAL_TAC;
  GEN_TAC;
  UND 1;
  ARITH_TAC;
  DISCH_THEN (fun t-> USE 3 (REWRITE_RULE[t]));
  TYPE_THEN `~((i=2) /\ (j = 1))` SUBGOAL_TAC;
  UND 1;
  ARITH_TAC ;
  DISCH_THEN (fun t-> USE 3(REWRITE_RULE[t]));
  ASM_REWRITE_TAC[];
  UND 3;
  REP_CASES_TAC THEN (ASM_REWRITE_TAC[]);
  ]);;
  (* }}} *)

let cis_distinct = 
prove_by_refinement(
  `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (&0 < r) ==>
        ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))`,

  (* {{{ proof *)

  [
  TYPE_THEN `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (i < j) /\ (&0 < r) ==> ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `!p x y. (euclid_plus p x = euclid_plus p y) ==> (x = y)` SUBGOAL_TAC;
  REWRITE_TAC[euclid_plus];
  REP_BASIC_TAC;
  USE 6 (REWRITE_RULE[FUN_EQ_THM]);
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  TSPEC `x'` 6;
  UND 6;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> USE 0 (MATCH_MP t));
  USE 0 (AP_TERM `( *# ) (&1/r)`);
  USE 0 (REWRITE_RULE [euclid_scale_act]);
  TYPE_THEN `&1/r * r = &1` SUBGOAL_TAC;
  ONCE_REWRITE_TAC [REAL_ARITH `x*y = y*x`];
  ASM_MESON_TAC[REAL_DIV_LMUL;REAL_ARITH `&0 < r ==> ~(r = &0)`];
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  USE 0(REWRITE_RULE[euclid_scale_one]);
  TYPE_THEN `((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/ ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/ ((i=2)/\ (j=3))` SUBGOAL_TAC;
  IMATCH_MP_TAC  cases4;
  ASM_REWRITE_TAC[];
  REP_CASES_TAC THEN (FIRST_ASSUM MP_TAC) THEN (DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t;REAL_ARITH `(&1*x=x) /\ (&0*x= &0)`;e1;e2;cis0;cispi;cispi2;cis3pi2;neg_point;point_inj; PAIR_SPLIT; REAL_ARITH `~(&1 = &0) /\ ~(&0 = &1) /\ (-- &0 = &0) /\ ~(&1 = -- &1) /\ ~(-- &1 = &0) /\ ~(&0 = -- &1)`;REAL_MUL_2; REAL_HALF_DOUBLE ]))) THEN (ASM_REWRITE_TAC[]);
  REP_BASIC_TAC;
  TYPE_THEN `( i <| j) \/ (j <| i)` SUBGOAL_TAC;
  UND 2;
  ARITH_TAC;
  REP_CASES_TAC;
  TYPEL_THEN [`i`;`j`;`r`] (USE 5 o ISPECL);
  ASM_MESON_TAC[];
  TYPEL_THEN [`j`;`i`;`r`] (USE 5 o ISPECL);
  ASM_MESON_TAC[];
  (* Tue Aug 17 15:01:38 EDT 2004 *)




  ]);;
  (* }}} *)

let cis_nz = 
prove_by_refinement(
  `!t. ~(cis(t) = euclid0)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE 0 (AP_TERM `norm2`);
  RULE_ASSUM_TAC (REWRITE_RULE[norm2_cis]);
  ASM_MESON_TAC[REAL_ARITH `~(&1= &0)`;norm2_0;];
  ]);;
  (* }}} *)

let polar_nz = 
prove_by_refinement(
  `!r t. ~(r = &0) ==> ~(r *# cis(t) =euclid0)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE 0 (AP_TERM `norm2`);
  RULE_ASSUM_TAC (REWRITE_RULE[norm2_scale_cis]);
  ASM_MESON_TAC[REAL_ARITH `(abs  r = &0) ==> (r = &0)`;norm2_0];
  ]);;
  (* }}} *)

let polar_euclid = 
prove_by_refinement(
  `!r t. euclid 2 (r *# (cis t))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cis;point_scale;euclid_point];
  ]);;
  (* }}} *)

let d_euclidpq = 
prove_by_refinement(
  `!n p q . (euclid n p) /\ (euclid n q) ==> (d_euclid p (p+q) =
      d_euclid q euclid0)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!z. d_euclid p z = d_euclid (p + euclid0) z` SUBGOAL_TAC;
  REWRITE_TAC[euclid_rzero];
  DISCH_THEN (fun t->ONCE_REWRITE_TAC[t]);
  TYPE_THEN `d_euclid (euclid_plus p euclid0) (euclid_plus p q) = d_euclid euclid0 q` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_translate_LEFT;
  TYPE_THEN `n` EXISTS_TAC;
  ASM_REWRITE_TAC[euclid_euclid0;polar_euclid;];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC metric_space_symm;
  TYPE_THEN `euclid n` EXISTS_TAC ;
  ASM_REWRITE_TAC[metric_euclid;euclid_euclid0;polar_euclid];
  ]);;
  (* }}} *)

let degree4_vertex_hv = 
prove_by_refinement(
  `!r p. (&0 < r) /\ (euclid 2 p) ==>
    (?C.
        (!i. (i< 4) ==>
           simple_arc_end (C i) p (p + r*# (cis(&i * pi/(&2))))) /\
        (!i. (i < 4) ==>
           (C i = mk_segment p (p + r*# (cis(&i * pi/(&2)))))) /\
        (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==>
           (C i INTER C j = {p})) /\
        (!i. (i < 4) ==>
          (C i INTER {x | r <= d_euclid p x } =
               { (p + r *# (cis(&i* pi/(&2)))) })) /\
        (!i. (i< 4) ==>
           C i SUBSET (closed_ball (euclid 2,d_euclid) p r)) /\
        (!i. (i< 4) ==>
           C i SUBSET (hyperplane 2 e2 (p 1) UNION
                     hyperplane 2 e1 (p 0))))   `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(\i. mk_segment p (euclid_plus p (r *# cis (&i * pi / &2))))` EXISTS_TAC;
  BETA_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `!i. ~(r *# cis (&i * pi/(&2)) = euclid0)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  ASM_MESON_TAC[polar_nz;REAL_ARITH `&0 < r ==> ~( r= &0)`];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!i . euclid 2 (r *# cis (&i * pi/(&2)))` SUBGOAL_TAC;
  GEN_TAC;
  REWRITE_TAC[polar_euclid];
  DISCH_TAC;
  (* -- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC   mk_segment_simple_arc_end;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  ASM_SIMP_TAC[euclid_add_closure];
  DISCH_TAC;
  TSPEC `i` 2;
  UND 2;
  TYPE_THEN `z =r *# cis(&i *pi/(&2))` ABBREV_TAC ;
  REWRITE_TAC[euclid0];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  USE 5 (REWRITE_RULE[FUN_EQ_THM ]);
  TSPEC `x` 5;
  UND 5;
  REWRITE_TAC[euclid_plus];
  REAL_ARITH_TAC;
  (* -- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  mk_segment_endpoint;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `!i. d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi / &2)) euclid0` SUBGOAL_TAC;
  GEN_TAC;
  IMATCH_MP_TAC  d_euclidpq;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[polar_euclid];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM norm2];
  REWRITE_TAC[norm2_scale_cis];
  CONJ_TAC;
  IMATCH_MP_TAC  cis_distinct;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[polar_euclid;euclid_add_closure];
  (* [B] *)
  TYPE_THEN `!a q. (euclid 2 q) /\ (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + q)) = (&1 - a)*(d_euclid p (p + q)))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  d_euclid_mk_segment;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[euclid_add_closure];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!a i. (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + r *# (cis (&i * pi/(&2))))) = (&1 - a)*r)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `d_euclid p (p + r *# (cis (&i * pi/(&2)))) = norm2 ( r *# (cis (&i * pi/(&2))))` SUBGOAL_TAC;
  REWRITE_TAC[norm2];
  IMATCH_MP_TAC  d_euclidpq;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[polar_euclid];
  REWRITE_TAC[norm2_scale_cis];
  TYPE_THEN `abs  r = r` SUBGOAL_TAC;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPEL_THEN [`2`;`a`;`p`;`p + (r *# cis (&i * pi / &2))`] (fun t-> ANT_TAC (ISPECL t d_euclid_mk_segment));
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[euclid_add_closure;polar_euclid];
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  (* -- *)
  CONJ_TAC;
  REP_BASIC_TAC ;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[mk_segment;INTER;INR IN_SING];
  EQ_TAC;
  REP_BASIC_TAC;
  UND 8;
  DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL);
  REWR 5;
  ASM_REWRITE_TAC[];
  REWR 7;
  TYPE_THEN `&1 * r <= (&1 - a) * r` SUBGOAL_TAC;
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[REAL_LE_RMUL_EQ];
  DISCH_TAC;
  TYPE_THEN `a = &0` SUBGOAL_TAC;
  UND 10;
  UND 8;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero];
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  TYPE_THEN `&0` EXISTS_TAC;
  REWRITE_TAC [REAL_ARITH `&0 <= &0 /\ &0 <= &1`];
  REDUCE_TAC;
  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero];
  TYPE_THEN `d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi/(&2))) euclid0` SUBGOAL_TAC;
  IMATCH_MP_TAC  d_euclidpq;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[polar_euclid];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
  UND 1;
  REAL_ARITH_TAC;
  (* C-- *)
  CONJ_TAC;
  REP_BASIC_TAC ;
  REWRITE_TAC[SUBSET];
  GEN_TAC;
  REWRITE_TAC[mk_segment;closed_ball];
  REP_BASIC_TAC;
  UND 7;
  DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL);
  REWR 5;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[euclid_add_closure;polar_euclid;euclid_scale_closure];
  ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1*y`];
  IMATCH_MP_TAC  REAL_PROP_LE_RMUL;
  UND 1;
  UND 9;
  REAL_ARITH_TAC;
  (* D-- *)
  REP_BASIC_TAC;
  IMATCH_MP_TAC  mk_segment_hyperplane;
  ASM_REWRITE_TAC[];
  (* Tue Aug 17 17:02:28 EDT 2004 *)

  ]);;
  (* }}} *)

let diff_pow1 = 
prove_by_refinement(
  `!t x. (( \ x. (t*x)) diffl t) x`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(\ x. (t * x)) = (\x. (t * (\u. (u pow 1)) x))` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  BETA_TAC;
  REWRITE_TAC[POW_1];
  DISCH_THEN_REWRITE;
  TYPE_THEN `((\x. (t * (\u. (u pow 1)) x)) diffl (t* &1)) x ` SUBGOAL_TAC;
  IMATCH_MP_TAC  DIFF_CMUL;
  TYPEL_THEN[`1`;`x`] (fun t-> ASSUME_TAC  (ISPECL t DIFF_POW));
  UND 0;
  REWRITE_TAC[ARITH_RULE `1-1 = 0`;pow];
  REDUCE_TAC;
  BETA_TAC;
  REDUCE_TAC;
  ]);;
  (* }}} *)

let pi_bounds = 
prove_by_refinement(
  `&3 < pi /\ pi < &22/ (&7)`,

  (* {{{ proof *)
  let tpi = recompute_pi 12 in
  let t3 = INTERVAL_OF_TERM 12 `&3` in
  let t227 = INTERVAL_OF_TERM 12 `&22/(&7)` in
  let th1 = INTERVAL_TO_LESS_CONV t3 tpi in
  let th2 = INTERVAL_TO_LESS_CONV tpi t227 in
  (
  [
  REP_BASIC_TAC;
  ASSUME_TAC th2;
  ASSUME_TAC th1;
  ASM_REWRITE_TAC[];
  ]));;
  (* }}} *)

let sinx_le_x = 
prove_by_refinement(
  `!x. (&0 <=x) ==> (sin x <= x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `x = &0` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SIN_0;];
  REAL_ARITH_TAC;
  TYPE_THEN `&0 < x` SUBGOAL_TAC;
  UND 0;
  UND 1;
  REAL_ARITH_TAC;
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `f = ( \ t x. t * x - sin(x))` ABBREV_TAC ;
  TYPE_THEN `!t. (&1 < t) ==> (!x. (&0 < x) ==> (&0 < f t x))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  (* --- *)
  TYPE_THEN `!x. (f t diffl (t - cos x)) x` SUBGOAL_TAC;
  EXPAND_TAC "f";
  GEN_TAC;
  IMATCH_MP_TAC  DIFF_SUB;
  REWRITE_TAC[DIFF_SIN;diff_pow1;];
  DISCH_TAC;
  TYPEL_THEN [`f t`;`&0`;`x'`] (fun t-> ANT_TAC (ISPECL t MVT));
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  REP_BASIC_TAC;
  ASM_MESON_TAC[DIFF_CONT];
  REWRITE_TAC[differentiable];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  UND 6;
  TYPE_THEN `f t (&0) = &0` SUBGOAL_TAC;
  EXPAND_TAC "f";
  REWRITE_TAC[SIN_0];
  REDUCE_TAC;
  DISCH_THEN_REWRITE;
  REDUCE_TAC;
  DISCH_TAC;
  UND 4;
  REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LT_MUL;
  ASM_REWRITE_TAC[];
  TSPEC `z` 5;
  TYPE_THEN `l = t - cos z` SUBGOAL_TAC;
  IMATCH_MP_TAC  DIFF_UNIQ;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  UND 3;
  MP_TAC COS_BOUNDS;
  DISCH_TAC;
  TSPEC `z` 3;
  REP_BASIC_TAC;
  UND 5;
  UND 3;
  REAL_ARITH_TAC;
  (* -- *)
  DISCH_TAC;
  IMATCH_MP_TAC  (REAL_ARITH  `~(x < sin x) ==> (sin x <= x)`) ;
  DISCH_TAC;
  TYPE_THEN `&1 < sin x/x` SUBGOAL_TAC;
  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
  REDUCE_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TSPEC  `(sin x)/x` 2;
  REWR 2;
  TSPEC `x` 2;
  REWR 2;
  UND 2;
  EXPAND_TAC "f";
  (* -- *)
  ASM_SIMP_TAC[REAL_DIV_RMUL;REAL_ARITH `&0 < x ==> ~(x = &0)`];
  REDUCE_TAC;
  (* Tue Aug 17 19:35:13 EDT 2004 *)

  ]);;
  (* }}} *)

let abssinx_lemma = 
prove_by_refinement(
  `!x. (&0 <= x) ==> ((abs  (sin x)) <= abs  x)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `abs  x = x` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  TYPE_THEN `x <= pi` ASM_CASES_TAC;
  TYPE_THEN `&0 <= sin x` SUBGOAL_TAC;
  IMATCH_MP_TAC  SIN_POS_PI_LE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `abs  (sin x) = sin x` SUBGOAL_TAC;
  UND 2;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[sinx_le_x];
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `&1` EXISTS_TAC;
  CONJ_TAC;
  ASSUME_TAC SIN_BOUNDS;
  TSPEC `x` 2;
  UND 2;
  REAL_ARITH_TAC;
  UND 1;
  TYPE_THEN `&3 < pi` SUBGOAL_TAC;
  REWRITE_TAC[pi_bounds];
  REAL_ARITH_TAC;
  (* Tue Aug 17 22:54:49 EDT 2004 *)

  ]);;
  (* }}} *)

let abssinx_le = 
prove_by_refinement(
  `!x. abs  (sin x) <= abs  x`,

  (* {{{ proof *)
  [
  GEN_TAC;
  TYPE_THEN `(&0 <= x) \/ (&0 <= -- x)` SUBGOAL_TAC;
  REAL_ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  ASM_MESON_TAC[abssinx_lemma];
  TYPE_THEN `y = --x` ABBREV_TAC ;
  TYPE_THEN `x = --y` SUBGOAL_TAC;
  UND 1;
  REAL_ARITH_TAC;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  REWRITE_TAC[SIN_NEG;REAL_ABS_NEG];
  ASM_MESON_TAC[abssinx_lemma];
  (* Tue Aug 17 22:59:20 EDT 2004 *)

  ]);;
  (* }}} *)

let cos_double2 = 
prove_by_refinement(
  `!x. cos (&2 * x) = &1 - &2 * (sin x pow 2)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  REWRITE_TAC[COS_DOUBLE;GSYM SIN_CIRCLE ];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let sin_half = 
prove_by_refinement(
  `!x. &2 * (sin (x/(&2)) pow 2) = &1 - cos (x)`,

  (* {{{ proof *)
  [
  GEN_TAC;
  ASSUME_TAC cos_double2;
  TSPEC `x/ &2` 0;
  TYPE_THEN `&2 *(x/(&2)) = x` SUBGOAL_TAC;
  REWRITE_TAC[REAL_MUL_2;];
  REDUCE_TAC;
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let x_diff_y2 = 
prove_by_refinement(
  `!x y. (x - y) pow 2 = x*x - &2*x*y + y*y`,

  (* {{{ proof *)
  [
  REWRITE_TAC[REAL_POW_2];
  real_poly_tac;
  ]);;
  (* }}} *)

let cosdiff2 = 
prove_by_refinement(
  `!x y. (cos x - cos y) pow 2 + (sin x - sin y) pow 2 =
         (&2 * sin ((x - y)/(&2))) pow 2`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[POW_MUL];
  TYPE_THEN  `!z. &2 pow 2 * z = &2 *(&2 *z)` SUBGOAL_TAC ;
  REWRITE_TAC[POW_2];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[sin_half];

  TYPE_THEN `cos (x - y) = cos (x + (--y))` SUBGOAL_TAC;
  AP_TERM_TAC;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[COS_ADD ];
  REWRITE_TAC[SIN_NEG;COS_NEG;REAL_ARITH `x - u*(-- v) = x + u*v`];
  REWRITE_TAC[x_diff_y2];
  REWRITE_TAC[POW_2];
  TYPE_THEN `a = cos x` ABBREV_TAC ;
  TYPE_THEN `b = sin x` ABBREV_TAC ;
  TYPE_THEN `a' = cos y` ABBREV_TAC ;
  TYPE_THEN `b' = sin y` ABBREV_TAC ;
  REWRITE_TAC[REAL_ARITH `x*(y-z) = x*y - x*z`];
  TYPE_THEN `&2 * &1 = ((b pow 2) + (a pow 2)) + ((b' pow 2) + (a' pow 2))` SUBGOAL_TAC;
  EXPAND_TAC "a";
  EXPAND_TAC "b";
  EXPAND_TAC "a'";
  EXPAND_TAC "b'";
  REWRITE_TAC[SIN_CIRCLE];
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[POW_2];
  real_poly_tac;
  (* Tue Aug 17 23:38:27 EDT 2004 *)

  ]);;
  (* }}} *)

let d_euclid_cis = 
prove_by_refinement(
  `!x y. d_euclid (cis x) (cis y) = &2 * (abs  (sin ((x-y)/(&2))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[cis;d_euclid_point;cosdiff2;POW_2_SQRT_ABS;ABS_MUL;];
  REWRITE_TAC[REAL_ARITH `abs  (&2) = &2`];
  (* Tue Aug 17 23:41:30 EDT 2004 *)
  ]);;
  (* }}} *)

let d_euclid_cis_ineq = 
prove_by_refinement(
  `!x y. d_euclid (cis x) (cis y) <= abs  (x - y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[d_euclid_cis];
  REP_GEN_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `&2 * (abs  ((x-y)/(&2)))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
  ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`;abssinx_le];
  REWRITE_TAC[REAL_ARITH `!z. &2*(abs  z) = abs  (&2 *z)`];
  TYPE_THEN `&2 * ((x - y)/(&2)) = (x - y)` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REAL_ARITH_TAC;
  (* Wed Aug 18 06:42:28 EDT 2004 *)

  ]);;
  (* }}} *)

let polar_fg_inj = 
prove_by_refinement(
  `!f g p. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\
    (!x. (&0 <= x /\ x <= &1) ==> (&0 <= f x)) /\ (euclid 2 p) ==>
   INJ (\t. p + (f t)*# (cis (g t))) {x | &0 <= x /\ x <= &1} (euclid 2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[INJ;polar_euclid];
  ASM_SIMP_TAC[euclid_add_closure;polar_euclid];
  REP_BASIC_TAC;
  (* INSERT *)
  TYPE_THEN `(f x *# cis (g x)) = (f y *# cis (g y))` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  USE 3 (REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x'` 3;
  USE 3(REWRITE_RULE[euclid_plus]);
  UND 3;
  REAL_ARITH_TAC;
  KILL 3;
  DISCH_TAC;
  (* end ins *)
  USE 3 (AP_TERM `norm2`);
  USE 3 (REWRITE_RULE[norm2_scale_cis]);
  TYPE_THEN `&0 <= f x /\ &0 <= f y` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[GSYM REAL_ABS_REFL]);
  REWR 3;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];

  ]);;
  (* }}} *)

let polar_distinct = 
prove_by_refinement(
  `!f g g'. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\
    (!x. (&0 <= x /\ x <= &1) ==> (&0 < f x)) /\
    (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g x /\ g x < &2 * pi)) /\
    (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g' x /\ g' x < &2 * pi))
    ==>
    (!x y. (&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 /\
      ((f x)*# (cis (g x)) = (f y)*# (cis (g' y)))) ==>
      (x = y) /\ (g x = g' y)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  COPY 0;
  USE 0 (AP_TERM `norm2`);
  USE 0 (REWRITE_RULE[norm2_scale_cis]);
  TYPE_THEN `&0 < f x /\ &0 < f y` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `f x = f y` SUBGOAL_TAC;
  UND 0;
  UND 10;
  UND 11;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  SUBCONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE [INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN  (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  TYPEL_THEN [`g y`;`g' y`;`f y`;`f y`] (fun t-> ANT_TAC (ISPECL t polar_inj));
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[REAL_ARITH `&0 < t ==> &0 <= t`];
  DISCH_THEN DISJ_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  REP_BASIC_TAC;
  UND 13;
  UND 10;
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  (* Wed Aug 18 07:42:54 EDT 2004 *)

  ]);;
  (* }}} *)

let d_euclid_eq_arg = 
prove_by_refinement(
  `!r r' x. (d_euclid (r *# (cis x)) (r' *# (cis x)) = abs  (r - r'))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[cis;point_scale;d_euclid_point];
  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB;POW_MUL;GSYM REAL_ADD_LDISTRIB];
  ONCE_REWRITE_TAC [REAL_ARITH `x + y = y + x`];
  REWRITE_TAC[SIN_CIRCLE];
  REDUCE_TAC;
  REWRITE_TAC[POW_2_SQRT_ABS];
  (* Wed Aug 18 08:15:39 EDT 2004 *)
  ]);;
  (* }}} *)

(* not used *)
let one_over_plus1 = 
prove_by_refinement(
  `!t. (&0 <= t) ==> (t / (&1 + t) <= &1)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  REAL_LE_LDIV;
  UND 0;
  REAL_ARITH_TAC;
  (* Wed Aug 18 08:17:46 EDT 2004 *)

  ]);;
  (* }}} *)

let polar_cont = 
prove_by_refinement(
  `!p f g. continuous f (top_of_metric(UNIV,d_real))
        (top_of_metric(UNIV,d_real)) /\
     continuous g (top_of_metric(UNIV,d_real))
        (top_of_metric(UNIV,d_real)) /\ (euclid 2 p)  ==>
     continuous (\t. p + (f t) *# cis(g t)) (top_of_metric(UNIV,d_real))
        (top2)`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  DISCH_TAC;
  TYPE_THEN `IMAGE (\t. p + (f t) *# cis(g t)) UNIV SUBSET (euclid 2)` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET;IMAGE ];
  ASM_MESON_TAC[euclid_add_closure;polar_euclid];
  REWRITE_TAC[top2];
  UND 0;
  ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_euclid;metric_real];
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  REP_BASIC_TAC;
  RIGHT_TAC "delta";
  DISCH_TAC;
  TYPEL_THEN [`x`;`epsilon/(&2)`] (USE 3 o ISPECL);
  TYPEL_THEN [`x`;`(&1/(&1 + abs  (f x)))*(epsilon/(&2))`] (USE 2 o ISPECL);
  REP_BASIC_TAC;
  TYPE_THEN `&0 < epsilon/(&2)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  DISCH_TAC;
  TYPE_THEN `&0 < &1 / (&1 + abs (f x)) * epsilon / &2` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LT_DIV;
  REAL_ARITH_TAC;
  DISCH_TAC;
  REWR 3;
  REWR 2;
  REP_BASIC_TAC;
  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[min_real];
  UND 3;
  UND 8;
  COND_CASES_TAC;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `d_real x y < delta /\ d_real x y < delta'` SUBGOAL_TAC ;
  UND 9;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  UND 9;
  REAL_ARITH_TAC;
  UND 9;
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  TSPEC `y` 2;
  TSPEC `y` 7;
  REWR 2;
  REWR 7;
  (* A-- *)
  IMATCH_MP_TAC  REAL_LET_TRANS;
  TYPE_THEN `d_euclid (p + f x *# cis(g x)) (p + f x *# cis(g y)) + d_euclid (p + f x *# cis(g y)) (p + f y *# cis(g y))` EXISTS_TAC;
  TYPE_THEN `!z r x r' x'. d_euclid (p + r *# (cis x)) (p + r' *# (cis x')) = d_euclid (r*# (cis x)) (r' *# (cis x'))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  metric_translate_LEFT;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[polar_euclid];
  DISCH_THEN_REWRITE;
  (* end of add-on *)
  CONJ_TAC;
  IMATCH_MP_TAC  metric_space_triangle;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_SIMP_TAC[polar_euclid;metric_euclid];
  REWRITE_TAC[d_euclid_eq_arg];
  TYPEL_THEN[`2`;`f x`;`cis (g x)`;`cis (g y)`] (fun t-> ANT_TAC (ISPECL t norm_scale_vec));
  REWRITE_TAC[cis;euclid_point];
  DISCH_THEN_REWRITE;
  TYPE_THEN `!x y z. (x <= z/ &2 /\ y < z/ &2 ==> x + y < z/ &2 + z/ &2)` SUBGOAL_TAC;
  REAL_ARITH_TAC;
  REWRITE_TAC[REAL_HALF_DOUBLE];
  DISCH_THEN IMATCH_MP_TAC ;
  USE 2 (REWRITE_RULE[d_real]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `abs  (f x) * (&1 / (&1 + abs (f x)) * epsilon / &2)` EXISTS_TAC;
  (* B-- *)
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
  REWRITE_TAC[REAL_MK_NN_ABS];
  IMATCH_MP_TAC (REAL_ARITH `!y. (x <= y /\ y < z) ==> (x <= z)`);
  TYPE_THEN `abs  (g x - g y)` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[d_euclid_cis_ineq];
  USE 7 (REWRITE_RULE[d_real]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_ARITH `(x*y*z <= z) <=> ((x*y)*(z) <= &1 * (z))`];
  IMATCH_MP_TAC  REAL_PROP_LE_RMUL;
  CONJ_TAC;
  REWRITE_TAC[real_div];
  REDUCE_TAC;
  REWRITE_TAC[GSYM real_div];
  IMATCH_MP_TAC  REAL_LE_LDIV;
  REAL_ARITH_TAC;
  UND 5;
  REAL_ARITH_TAC;

  ]);;
  (* }}} *)

let lc_bounds = 
prove_by_refinement(
  `!a b x. (&0 <= x /\ x <= &1) ==> (min_real a b <= x*a + (&1- x)*b) /\
       (x*a + (&1 - x)*b <= max_real a b)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  CONJ_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  ineq_le_tac `a + (&1 - x)*(b - a) = (x*a + (&1- x)*b)`;
  ineq_le_tac `b + x*(a - b) = x*a + (&1- x)*b`;
  REWRITE_TAC[max_real];
  COND_CASES_TAC;
  ineq_le_tac `(x*a + (&1 - x)*b) + (&1 - x)*(a - b) = a`;
  ineq_le_tac `(x*a + (&1 - x)*b) + (x*(b - a)) = b`;
  (* Wed Aug 18 11:52:54 EDT 2004 *)

  ]);;
  (* }}} *)

let min_real_symm = 
prove_by_refinement(
  `!a b. min_real a b = min_real b a`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`));
  ASM_REWRITE_TAC[];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  UND 0;
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let max_real_symm = 
prove_by_refinement(
  `!a b. max_real a b = max_real b a`,

  (* {{{ proof *)
  [
  REP_GEN_TAC;
  REWRITE_TAC[max_real];
  COND_CASES_TAC;
  USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`));
  ASM_REWRITE_TAC[];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  UND 0;
  UND 1;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let curve_annulus_lemma = 
prove_by_refinement(
  `!r g p. (&0 < r) /\ (euclid 2 p) ==>
      (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
           {x | &0 <= x /\ x <= &1})
         SUBSET ({ x | (r/(&2) <= d_euclid p x /\
                             d_euclid p x <= r)} )`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  REP_BASIC_TAC;
  UND 2;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
  TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC;
  IMATCH_MP_TAC  d_euclidpq;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[polar_euclid];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
  TYPE_THEN `r/(&2) < r` SUBGOAL_TAC;
  ASM_MESON_TAC[half_pos];
  DISCH_TAC;
  TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC;
  REWRITE_TAC[min_real;max_real];
  ASM_REWRITE_TAC[];
  COND_CASES_TAC;
  UND 2;
  UND 5;
  REAL_ARITH_TAC;
  REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ;
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  (REAL_ARITH `&0 < x ==> &0 <= x`);
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  ONCE_REWRITE_TAC [min_real_symm];
  ASM_MESON_TAC[lc_bounds];
  REWRITE_TAC[GSYM ABS_REFL];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[lc_bounds;min_real_symm;max_real_symm];
  (* Wed Aug 18 12:13:50 EDT 2004 *)

  ]);;
  (* }}} *)

let curve_circle_lemma = 
prove_by_refinement(
  `!r g p. (&0 < r) /\ (euclid 2 p) ==>
      (((IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
           {x | &0 <= x /\ x <= &1})
     INTER ({ x |  d_euclid p x <= (r/(&2))})) =
                          { ( p + (r/(&2)) *# (cis (g (&0) ))) })
     `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE;SUBSET;INTER;];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  GEN_TAC;
  (* A *)
  EQ_TAC;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  REP_BASIC_TAC;
  CONJ_TAC;
  TYPE_THEN `&0` EXISTS_TAC;
  REDUCE_TAC;
  TYPEL_THEN [`2`;`p`;`(r / &2 *# cis (g (&0)))`] (fun t-> ANT_TAC (ISPECL t d_euclidpq));
  ASM_REWRITE_TAC[polar_euclid];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM norm2;norm2_scale_cis;];
  IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
  REWRITE_TAC[ABS_REFL];
  IMATCH_MP_TAC  (REAL_ARITH `(&0 < x) ==> (&0 <= x)`);
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  REP_BASIC_TAC;
  (* B other direction *)
  UND 3;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  PROOF_BY_CONTR_TAC;
  UND 2;
  TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC;
  IMATCH_MP_TAC  d_euclidpq;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[polar_euclid];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
  TYPE_THEN `r/(&2) < r` SUBGOAL_TAC;
  ASM_MESON_TAC[half_pos];
  DISCH_TAC;
  TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC;
  REWRITE_TAC[min_real;max_real];
  ASM_REWRITE_TAC[];
  COND_CASES_TAC;
  UND 2;
  UND 6;
  REAL_ARITH_TAC;
  REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ;
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  (REAL_ARITH `&0 < x ==> &0 <= x`);
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  ONCE_REWRITE_TAC [min_real_symm];
  ASM_MESON_TAC[lc_bounds];
  REWRITE_TAC[GSYM ABS_REFL];
  DISCH_THEN_REWRITE;
  TYPE_THEN `~(x'  = &0)` SUBGOAL_TAC;
  DISCH_TAC;
  UND 7;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  UND 3;
  REDUCE_TAC;
  DISCH_TAC;
  TYPE_THEN `&0 < x'` SUBGOAL_TAC;
  UND 7;
  UND 5;
  REAL_ARITH_TAC;
  DISCH_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `a < b ==> ~(b <= a)`);
  ineq_lt_tac `(r/ &2) + x'* (r - (r/(&2))) = (x' * r + (&1 - x') * r / &2)`;
  (* Wed Aug 18 12:41:16 EDT 2004 *)

  ]);;
  (* }}} *)

let curve_simple_lemma = 
prove_by_refinement(
  `!r g p. (&0 < r) /\ (euclid 2 p) /\
    (continuous g (top_of_metric(UNIV,d_real))
       (top_of_metric(UNIV,d_real))) ==>
   (simple_arc_end
      (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
           {x | &0 <= x /\ x <= &1}) (p + (r/(&2))*# (cis (g (&0))))
             (p + (r)*# (cis (g (&1)))))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  REP_BASIC_TAC;
  TYPE_THEN `(\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  polar_cont;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
  REWRITE_TAC[linear_cont];
  IMATCH_MP_TAC  polar_fg_inj;
  ASM_REWRITE_TAC[INJ;SUBSET_UNIV ];
  (* -- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  USE 3 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]);
  TYPE_THEN `(x * r + (&1 - x) * r / &2) - (y * r + (&1 - y) * r / &2) = (x - y)*(r - r/(&2)) ` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_TAC;
  REWR 3;
  USE 3(REWRITE_RULE[REAL_ENTIRE]);
  UND 3;
  DISCH_THEN DISJ_CASES_TAC;
  UND 3;
  REAL_ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  UND 3;
  TYPE_THEN `r - r/(&2) = (r/ &2 + r/ &2) - r/ &2` SUBGOAL_TAC;
  REWRITE_TAC[REAL_HALF_DOUBLE];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[REAL_ARITH `(x + x) - x = x`];
  USE 2 (ONCE_REWRITE_RULE  [GSYM REAL_HALF_DOUBLE]);
  USE 2 (REWRITE_RULE[REAL_DIV_LZERO]);
  UND 2;
  REAL_ARITH_TAC;
  (* -- *)
  GEN_TAC;
  DISCH_TAC;
  WITH 3 (MATCH_MP lc_bounds);
  TYPEL_THEN [`r`;`r/ &2`] (USE 4 o ISPECL);
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `min_real r (r/ &2)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `r / &2 < r` SUBGOAL_TAC;
  UND 2;
  MESON_TAC [half_pos];
  TYPE_THEN `&0 < r/ (&2)` SUBGOAL_TAC;
  ASM_MESON_TAC[half_pos];
  TYPE_THEN `a = r/ &2` ABBREV_TAC ;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  (* Wed Aug 18 14:02:54 EDT 2004 *)

  ]);;
  (* }}} *)

let segpath = jordan_def
  `segpath x y t = t* x + (&1 - t)*y` ;;

let segpathxy = 
prove_by_refinement(
  `!x y. segpath x y = (\ t. t*x + (&1 - t)*y)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[segpath];
  ]);;
  (* }}} *)

let segpath_lemma = 
prove_by_refinement(
  `(!x y . (continuous (segpath x y) (top_of_metric(UNIV,d_real))
       (top_of_metric(UNIV,d_real)))) /\
   (!x y b. (&0 <= x /\ x < b /\ &0 <= y /\ y < b ==>
     (!t. &0 <= t /\ t <= &1 ==> &0 <= segpath x y t /\
       segpath x y t < b))) /\
   (!x y x' y' t. (x < x' /\ y < y' /\ &0 <= t /\ t <= &1)
        ==> ~(segpath x y t = segpath x' y' t))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  CONJ_TAC;
  REP_BASIC_TAC;
  ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_real];
  REWRITE_TAC[segpathxy;linear_cont];
  (* -- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[segpath];
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `min_real x y` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[lc_bounds];
  IMATCH_MP_TAC  REAL_LET_TRANS;
  TYPE_THEN `max_real x y` EXISTS_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[lc_bounds];
  REWRITE_TAC[max_real];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[segpath];
  REP_BASIC_TAC;
  UND 0;
  REWRITE_TAC[REAL_ARITH `(u + v = u' + v') <=> ((u' - u) + (v' - v) = &0)`];
  REWRITE_TAC[GSYM REAL_SUB_LDISTRIB];
  TYPE_THEN `t = &0` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  UND 3;
  REAL_ARITH_TAC;
  TYPE_THEN `t = &1` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  REDUCE_TAC;
  UND 4;
  REAL_ARITH_TAC;
  (* -- *)
  TYPE_THEN `&0 < t * (x' - x) + (&1 - t)*(y' - y)` SUBGOAL_TAC;
  ineq_lt_tac `&0 + t * (x' - x) + (&1 - t)*(y' - y) = (t*(x' - x) + (&1- t)*(y' - y))` ;
  UND 5;
  UND 1;
  REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  (* Wed Aug 18 14:48:37 EDT 2004 *)

  ]);;
  (* }}} *)

let segpath_end = 
prove_by_refinement(
  `!x y. ( segpath x y (&0) = y) /\ (segpath x y (&1) = x)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segpath];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let segpath_inj = 
prove_by_refinement(
  `!x y. ~(x = y) ==> INJ (segpath x y) {t | &0 <= t /\ t <= &1} UNIV`,

  (* {{{ proof *)

  [
  REWRITE_TAC[segpath;INJ;SUBSET_UNIV];
  REP_BASIC_TAC;
  USE 0 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]);
  TYPE_THEN `(x' * x + (&1 - x') * y) - (y' * x + (&1 - y') * y) = (x' - y')*(x - y) ` SUBGOAL_TAC;
  real_poly_tac;
  DISCH_TAC;
  REWR 0;
  USE 0(REWRITE_RULE[REAL_ENTIRE]);
  UND 0;
  DISCH_THEN DISJ_CASES_TAC;
  UND 0;
  REAL_ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  UND 0;
  UND 5;
  REAL_ARITH_TAC;
  (* Wed Aug 18 15:15:11 EDT 2004 *)

  ]);;
  (* }}} *)

let degree_vertex_annulus = 
prove_by_refinement(
  `!n r p xx zz. (&0 < r) /\ (euclid 2 p) /\
    (!j. j < n ==> (&0 <= xx j /\ xx j < &2 * pi)) /\
   (!j. j < n ==> (&0 <= zz j /\ zz j < &2 * pi)) /\
    (!i j. (i < j) /\ (j <| n) ==> (xx i < xx j)) /\
       (!i j. (i < j) /\ (j < n) ==> (zz i < zz j))  ==>
    (?C.
       (!i. (i < n) ==>
          simple_arc_end (C i ) (p + (r/ &2)*# (cis(zz i)))
                                (p + r*# (cis(xx i)))) /\
       (!i j. (i < n) /\ (j < n) /\ (~(i=j)) ==>
           (C i INTER C j = EMPTY )) /\
       (!i. (i< n) ==>
           C i SUBSET ({ x | (r/(&2) <= d_euclid p x /\
                             d_euclid p x <= r)} )) /\
       (!i. (i< n) ==>
           (C i INTER  ({ x |  d_euclid p x <= (r/(&2))}) =
                          { ( p + (r/(&2)) *# (cis (zz i ))) }))
       )
    `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `C = ( \ i. IMAGE ( \ t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (segpath (xx i) (zz i)  t))) {t | &0 <= t /\ t <= &1})` ABBREV_TAC ;
  TYPE_THEN `C` EXISTS_TAC;
  (* -- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "C";
  TYPEL_THEN [`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> (ANT_TAC(ISPECL t curve_simple_lemma)));
  ASM_REWRITE_TAC[segpath_lemma];
  REWRITE_TAC[segpath_end];
  (* -- *)
  TYPE_THEN `&0 < r/ &2 /\ r / &2 < r` SUBGOAL_TAC;
  IMATCH_MP_TAC  half_pos;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  REP_BASIC_TAC;
  TYPEL_THEN [`( \ t. t * r + (&1 - t) * r / &2)`;`segpath (xx i) (zz i)`;`segpath (xx j) (zz j)`] (fun t-> ANT_TAC (ISPECL t polar_distinct));
  ASM_REWRITE_TAC[];
  (* --- *)
  CONJ_TAC;
  TYPEL_THEN [`r`;`r / &2`] (fun t-> ANT_TAC(ISPECL t segpath_inj));
  UND 10;
  REAL_ARITH_TAC;
  REWRITE_TAC[segpathxy];
  (* --- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  ineq_lt_tac `&0 + (x* (r - r/(&2))) + (r/ &2) = x*r + (&1 - x)*(r/ &2)`;
  (* --- *)
  ASM_MESON_TAC[segpath_lemma];
  (* -- *)
  DISCH_TAC;
  EXPAND_TAC "C";
  REWRITE_TAC[EQ_EMPTY];
  GEN_TAC;
  REWRITE_TAC[IMAGE;INTER];
  REP_BASIC_TAC;
  UND 13;
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t]));
  TYPEL_THEN[`x'`;`x''`] (USE 12 o ISPECL);
  REWR 12;
  TYPE_THEN `((x'' * r + (&1 - x'') * r / &2) *# cis (segpath (xx j) (zz j) x'')) = ((x' * r + (&1 - x') * r / &2) *# cis (segpath (xx i) (zz i) x'))` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  USE 16 ( (REWRITE_RULE[FUN_EQ_THM]));
  TSPEC `x'''` 13;
  UND 13;
  REWRITE_TAC[euclid_plus];
  REAL_ARITH_TAC;
  DISCH_TAC;
  KILL 16;
  USE 13 (ONCE_REWRITE_RULE [EQ_SYM_EQ]);
  REWR 12;
  REP_BASIC_TAC;
  USE 16 GSYM;
  UND 16;
    DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t]));
  TYPE_THEN `(i <| j) \/ (j < i)` SUBGOAL_TAC;
  UND 7;
  ARITH_TAC;
  (* ---- *)
  DISCH_THEN DISJ_CASES_TAC;
  TYPEL_THEN [`i`;`j`] (USE 0 o ISPECL);
  TYPEL_THEN [`i`;`j`] (USE 1 o ISPECL);
  KILL  2;
  KILL  3;
  KILL 6;
  KILL 13;
  ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)];
  TYPEL_THEN [`j`;`i`] (USE 0 o ISPECL);
  TYPEL_THEN [`j`;`i`] (USE 1 o ISPECL);
  KILL  2;
  KILL  3;
  KILL 6;
  KILL 13;
  ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)];
  (* B-- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "C";
  IMATCH_MP_TAC  curve_annulus_lemma;
  ASM_REWRITE_TAC[];
  (* -- *)
  REP_BASIC_TAC;
  EXPAND_TAC "C";
  TYPEL_THEN[`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> ANT_TAC(ISPECL t curve_circle_lemma));
  ASM_REWRITE_TAC[];
  REWRITE_TAC[segpath_end];
  (* Wed Aug 18 15:57:53 EDT 2004 *)
  ]);;
  (* }}} *)

let closed_ball2_center = 
prove_by_refinement(
  `!p r. closed_ball (euclid 2,d_euclid) p r p <=> (euclid 2 p) /\ (&0 <= r)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed_ball];
  TYPE_THEN `!p. (euclid 2 p) ==> (d_euclid p p = &0)` SUBGOAL_TAC;
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  metric_space_zero;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_euclid];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let degree_vertex_disk = 
prove_by_refinement(
  `!r p xx . (&0 < r) /\ (euclid 2 p) /\
  (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\
    (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j))
  ==>
      (?C.
       (!i. (i< 4) ==> (?C' C'' v.
           simple_arc_end C' p v /\
           simple_arc_end C'' v (p + r*# (cis(xx i )))  /\
           C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\
           (C' INTER C'' = {v}) /\
           (C' UNION C'' = C i )) /\
          simple_arc_end (C i ) p  (p + r*# (cis(xx i))) /\
           C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\
           C i  INTER (closed_ball(euclid 2,d_euclid) p (r / &2))
           SUBSET (hyperplane 2 e2 (p 1) UNION
                     hyperplane 2 e1 (p 0))) /\
       (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==>
           (C i INTER C j = {p} )))
       `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(&0 < (r /(&2))) /\ (euclid 2 p)` SUBGOAL_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  DISCH_THEN (fun t-> MP_TAC (MATCH_MP   degree4_vertex_hv t));
  REP_BASIC_TAC;
  TYPE_THEN `C' = C` ABBREV_TAC ;
  KILL 10;
  TYPE_THEN `zz = (\j. (&j) * pi/(&2))` ABBREV_TAC ;
  TYPE_THEN `(&0 < r) /\ (euclid 2 p) /\  (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\  (!j. j < 4 ==> (&0 <= zz j /\ zz j < &2 * pi)) /\  (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j)) /\ (!i j. (i < j) /\ (j < 4) ==> (zz i < zz j))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  EXPAND_TAC "zz";
  REP_BASIC_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_MUL;
  CONJ_TAC;
  REDUCE_TAC;
  IMATCH_MP_TAC  REAL_LE_DIV;
  MP_TAC PI_POS;
  REAL_ARITH_TAC;
  REWRITE_TAC[real_div;REAL_ARITH `pi*x = x*pi`];
  REWRITE_TAC[REAL_ARITH `x*y*z = (x*y)*z`];
  IMATCH_MP_TAC  REAL_PROP_LT_RMUL;
  ASM_REWRITE_TAC[PI_POS;GSYM real_div;];
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ;REAL_ARITH `&0 < &2`];
  REDUCE_TAC;
  UND 11;
  ARITH_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "zz";
  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> (&0 < y - x)`];
  REWRITE_TAC[REAL_ARITH `x*y - z*y = (x - z)*y`];
  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
  REWRITE_TAC[PI2_BOUNDS];
  REDUCE_TAC;
  UND 12;
  REWRITE_TAC[REAL_ARITH `&0 < &j - &i <=> &i < &j`];
  REDUCE_TAC;
  DISCH_THEN (fun t-> MP_TAC (MATCH_MP degree_vertex_annulus t));
  REP_BASIC_TAC;
  (* A *)
  TYPE_THEN `(\j. C' j UNION C'' j)` EXISTS_TAC;
  BETA_TAC;
  (* B 1st conjunct *)
  TYPE_THEN `!i. (i<| 4) ==> (simple_arc_end (C' i ) p (p + ((r/ &2) *# (cis (&i * pi/(&2))))) /\   simple_arc_end (C'' i) (p + ((r/ &2) *# (cis (&i * pi/(&2))))) (euclid_plus p (r *# cis (xx i))) /\ (C' i) SUBSET closed_ball (euclid 2,d_euclid) p (r / &2) /\  ((C' i) INTER (C'' i) = {(p + ((r/ &2) *# (cis (&i * pi/(&2)))))})) ` SUBGOAL_TAC;
  REP_BASIC_TAC;
  SUBCONJ_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  SUBCONJ_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  SUBCONJ_TAC;
  ASM_MESON_TAC[];
  DISCH_TAC;
  REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INR IN_SING;INTER ];
  EQ_TAC;
  DISCH_TAC;
  TYPE_THEN `closed_ball (euclid 2,d_euclid) p (r / &2) x` SUBGOAL_TAC;
  UND 18;
  REWRITE_TAC[SUBSET];
  UND 19;
  MESON_TAC[];
  TSPEC `i` 11;
  REWR 11;
  REWRITE_TAC[closed_ball];
  FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
  UND 19;
  REWRITE_TAC[INTER;INR IN_SING;];
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  EXPAND_TAC "zz";
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  UND 17;
  UND 16;
  MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* [C] 1nd conjunct. simple-arc-end; *)
  TYPE_THEN `D = closed_ball (euclid 2,d_euclid) p (r /(&2))` ABBREV_TAC ;
  TYPE_THEN `!i x. (i <| 4) /\ (D x) ==> ((C' i UNION C'' i) x = C' i x)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[UNION];
  IMATCH_MP_TAC  (TAUT `(b ==> a) ==> (a \/ b <=> a)`);
  TSPEC `i` 11;
  REWR 11;
  FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
  UND 17;
  EXPAND_TAC"D";
  REWRITE_TAC[closed_ball];
  REWRITE_TAC[INTER;INR IN_SING];
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[simple_arc_end_end2];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!i x. (i <| 4) /\ ~(D x) ==> ((C' i UNION C'' i) x = C'' i x)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[UNION];
  IMATCH_MP_TAC  (TAUT `(a ==> b) ==> (a \/ b <=> b)`);
  TSPEC `i` 5;
  REWR 5;
  USE 5 (REWRITE_RULE[SUBSET]);
  TSPEC `x` 5;
  UND 5;
  UND 18;
  MESON_TAC[];
  DISCH_TAC;
  ONCE_REWRITE_TAC [TAUT `(x /\ y) <=> (y /\ x)`];
  (* D-- *)
  CONJ_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER;INR IN_SING];
  TYPE_THEN `D x` ASM_CASES_TAC;
  TYPEL_THEN [`i`;`x`] (WITH 17 o ISPECL);
  TYPEL_THEN [`j`;`x`] (WITH 17 o ISPECL);
  UND 23;
  UND 24;
  KILL 17;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  TYPEL_THEN [`i`;`j`;] (USE 7 o ISPECL);
  REWR 7;
  FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
  REWRITE_TAC[INTER;INR IN_SING];
  (* --2-- *)
  TYPEL_THEN [`i`;`x`] (WITH 18 o ISPECL);
  TYPEL_THEN [`j`;`x`] (WITH 18 o ISPECL);
  UND 23;
  UND 24;
  KILL 18;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  TYPEL_THEN [`i`;`j`;] (USE 13 o ISPECL);
  REWR 13;
  USE 13 (REWRITE_RULE[EQ_EMPTY;INTER ]);
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 18(REWRITE_RULE[]);
  UND 18;
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
  UND 22;
  REWRITE_TAC[];
  EXPAND_TAC "D";
  REWRITE_TAC[closed_ball2_center];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  (REAL_ARITH `&0 <x ==> &0 <= x`);
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  (* E *)
  REP_BASIC_TAC;
  CONJ_TAC;
  TYPE_THEN `C' i` EXISTS_TAC;
  TYPE_THEN `C'' i` EXISTS_TAC;
  TYPE_THEN `p + (r / &2 *# cis (&i * pi / &2))` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_trans;
  ASM_MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  TSPEC `i` 5;
  UND 5;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "D";
  REWRITE_TAC[SUBSET;closed_ball;];
  TYPE_THEN `r / &2 < r` SUBGOAL_TAC;
  UND 3;
  MESON_TAC[half_pos];
  MESON_TAC[REAL_ARITH `(x <= y) /\ (y < z) ==> (x <= z)`];
  TSPEC `i` 12;
  UND 12;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;closed_ball];
  ASM_REWRITE_TAC[];
  TSPEC `i` 14;
  REWR 12;
  TYPE_THEN `C'' i SUBSET (euclid 2)` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  UND 12;
  MESON_TAC[];
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  (* -- *)
  KILL 15;
  KILL 9;
  KILL 8;
  KILL 11;
  KILL 12;
  TYPE_THEN `(C' i UNION C'' i) INTER D = (C' i INTER D)` SUBGOAL_TAC;
  REWRITE_TAC[INTER];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  UND 17;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TSPEC `i` 4;
  REWR 4;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C' i` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER;SUBSET];
  MESON_TAC[];
  (* Thu Aug 19 07:36:47 EDT 2004 *)

   ]);;
  (* }}} *)

let euclid_cancel1 = 
prove_by_refinement(
  `!x y z. (x = euclid_plus y z) <=> (x - y = z)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  EQ_TAC;
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[euclid_plus;euclid_minus];
  REAL_ARITH_TAC;
  DISCH_TAC;
  USE 0 SYM;
  ASM_REWRITE_TAC[];
    IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[euclid_plus;euclid_minus];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let infinite_subset = 
prove_by_refinement(
  `!(X:A->bool) Y. INFINITE X /\ X SUBSET Y ==> INFINITE Y`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INFINITE];
  MESON_TAC[FINITE_SUBSET];
  ]);;
  (* }}} *)

let EXPinj = 
prove_by_refinement(
  `!x y n. (1 < n) /\ (n **| x = n **| y) ==> (x = y)`,

  (* {{{ proof *)
  [
  TYPE_THEN `! x y n. (x <| y) /\ (n **| x = n **| y) ==> ~(1 <| n)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `n **| y <= n **| x` SUBGOAL_TAC;
  UND 1;
  ARITH_TAC;
  REWRITE_TAC[LE_EXP];
  TYPE_THEN `~(n = 0)` SUBGOAL_TAC;
  UND 0;
  ARITH_TAC;
  DISCH_THEN_REWRITE;
  REWRITE_TAC[DE_MORGAN_THM];
  CONJ_TAC;
  UND 0;
  ARITH_TAC;
  UND 2;
  ARITH_TAC;
  DISCH_TAC;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `x < y \/ y <| x` SUBGOAL_TAC;
  UND 3;
  ARITH_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  TYPEL_THEN[`x`;`y`;`n`] (USE 0 o ISPECL);
  ASM_MESON_TAC[];
  TYPEL_THEN[`y`;`x`;`n`] (USE 0 o ISPECL);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let infinite_interval = 
prove_by_refinement(
  `!a b. a < b ==> (INFINITE {x | a < x /\ x < b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  infinite_subset;
  TYPE_THEN `f = (\ n. a + (b-a)/((&2) pow (SUC n)))` ABBREV_TAC ;
  TYPE_THEN `IMAGE f  UNIV` EXISTS_TAC ;
  CONJ_TAC;
  TYPE_THEN `(! x y. (f x = f y) ==> (x = y))` SUBGOAL_TAC;
  EXPAND_TAC "f";
  REP_BASIC_TAC;
  USE 2 (REWRITE_RULE[REAL_ARITH `(a + d = a + d') <=> (d = d')`;real_div;REAL_PROP_EQ_RMUL_';]);
  TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC;
  UND 0;
  REAL_ARITH_TAC;
  DISCH_TAC;
  REWR 2;
  USE 2 (REWRITE_RULE[GSYM REAL_EQ_INV]);
  UND 2;
  REDUCE_TAC;
  DISCH_TAC;
  ONCE_REWRITE_TAC[GSYM SUC_INJ];
  IMATCH_MP_TAC  EXPinj;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ARITH_TAC;
  DISCH_TAC;
  TYPE_THEN `INFINITE (UNIV:num->bool) ==> INFINITE (IMAGE f UNIV)` SUBGOAL_TAC;
  ASM_MESON_TAC[INFINITE_IMAGE_INJ];
  REWRITE_TAC[num_INFINITE];
  (* -- *)
  REWRITE_TAC[IMAGE;SUBSET];
  GEN_TAC;
  REP_BASIC_TAC;
  UND 2;
  DISCH_THEN_REWRITE;
  EXPAND_TAC "f";
  CONJ_TAC;
  ONCE_REWRITE_TAC[REAL_ARITH `a < a + x <=> &0 < x`];
  REWRITE_TAC[real_div];
  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
  CONJ_TAC;
  UND 0;
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  REAL_PROP_POS_INV;
  REDUCE_TAC;
  ARITH_TAC;
  ONCE_REWRITE_TAC [REAL_ARITH `a + x < b <=> x < (b - a)*(&1)`];
  REWRITE_TAC[real_div];
  IMATCH_MP_TAC  REAL_PROP_LT_LMUL;
  CONJ_TAC;
  UND 0;
  REAL_ARITH_TAC;
  ONCE_REWRITE_TAC[GSYM REAL_INV_1];
  IMATCH_MP_TAC  REAL_LT_INV2;
  REDUCE_TAC;
  IMATCH_MP_TAC  exp_gt1;
  ARITH_TAC;
  (* Thu Aug 19 14:59:58 EDT 2004 *)
  ]);;
  (* }}} *)

let finite_augment1 = 
prove_by_refinement(
  `!n (X:A->bool) . (INFINITE X) ==> (?Z. Z SUBSET X /\ Z HAS_SIZE n)`,

  (* {{{ proof *)
  [
  INDUCT_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `EMPTY:A->bool` EXISTS_TAC  ;
  REWRITE_TAC[HAS_SIZE_0];
  REP_BASIC_TAC;
  TSPEC `X` 0;
  REWR 0;
  REP_BASIC_TAC;
  TYPE_THEN `INFINITE (X DIFF Z)` SUBGOAL_TAC;
  IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[HAS_SIZE];
  DISCH_TAC;
  USE 3 (MATCH_MP INFINITE_NONEMPTY);
  USE 3 (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  TYPE_THEN `u INSERT Z` EXISTS_TAC;
  CONJ_TAC;
  UND 2;
  UND 3;
  REWRITE_TAC[DIFF;SUBSET;INSERT];
  ASM_MESON_TAC[];
  (* -- *)
  USE 0 (REWRITE_RULE[HAS_SIZE]);
  ASM_SIMP_TAC [HAS_SIZE;FINITE_INSERT;CARD_CLAUSES;];
  UND 3;
  REWRITE_TAC[DIFF];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let finite_augment = 
prove_by_refinement(
  `!(X:A->bool) Y n m . (n <= m) /\ (X HAS_SIZE n) /\ (INFINITE Y) /\
   (X SUBSET Y) ==> (?Z. (X SUBSET Z /\ Z SUBSET Y /\ Z HAS_SIZE m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `INFINITE (Y DIFF X)` SUBGOAL_TAC;
  IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
  ASM_MESON_TAC[HAS_SIZE];
  DISCH_TAC;
  USE 4(MATCH_MP finite_augment1);
  USE 3(REWRITE_RULE[LE_EXISTS]);
  REP_BASIC_TAC;
  TSPEC `d` 4;
  REP_BASIC_TAC;
  TYPE_THEN `X UNION Z` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  REWRITE_TAC[union_subset];
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 5;
  SET_TAC[SUBSET;DIFF];
  REWRITE_TAC[HAS_SIZE];
  CONJ_TAC;
  ASM_REWRITE_TAC[FINITE_UNION];
  ASM_MESON_TAC[HAS_SIZE];
  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
  REP_BASIC_TAC;
  EXPAND_TAC "d";
  EXPAND_TAC "n";
  IMATCH_MP_TAC  CARD_UNION;
  ASM_REWRITE_TAC[];
  UND 5;
  REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY ];
  MESON_TAC[];
  (* Thu Aug 19 15:29:05 EDT 2004 *)

  ]);;
  (* }}} *)

let euclid_add_cancel = 
prove_by_refinement(
  `!p q q'. (euclid_plus p q = euclid_plus p q') <=> (q = q')`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC [euclid_plus;];
  REWRITE_TAC[REAL_ARITH `(x + a = x + b) <=> (a = b)`];
  ]);;
  (* }}} *)


let degree_vertex_disk_ver2 = 
prove_by_refinement(
  `!r p X. (&0 < r) /\ (euclid 2 p) /\ (FINITE X) /\ (CARD X <= 4) /\
     (X SUBSET {x | (euclid 2 x) /\ (d_euclid p x = r)}) ==>
    (?C. (!i. (X i) ==> (?C' C'' v.
           simple_arc_end C' p v /\
           simple_arc_end C'' v i  /\
           C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\
           (C' INTER C'' = {v}) /\
           (C' UNION C'' = C i )) /\
          simple_arc_end (C i ) p  i /\
           C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\
           C i  INTER (closed_ball(euclid 2,d_euclid) p (r / &2))
           SUBSET (hyperplane 2 e2 (p 1) UNION
                     hyperplane 2 e1 (p 0))) /\
       (!i j. (X i ) /\ (X j) /\ (~(i=j)) ==>
           (C i INTER C j = {p} )))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!x. (X x) ==> (?r t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[euclid_cancel1];
  IMATCH_MP_TAC  polar_exist;
  USE 0(REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[euclid_sub_closure];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!x. (X x) ==> (?t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TSPEC `x` 5;
  REWR 5;
  REP_BASIC_TAC;
  UND 5;
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
  TYPE_THEN `t` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 4;
  REAL_ARITH_TAC;
  USE 0 (REWRITE_RULE[SUBSET]);
  TSPEC `euclid_plus p (r' *# cis t)` 0;
  REWR 0;
  REP_BASIC_TAC;
  UND 0;
  TYPEL_THEN[`2`;`p`;`r' *# cis t`] (fun t-> ANT_TAC (ISPECL t d_euclidpq));
  ASM_REWRITE_TAC[polar_euclid];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
  DISCH_TAC;
  TYPE_THEN `abs  r' = r'` SUBGOAL_TAC;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_TAC;
  REWR 0;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  KILL 5;
  (* -- *)
  TYPE_THEN `TX = {t | (&0 <= t /\ t < &2 *pi /\ (X( p + (r *# (cis t))))) }` ABBREV_TAC ;
  TYPE_THEN `BIJ ( \ t. p + r *# cis t) TX X` SUBGOAL_TAC;
  REWRITE_TAC[BIJ;INJ;SURJ];
  SUBCONJ_TAC;
  CONJ_TAC;
  EXPAND_TAC "TX";
  REWRITE_TAC[];
  MESON_TAC[];
  EXPAND_TAC "TX";
  REWRITE_TAC[];
  REP_BASIC_TAC;
  USE 7 (REWRITE_RULE[euclid_add_cancel]);
  PROOF_BY_CONTR_TAC;
  TYPEL_THEN[`x`;`y`;`r`;`r`] (fun t-> ANT_TAC(ISPECL t polar_inj));
  ASM_REWRITE_TAC[];
  UND 4;
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  UND 4;
  REAL_ARITH_TAC;
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  EXPAND_TAC "TX";
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `INFINITE {x | &0 <= x /\ x < &2* pi}` SUBGOAL_TAC;
  IMATCH_MP_TAC  infinite_subset;
  TYPE_THEN `{x | &0 < x /\ x < &2 * pi}` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  infinite_interval;
  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
  REWRITE_TAC[PI_POS];
  REAL_ARITH_TAC;
  REWRITE_TAC[SUBSET];
  MESON_TAC[REAL_ARITH `&0 < x ==> &0 <= x`];
  DISCH_TAC;
  (* A -- *)
  TYPE_THEN `TX HAS_SIZE CARD X` SUBGOAL_TAC;
  REWRITE_TAC[HAS_SIZE];
  SUBCONJ_TAC;
  COPY 7;
  JOIN 2 7;
  USE 2 (MATCH_MP FINITE_BIJ2);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  IMATCH_MP_TAC BIJ_CARD;
  ASM_REWRITE_TAC [];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `(?Z. (TX SUBSET Z /\ Z SUBSET {x | &0 <= x /\ x < &2 *pi}  /\ Z HAS_SIZE 4))` SUBGOAL_TAC;
  IMATCH_MP_TAC  finite_augment;
  TYPE_THEN `CARD X` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC"TX";
  REWRITE_TAC[SUBSET];
  REAL_ARITH_TAC;
  REP_BASIC_TAC;
  (* B -- order points *)
  TYPE_THEN `FINITE Z` SUBGOAL_TAC;
  ASM_MESON_TAC[HAS_SIZE];
  DISCH_TAC;
  USE 13 (MATCH_MP real_finite_increase);
  REP_BASIC_TAC;
  USE 10(REWRITE_RULE[HAS_SIZE]);
  REP_BASIC_TAC;
  REWR 13;
  REWR 14;
  (* -- *)
  TYPEL_THEN [`r`;`p`;`u`] (fun t-> ANT_TAC (ISPECL t degree_vertex_disk));
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 14;
  REWRITE_TAC[BIJ;SURJ];
  REP_BASIC_TAC;
  USE 11(REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 16;
  UND 17;
  ARITH_TAC;
  REP_BASIC_TAC;
  (* [C] -- create C *)
  TYPE_THEN `f = (\t. euclid_plus p (r *# cis t))` ABBREV_TAC ;
  TYPE_THEN `g = INV f TX X` ABBREV_TAC ;
  TYPE_THEN `u' = INV u {x | x <| 4} Z` ABBREV_TAC ;
  TYPE_THEN `BIJ g X TX` SUBGOAL_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `BIJ u' Z {x | x <| 4}` SUBGOAL_TAC;
  EXPAND_TAC "u'";
  IMATCH_MP_TAC  INVERSE_BIJ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `INJ (compose u'  g) X { x | x <| 4}` SUBGOAL_TAC;
  IMATCH_MP_TAC  COMP_INJ;
  TYPE_THEN `TX` EXISTS_TAC;
  CONJ_TAC;
  UND 21;
  REWRITE_TAC[BIJ];
  MESON_TAC[];
  IMATCH_MP_TAC  inj_subset_domain;
  TYPE_THEN `Z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 22;
  REWRITE_TAC [BIJ];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  TYPE_THEN `(\ j. C ((compose u' g) j))` EXISTS_TAC;
  REWRITE_TAC[];
  (* D -- check properties *)
  CONJ_TAC;
  REP_BASIC_TAC;
  TYPE_THEN   `j = compose u' g i` ABBREV_TAC ;
  TSPEC `j` 17;
  TYPE_THEN `j <| 4` SUBGOAL_TAC;
  USE 23 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  EXPAND_TAC "j";
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 17;
  ASM_REWRITE_TAC[];
  (* --2-- *)
  TYPE_THEN `i = f (u j)` SUBGOAL_TAC;
  EXPAND_TAC "j";
  EXPAND_TAC "f";
  EXPAND_TAC "u'";
  REWRITE_TAC[compose];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  TYPE_THEN `u (INV u {x | x <| 4} Z (g i)) = (g i)` SUBGOAL_TAC;
  IMATCH_MP_TAC  inv_comp_right;
  ASM_REWRITE_TAC[];
  UND 21;
  UND 12;
  REWRITE_TAC[SUBSET;BIJ;SURJ;];
  UND 24;
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `f (g i) = i` SUBGOAL_TAC;
  EXPAND_TAC "g";
  IMATCH_MP_TAC  inv_comp_right;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "f";
  DISCH_THEN_REWRITE;
  EXPAND_TAC "f";
  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[GSYM t]));
  ASM_REWRITE_TAC[];
  (* E *)
  REP_BASIC_TAC;
  TYPE_THEN `i' = compose u' g i` ABBREV_TAC ;
  TYPE_THEN `j' = compose u' g j` ABBREV_TAC ;
  KILL 17;
  TYPE_THEN `~(i' = j')` SUBGOAL_TAC;
  DISCH_TAC;
  UND 24;
  REWRITE_TAC[];
  USE 23 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `(i' <| 4) /\ (j' <| 4) ` SUBGOAL_TAC;
  EXPAND_TAC "i'";
  EXPAND_TAC "j'";
  USE 23 (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPEL_THEN [`i'`;`j'`] (USE 16 o ISPECL);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Thu Aug 19 18:06:33 EDT 2004 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION O *)
(* ------------------------------------------------------------------ *)


let simple_arc_connected = 
prove_by_refinement(
  `!C. simple_arc top2 C ==> connected top2 C`,

  (* {{{ proof *)

  [
  REWRITE_TAC[simple_arc;];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  connect_image;
  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
  ASM_REWRITE_TAC[connect_real];
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  REP_BASIC_TAC;
  ASM_SIMP_TAC[];
  (* Fri Aug 20 08:32:31 EDT 2004 *)
  ]);;
  (* }}} *)

let disk_endpoint = 
prove_by_refinement(
  `!C r p v v'. simple_arc_end C v v' /\ (&0 < r) /\ (euclid 2 p) /\
       (C INTER (closed_ball(euclid 2,d_euclid) p r) = {v}) ==>
      (d_euclid p v = r)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `connected top2 C` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_connected;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `A = euclid 2 DIFF (closed_ball (euclid 2, d_euclid) p r)` ABBREV_TAC ;
  TYPE_THEN `B = closed_ball(euclid 2, d_euclid) p r` ABBREV_TAC ;
  TYPE_THEN `closed_ top2 B` SUBGOAL_TAC;
  EXPAND_TAC "B";
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  closed_ball_closed;
  REWRITE_TAC[metric_euclid];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `top2 A` SUBGOAL_TAC;
  UND 8;
  EXPAND_TAC "A";
  EXPAND_TAC "B";
  REWRITE_TAC[closed;top2_unions;open_DEF ;];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* - *)
  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `B' = open_ball(euclid 2,d_euclid) p r` ABBREV_TAC ;
  TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC;
  EXPAND_TAC "A";
  EXPAND_TAC "B'";
  EXPAND_TAC "B";
  REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION];
  USE 10 (REWRITE_RULE[SUBSET]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TSPEC `x` 10;
  REWR 10;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 13 (REWRITE_RULE[DE_MORGAN_THM]);
  REP_BASIC_TAC;
  TYPE_THEN `B x` SUBGOAL_TAC;
  EXPAND_TAC "B";
  REWRITE_TAC[closed_ball];
  ASM_REWRITE_TAC[];
  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_MESON_TAC[REAL_ARITH `u <= v /\ ~(u = v) ==> (u < v)`];
  (* - *)
  USE 5 (REWRITE_RULE[connected;top2_unions]);
  REP_BASIC_TAC;
  TYPEL_THEN[`B'`;`A`] (USE 12 o ISPECL);
  REWR 12;
  TYPE_THEN `top2 B'` SUBGOAL_TAC;
  EXPAND_TAC "B'";
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  open_ball_open;
  REWRITE_TAC[metric_euclid];
  DISCH_THEN_FULL_REWRITE;
  (* - *)
  TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC;
  EXPAND_TAC "A";
  EXPAND_TAC "B'";
  EXPAND_TAC "B";
  REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;];
  REP_BASIC_TAC;
  UND 14;
  ASM_REWRITE_TAC[];
  UND 16;
  REAL_ARITH_TAC;
  DISCH_THEN_FULL_REWRITE;
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `C SUBSET B` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `B'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "B";
  EXPAND_TAC "B'";
  REWRITE_TAC[SUBSET;open_ball;closed_ball];
  MESON_TAC[REAL_ARITH `x < y ==> x <= y`];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `~(v = v')` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_distinct;
  ASM_MESON_TAC[];
  REWRITE_TAC[];
  TYPE_THEN `C v'` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end2];
  DISCH_TAC;
  TYPE_THEN `B v'` SUBGOAL_TAC;
  UND 15;
  UND 16;
  MESON_TAC[ISUBSET];
  UND 16;
  UND 0;
  REWRITE_TAC[INTER;eq_sing];
  MESON_TAC[];
  (* - *)
  TYPE_THEN `C v` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  DISCH_TAC;
  TYPE_THEN `A v` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  TYPE_THEN `B v` SUBGOAL_TAC;
  UND 0;
  REWRITE_TAC[INTER;eq_sing];
  DISCH_THEN_REWRITE;
  EXPAND_TAC "A";
  REWRITE_TAC[DIFF];
  DISCH_THEN_REWRITE;
  (* Fri Aug 20 09:12:44 EDT 2004 *)

  ]);;
  (* }}} *)

let disk_endpoint_gen = 
prove_by_refinement(
  `!C B' B v v'. simple_arc_end C v v'  /\
      (top2 B') /\ (closed_ top2 B) /\ (B' SUBSET B) /\
       (C INTER B = {v}) ==>
      (~(B' v))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `connected top2 C` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_connected;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `A = euclid 2 DIFF B` ABBREV_TAC ;
  (* - *)
  TYPE_THEN `top2 A` SUBGOAL_TAC;
  EXPAND_TAC "A";
  UND 3;
  REWRITE_TAC[closed;top2_unions;open_DEF ;];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* - *)
  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC;
  EXPAND_TAC "A";
  REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION];
  USE 9 (REWRITE_RULE[SUBSET]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `B x` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  USE 1(REWRITE_RULE[INTER;eq_sing]);
  REP_BASIC_TAC;
  TYPE_THEN `(x = v)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  DISJ2_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  DISCH_TAC;
  USE 6 (REWRITE_RULE[connected;top2_unions]);
  REP_BASIC_TAC;
  TYPEL_THEN[`B'`;`A`] (USE 6 o ISPECL);
  REWR 6;
  (* - *)
  TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC;
  EXPAND_TAC "A";
  REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  DISCH_THEN_FULL_REWRITE;
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `C SUBSET B` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `B'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `~(v = v')` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_distinct;
  ASM_MESON_TAC[];
  REWRITE_TAC[];
  TYPE_THEN `C v'` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end2];
  DISCH_TAC;
  TYPE_THEN `B v'` SUBGOAL_TAC;
  UND 13;
  UND 14;
  MESON_TAC[ISUBSET];
  UND 14;
  UND 1;
  REWRITE_TAC[INTER;eq_sing];
  MESON_TAC[];
  (* - *)
  TYPE_THEN `C v` SUBGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  DISCH_TAC;
  TYPE_THEN `A v` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  TYPE_THEN `B v` SUBGOAL_TAC;
  UND 1;
  REWRITE_TAC[INTER;eq_sing];
  DISCH_THEN_REWRITE;
  EXPAND_TAC "A";
  REWRITE_TAC[DIFF];
  DISCH_THEN_REWRITE;
  ]);;
  (* }}} *)

let disk_endpoint_outer = 
prove_by_refinement(
  `!C r p v v'. simple_arc_end C v v'  /\ (&0 < r) /\ (euclid 2 p) /\
      (C INTER (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r)) = {v})
     ==>
      (d_euclid p v = r)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `B = (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ;
  TYPE_THEN `B' = (euclid 2 DIFF (closed_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ;
  (* - *)
  TYPE_THEN `B' SUBSET B` SUBGOAL_TAC;
  EXPAND_TAC "B'";
  EXPAND_TAC "B";
  REWRITE_TAC[closed_ball;open_ball;SUBSET;DIFF];
  MESON_TAC[REAL_ARITH `x < u ==> x <= u`];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `closed_ top2 B` SUBGOAL_TAC;
  EXPAND_TAC "B";
  REWRITE_TAC[closed;top2_unions;open_DEF ;SUBSET_DIFF];
  TYPE_THEN `open_ball (euclid 2,d_euclid) p r SUBSET (euclid 2)` SUBGOAL_TAC;
  REWRITE_TAC[open_ball;SUBSET];
  MESON_TAC[];
  ASM_SIMP_TAC[DIFF_DIFF2];
  ASM_SIMP_TAC [open_ball_open;top2;metric_euclid];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `top2 B'` SUBGOAL_TAC;
  EXPAND_TAC "B'";
  TH_INTRO_TAC [`top2`;`closed_ball (euclid 2,d_euclid) p r`] closed_open;
  REWRITE_TAC[metric_euclid;top2];
  IMATCH_MP_TAC  closed_ball_closed;
  REWRITE_TAC[metric_euclid];
  REWRITE_TAC[open_DEF;top2_unions;];
  DISCH_TAC;
  (* - *)
  TH_INTRO_TAC [`C`;`B'`;`B`;`v`;`v'`] disk_endpoint_gen;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `B v` SUBGOAL_TAC;
  UND 0;
  REWRITE_TAC[INTER;eq_sing];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* - *)
  TYPE_THEN `B v /\ ~B' v ==> (d_euclid p v = r)` SUBGOAL_TAC;
  EXPAND_TAC "B";
  EXPAND_TAC "B'";
  REWRITE_TAC[DIFF;open_ball;closed_ball;];
  MESON_TAC[REAL_ARITH `x <= y /\ ~(x < y) ==> (x = y)`];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let graph_edge_around = jordan_def
  `graph_edge_around (G:(A,B)graph_t) v =
   { e | graph_edge G e /\ graph_inc G e v}`;;

let graph_edge_around_empty = 
prove_by_refinement(
  `!(G:(A,B)graph_t) v. (graph G) /\ ~(graph_vertex G v) ==>
      (graph_edge_around G v = EMPTY)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[graph_edge_around;EQ_EMPTY;];
  REP_BASIC_TAC;
  TH_INTRO_TAC [`G`;`x`] graph_inc_subset;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* Fri Aug 20 09:25:57 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_disk_hv_preliminaries = 
prove_by_refinement(
  `!G. plane_graph G /\
      FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
      ~(graph_edge G = EMPTY) /\
     (!v. (CARD (graph_edge_around G v) <=| 4))
   ==>
  (?NC D short_end hyper r d f. ((!e p. graph_edge G e /\ (!v. ~D v p) ==> (f e p = d e p)) /\
  (!e v p.
           graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v /\ D v p
           ==> ~f e p) /\
  (!e v p.
           (graph_edge G e /\ graph_inc G e v) /\ D v p
           ==> (f e p = NC e v p)) /\
  (!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}) /\
  (!v e e'.
           graph_edge G e /\
           graph_edge G e' /\
           graph_inc G e v /\
           graph_inc G e' v /\
           ~(e = e')
           ==> (NC e v INTER NC e' v = {v})) /\
  (!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)) /\
  (!e e'.
           graph_edge G e /\ graph_edge G e' /\ ~(e = e')
           ==> (d e INTER d e' = {})) /\
  (!e v.
           graph_edge G e /\ graph_inc G e v
           ==> ~graph_vertex G (short_end e v)) /\
  (!v v'.
           graph_vertex G v /\ graph_vertex G v' /\ ~(v = v')
           ==> (D v INTER D v' = {})) /\
  (!e v.
           graph_edge G e /\ graph_inc G e v
           ==> simple_arc_end (NC e v) v (short_end e v) /\
               NC e v SUBSET D v /\
               hyper (NC e v) v) /\
  ((\ B v.
            B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET
            hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) =
       hyper) /\
  (!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v) /\
  (!e v.
           graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v
           ==> (d e INTER D v = {})) /\
  (!e. graph_edge G e ==> d e SUBSET e) /\
  (!e v.
           graph_edge G e /\ graph_inc G e v
           ==> (d e INTER D v = {(short_end e v)}) /\
               (d_euclid v (short_end e v) = r) /\
               (!v'. graph_inc G e v' /\ ~(v = v')
                     ==> simple_arc_end (d e) (short_end e v)
                         (short_end e v'))) /\
  (!v. euclid 2 v ==> D v v) /\
  (!u. closed_ top2 (D u)) /\
  (( \ u. closed_ball (euclid 2,d_euclid) u r) = D) /\
  (&0 < r) /\
  (plane_graph G)))
     `,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TH_INTRO_TAC [`G`] graph_disk;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* TYPE_THEN `r /(&2)` EXISTS_TAC; *)
  (* - *)
  TYPE_THEN `D = (\u. (closed_ball (euclid 2,d_euclid ) u r))` ABBREV_TAC ;
  TYPE_THEN `!u. closed_ top2 (D u)` SUBGOAL_TAC;
  EXPAND_TAC "D";
  GEN_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  closed_ball_closed;
  REWRITE_TAC[metric_euclid];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!v. (euclid 2 v) ==> D v v` SUBGOAL_TAC;
  EXPAND_TAC "D";
  REWRITE_TAC[closed_ball2_center];
  GEN_TAC;
  DISCH_THEN_REWRITE;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* - *)
  (* [A]- Pick middle arcs *)
  (* {{{ *)

  TYPE_THEN `!e. ?d. (graph_edge G e) ==> (?u u' v v'.  simple_arc_end d u u' /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') /\  (d INTER (D v) = {u}) /\ (d INTER (D v') = {u'}) /\ (d SUBSET e) /\ (d_euclid v u = r) /\ (d_euclid v' u' = r))` SUBGOAL_TAC ;
  GEN_TAC;
  RIGHT_TAC "d";
  DISCH_TAC;
  TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);  (* -xx- *)
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TH_INTRO_TAC [`e`;`D v`;`D v'`] simple_arc_end_restriction;
  ASM_REWRITE_TAC[GSYM top2];
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  USE 16 (REWRITE_RULE[SUBSET ]);
  ASM_MESON_TAC[];
  UND 6;
  DISCH_THEN (TH_INTRO_TAC [`v`;`v'`] );
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE [plane_graph;]);
  ASM_MESON_TAC[REWRITE_RULE[SUBSET] graph_inc_subset];
  DISCH_TAC;
  CONJ_TAC;
  EXPAND_TAC "D";
  UND 6;
  REWRITE_TAC[INTER;EQ_EMPTY];
  MESON_TAC[];
  REWRITE_TAC[EMPTY_EXISTS ];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TSPEC `e` 15;
  REWR 15;
  REWR 13;
  REWR 14;
  UND 18;
  REWRITE_TAC[SUBSET];
  UND 13;
  UND 14;
  REWRITE_TAC[INTER];
  UND 10;
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `v''` EXISTS_TAC;
  TYPE_THEN `v'''` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `v'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  disk_endpoint;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `v'''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 16;
  EXPAND_TAC "D";
  DISCH_THEN_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  USE 21 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset];
  (* -- *)
  IMATCH_MP_TAC  disk_endpoint;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `v''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 15;
  EXPAND_TAC "D";
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  USE 21 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset];
  DISCH_TAC;
  RIGHT  11 "e";
  REP_BASIC_TAC;
  (* B-  short_end *)
  TYPE_THEN `short_end = ( \ e v. @s. (d e INTER (D v)) s)` ABBREV_TAC ;
  TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v) ==> (d e INTER (D v) = {(short_end e v)}) /\ (d_euclid v (short_end e v) = r) /\ (!v'. (graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (d e) (short_end e v) (short_end e v'))))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TSPEC `e` 11;
  REWR 11;
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
  IMATCH_MP_TAC graph_edge2;
  UND 4;
  REWRITE_TAC[plane_graph];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `!u. graph_inc G e u ==> (u = v') \/ (u = v'')` SUBGOAL_TAC;
  ASM_MESON_TAC[two_exclusion];
  DISCH_TAC;
  TYPE_THEN `?s. (d e INTER D v) s` SUBGOAL_TAC;
  TSPEC `v` 24;
  REWR 24;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[INR IN_SING ];
  MESON_TAC[];
  ASM_REWRITE_TAC[INR IN_SING ];
  MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `(d e INTER D v) (short_end e v)` SUBGOAL_TAC;
  EXPAND_TAC "short_end";
  SELECT_TAC;
  DISCH_THEN_REWRITE ;
  ASM_MESON_TAC[];
  DISCH_TAC;
  LEFT_TAC "v'";
  LEFT_TAC "v'";
  GEN_TAC;
  TYPE_THEN `(v = v') \/ (v = v'')` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(graph_inc G e v''') ==> (v''' = v') \/ (v''' = v'')` SUBGOAL_TAC;
  DISCH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* --- *)
  DISCH_THEN DISJ_CASES_TAC;
  FIRST_ASSUM MP_TAC;
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `short_end e v' = u` SUBGOAL_TAC;
  REWR 26;
  USE 26 (REWRITE_RULE[INR IN_SING]);
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  KILL 24;
  REWR 27;
  UND 24;
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC;
  TYPE_THEN `?s. (d e INTER D v'') s` SUBGOAL_TAC;
  ASM_REWRITE_TAC[INR IN_SING ];
  MESON_TAC[];
  EXPAND_TAC "short_end";
  SELECT_TAC;
  ASM_REWRITE_TAC[INR IN_SING ];
  DISCH_THEN_REWRITE;
  UND 24;
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  (* -- *)
  FIRST_ASSUM MP_TAC;
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC;
  REWR 26;
  USE 26 (REWRITE_RULE[INR IN_SING]);
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  KILL 24;
  REWR 27;
  UND 24;
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `short_end e v' = u` SUBGOAL_TAC;
  TYPE_THEN `?s. (d e INTER D v') s` SUBGOAL_TAC;
  ASM_REWRITE_TAC[INR IN_SING ];
  MESON_TAC[];
  EXPAND_TAC "short_end";
  SELECT_TAC;
  ASM_REWRITE_TAC[INR IN_SING ];
  DISCH_THEN_REWRITE;
  UND 24;
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  DISCH_TAC;

  (* }}} *)
  (* [C]- *)
  TYPE_THEN `X = (\ v. (IMAGE (\ e. short_end e v) (graph_edge_around G v)))` ABBREV_TAC ;
  TYPE_THEN `!v. FINITE (graph_edge_around G v)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[graph_edge_around];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `graph_edge G ` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!v. graph_vertex G v ==> (FINITE (X v) /\ (CARD (X v) <=| 4) /\ ((X v) SUBSET {x | euclid 2 x /\ (d_euclid v x = r)}))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "X";
  SUBCONJ_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  LE_TRANS;
  TYPE_THEN `CARD (graph_edge_around G v)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  CARD_IMAGE_LE;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;IMAGE];
  REP_BASIC_TAC;
  UND 18;
  DISCH_THEN_FULL_REWRITE;
  USE 19 (REWRITE_RULE[graph_edge_around]);
  TSPEC `x'` 13;
  TSPEC `v` 13;
  REWR 13;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  UND 19;
  EXPAND_TAC "D";
  REWRITE_TAC[INTER;eq_sing;closed_ball];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* -D now generate curves C in disk.  *)
  TYPE_THEN `!v. (graph_vertex G v) ==> (?C. (!i. X v i                       ==> (?C' C'' v'.                                simple_arc_end C' v v' /\                                simple_arc_end C'' v' i /\                                C' SUBSET                                closed_ball (euclid 2,d_euclid) v (r / &2) /\                                (C' INTER C'' = {v'}) /\                                (C' UNION C'' = C i)) /\                           simple_arc_end (C i) v i /\                           C i SUBSET closed_ball (euclid 2,d_euclid) v r /\                           C i INTER                           closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET                           hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) /\                  (!i j. X v i /\ X v j /\ ~(i = j) ==> (C i INTER C j = {v})))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  degree_vertex_disk_ver2;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(\j. X v j) = X v` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  BETA_TAC;
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  TSPEC `v` 16;
  REWR 16;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  LEFT 17 "C";
  LEFT 17 "C";
  REP_BASIC_TAC;
  TYPE_THEN `f = (\ e. { x | d e x \/ (?v. graph_inc G e v /\ C v (short_end e v) x)})` ABBREV_TAC ;
  (* -[E] lets try to flatten some hypotheses *)
  TYPE_THEN `NC  = (\ e v. (C v (short_end e v)))` ABBREV_TAC ;
  KILL 1;
  KILL 2;
  KILL 3;
  KILL 0;
  (* rework 5 *)
  TYPE_THEN `!e . graph_edge G e ==> (d e SUBSET e)` SUBGOAL_TAC;
  UND 11;
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `!e v. graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v ==> (d e INTER (D v) = EMPTY)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
  REWR 5;
  UND 5;
  UND 0;
  REWRITE_TAC[SUBSET;EQ_EMPTY];
  UND 3;
  EXPAND_TAC "D";
  REWRITE_TAC[INTER];
  MESON_TAC[];
  DISCH_TAC;
  KILL 5;
  KILL 11;
  KILL 12;
  (* rework 16 *)
  TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TH_INTRO_TAC  [`G`;`e`] graph_inc_subset;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> X v (short_end e v))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "X";
  REWRITE_TAC[IMAGE];
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[graph_edge_around];
  DISCH_TAC;
  KILL 16;
  KILL 14;
  (* rework 17 *)
  TYPE_THEN `hyper = (\ B v. (B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)))` ABBREV_TAC ;
  TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> (simple_arc_end (NC e v) v (short_end e v)) /\ (NC e v SUBSET D v) /\ (hyper (NC e v) v)` SUBGOAL_TAC;
  EXPAND_TAC "hyper";
  EXPAND_TAC "NC";
  REP_BASIC_TAC;
  TSPEC `v` 17;
  TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  REP_BASIC_TAC;
  TSPEC `short_end e v` 16;
  TYPE_THEN `X v (short_end e v)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "D";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* F- continue simplification *)
  TYPE_THEN `!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (D v INTER D v' = EMPTY)` SUBGOAL_TAC;
  EXPAND_TAC "D";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  KILL 6;
  (* - *)
  TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> ~(graph_vertex G (short_end e v)))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
  REWR 13;
  REP_BASIC_TAC;
  USE 21 (REWRITE_RULE[eq_sing;INTER]);
  REP_BASIC_TAC;
  TYPE_THEN `D (short_end e v) (short_end e v)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]);
  REP_BASIC_TAC;
  USE 27 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `~(D (short_end e v) INTER D v = EMPTY)` SUBGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `short_end e v` EXISTS_TAC;
  ASM_REWRITE_TAC[INTER];
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 25 (REWRITE_RULE[]);
  UND 25;
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_zero;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_euclid];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  USE 28 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  UND 20;
  UND 7;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (d e INTER d e' = EMPTY)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  USE 21 (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TYPEL_THEN [`e`;`e'`] (USE 4 o ISPECL);
  REWR 4;
  TYPE_THEN `d e INTER d e' SUBSET graph_vertex G` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `e INTER e'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_inter_pair;
  UND 0;
  UND 20;
  UND 16;
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `graph_vertex G u` SUBGOAL_TAC;
  USE 26 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  USE 21(REWRITE_RULE[INTER]);
  TYPE_THEN `graph_inc G e u` ASM_CASES_TAC;
  TYPEL_THEN [`e`;`u`] (USE 13 o ISPECL);
  REWR 13;
  TYPE_THEN `(d e INTER D u) u` SUBGOAL_TAC;
  REP_BASIC_TAC;
  USE 28 GSYM;
  ASM_REWRITE_TAC[INTER];
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 25 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  USE 28 GSYM;
  REWR 28;
  USE 28 (REWRITE_RULE[INR IN_SING]);
  UND 28;
  DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `d e INTER D u = EMPTY ` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC [];
  USE 26 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[INTER];
  DISCH_TAC;
  USE 28(REWRITE_RULE[EQ_EMPTY]);
  TSPEC `u` 28;
  DISCH_TAC;
  USE 28(REWRITE_RULE[INTER]);
  UND 28;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 25 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -G continue to simplify *)
  TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
  REWR 13;
  REP_BASIC_TAC;
  USE 22(REWRITE_RULE[eq_sing;INTER]);
  ASM_REWRITE_TAC[];
 DISCH_TAC;
  (* - *)
  TYPE_THEN `! v e e'. graph_edge G e /\ graph_edge G e' /\ graph_inc G e v /\ graph_inc G e' v /\ ~(e = e') ==> (NC e v INTER NC e' v = {v})` SUBGOAL_TAC;
  EXPAND_TAC "NC";
  REP_BASIC_TAC;
  TSPEC `v` 17;
  TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  REP_BASIC_TAC;
  TYPEL_THEN  [`short_end e v`;`short_end e' v`](USE 17 o ISPECL);
  KILL 25;
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  KILL 17;
  DISCH_TAC;
  TYPE_THEN `d e (short_end e v)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `d e' (short_end e' v)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `d e INTER d e' = EMPTY ` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EQ_EMPTY;INTER];
  UND 17;
  MESON_TAC[];
  DISCH_TAC;
  KILL 17;
  KILL 3;
  KILL 15;
  (* H- *)
  TYPE_THEN `!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "f";
  EXPAND_TAC "NC";
  REWRITE_TAC[];
  DISCH_TAC;
  KILL 18;
  KILL 19;
  TYPE_THEN `!e v p. (graph_edge G e /\ graph_inc G e v) /\ (D v p) ==> (f e p = NC e v  p)` SUBGOAL_TAC  ;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  EQ_TAC;
  UND 17;
  MESON_TAC[];
  DISCH_THEN DISJ_CASES_TAC;
  TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
  REWR 13;
  REP_BASIC_TAC;
  USE 22 (REWRITE_RULE[eq_sing;INTER ]);
  REP_BASIC_TAC;
  TSPEC `p` 22;
  REWR 22;
  UND 22;
  DISCH_THEN_FULL_REWRITE;
  TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL);
  REWR 11;
  REP_BASIC_TAC;
  UND 25;
  MESON_TAC[simple_arc_end_end2];
  REP_BASIC_TAC;
  TYPE_THEN `v' = v` ASM_CASES_TAC;
  UND 19;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `p` EXISTS_TAC;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  TYPEL_THEN[`e`;`v'`] (USE 11 o ISPECL);
  REWR 11;
  REP_BASIC_TAC;
  USE 24 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!e v p. (graph_edge G e /\ (graph_vertex G v) /\ ~(graph_inc G e v) /\ (D v p)  ==> ~(f e p))` SUBGOAL_TAC;
  ASM_REWRITE_TAC[DE_MORGAN_THM ];
  REP_BASIC_TAC;
  CONJ_TAC;
  DISCH_TAC;
  TYPE_THEN `d e INTER D v = EMPTY` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS;INTER  ];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  LEFT_TAC "v";
  GEN_TAC;
  DISCH_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `~(v = v')` SUBGOAL_TAC;
  DISCH_TAC;
  UND 23;
  UND 18;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPEL_THEN [`e`;`v'`] (USE 11 o ISPECL);
  REP_BASIC_TAC;
  REWR 11;
  REP_BASIC_TAC;
  USE 25 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!e p.  graph_edge G e /\ (!v. ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC ;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  (TAUT `~B ==> (A \/ B <=> A)`);
  DISCH_TAC;
  REP_BASIC_TAC;
  TSPEC `v` 18;
  UND 18;
  REWRITE_TAC[];
  TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL);
  REWR 11;
  REP_BASIC_TAC;
  USE 18(REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* I- *)
  TYPE_THEN `NC` EXISTS_TAC;
  TYPE_THEN `D` EXISTS_TAC;
  TYPE_THEN `short_end` EXISTS_TAC;
  TYPE_THEN `hyper` EXISTS_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  TYPE_THEN `d` EXISTS_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Sat Aug 21 08:06:22 EDT 2004 *)

  ]);;

  (* }}} *)


let graph_vertex_exhaust = 
prove_by_refinement(
  `!(G:(A,B)graph_t) e v v'.
  (graph G /\ (graph_edge G e) /\ (graph_inc G e v) /\
     (graph_inc G e v') /\ ~(v = v') ==> (graph_inc G e = {v,v'}))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_edge2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  UND 6;
  DISCH_THEN_FULL_REWRITE;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[in_pair];
  KILL 3;
  KILL 4;
  RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)


let graph_disk_hv = 
prove_by_refinement(
  `!G. plane_graph G /\
      FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
      ~(graph_edge G = EMPTY) /\
     (!v. (CARD (graph_edge_around G v) <=| 4))
   ==>
    (?r H . graph_isomorphic G H /\ good_plane_graph H /\
      (&0 < r) /\
      (!v v'.
         graph_vertex H v /\ graph_vertex H v' /\ ~(v = v')
         ==> (closed_ball (euclid 2,d_euclid) v r INTER
                closed_ball (euclid 2,d_euclid) v' r =
                {})) /\
      (!e v.
         graph_edge H e /\ graph_vertex H v /\ ~graph_inc H e v
         ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\
      (!e v.
         graph_edge H e /\  graph_inc H e v
         ==> (e INTER closed_ball (euclid 2, d_euclid) v r SUBSET
            (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))))
    )`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TH_INTRO_TAC [`G`] graph_disk_hv_preliminaries;
  ASM_REWRITE_TAC[];
  POP_ASSUM_LIST (fun t-> ALL_TAC);
  REP_BASIC_TAC;
  (* - *) (* redo 19 *)
  TYPE_THEN `!e p. graph_edge G e /\ (!v. graph_inc G e v ==> ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  (TAUT  `~B ==> (A \/ B <=> A)`);
  DISCH_TAC;
  REP_BASIC_TAC;
  TSPEC `v` 20;
  UND 20;
  ASM_REWRITE_TAC[];
  TYPEL_THEN[`e`;`v`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  USE 20 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  KILL 19;
  (* - *)
  TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (f e INTER f e' SUBSET e INTER e')` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[SUBSET;INTER ];
  REP_BASIC_TAC;
  TYPE_THEN `?v. (graph_inc G e v /\ D v x)` ASM_CASES_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `f e x = NC e v x` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `graph_inc G e' v` ASM_CASES_TAC;
  TYPE_THEN `f e' x = NC e' v x` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `(NC e v INTER NC e' v = {v})` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[INR IN_SING;INTER];
  DISCH_TAC;
  TSPEC `x` 28;
  REWR 28;
  UND 28;
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TYPE_THEN `e` (WITH 28 o ISPEC);
  TSPEC `e'` 28;
  UND 28;
  UND 32;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  DISCH_THEN_FULL_REWRITE;
  UND 26;
  UND 27;
  REWRITE_TAC[INTER];
  DISCH_THEN_REWRITE;
  PROOF_BY_CONTR_TAC;
  UND 23;
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `(f e x = d e x)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  GEN_TAC;
  UND 25;
  MESON_TAC[];
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `(?v. graph_inc G e' v /\ D v x)` ASM_CASES_TAC;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `d e INTER D v = {}` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  LEFT 25 "v";
  TSPEC `v` 25;
  UND 25;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `f e' x = d e' x` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  GEN_TAC;
  UND 26;
  MESON_TAC[];
  DISCH_THEN_FULL_REWRITE;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `d e INTER d e' = EMPTY` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS ;INTER];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* A injective *)
  TYPE_THEN `INJ f (graph_edge G) UNIV` SUBGOAL_TAC;
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  TYPE_THEN ` (graph_inc G x ) HAS_SIZE 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_edge2;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G x a` SUBGOAL_TAC;
  ASM_REWRITE_TAC[in_pair];
  DISCH_TAC;
  TYPE_THEN `d x SUBSET f x` SUBGOAL_TAC;
  KILL 21;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `d x (short_end x a)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `f x (short_end x a)` SUBGOAL_TAC;
  UND 28;
  UND 27;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `f x INTER f y SUBSET  x INTER y` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `(x INTER y) (short_end x a)` SUBGOAL_TAC;
  USE 31 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 21 GSYM;
  KILL 16;
  ASM_REWRITE_TAC[INTER_IDEMPOT];
  TYPE_THEN `(x INTER y) SUBSET (graph_vertex G)` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `(graph_vertex G (short_end x a))` SUBGOAL_TAC;
  USE 33(REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* B now simple arc -- ugh *)
  TYPE_THEN `(!e v v'. (graph_edge G e /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (f e) v v')))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `f e = (NC e v UNION d e) UNION NC e v'` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[UNION];
  ONCE_REWRITE_TAC [EQ_SYM_EQ;];
  REWRITE_TAC[GSYM DISJ_ASSOC];
  EQ_TAC;
  REP_CASES_TAC;
  DISJ2_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  DISJ2_TAC;
  TYPE_THEN `v'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_CASES_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e = {v , v'}` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_vertex_exhaust;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 27;
  USE 27 (REWRITE_RULE[in_pair]);
  UND 27;
  REP_CASES_TAC;
  UND 27;
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  UND 27;
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN ASSUME_TAC t);
  (* -- *)
  TYPE_THEN `simple_arc_end (NC e v UNION d e) v (short_end e v')` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `short_end e v` EXISTS_TAC;
  CONJ_TAC;
  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
  REWR 5;
  REP_BASIC_TAC;
  TSPEC `v'` 5;
  REWR 5;
  (* --- *)
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING;INTER ];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  GEN_TAC;
  EQ_TAC;
  DISCH_THEN_FULL_REWRITE;
  CONJ_TAC;
  TYPE_THEN `simple_arc_end (NC e v) v (short_end e v)` SUBGOAL_TAC;
  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  MESON_TAC[simple_arc_end_end2];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* --- *)
  DISCH_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `D v x` SUBGOAL_TAC;
  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  USE 29 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `d e INTER D v = {(short_end e v)}` SUBGOAL_TAC;
  TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
  REWR 5;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[eq_sing];
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `(short_end e v')` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING];
  GEN_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  EQ_TAC;
  DISCH_THEN_FULL_REWRITE;
  CONJ_TAC;
  UND 27;
  MESON_TAC[simple_arc_end_end2];
  TYPEL_THEN[`e`;`v'`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  UND 29;
  MESON_TAC[simple_arc_end_end2];
  REP_BASIC_TAC;
  UND 29;
  REWRITE_TAC[UNION];
  REP_CASES_TAC ;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `x` EXISTS_TAC;
  CONJ_TAC;
  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  USE 31 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  USE 31 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `D v' x` SUBGOAL_TAC;
  TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  USE 30 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `d e INTER D v' = {(short_end e v')}` SUBGOAL_TAC;
  TYPEL_THEN [`e`;`v'`] (USE 5 o ISPECL);
  REWR 5;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER;eq_sing];
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* C - *)
  TYPE_THEN `!e v. (graph_edge G e) ==> ( e INTER graph_vertex G = (f e) INTER (graph_vertex G))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER];
  GEN_TAC;
  IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`);
  DISCH_TAC;
  TYPE_THEN `D x x` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `graph_inc G e x` ASM_CASES_TAC;
  TYPE_THEN `f e x = NC e x x` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `NC e x x` SUBGOAL_TAC;
  TYPEL_THEN[`e`;`x`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  UND 28;
  MESON_TAC[simple_arc_end_end];
  DISCH_THEN_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TSPEC `e` 27;
  REWR 27;
  REWR 26;
  UND 26;
  REWRITE_TAC[INTER];
  DISCH_THEN_REWRITE;
  TYPE_THEN `~f e x` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  UND 26;
  REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TSPEC `e` 26;
  REWR 26;
  ASM_REWRITE_TAC[INTER];
  DISCH_TAC;
  (* D start on graph and goal *)
  TYPE_THEN `r /(&2)` EXISTS_TAC;
  TYPE_THEN `graph_edge_mod G f` EXISTS_TAC;
  REWRITE_TAC[good_plane_graph];
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  CONJ_TAC;
  IMATCH_MP_TAC  graph_edge_iso;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[TAUT `(A /\ B) /\ C <=> (A /\ (B /\ C))`];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  plane_graph_mod;
  USE 16 GSYM;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);  (* --x-- *)
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `v'` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i]);
  REP_BASIC_TAC;
  USE 29 GSYM;
  UND 29;
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `e'' =e'` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!v. closed_ball (euclid 2, d_euclid) v (r/(&2)) SUBSET D v` SUBGOAL_TAC;
  GEN_TAC;
  EXPAND_TAC "D";
  REWRITE_TAC[closed_ball;SUBSET];
  TYPE_THEN `r /(&2) < r` SUBGOAL_TAC;
  UND 1;
  MESON_TAC[  half_pos];
  MESON_TAC[REAL_ARITH `x <= u /\ u < v ==> x <= v`];
  DISCH_TAC;
  (* - *)
  CONJ_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `D v INTER D v'` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v]);
  TYPE_THEN `(D v INTER D v' = EMPTY)` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[];
  (* E - down to 2 *)
  CONJ_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v;graph_edge_mod_i;graph_edge_mod_e]);
  USE 27 (REWRITE_RULE[IMAGE]);
  REP_BASIC_TAC;
  UND 27;
  DISCH_THEN_FULL_REWRITE;
  LEFT 25 "e'";
  TSPEC `x` 25;
  PROOF_BY_CONTR_TAC;
  USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER]);
  REP_BASIC_TAC;
  TYPE_THEN `D v u` SUBGOAL_TAC;
  USE 24 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `~f x u` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 25;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - final *)
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_i;graph_edge_mod_e]);
  USE 26 (REWRITE_RULE[IMAGE]);
  REP_BASIC_TAC;
  UND 28;
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `e' = x` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  (* - *)
  TYPE_THEN `f x INTER D v = NC x v INTER D v` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER];
  IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`);
  DISCH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `f x INTER (closed_ball (euclid 2,d_euclid) v (r/(&2))) = NC x v INTER (closed_ball(euclid 2, d_euclid) v (r/(&2)))` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INTER];
  USE 28 (REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x'` 28;
  UND 28;
  UND 24;
  REWRITE_TAC[SUBSET;INTER];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPEL_THEN[`x`;`v`] (USE 10 o ISPECL);
  REWR 10;
  REP_BASIC_TAC;
  UND 10;
  EXPAND_TAC "hyper";
  DISCH_THEN_REWRITE;
  (* Sat Aug 21 14:12:41 EDT 2004 *)

  ]);;

  (* }}} *)

let hv_finite = jordan_def `hv_finite C <=>
   (?E. C SUBSET UNIONS E /\ FINITE E /\ hv_line E)`;;

let hv_finite_subset = 
prove_by_refinement(
  `!A B. hv_finite B /\ A SUBSET B ==> hv_finite A`,

  (* {{{ proof *)
  [
  REWRITE_TAC[hv_finite];
  REP_BASIC_TAC;
  TYPE_THEN `E` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `B` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let mk_line_hyper2_e1 = 
prove_by_refinement(
  `!z. mk_line (point (z, &0)) (point(z, &1)) = hyperplane 2 e1 z`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM line2D_F;e1;mk_line;];
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[point_scale;point_add];
  GEN_TAC;
  REDUCE_TAC;
  TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC;
  GEN_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `(z, &1 - t)` EXISTS_TAC;
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `&1 - (SND p)` EXISTS_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let mk_line_hyper2_e2 = 
prove_by_refinement(
  `!z. mk_line (point (&0, z)) (point(&1, z)) = hyperplane 2 e2 z`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM line2D_S;e2;mk_line;];
  GEN_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[point_scale;point_add];
  GEN_TAC;
  REDUCE_TAC;
  TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC;
  GEN_TAC;
  real_poly_tac;
  DISCH_THEN_REWRITE;
  EQ_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `( &1 - t, z)` EXISTS_TAC;
  REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `&1 - (FST  p)` EXISTS_TAC;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let hv_finite_hyper = 
prove_by_refinement(
  `!C.
  (?v. C SUBSET (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))) ==>
   (hv_finite C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[hv_finite];
  TYPE_THEN `{(hyperplane 2 e2 (v 1)), (hyperplane 2 e1 (v 0))}` EXISTS_TAC ;
  ASM_REWRITE_TAC[UNIONS_2;FINITE_INSERT;FINITE_SING;FINITE_RULES; ];
  REWRITE_TAC[hv_line;in_pair;GSYM mk_line_hyper2_e2;GSYM mk_line_hyper2_e1];
  GEN_TAC;
  REP_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(v 0, &0)` EXISTS_TAC;
  TYPE_THEN `(v 0, &1)` EXISTS_TAC;
  REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  TYPE_THEN `(&0, v 1)` EXISTS_TAC;
  TYPE_THEN `(&1, v 1)` EXISTS_TAC;
  REWRITE_TAC[];
  ]);;
   (* }}} *)

let graph_hv_finite_radius = jordan_def
  `graph_hv_finite_radius G r <=> (good_plane_graph G /\
      (&0 < r) /\
      (!v v'.
         graph_vertex G v /\ graph_vertex G v' /\ ~(v = v')
         ==> (closed_ball (euclid 2,d_euclid) v r INTER
                closed_ball (euclid 2,d_euclid) v' r =
                {})) /\
      (!e v.
         graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v
         ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\
      (!e v.
         graph_edge G e /\  graph_inc G e v
         ==> (hv_finite (e INTER closed_ball (euclid 2, d_euclid) v r))))
    `;;

let p_conn_hv_finite = 
prove_by_refinement(
  `!A x y. ~(x = y) ==>
     (p_conn A x y <=> (?C. (hv_finite C) /\ (C SUBSET A) /\
    (simple_arc_end C x y)))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  REWRITE_TAC[p_conn;simple_polygonal_arc];
  (* - *)
  EQ_TAC;
  REP_BASIC_TAC;
  TH_INTRO_TAC [`C`;`x`;`y`] simple_arc_end_select;
  ASM_REWRITE_TAC[top2];
  REP_BASIC_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  REWRITE_TAC[hv_finite];
  CONJ_TAC;
  TYPE_THEN `E` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]);
  REP_BASIC_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  CONJ_TAC;
  CONJ_TAC;
  REWRITE_TAC[GSYM top2];
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  ]);;
  (* }}} *)


let graph_iso_around = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (H:(A',B')graph_t) f v. (graph G) /\
     graph_iso f G H /\ (graph_vertex G v) ==>
        (graph_edge_around H (FST  f v) =
            (IMAGE (SND f) (graph_edge_around G v)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_iso;graph_edge_around];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REP_BASIC_TAC;
  REWRITE_TAC[];
  EQ_TAC ;
  REP_BASIC_TAC;
  TYPE_THEN `(?y. graph_edge G y /\ (v' y = x))` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  USE 8 GSYM;
  UND 8;
  DISCH_THEN_FULL_REWRITE;
  TSPEC `y` 1;
  REWR 1;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `y` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWR 6;
  USE 6 (REWRITE_RULE[IMAGE]);
  REP_BASIC_TAC;
  TYPE_THEN `v = x'` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TH_INTRO_TAC [`G`;`y`] graph_inc_subset;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC  ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  REWR 6;
  UND 6;
  DISCH_THEN_FULL_REWRITE;
  SUBCONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  ASM_SIMP_TAC[];
  REWRITE_TAC[IMAGE];
  REP_BASIC_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Sat Aug 21 16:49:58 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_radius_exists = 
prove_by_refinement(
  `!G. planar_graph (G:(A,B) graph_t) /\
      FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
      ~(graph_edge G = EMPTY) /\
     (!v. (CARD (graph_edge_around G v) <=| 4)) ==>
   (?r H.
       (graph_isomorphic G H /\ graph_hv_finite_radius H r))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[planar_graph]);
  REP_BASIC_TAC;
  TYPE_THEN `FINITE (graph_edge H) /\ FINITE (graph_vertex H) /\ ~(graph_edge H = EMPTY) /\  (!v. (CARD (graph_edge_around H v) <=| 4))` SUBGOAL_TAC;
  WITH 4 (REWRITE_RULE[graph_isomorphic]);
  REP_BASIC_TAC;
  SUBCONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
  REP_BASIC_TAC;
  TH_INTRO_TAC [`graph_edge H`;`graph_edge G`;`v`] FINITE_BIJ2;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* -- *)
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
  REP_BASIC_TAC;
  TH_INTRO_TAC [`graph_vertex H`;`graph_vertex G`;`u`] FINITE_BIJ2;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  CONJ_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
  REP_BASIC_TAC;
   RULE_ASSUM_TAC (REWRITE_RULE[graph_iso;BIJ;SURJ]);
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  GEN_TAC;
  (* -- *)
  TYPE_THEN `graph_vertex H v` ASM_CASES_TAC;
  TH_INTRO_TAC [`H`;`G`;`f`;`v`] graph_iso_around;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
  REP_BASIC_TAC;
  UND 12;
  DISCH_THEN_FULL_REWRITE;
  TSPEC `u v` 0;
  REWR 0;
  TH_INTRO_TAC [`v'`;`graph_edge_around H v`] CARD_IMAGE_INJ;
  REWRITE_TAC[];
  CONJ_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ;BIJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_around]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `graph_edge H` EXISTS_TAC ;
  ASM_REWRITE_TAC[SUBSET;graph_edge_around];
  MESON_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  TH_INTRO_TAC [`H`;`v`] graph_edge_around_empty;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[CARD_CLAUSES];
  ARITH_TAC;
  REP_BASIC_TAC;
  (* - *)
  TH_INTRO_TAC [`H`] graph_disk_hv;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  TYPE_THEN `H'` EXISTS_TAC;
  REWRITE_TAC[graph_hv_finite_radius];
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TH_INTRO_TAC [`G`;`H`;`H'`] graph_isomorphic_trans;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  graph_isomorphic_symm;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (* - *)
  REP_BASIC_TAC;
  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
  REWR 10;
  IMATCH_MP_TAC  hv_finite_hyper;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Sat Aug 21 17:28:09 EDT 2004 *)

  ]);;
  (* }}} *)

let replace = jordan_def `replace (x:A) y =
    (\ z. (if (z  = x) then y else z))`;;

let replace_x = 
prove_by_refinement(
  `!(x:A) y. replace x y x = y`,

  (* {{{ proof *)
  [
  REWRITE_TAC[replace];
  (* Sun Aug 22 09:01:27 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_replace = jordan_def
   `graph_replace (G:(A,B)graph_t) e e' =
     graph_edge_mod G (replace e e')`;;

let replace_inj = 
prove_by_refinement(
  `!(x:A) y Z. ~(Z y) ==> INJ (replace x y) Z UNIV`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;replace];
  REP_BASIC_TAC;
  MP_TAC (TAUT  `((x' = (x:A)) \/ ~(x' = x)) /\ ((y' = x) \/ ~(y' = x))`);
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  REP_CASES_TAC THEN (REWR 0);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let graph_replace_iso = 
prove_by_refinement(
  `!(G:(A,B)graph_t) e e'.
      ~(graph_edge G e') ==> graph_isomorphic G (graph_replace G e e')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_replace];
  REP_BASIC_TAC;
  IMATCH_MP_TAC  graph_edge_iso;
  IMATCH_MP_TAC  replace_inj;
  ASM_REWRITE_TAC[];
  (* Sun Aug 22 09:30:14 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_replace_plane = 
prove_by_refinement(
  `!G e e'. plane_graph G /\ ~(graph_edge G e') /\
      (graph_edge G e) /\
      (!e''. graph_edge G e'' /\ ~(e'' = e) ==>
           (e' INTER e'' SUBSET  e INTER e'')) /\
      (simple_arc top2 e') /\
      (e INTER graph_vertex G = e' INTER graph_vertex G) ==>
      plane_graph (graph_replace G e e')`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[graph_replace];
  IMATCH_MP_TAC  plane_graph_mod;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  replace_inj;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[replace];
  TYPE_THEN `((e'' = e) \/ ~(e'' = e)) /\ ((e''' = e) \/ ~(e''' = e))` (fun t-> MP_TAC (TAUT t));
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  REP_CASES_TAC THEN (FIRST_ASSUM (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN (ASSUME_TAC t)));
  ASM_MESON_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC [INTER_COMM];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET_REFL];
  (* - *)
  CONJ_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[replace];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  REP_BASIC_TAC;
  REWRITE_TAC[replace];
  COND_CASES_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[];
  (* Sun Aug 22 10:28:15 EDT 2004 *)

  ]);;
  (* }}} *)

let good_replace = 
prove_by_refinement(
  `!G e e'. (good_plane_graph G) /\ plane_graph (graph_replace G e e') /\
      ~(graph_edge G e') /\
   ( e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\
      (!v v'. (graph_vertex G v) /\ (graph_vertex G v') /\
            ~(v = v') /\ e' v /\  e' v' ==> simple_arc_end e' v v')
    ==> (good_plane_graph (graph_replace G e e'))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[good_plane_graph;graph_replace];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i ;IMAGE ]);
  REP_BASIC_TAC;
  UND 6;
  DISCH_THEN_FULL_REWRITE;
  TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `e'''' = x` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `e''' = x` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  (* - *)
  REWRITE_TAC[replace];
  COND_CASES_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UNDF `x`;
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  UNDF `e INTER u = e' INTER u`;
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER;]);
  ASM_REWRITE_TAC[];
  (* - *)
  KILL 0;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Sun Aug 22 10:59:34 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_replace_hv_finite_radius = 
prove_by_refinement(
  `!G r e e'. graph_hv_finite_radius G r /\ ~(graph_edge G e') /\
     good_plane_graph (graph_replace G e e') /\
    (e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\
    (!v. graph_vertex G v /\ ~(e' v) ==>
        ((e' INTER closed_ball (euclid 2,d_euclid) v r = {}))) /\
    (hv_finite e')
    ==> graph_hv_finite_radius (graph_replace G e e') r`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_hv_finite_radius];
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  REP_BASIC_TAC;
  UND 7;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_replace ;graph_edge_mod_v]);
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]);
  REP_BASIC_TAC;
  UNDF `e''`;
  DISCH_THEN_FULL_REWRITE;
  REWRITE_TAC[replace];
  COND_CASES_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWR 13;
  DISCH_TAC;
  LEFT 10 "e'''";
  TSPEC `e` 10;
  UND 10;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[INTER];
  KILL 1;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  LEFT 10 "e'''";
  TSPEC `x` 1;
  REWR 1;
  (* - *)
  REP_BASIC_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]);
  REP_BASIC_TAC;
  UNDF `e''`;
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `e''' = x` SUBGOAL_TAC;
  TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INJ];
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  (* - *)
  REWRITE_TAC[replace];
  COND_CASES_TAC ;
  UNDF `x`;
  DISCH_THEN_FULL_REWRITE;
  IMATCH_MP_TAC  hv_finite_subset;
  TYPE_THEN `e'` EXISTS_TAC;
  ASM_REWRITE_TAC[INTER;SUBSET;];
  MESON_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Sun Aug 22 12:09:03 EDT 2004 *)

  ]);;
  (* }}} *)

let card_suc_insert = 
prove_by_refinement(
  `!(x:A) s. FINITE s /\ (~(s x)) ==> (SUC (CARD s) = CARD(x INSERT s))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASM_SIMP_TAC [CARD_CLAUSES];
  ]);;
  (* }}} *)

let graph_replace_card = 
prove_by_refinement(
  `!G e e'.
    (FINITE (graph_edge (G:(A,(num->real)->bool)graph_t))) /\
      (graph_edge G e) /\ ~(graph_edge G e') /\
     ~(hv_finite e) /\ (hv_finite e') ==>
   (CARD {x | graph_edge (graph_replace G e e') x /\ ~(hv_finite x)} <
      CARD{ x | graph_edge G x /\ ~hv_finite x})
                                                `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `(SUC x = y) ==> (x <| y)`);
  (* - *)
  TYPE_THEN `FINITE (graph_edge (graph_replace G e e'))` SUBGOAL_TAC;
  REWRITE_TAC[graph_edge_mod_e;graph_replace];
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `A = {x | graph_edge (graph_replace G e e') x /\ ~hv_finite x}` ABBREV_TAC ;
  TYPE_THEN `FINITE A` SUBGOAL_TAC;
  EXPAND_TAC "A";
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `graph_edge (graph_replace G e e')` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "A";
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `~A e` SUBGOAL_TAC;
  EXPAND_TAC"A";
  REWRITE_TAC[];
  ASM_REWRITE_TAC[graph_replace;graph_edge_mod_e;IMAGE];
  DISCH_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[replace]);
  UND 8;
  COND_CASES_TAC;
  ASM_MESON_TAC[];
  UND 8;
  REWRITE_TAC[];
  MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `SUC (CARD A) = CARD(e INSERT A)` SUBGOAL_TAC;
  IMATCH_MP_TAC  card_suc_insert;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (* - *)
  AP_TERM_TAC;
  EXPAND_TAC "A";
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[INSERT;graph_replace;graph_edge_mod_e;IMAGE;replace; ];
  EQ_TAC;
  REP_BASIC_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  REP_BASIC_TAC;
  UNDF `x = u`;
  DISCH_THEN_FULL_REWRITE;
  COND_CASES_TAC;
  UNDF `x' = e`;
  DISCH_THEN_FULL_REWRITE;
  ASM_MESON_TAC[];
  REWR 10;
  UNDF `x = e`;
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  (* - *)
  REP_BASIC_TAC;
  TYPE_THEN `x = e` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let graph_edge_end_select_other = 
prove_by_refinement(
  `!(G:(A,B)graph_t) e v. (graph G /\ graph_edge G e /\
         (graph_inc G e v) ==>
    (?v'. (graph_inc G e v' /\ ~(v = v'))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_edge2;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[has_size2];
  REP_BASIC_TAC;
  UND 7;
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
  REWRITE_TAC[in_pair];
  TYPE_THEN `(v'' = b)` ASM_CASES_TAC;
  UNDF `v''`;
  DISCH_THEN_FULL_REWRITE;
  REWR 5;
  UNDF`v'`;
  DISCH_THEN_FULL_REWRITE;
  ASM_MESON_TAC[];
  REWR 4;
  UNDF`v''`;
  DISCH_THEN_FULL_REWRITE;
  REWR 5;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let graph_rad_pt_select = 
prove_by_refinement(
  `!G r e v. graph_hv_finite_radius G r /\ graph_inc G e v  /\
     graph_edge G e ==>
     (?C u. (hv_finite C) /\ (simple_arc_end C v u) /\ (euclid 2 u) /\
        (d_euclid v u = r) /\ (C SUBSET e) /\ (C SUBSET (closed_ball(euclid 2,d_euclid) v r)))   `,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_hv_finite_radius];
  REP_BASIC_TAC;
  (* - *)
  TH_INTRO_TAC [`e`;`{v}`;`(euclid 2 DIFF (open_ball(euclid 2,d_euclid) v r))`] simple_arc_end_restriction;
  (* -- *)
    CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE [good_plane_graph;plane_graph;SUBSET ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* -- *)
  TH_INTRO_TAC[`G`;`e`;`v`] graph_edge_end_select_other;
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* -- *)
  CONJ_TAC;
  RULE_ASSUM_TAC  (REWRITE_RULE[good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  IMATCH_MP_TAC simple_arc_end_end_closed;
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `v'` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* -- *)
  CONJ_TAC;
  TH_INTRO_TAC [`top2`;`open_ball(euclid 2,d_euclid) v r`] open_closed;
  REWRITE_TAC[top2_top];
  ASM_SIMP_TAC [top2;open_ball_open;metric_euclid;open_DEF ];
  REWRITE_TAC[top2_unions];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[INTER;DIFF;EQ_EMPTY;open_ball;INR IN_SING ];
  REP_BASIC_TAC;
  UNDF  `x = v`;
  DISCH_THEN_FULL_REWRITE;
  UNDF `x < r`;
  ASM_REWRITE_TAC[];
  TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_zero;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_euclid];
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `v` EXISTS_TAC;
  REWRITE_TAC[INTER;INR IN_SING];
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  UNDF `graph_inc G e = y`;
  DISCH_THEN (TH_INTRO_TAC [`e`]);
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `v'` EXISTS_TAC;
  REWRITE_TAC[INTER];
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  UNDF `graph_inc G e = y`;
  DISCH_THEN (TH_INTRO_TAC [`e`]);
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[DIFF];
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[open_ball;DE_MORGAN_THM ];
  DISJ2_TAC;
  DISJ2_TAC;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!v. graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC;
  TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `!v. graph_inc G e v ==> euclid 2 v` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  UND 4;
  DISCH_THEN (  TH_INTRO_TAC [`v`;`v'`] );
  ASM_MESON_TAC [];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `v` EXISTS_TAC;
  REWRITE_TAC[closed_ball];
  TYPE_THEN `euclid 2 v` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `euclid 2 v'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_zero;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_MESON_TAC[metric_euclid];
  DISCH_THEN_REWRITE;
  UND 5;
  UND 9;
  TYPE_THEN `d_euclid v v' = d_euclid v' v` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_symm;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_MESON_TAC[metric_euclid];
  DISCH_THEN_REWRITE;
  REAL_ARITH_TAC;
  (* A- *)
  REP_BASIC_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `v''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `v' = v` SUBGOAL_TAC;
  UND 8;
  REWRITE_TAC[INTER;eq_sing;INR IN_SING ];
  MESON_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `euclid 2 v''` SUBGOAL_TAC;
  FIRST_ASSUM MP_TAC;
  REWRITE_TAC[INTER;DIFF;eq_sing;];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `d_euclid v v'' = r` SUBGOAL_TAC;
  IMATCH_MP_TAC  disk_endpoint_outer;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  TH_INTRO_TAC [`C'`] simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  UND 9;
  MESON_TAC[simple_arc_end_end];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* B- *)
  TYPE_THEN `C' SUBSET closed_ball(euclid 2,d_euclid) v r` SUBGOAL_TAC;
  UND 7;
  REWRITE_TAC[SUBSET;closed_ball;INTER;open_ball;DIFF;eq_sing;INR IN_SING];
  REP_BASIC_TAC;
  TYPE_THEN `!x. C' x ==> euclid 2 x` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TH_INTRO_TAC[`C'`] simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `C' v` SUBGOAL_TAC;
  UND 8;
  REWRITE_TAC[INTER;INR IN_SING;eq_sing;];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `x = v''` ASM_CASES_TAC;
  UNDF `x = v''`;
  DISCH_THEN_FULL_REWRITE;
  UND 12;
  REAL_ARITH_TAC;
  TSPEC `x` 13;
  PROOF_BY_CONTR_TAC;
  UND 19;
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[DE_MORGAN_THM];
  DISJ2_TAC;
  UND 20;
  REAL_ARITH_TAC;
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  hv_finite_subset;
  TYPE_THEN `e INTER (closed_ball(euclid 2,d_euclid) v r)` EXISTS_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET_INTER];
  ASM_REWRITE_TAC[];
  (* Sun Aug 22 15:50:58 EDT 2004 *)

  ]);;
  (* }}} *)

(* not needed here *)
let top_union = 
prove_by_refinement(
  `!A B U. topology_ U /\ U A /\ U (B:A->bool) ==> U(A UNION B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[GSYM UNIONS_2];
  IMATCH_MP_TAC  top_unions;
  ASM_REWRITE_TAC[in_pair; SUBSET;];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let top_closed_unions = 
prove_by_refinement(
  `!(B:(A->bool)->bool) U.
     topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==>
            closed_ U(UNIONS B)`,

  (* {{{ proof *)
  [
  TYPE_THEN `!n (B:(A->bool)->bool) U. (CARD B = n) /\  topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==> closed_ U(UNIONS B)` SUBGOAL_TAC;
  INDUCT_TAC;
  REP_BASIC_TAC;
  TYPE_THEN `B HAS_SIZE 0` SUBGOAL_TAC;
  ASM_REWRITE_TAC[HAS_SIZE];
  REWRITE_TAC[HAS_SIZE_0];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  empty_closed;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* -- *)
  TYPE_THEN `~(B = EMPTY)` SUBGOAL_TAC;
  DISCH_TAC;
  UNDF `EMPTY`;
  DISCH_THEN_FULL_REWRITE;
  UNDF `SUC`;
  REWRITE_TAC[CARD_CLAUSES];
  ARITH_TAC;
  DISCH_TAC;
  (* -- *)
  TH_INTRO_TAC [`B`] CARD_DELETE_CHOICE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  USEF `SUC` SYM;
  REWR 4;
  RULE_ASSUM_TAC (REWRITE_RULE[SUC_INJ]);
  TYPEL_THEN [`(B DELETE CHOICE B)`;`U`] (USE 0 o ISPECL);
  UNDF `n`;
  DISCH_THEN (TH_INTRO_TAC []);
  ASM_REWRITE_TAC[FINITE_DELETE];
  UNDF `(SUBSET)`;
  REWRITE_TAC[SUBSET;DELETE];
  MESON_TAC[];
  (* -- *)
  DISCH_TAC;
  TYPE_THEN `closed_ U( UNIONS (B DELETE CHOICE B) UNION (CHOICE B))` SUBGOAL_TAC;
  IMATCH_MP_TAC  closed_union;
  ASM_REWRITE_TAC[];
  UND 1;
  REWRITE_TAC[SUBSET];
  USEF `(~)` (MATCH_MP CHOICE_DEF);
  UNDF  `(IN)`;
  REWRITE_TAC[];
  MESON_TAC[];
  ASM_MESON_TAC[unions_delete_choice];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let euclid2_d0 = 
prove_by_refinement(
  `!x. (euclid 2 x) ==> (d_euclid x x = &0)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  metric_space_zero;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_euclid];
  ]);;
  (* }}} *)

let union_imp_subset = 
prove_by_refinement(
  `!(Z1:A->bool) Z2 A. (Z1 UNION Z2 = A) ==>
         (Z1 SUBSET A /\ Z2 SUBSET A)`,

  (* {{{ proof *)
  [
  SET_TAC[UNION;SUBSET];
  ]);;
  (* }}} *)

let loc_path_conn_top2 = 
prove_by_refinement(
  `loc_path_conn top2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  loc_path_conn_euclid;
  TYPE_THEN `2` EXISTS_TAC;
  MESON_TAC[metric_euclid;top_of_metric_top;top_of_metric_unions;top_univ];
  ]);;
  (* }}} *)

let connected_empty = 
prove_by_refinement(
  `!U. connected (U:(A->bool)->bool) EMPTY `,

  (* {{{ proof *)
  [
  REWRITE_TAC[connected];
  ]);;
  (* }}} *)

let component_imp_connected = 
prove_by_refinement(
  `!U (x:A). (topology_ U) ==> (connected U (component U x))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `~(UNIONS U x)` ASM_CASES_TAC;
  UND 1;
  ASM_SIMP_TAC[GSYM component_empty];
  REWRITE_TAC[connected_empty];
  REWR 1;
  (* - *)
  REWRITE_TAC[connected];
  CONJ_TAC;
  REWRITE_TAC[SUBSET;connected;component];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `component U x x` SUBGOAL_TAC;
  ASM_MESON_TAC[component_refl];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `A x \/ B x` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET;UNION]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!A B. component U x SUBSET A UNION B /\ (A INTER B = EMPTY) /\ U B /\ U A /\ A x ==> component U x SUBSET A` SUBGOAL_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `B' x'` SUBGOAL_TAC;
  USE 11 (REWRITE_RULE[SUBSET;UNION]);
  TSPEC `x'` 11;
  ASM_MESON_TAC[];
  DISCH_TAC;
  USE 12 (REWRITE_RULE[component]);
  REP_BASIC_TAC;
  TYPE_THEN `Z SUBSET (component U x)` SUBGOAL_TAC;
  IMATCH_MP_TAC  connected_component;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  USE 16 (REWRITE_RULE[connected]);
  REP_BASIC_TAC;
  TYPEL_THEN[`A'`;`B'`] (USE 16 o ISPECL);
  UND 16;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Z SUBSET A' UNION B'` SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `component U x` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  REWRITE_TAC[DE_MORGAN_THM];
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[];
  USE 10 (REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* - *)
  DISCH_THEN DISJ_CASES_TAC;
  TYPEL_THEN[`A`;`B`] (USE 7 o ISPECL);
  ASM_MESON_TAC[];
  TYPEL_THEN [`B`;`A`] (USE 7 o ISPECL);
  REWR 7;
  DISJ2_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ONCE_REWRITE_TAC[INTER_COMM];
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[UNION_COMM];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let open_induced = 
prove_by_refinement(
  `!U (A:A->bool). (topology_ U) /\ U A ==>
          (induced_top U A = { B | U B /\ B SUBSET A })`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[induced_top;IMAGE;];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[];
  GEN_TAC;
  EQ_TAC;
  REP_BASIC_TAC;
  FIRST_ASSUM MP_TAC ;
  DISCH_THEN_FULL_REWRITE;
  CONJ_TAC;
  IMATCH_MP_TAC  top_inter;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER;SUBSET];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 2;
  SET_TAC [INTER;SUBSET];
  ]);;
  (* }}} *)

let connected_induced = 
prove_by_refinement(
  `!U (C:A->bool) . (topology_ U /\ U C ) ==>
           (connected U C = connected (induced_top U C) C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[connected];
  ASM_SIMP_TAC[open_induced];
  EQ_TAC;
  REP_BASIC_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  sub_union;
  ASM_REWRITE_TAC[SUBSET_REFL ];
  REP_BASIC_TAC;
  TYPEL_THEN [`A`;`B`] (USE 2 o ISPECL);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  REP_BASIC_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS {B | U B /\ B SUBSET C}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  UNIONS_UNIONS;
  ONCE_REWRITE_TAC[SUBSET];
  REWRITE_TAC[];
  MESON_TAC[];
  (* - *)
  REP_BASIC_TAC;
  TYPEL_THEN[`A INTER C`;`B INTER C`] (USE 2 o ISPECL);
  REWR 2;
  UND 2;
  DISCH_THEN  (TH_INTRO_TAC []);
  TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC top_inter;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWRITE_TAC[GSYM CONJ_ASSOC];
  CONJ_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[INTER_SUBSET];
  CONJ_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  UND 5;
  SET_TAC[INTER];
  UND 4;
  SET_TAC[SUBSET;UNION;INTER];
  SET_TAC[INTER;SUBSET];
  ]);;
  (* }}} *)

let connected_induced2 = 
prove_by_refinement(
  `!U (C:A->bool) Z. (topology_ U /\ U C /\ Z SUBSET (UNIONS U))  ==>
        (connected (induced_top U C) Z <=> (Z SUBSET C) /\ (connected U Z))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[connected];
  ASM_SIMP_TAC[open_induced];
  EQ_TAC;
  REP_BASIC_TAC;
  SUBCONJ_TAC;
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  USE 4(REWRITE_RULE[SUBSET;UNIONS]);
  TSPEC `x` 4;
  REWR 4;
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REP_BASIC_TAC;
  TYPEL_THEN [`A INTER C`;`B INTER C`] (USE 3 o ISPECL);
  REWR 3;
  UND 3;
  DISCH_THEN  (TH_INTRO_TAC []);
  TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC;
  REP_BASIC_TAC;
  IMATCH_MP_TAC top_inter;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWRITE_TAC[GSYM CONJ_ASSOC];
  CONJ_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[INTER_SUBSET];
  CONJ_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC;
  UND 7;
  SET_TAC[INTER];
  UND 6;
  UND 5;
  SET_TAC[INTER;SUBSET;UNION];
  UND 5;
  SET_TAC[INTER;SUBSET;UNION];
  REP_BASIC_TAC;
  (* - *)
  CONJ_TAC;
  UND 0;
  REWRITE_TAC[SUBSET;UNIONS];
  REP_BASIC_TAC;
  TSPEC `x` 5;
  REWR 5;
  REP_BASIC_TAC;
  TYPE_THEN `u INTER C` EXISTS_TAC;
  REWRITE_TAC[GSYM CONJ_ASSOC];
  CONJ_TAC;
  IMATCH_MP_TAC  top_inter;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER];
  ASM_MESON_TAC[ISUBSET ];
  (* - *)
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let connected_metric = 
prove_by_refinement(
  `!X d (C:A->bool). metric_space (X,d) /\ C SUBSET X /\
    (top_of_metric(X,d)C) ==>
     (connected(top_of_metric(X,d))C <=> connected(top_of_metric(C,d))C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d))C` SUBGOAL_TAC;
  ASM_MESON_TAC[top_of_metric_induced];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  connected_induced;
  ASM_MESON_TAC[top_of_metric_top];
  ]);;
  (* }}} *)

let connected_metric_pair = 
prove_by_refinement(
  `!(X:A->bool) Y Z d. metric_space (X,d) /\
     top_of_metric(X,d) Y /\ top_of_metric(X,d) Z /\
       Z SUBSET Y  ==>
   (connected (top_of_metric(X,d)) Z = connected (top_of_metric(Y,d)) Z)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* - *)
  TYPE_THEN `Y SUBSET X` SUBGOAL_TAC;
  USE 2(MATCH_MP sub_union);
  UND 2;
  ASM_SIMP_TAC[GSYM top_of_metric_unions];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `Z SUBSET X` SUBGOAL_TAC ;
  ASM_MESON_TAC[SUBSET_TRANS];
  DISCH_TAC;
  ASM_SIMP_TAC[connected_metric];
  (* - *)
  TYPE_THEN `metric_space (Y,d)` SUBGOAL_TAC;
  ASM_MESON_TAC[metric_subspace];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `top_of_metric(Y,d)  = induced_top(top_of_metric(X,d)) Y` SUBGOAL_TAC;
  ASM_MESON_TAC[top_of_metric_induced];
  DISCH_TAC;
  TYPE_THEN `top_of_metric(Y,d) Z` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[open_induced;top_of_metric_top];
  DISCH_TAC;
  ASM_SIMP_TAC[connected_metric];
  ]);;
  (* }}} *)

let construct_hv_finite = 
prove_by_refinement(
  `!A C v v'. (top2 A) /\ (C SUBSET A) /\ (simple_arc_end C v v') ==>
    (?C'. C' SUBSET A /\ simple_arc_end C' v v' /\ hv_finite C')`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `A' = path_component(top_of_metric(A,d_euclid)) v` ABBREV_TAC ;
  TYPE_THEN `A' = component (top_of_metric(A,d_euclid)) v` SUBGOAL_TAC;
  EXPAND_TAC "A'";
  AP_THM_TAC;
  IMATCH_MP_TAC  loc_path_euclid_cor ;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_REWRITE_TAC[GSYM top2];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `A SUBSET (euclid 2)` SUBGOAL_TAC;
  USEF `top2`  (MATCH_MP sub_union );
  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN`UNIONS (top_of_metric(A,d_euclid)) = A` SUBGOAL_TAC;
  ASM_MESON_TAC [GSYM top_of_metric_unions;metric_euclid;metric_subspace];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `A' SUBSET (UNIONS (top_of_metric(A,d_euclid)))` SUBGOAL_TAC;
  ASM_MESON_TAC[component_unions];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `A' SUBSET (euclid 2)`  SUBGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `A` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  ASSUME_TAC  loc_path_conn_top2 ;
  (* - *)
  TYPE_THEN `A v` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
  UND 1;
  DISCH_THEN IMATCH_MP_TAC ;
  UND 0;
  MESON_TAC[simple_arc_end_end];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `top_of_metric(A,d_euclid) = induced_top top2 A` SUBGOAL_TAC;
  REWRITE_TAC[top2];
  UND 5;
  SIMP_TAC [metric_euclid;top_of_metric_induced ];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `top2 A'` SUBGOAL_TAC;
  EXPAND_TAC "A'";
  UND 11;
  DISCH_THEN_REWRITE;
  USE 9 (REWRITE_RULE[ loc_path_conn]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `~(v  = v')` SUBGOAL_TAC;
  UND 0;
  ASM_MESON_TAC[simple_arc_end_distinct];
  DISCH_TAC;
  (* A' - *)
  TYPE_THEN `connected (top_of_metric(A,d_euclid)) A'` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  component_imp_connected;
  ASM_MESON_TAC[top_of_metric_top;metric_subspace;metric_euclid];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) A'` SUBGOAL_TAC;
  TH_INTRO_TAC [`euclid 2`;`A`;`A'`;`d_euclid`] connected_metric_pair;
  ASM_MESON_TAC [metric_euclid;GSYM top2];
  DISCH_THEN_REWRITE;
  ASM_MESON_TAC[];
  REWRITE_TAC[GSYM top2];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `connected top2 C` SUBGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_connected;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `C SUBSET A'` SUBGOAL_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  connected_component;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\a`);
  CONJ_TAC;
  UND 0;
  MESON_TAC[simple_arc_end_end];
  TH_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
  REWRITE_TAC[top2_top;top2_unions];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[SUBSET_TRANS];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `C v /\ C v'` SUBGOAL_TAC;
  UND 0;
  MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  DISCH_TAC;
  TYPE_THEN `A' v /\ A' v'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  DISCH_TAC;
  (* - *)
  TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_conn;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_hv_finite;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  REP_BASIC_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `A'` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let graph_rad_pt_center_piece = 
prove_by_refinement(
  `!G r e v v'.
     graph_hv_finite_radius G r /\ graph_inc G e v /\
     FINITE(graph_edge G) /\ FINITE(graph_vertex G) /\
    graph_edge G e /\ graph_inc G e v' /\ ~(v = v') ==>
   (? Cv u Cv' u' C''.
        (hv_finite Cv /\ hv_finite Cv' /\  (hv_finite C'') /\
        ~(graph_vertex G u) /\
        ~(graph_vertex G u') /\
        simple_arc_end Cv v u /\
        simple_arc_end Cv' v' u' /\
        simple_arc_end C'' u u' /\
         ~C'' v /\ ~C'' v' /\
        (euclid 2 u)  /\ (euclid 2 u') /\
        (d_euclid v u = r) /\ (d_euclid v' u' = r) /\
        (Cv SUBSET e) /\ (Cv' SUBSET e) /\
        (Cv SUBSET  (closed_ball(euclid 2,d_euclid) v r)) /\
        (Cv' SUBSET (closed_ball(euclid 2,d_euclid) v' r)) /\
   (!e'. (graph_edge G e') /\ ~(e = e') ==> (C'' INTER e' = EMPTY)) /\
   (!v''. graph_vertex G v'' /\ ~(graph_inc G e v'') ==>
        (C'' INTER (closed_ball(euclid 2,d_euclid) v'' r) = EMPTY))
     ))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TH_INTRO_TAC [`G`;`r`;`e`;`v`] graph_rad_pt_select;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `Cv = C` ABBREV_TAC ;
  KILL 13;
  TYPE_THEN `Cv` EXISTS_TAC;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TH_INTRO_TAC [`G`;`r`;`e`;`v'`] graph_rad_pt_select;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `Cv' = C'` ABBREV_TAC ;
  KILL 19;
  TYPE_THEN `Cv'` EXISTS_TAC;
  TYPE_THEN `u'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* A' *)
  TYPE_THEN `!v''. graph_vertex G v'' ==> (euclid 2 v'')` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;SUBSET ]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!v''. graph_inc G e v'' ==> graph_vertex G v''`  SUBGOAL_TAC;
  REP_BASIC_TAC;
  TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]);
  ASM_REWRITE_TAC[SUBSET ];
  FIRST_ASSUM MP_TAC;
  MESON_TAC[ISUBSET];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ;
  TYPE_THEN `B  = (UNIONS { e' | graph_edge G e' /\ ~(e' = e)})` ABBREV_TAC ;
  TYPE_THEN `B' = (UNIONS { DD | ?v''. (graph_vertex G v'' /\ (DD = D v'') /\ ~(graph_inc G e v''))})` ABBREV_TAC ;
  TYPE_THEN `B'' = {v, v'}` ABBREV_TAC ;
  TYPE_THEN `A = (euclid 2 DIFF (B UNION B' UNION B''))` ABBREV_TAC ;
  TYPE_THEN `top2 A` SUBGOAL_TAC;
  TH_INTRO_TAC [`top2`;`B UNION B' UNION B''`] closed_open;
  IMATCH_MP_TAC  closed_union;
  REWRITE_TAC[top2_top];
  EXPAND_TAC "B";
  EXPAND_TAC "B'";
  EXPAND_TAC "B''";
  CONJ_TAC;
  IMATCH_MP_TAC  top_closed_unions;
  REWRITE_TAC[top2_top;SUBSET;];
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `graph_edge G` EXISTS_TAC ;
  ASM_REWRITE_TAC[SUBSET];
  MESON_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]);
  REP_BASIC_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  TH_INTRO_TAC [`G`;`x`] graph_edge_end_select;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  (* --- *)
  IMATCH_MP_TAC  closed_union;
  REWRITE_TAC[top2_top];
  CONJ_TAC;
  IMATCH_MP_TAC  top_closed_unions;
  REWRITE_TAC[top2_top];
  CONJ_TAC;
  TYPE_THEN `{DD | ?v''. graph_vertex G v'' /\ (DD = D v'') /\ ~graph_inc G e v''} = IMAGE D { v'' | graph_vertex G v'' /\ ~graph_inc G e v''}` SUBGOAL_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  GEN_TAC;
  REWRITE_TAC[];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  FINITE_IMAGE;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `graph_vertex G` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET ];
  MESON_TAC[];
  REWRITE_TAC[SUBSET];
  REP_BASIC_TAC;
  UNDF `x = D v''`;
  DISCH_THEN_FULL_REWRITE;
  EXPAND_TAC "D";
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  closed_ball_closed;
  REWRITE_TAC[metric_euclid];
  (* --- *)
  TYPE_THEN `{v,v'} = {v} UNION {v'}` SUBGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[in_pair;UNION;INR IN_SING];
  MESON_TAC[];
  DISCH_THEN_REWRITE;
  IMATCH_MP_TAC  closed_union;
  REWRITE_TAC[top2_top];
  TYPE_THEN `graph_inc G e v` (FIND_ASSUM MP_TAC);
  TYPE_THEN `graph_inc G e v'` (FIND_ASSUM MP_TAC);
  ASM_MESON_TAC[closed_point];
  REWRITE_TAC[open_DEF;top2_unions];
  EXPAND_TAC "A";
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* B' *)
  TYPE_THEN `!u'' v''. graph_vertex G v'' /\ (d_euclid v'' u'' = r) ==> ~(graph_vertex G u'')` SUBGOAL_TAC;
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  TYPEL_THEN [`u''`;`v''`] (USE 31 o ISPECL);
  TYPE_THEN `~(u'' = v'')` SUBGOAL_TAC;
  DISCH_TAC;
  POP_ASSUM MP_TAC;
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `d_euclid v'' v'' = &0` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_zero;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_euclid];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  UNDF `&0 = r`;
  UNDF   `&0 < r`;
  REAL_ARITH_TAC;
  DISCH_TAC;
  UNDF `(graph_vertex)`;
  ASM_REWRITE_TAC[EMPTY_EXISTS ;INTER ;closed_ball ;];
  TYPE_THEN `u''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `d_euclid u'' u'' = &0` SUBGOAL_TAC;
  IMATCH_MP_TAC  metric_space_zero;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  ASM_REWRITE_TAC[metric_euclid];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `euclid 2 u'' ` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `euclid 2 v'' ` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  UNDF `&0 < r`;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* B1'- *)
  TYPE_THEN `~graph_vertex G u` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~graph_vertex G u'` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `v'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  ASM_REWRITE_TAC[];
  (* C' *)
  TYPE_THEN `!(X:A->bool) Y Z. (X UNION Y = Z) ==> (X SUBSET Z)` SUBGOAL_TAC;
  SET_TAC[UNION;SUBSET];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `simple_arc_end e v v'` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE [graph_hv_finite_radius;good_plane_graph]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `graph_vertex G v'` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `~D v u'` SUBGOAL_TAC;
  EXPAND_TAC "D";
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]);
  REP_BASIC_TAC;
  GRABF `~(v = v')` (TH_INTRO_TAC [`v`;`v'`]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u'` EXISTS_TAC;
  ASM_REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[closed_ball];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* C1'- *)
  TYPE_THEN `~(v = u) /\ ~(v = u')` SUBGOAL_TAC;
  CONJ_TAC;
  DISCH_TAC;
  POP_ASSUM MP_TAC;
  DISCH_THEN_FULL_REWRITE;
  TH_INTRO_TAC[`u`] euclid2_d0;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UNDF `&0 < r`;
  UNDF `&0 = r`;
  REAL_ARITH_TAC;
  DISCH_TAC;
  POP_ASSUM MP_TAC;
  DISCH_THEN_FULL_REWRITE;
  POP_ASSUM MP_TAC;
  EXPAND_TAC "D";
  REWRITE_TAC[closed_ball];
  ASM_REWRITE_TAC[];
  TH_INTRO_TAC [`u'`] euclid2_d0;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UNDF `&0 < r`;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* - *)
  TYPE_THEN `~(v' = u') ` SUBGOAL_TAC;
  DISCH_TAC;
  POP_ASSUM MP_TAC;
  DISCH_THEN_FULL_REWRITE;
  TH_INTRO_TAC[`u'`] euclid2_d0;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UNDF `&0 < r`;
  UNDF `&0 = r`;
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* - *)
  TH_INTRO_TAC [`e`;`v`;`v'`;`u'`] simple_arc_end_cut;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Cv' u'` SUBGOAL_TAC;
  TYPE_THEN `simple_arc_end Cv' v' u'` (FIND_ASSUM  MP_TAC );
  MESON_TAC[simple_arc_end_end2];
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `Cvu' = C''` ABBREV_TAC ;
  POP_ASSUM (fun t-> ALL_TAC);
  TYPE_THEN `Cu'v' = C'''` ABBREV_TAC ;
  POP_ASSUM (fun t -> ALL_TAC);
  TYPE_THEN `Cu'v' v'` SUBGOAL_TAC;
  TYPE_THEN `simple_arc_end Cu'v' u' v'` (FIND_ASSUM  MP_TAC );
  MESON_TAC[simple_arc_end_end2];
  DISCH_TAC;
  TYPE_THEN `~Cvu' v'` SUBGOAL_TAC;
  DISCH_TAC;
  USEF `(INTER)` (REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `v'` 37;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing ;INR IN_SING]);
  UND 37;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `~D v' u` SUBGOAL_TAC;
  EXPAND_TAC "D";
  DISCH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]);
  REP_BASIC_TAC;
  GRABF `~(v' = v)` (TH_INTRO_TAC [`v'`;`v`]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  ASM_REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[closed_ball];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  DISCH_TAC;
  (* D'- *)
  TYPE_THEN `Cvu' u \/ Cu'v' u` SUBGOAL_TAC;
  USE 35 (REWRITE_RULE[FUN_EQ_THM;]);
  TSPEC  `u` 35 ;
  USE 35 (REWRITE_RULE[UNION]);
  ASM_REWRITE_TAC[];
  USE 8(REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 11;
  MESON_TAC[simple_arc_end_end2];
  DISCH_TAC;
  (* - *)
  USE 35 (MATCH_MP   union_imp_subset);
  TYPE_THEN `Cu'v' = Cv'` SUBGOAL_TAC;
  TH_INTRO_TAC [`Cu'v'`;`Cv'`;`e`;`v'`;`u'`] simple_arc_end_inj;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  DISCH_THEN_FULL_REWRITE;
  (* - *)
  TYPE_THEN `~Cv' u` SUBGOAL_TAC;
  DISCH_TAC;
  UNDF `~D v' u` ;
  REWRITE_TAC[];
  EXPAND_TAC "D";
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  REWR 45;
  (* - *)
  TYPE_THEN `~(u = u')` SUBGOAL_TAC;
  DISCH_TAC;
  UND 47;
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  GRABF `~(v=v')` (TH_INTRO_TAC[`v`;`v'`]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u'` EXISTS_TAC;
  REWRITE_TAC[INTER;closed_ball];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_ARITH `r <= r`];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TH_INTRO_TAC[`Cvu'`;`v`;`u'`;`u`] simple_arc_end_cut;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `CC = C'''''` ABBREV_TAC ;
  POP_ASSUM (fun t->ALL_TAC);
  (* E' *)
  TYPE_THEN `~CC v` SUBGOAL_TAC;
  DISCH_TAC;
  TYPE_THEN `C'''' v` SUBGOAL_TAC;
  UND 50;
  MESON_TAC[simple_arc_end_end];
  DISCH_TAC;
  TYPE_THEN `v = u` SUBGOAL_TAC;
  UND 48;
   REWRITE_TAC[INTER;eq_sing;INR IN_SING];
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_THEN_FULL_REWRITE;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `~CC v'` SUBGOAL_TAC;
  DISCH_TAC;
  USE 35 (MATCH_MP union_imp_subset);
  UND 43;
  REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `CC SUBSET A` SUBGOAL_TAC;
  EXPAND_TAC "A";
  REWRITE_TAC[DIFF_SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  UND 49;
  MESON_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 55 (MATCH_MP inter_union);
  FIRST_ASSUM MP_TAC;
  REWRITE_TAC[];
  REWRITE_TAC[DE_MORGAN_THM];
  TYPE_THEN `CC SUBSET e` SUBGOAL_TAC;
  USE 35 (MATCH_MP union_imp_subset);
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Cvu'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_TAC;
  (* -- *)
  CONJ_TAC;
  EXPAND_TAC"B";
  REWRITE_TAC[INTER;UNIONS;EQ_EMPTY ];
  REP_BASIC_TAC;
  TYPE_THEN `e x` SUBGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  REP_BASIC_TAC  ; (* we are up to 69 in the hypothesis stack *)
  TYPEL_THEN  [`e`;`u''`] (USE 66 o ISPECL);
  REWR 66;
  TYPE_THEN `graph_vertex G x` SUBGOAL_TAC;
  USE 66 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[INTER];
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* --- *)
  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_edge2;
  ASM_REWRITE_TAC[];
  TYPE_THEN `graph_inc G e x` SUBGOAL_TAC;
  ASM_SIMP_TAC[];
  ASM_REWRITE_TAC[INTER];
  REP_BASIC_TAC;
  TH_INTRO_TAC [`graph_inc G e`;`v`;`x`;`v'`] two_exclusion;
  ASM_REWRITE_TAC[];
   UND 60;
  UND 54;
  MESON_TAC[];
  UND 60;
  UND 53;
  MESON_TAC[];
  (* -- *)
  PROOF_BY_CONTR_TAC;
  USE 57 (MATCH_MP inter_union);
  UND 57;
  REWRITE_TAC[DE_MORGAN_THM];
  CONJ_TAC;
  EXPAND_TAC "B'";
  REWRITE_TAC[INTER;UNIONS;];
  REWRITE_TAC [EQ_EMPTY];
  REP_BASIC_TAC;
  UNDF `u''' = D v''` ;
  DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  TYPEL_THEN [`e`;`v''`] (USE 59 o ISPECL);
  REWR 59;
  UND 59;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `x` EXISTS_TAC;
  REWRITE_TAC[INTER];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UND 57;
  EXPAND_TAC "D";
  DISCH_THEN_REWRITE;
  (* -- *)
  EXPAND_TAC "B''";
  REWRITE_TAC[INTER;EQ_EMPTY;in_pair];
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* F' *)
  TH_INTRO_TAC[`A`;`CC`;`u`;`u'`] construct_hv_finite;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `Chv = C''''''` ABBREV_TAC ;
  KILL 59;
  TYPE_THEN `Chv` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~(A v) /\ ~(A v')` SUBGOAL_TAC;
  EXPAND_TAC "A";
  EXPAND_TAC "B''";
  REWRITE_TAC[DIFF;UNION;in_pair];
  DISCH_TAC;
  TYPE_THEN `~(Chv v) /\ ~(Chv v')` SUBGOAL_TAC;
  UND 59;
  UND 58;
  MESON_TAC[ISUBSET];
  DISCH_THEN_REWRITE;
  (* - *)
  TYPE_THEN `(!e'. ~(e = e') /\ (graph_edge G e') ==> (A INTER e' = {}))` SUBGOAL_TAC;
  EXPAND_TAC "A";
  EXPAND_TAC "B";
  REP_BASIC_TAC;
  REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS ];
  REP_BASIC_TAC;
  LEFT 64 "u";
  LEFT 64 "u";
  TSPEC `e'` 64;
  UND 64;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  CONJ_TAC;
  REP_BASIC_TAC;
  TSPEC `e'` 60;
  REWR 60;
  UND 60;
  UND 58;
  REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;];
  MESON_TAC[];
  (* - *)
  TYPE_THEN `!v''. graph_vertex G v'' /\ ~graph_inc G e v'' ==> (A INTER closed_ball (euclid 2,d_euclid) v'' r = {})` SUBGOAL_TAC;
  REP_BASIC_TAC;
  EXPAND_TAC "A";
  EXPAND_TAC "B'";
  REP_BASIC_TAC;
  REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS;];
  EXPAND_TAC "D";
  REP_BASIC_TAC;
  UND 65;
  REWRITE_TAC[];
  DISJ2_TAC;
  DISJ1_TAC;
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `v''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TSPEC `v''` 62;
  REWR 62;
  UND 62;
  UND 58;
  REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;];
  MESON_TAC[];
  (* Wed Aug 25 14:58:37 EDT 2004 *)


  ]);;
  (* }}} *)

let planar_graph_hv = 
prove_by_refinement(
  `!(G:(A,B)graph_t). (planar_graph G) /\
         FINITE (graph_edge G) /\
         FINITE (graph_vertex G) /\
         ~(graph_edge G = {}) /\
         (!v. CARD (graph_edge_around G v) <=| 4)
         ==> (?H. graph_isomorphic G H /\
              good_plane_graph H /\ (!e. graph_edge H e ==>
           hv_finite e))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TH_INTRO_TAC[`G`] graph_radius_exists;
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  (* - *)
  TYPE_THEN `X = { K | graph_isomorphic H K /\ graph_hv_finite_radius K r}` ABBREV_TAC  ;
  TYPE_THEN `c = (\ (K:(num->real,(num->real)->bool)graph_t). CARD {x | graph_edge K x /\ ~hv_finite x})` ABBREV_TAC ;
  TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ;
  TH_INTRO_TAC[`X`;`c`] select_image_num_min;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `H` EXISTS_TAC;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  ASM_REWRITE_TAC[graph_isomorphic_refl];
  REP_BASIC_TAC;
  TYPE_THEN `K = z` ABBREV_TAC ;
  KILL 12;
  TYPE_THEN `K` EXISTS_TAC;
  CONJ_TAC;
  UND 11;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  ASM_MESON_TAC[graph_isomorphic_trans];
  (* - *)
  TYPE_THEN `graph_hv_finite_radius K r` SUBGOAL_TAC;
  UND 11;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* - *)
  CONJ_TAC;
  UND 12;
  REWRITE_TAC[graph_hv_finite_radius];
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  (* - *)
  TH_INTRO_TAC[`K`;`e`] graph_edge_end_select;
  ASM_REWRITE_TAC[];
  UND 12;
  REWRITE_TAC[graph_hv_finite_radius;good_plane_graph;plane_graph];
  DISCH_THEN_REWRITE;
  REP_BASIC_TAC;
  (* A *)
  TYPE_THEN `graph_isomorphic G K` SUBGOAL_TAC;
  TH_INTRO_TAC[`G`;`H`;`K`] graph_isomorphic_trans;
  ASM_REWRITE_TAC[];
  UND 11;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* - *)
  TYPE_THEN `FINITE (graph_edge K)` SUBGOAL_TAC;
  USE 18(REWRITE_RULE[graph_isomorphic;graph_iso]);
  REP_BASIC_TAC;
  UND 19;
  UND 3;
  MESON_TAC[FINITE_BIJ];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `~(? e' . (~graph_edge K e') /\ hv_finite e' /\ simple_arc_end e' v v' /\ (e INTER (graph_vertex K) = (e' INTER (graph_vertex K))) /\ (!v. graph_vertex K v /\ ~e' v  ==> (e' INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ (!e''. graph_edge K e'' /\ ~(e'' = e)  ==> e' INTER e'' SUBSET e INTER e''))` SUBGOAL_TAC;
  DISCH_TAC;
  REP_BASIC_TAC;
  (* -- *)
  TH_INTRO_TAC[`K`;`e`;`e'`] graph_replace_card;
  ASM_REWRITE_TAC[];
  TYPE_THEN `K' = graph_replace K e e'` ABBREV_TAC ;
  DISCH_TAC;
  TYPE_THEN `graph_isomorphic H K'` SUBGOAL_TAC;
  EXPAND_TAC "X";
  EXPAND_TAC "K'";
  REWRITE_TAC[];
  TH_INTRO_TAC[`H`;`K`;`K'`] graph_isomorphic_trans;
  ASM_REWRITE_TAC[];
  UND 11;
  EXPAND_TAC "X";
  REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  EXPAND_TAC "K'";
  IMATCH_MP_TAC  graph_replace_iso;
  ASM_REWRITE_TAC[];
  EXPAND_TAC "K'";
  DISCH_THEN_REWRITE;
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `plane_graph K'` SUBGOAL_TAC;
  EXPAND_TAC "K'";
  IMATCH_MP_TAC  graph_replace_plane;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `good_plane_graph K'` SUBGOAL_TAC;
  EXPAND_TAC "K'";
  IMATCH_MP_TAC  good_replace;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `e v'' /\ e v'''` SUBGOAL_TAC;
  USE 22 (REWRITE_RULE[FUN_EQ_THM]);
  TYPE_THEN  `v''` (WITH 22 o ISPEC);
  TYPE_THEN `v'''` (USE 22 o ISPEC);
  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
  UND 22;
  UND 35;
  UND 33;
  UND 34;
  DISCH_THEN_REWRITE;
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  MESON_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc K e = {v,v'}` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_vertex_exhaust;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `graph_inc K e = {v'',v'''}` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_vertex_exhaust;
  USE 37 (SYM);
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  TSPEC `e` 46;
  REWR 46;
  ASM_REWRITE_TAC[INTER];
  DISCH_THEN_FULL_REWRITE;
  TYPE_THEN `((v'' = v) /\ (v''' = v')) \/ ((v'' = v') /\ (v''' = v))` SUBGOAL_TAC;
  USE 37 (REWRITE_RULE[FUN_EQ_THM]);
  TYPE_THEN `v''` (WITH 37 o ISPEC);
  TYPE_THEN `v'''` (USE 37 o ISPEC);
  UND 37;
  UND 38;
  REWRITE_TAC[in_pair];
  UND 32;
  UND 15;
  MESON_TAC[];
  DISCH_THEN DISJ_CASES_TAC;
  REP_BASIC_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* -- *)
  TYPE_THEN `graph_hv_finite_radius K' r` SUBGOAL_TAC;
  EXPAND_TAC "K'";
  IMATCH_MP_TAC  graph_replace_hv_finite_radius;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TYPE_THEN `X K'` SUBGOAL_TAC;
  EXPAND_TAC "X";
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  TSPEC `K'` 10;
  REWR 10;
  UND 10;
  EXPAND_TAC "c";
  UND 27;
(**** Changed by JRH; the new ARITH_TAC doesn't accept alpha-equivs (maybe)
  ARITH_TAC;
 ****)
  REWRITE_TAC[NOT_IMP; NOT_LE];
  REWRITE_TAC[];
  (* B *)
  TH_INTRO_TAC [`K`;`r`;`e`;`v`;`v'`] graph_rad_pt_center_piece;
  ASM_REWRITE_TAC[];
  USE 18 (REWRITE_RULE[graph_isomorphic;graph_iso]);
  REP_BASIC_TAC;
  UND 21;
  UND 2;
  MESON_TAC[FINITE_BIJ];
  REP_BASIC_TAC;
  KILL 4;
  KILL 3;
  KILL 2;
  KILL 1;
  KILL 0;
  KILL 6;
  KILL 5;
  KILL 7;
  KILL 8;
  KILL 11;
  KILL 10;
  KILL 18;
  KILL 19;
  TYPE_THEN `graph_inc K e  = {v,v'}` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_vertex_exhaust;
  ASM_REWRITE_TAC[];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `e INTER graph_vertex K = {v,v'}` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  TSPEC `e` 7;
  REWR 7;
  ASM_REWRITE_TAC[];
  DISCH_THEN_REWRITE;
  (* C- *)
  TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TH_INTRO_TAC[`K`;`e'`] graph_inc_subset;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `p_conn (Cv UNION Cv' UNION C'') v v'` SUBGOAL_TAC;
  IMATCH_MP_TAC  pconn_trans;
  TYPE_THEN `u` EXISTS_TAC;
  CONJ_TAC;
  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`u`] p_conn_hv_finite;
  IMATCH_MP_TAC  simple_arc_end_distinct;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `Cv` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  IMATCH_MP_TAC  pconn_trans;
  TYPE_THEN `u'` EXISTS_TAC;
  CONJ_TAC;
  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u`;`u'`] p_conn_hv_finite;
  IMATCH_MP_TAC  simple_arc_end_distinct;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `C''` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u'`;`v'`] p_conn_hv_finite;
  IMATCH_MP_TAC  simple_arc_end_distinct;
  TYPE_THEN `Cv'` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_MESON_TAC[];
  DISCH_THEN_REWRITE;
  TYPE_THEN `Cv'` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`v'`] p_conn_hv_finite;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* D final constraints *)
  TYPE_THEN`graph K` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC;
  REP_BASIC_TAC;
  TH_INTRO_TAC[`K`;`e'`]graph_inc_subset;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  (* - *)
  CONJ_TAC;
  DISCH_TAC;
  TYPE_THEN `C = e` ASM_CASES_TAC;
  ASM_MESON_TAC[];
  TSPEC `C` 21;
  REWR 11;
  TYPE_THEN `C SUBSET Cv UNION Cv'` SUBGOAL_TAC;
  UND 11;
  UND 4;
  REWRITE_TAC[SUBSET;UNION;EQ_EMPTY;INTER ];
  MESON_TAC[];
  DISCH_TAC;
  TYPE_THEN `D v INTER D v' = EMPTY ` SUBGOAL_TAC;
  EXPAND_TAC "D";
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UND 21;
  DISCH_THEN IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  DISCH_TAC;
  (* -- *)
  UND 10;
  REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `v'` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL];
  SUBCONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]);
  REP_BASIC_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISCH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Cv UNION Cv'` EXISTS_TAC;
  ASM_REWRITE_TAC[union_subset ];
  (* E *)
  CONJ_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[in_pair;INTER ];
  GEN_TAC;
  EQ_TAC;
  DISCH_THEN DISJ_CASES_TAC;
  UND 8;
  DISCH_THEN_FULL_REWRITE;
  CONJ_TAC;
  UND 3;
  MESON_TAC[simple_arc_end_end2];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  UND 8;
  DISCH_THEN_FULL_REWRITE;
  CONJ_TAC;
  UND 3;
  MESON_TAC[simple_arc_end_end];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `graph_inc K e x` ASM_CASES_TAC;
  REWR 8;
  RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
  ASM_REWRITE_TAC[];
  USE 4 (REWRITE_RULE[SUBSET ]);
  REP_BASIC_TAC;
  TSPEC `x` 4;
  REWR 4;
  USE 4(REWRITE_RULE[UNION]);
  UND 4;
  REP_CASES_TAC;
  DISJ2_TAC;
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UND 40;
  DISCH_THEN (TH_INTRO_TAC[`v`;`x`]);
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `x` EXISTS_TAC;
  REWRITE_TAC[INTER];
  CONJ_TAC;
  UND 4;
  UND 23;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  REWRITE_TAC[closed_ball2_center];
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  CONJ_TAC;
  USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UNDF `&0 < r`;
  REAL_ARITH_TAC;
  (* --- *)
  DISJ1_TAC;
  PROOF_BY_CONTR_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UNDF `~(v = v')`;
  DISCH_THEN (TH_INTRO_TAC[`v'`;`x`]);
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `x` EXISTS_TAC;
  REWRITE_TAC[INTER];
  CONJ_TAC;
  UND 4;
  UND 22;
  REWRITE_TAC[SUBSET];
  MESON_TAC[];
  REWRITE_TAC[closed_ball2_center];
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  CONJ_TAC;
  USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UNDF `&0 < r`;
  REAL_ARITH_TAC;
 (* -- *)
  TYPE_THEN `graph_inc K e x` ASM_CASES_TAC;
  REWR 18;
  TSPEC `x` 20;
  REWR 19;
  PROOF_BY_CONTR_TAC;
  UND 19;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[INTER;closed_ball2_center];
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
  REP_BASIC_TAC;
  USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UNDF `&0 < r`;
  REAL_ARITH_TAC;
  (* F *)
  KILL 14;
  KILL 39;
  KILL 38;
  KILL 37;
  KILL 36;
  KILL 35;
  KILL 34;
  KILL 33;
  KILL 32;
  KILL 29;
  KILL 28;
  KILL 27;
  KILL 26;
  KILL 5;
  KILL 2;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[SUBSET;INTER];
  REP_BASIC_TAC;
  USEF `(SUBSET)` (REWRITE_RULE[SUBSET]);
  TSPEC `x` 4;
  REWR 4;
  UND 4;
  REWRITE_TAC[UNION];
  REP_CASES_TAC;
  ASM_MESON_TAC[ISUBSET];
  ASM_MESON_TAC[ISUBSET];
  PROOF_BY_CONTR_TAC;
  UND 21;
  DISCH_THEN (TH_INTRO_TAC[`e''`]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[INTER];
  (* G *)
  REP_BASIC_TAC;
  TYPE_THEN `graph_inc K e v''` ASM_CASES_TAC;
  REWR 8;
  UND 8;
  REWRITE_TAC[in_pair];
  REP_CASES_TAC;
  UND 8;
  DISCH_THEN_FULL_REWRITE;
  PROOF_BY_CONTR_TAC;
  UND 2;
  UND 3;
  MESON_TAC[simple_arc_end_end2];
  UND 8;
  DISCH_THEN_FULL_REWRITE;
  PROOF_BY_CONTR_TAC;
  UND 2;
  UND 3;
  MESON_TAC[simple_arc_end_end];
  (* - *)
  TYPE_THEN `C SUBSET D v UNION D v' UNION C''` SUBGOAL_TAC;
  EXPAND_TAC "D";
  UND 4;
  UND 22;
  UND 23;
  REWRITE_TAC[SUBSET;UNION];
  MESON_TAC[];
  REWRITE_TAC[SUBSET];
  DISCH_TAC;
  PROOF_BY_CONTR_TAC;
  USE 11 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  REP_BASIC_TAC;
  TSPEC `u` 10;
  REWR 10;
  USE 10 (REWRITE_RULE[UNION]);
  UND 10;
  REP_CASES_TAC ;
  (* -- *)
  UND 8;
  ASM_REWRITE_TAC[in_pair];
  PROOF_BY_CONTR_TAC;
  USE 8 (REWRITE_RULE[DE_MORGAN_THM]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UND 26;
  DISCH_THEN (TH_INTRO_TAC[`v`;`v''`]);
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  UND 10;
  EXPAND_TAC "D";
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  (* -- *)
  UND 8;
  ASM_REWRITE_TAC[in_pair];
  PROOF_BY_CONTR_TAC;
  USE 8 (REWRITE_RULE[DE_MORGAN_THM]);
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
  REP_BASIC_TAC;
  UND 26;
  DISCH_THEN (TH_INTRO_TAC[`v'`;`v''`]);
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  UND 10;
  EXPAND_TAC "D";
  DISCH_THEN_REWRITE;
  ASM_REWRITE_TAC[];
  (* - *)
  UND 20;
  DISCH_THEN (TH_INTRO_TAC[`v''`]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  ASM_MESON_TAC[];
  (* Thu Aug 26 08:46:13 EDT 2004 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION P *)
(* ------------------------------------------------------------------ *)


let (UNDISCHQ_TAC:(term->bool) -> tactic) =
  fun cond (asl,w) ->
  let cond' x = try (cond x) with failure -> false in
  let asl' = (fst(partition cond' (map (concl o snd) asl))) in
  EVERY (map (TRY o UNDISCH_TAC ) asl') (asl,w);;

let UNABBREV_TAC tm  =
  FIRST[ UNDISCHQ_TAC ( ((=) tm o rhs))
      THEN (DISCH_THEN (MP_TAC o SYM))  ;
      UNDISCHQ_TAC ( ((=) tm o lhs)) ]
  THEN DISCH_THEN_FULL_REWRITE;;

let set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net =
  let rewrites = ref (basic_rewrites())
  and conv_net = ref (basic_net()) in
  let set_simp_rewrites thl =
    let canon_thl = itlist (mk_rewrites false) thl ([]:thm list) in
    (rewrites := canon_thl;
     conv_net := itlist (net_of_thm true) canon_thl empty_net) in
  let extend_simp_rewrites thl =
    (* is false in simp.ml .  Important change.  *)
    let canon_thl = itlist (mk_rewrites true) thl ([]:thm list) in
     (rewrites := canon_thl @ !rewrites;
      conv_net := itlist (net_of_thm true) canon_thl (!conv_net)) in
  let simp_rewrites() = !rewrites in
  let simp_net() = !conv_net in
  set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net;;

let simp_ss =
  let rewmaker = mk_rewrites true in
  fun thl ->
    let cthms = itlist rewmaker thl ([]:thm list) in
    let net' = itlist (net_of_thm true) cthms (simp_net()) in
    let net'' = itlist net_of_cong (basic_congs()) net' in
  Simpset(net'',basic_prover,([]:prover list),rewmaker);;

let RSIMP_CONV thl = ONCE_SIMPLIFY_CONV (simp_ss ([]:thm list)) thl;;

let (RSIMP_TAC:thm list -> tactic) = fun (thl:thm list) -> CONV_TAC(RSIMP_CONV thl);;

let ASM_RSIMP_TAC = ASM RSIMP_TAC;;

EVERY_STEP_TAC :=
     (RSIMP_TAC[]) THEN
     REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN
     (ASM_RSIMP_TAC[]) THEN
     (REWRITE_TAC[]) ;;

let SUBAGOAL_TAC t = SUBGOAL_THEN t ASSUME_TAC;;

(* EVERY_STEP_TAC := ALL_TAC *)

let subset_imp = 
prove_by_refinement(
  `!A B (x:A). A x /\ A SUBSET B ==> B x`,

  (* {{{ proof *)
  [
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

(*
extend_simp_rewrites[subset_imp]
*)

(* ------------------------------------------------------------------ *)
(* ------------------------------------------------------------------ *)


let plane_graph_image = jordan_def
  `plane_graph_image (f:(num->real)->(num->real)) G =
     mk_graph_t
       (IMAGE f (graph_vertex G),
        IMAGE2 f (graph_edge G),
        ( \ e v. (?e' v'. (graph_edge G e') /\
             (IMAGE f e' = e) /\ (f v' = v) /\
            (graph_inc G e' v'))))`;;

let plane_graph_image_e = 
prove_by_refinement(
  `!f G. (graph_edge (plane_graph_image f G)) =
         IMAGE2 f (graph_edge G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[plane_graph_image;graph_edge;part1;drop0;dest_graph_t];
  (* Thu Aug 26 10:16:26 EDT 2004 *)

  ]);;
  (* }}} *)

let plane_graph_image_v = 
prove_by_refinement(
  `!f G. (graph_vertex (plane_graph_image f G)) =
          IMAGE f (graph_vertex G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[plane_graph_image;dest_graph_t;graph_vertex;];
  (*     Thu Aug 26 10:17:56 EDT 2004 *)

  ]);;
  (* }}} *)

let plane_graph_image_i = 
prove_by_refinement(
  `!f G. (graph_inc (plane_graph_image f G)) =
     ( \ e v. (?e' v'. (graph_edge G e') /\
             (IMAGE f e' = e) /\ (f v' = v) /\
            (graph_inc G e' v')))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[plane_graph_image ;graph_inc;dest_graph_t;drop1];
  (* Thu Aug 26 10:20:07 EDT 2004 *)

  ]);;
  (* }}} *)

let plane_graph_image_bij = 
prove_by_refinement(
  `!f G. homeomorphism f top2 top2 /\ plane_graph G ==>
   BIJ f (graph_vertex G) (IMAGE f (graph_vertex G)) /\
   BIJ (IMAGE f) (graph_edge G) (IMAGE2 f (graph_edge G))`,

  (* {{{ proof *)
  [
  ALL_TAC ;
  (* - *)
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]);
  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[subset_imp];
  (* - *)
  USE 3 (MATCH_MP image_powerset);
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* ASM_MESON_TAC[ISUBSET]; *)
  ]);;
  (* }}} *)

let plane_graph_image_iso = 
prove_by_refinement(
  `!f G. (homeomorphism f top2 top2 /\ plane_graph G ==>
      graph_isomorphic G (plane_graph_image f G))`,

  (* {{{ proof *)
  [
  ALL_TAC;
  REWRITE_TAC[graph_isomorphic;graph_iso;];
  LEFT_TAC "u";
  TYPE_THEN `f` EXISTS_TAC;
  LEFT_TAC "v";
  TYPE_THEN `IMAGE f` EXISTS_TAC;
  TYPE_THEN `f,IMAGE f` EXISTS_TAC;
  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
  (* - *)
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]);
  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  (* - *)
  TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[ISUBSET];
  (* - *)
  SUBCONJ_TAC;
  USE 3 (MATCH_MP image_powerset);
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* A- *)
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  EQ_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `e' = e` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2;BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* ---- *)
  TYPE_THEN `e'`  UNABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  USE 5 GSYM;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  USE 8(REWRITE_RULE[IMAGE]);
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Thu Aug 26 10:49:22 EDT 2004 *)
  ]);;
  (* }}} *)

extend_simp_rewrites [(REAL_ARITH `&0 < &1`)];;

extend_simp_rewrites [prove_by_refinement(
  `metric_space(euclid 2,d_euclid)`,
  (* {{{ proof *)
  [
  ASM_MESON_TAC[metric_euclid];
  ])];;
  (* }}} *)

extend_simp_rewrites [prove_by_refinement(
  `!G. plane_graph G ==> graph_vertex G SUBSET (euclid 2)`,
  (* {{{ proof *)
  [
  REWRITE_TAC[plane_graph];
  ])];;
  (* }}} *)

let simple_arc_end_cont = 
prove_by_refinement(
  `!C v v'. simple_arc_end C v v' <=>
       (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
        continuous f
           (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) top2 /\
              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
              (f (&0) = v) /\
              (f (&1) = v'))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  EQ_TAC;
  TH_INTRO_TAC [`&0`;`&1`;`f`;`euclid 2`;`d_euclid`] cont_extend_real_lemma;
  CONJ_TAC;
  ASM_REWRITE_TAC[GSYM top2];
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `g` EXISTS_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  EQ_TAC;
  UNIFY_EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNIFY_EXISTS_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  ASM_REWRITE_TAC[top2];
  CONJ_TAC;
  REWRITE_TAC[INJ];
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[REAL_ARITH `x <=. x `;REAL_ARITH `&0 <=. &1`];
  (* - *)
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  continuous_interval;
  (* Thu Aug 26 12:57:09 EDT 2004 *)
  ]);;
  (* }}} *)

let graph_edge_euclid = 
prove_by_refinement(
  `!G e. (plane_graph G /\ graph_edge G e) ==> (e SUBSET (euclid 2))`,

  (* {{{ proof *)
  [
  ALL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let plane_graph_image_plane = 
prove_by_refinement(
  `!f G. (homeomorphism f top2 top2 /\ good_plane_graph G ==>
     good_plane_graph(plane_graph_image f G))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[good_plane_graph];
  TH_INTRO_TAC[`G`;`plane_graph_image f G`] graph_isomorphic_graph;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  plane_graph_image_iso;
  ASM_REWRITE_TAC[plane_graph];
  (* - *)
  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
  (* - *)
  TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
  IMATCH_MP_TAC  graph_edge_euclid;
  UNIFY_EXISTS_TAC;
  (* - *)
  TH_INTRO_TAC[`f`;`G`] plane_graph_image_bij;
  (* A- *)
  ASM_REWRITE_TAC[plane_graph;GSYM CONJ_ASSOC;];
  TYPE_THEN `(!e v v'.  graph_edge (plane_graph_image f G) e /\  ~(v = v') /\  graph_inc (plane_graph_image f G) e v /\  graph_inc (plane_graph_image f G) e v' ==> simple_arc_end e v v')` SUBGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]);
  TYPE_THEN `v` UNABBREV_TAC;
  TYPE_THEN `v'` UNABBREV_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `e' = e''` SUBGOAL_TAC ;
  USE 6 (REWRITE_RULE[BIJ;INJ;IMAGE2]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `e''` UNABBREV_TAC;
  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC [`e'`;`v'''`;`v''`]));
  DISCH_TAC;
  TYPE_THEN `v'''` UNABBREV_TAC;
  USE 0 (REWRITE_RULE[simple_arc_end_cont]);
  REWRITE_TAC[simple_arc_end_cont];
  TYPE_THEN `f o f'` EXISTS_TAC;
  REWRITE_TAC[IMAGE_o];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `top2` EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
  ASM_REWRITE_TAC[top2_unions];
  TYPE_THEN `UNIONS (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
  TH_INTRO_TAC[`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_unions;
  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV ` SUBAGOAL_TAC;
  alpha_tac;
  IMATCH_MP_TAC  metric_subspace;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC [metric_real;];
  UND 21 THEN   DISCH_THEN (fun t->ONCE_REWRITE_TAC[GSYM t]);
  REWRITE_TAC[];
  USE 15 (REWRITE_RULE[INJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[comp_comp];
  IMATCH_MP_TAC  COMP_INJ;
  UNIFY_EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]);
  REWRITE_TAC[o_DEF];
  (* B- *)
  ASM_REWRITE_TAC[];
  TYPE_THEN `graph_edge (plane_graph_image f G) SUBSET simple_arc top2` SUBGOAL_TAC;
  REWRITE_TAC[SUBSET];
  TH_INTRO_TAC[`plane_graph_image f G`;`x`] graph_edge_end_select;
  UND 8 THEN DISCH_THEN (TH_INTRO_TAC[`x`;`v`;`v'`]);
  IMATCH_MP_TAC  simple_arc_end_simple;
  UNIFY_EXISTS_TAC;
  KILL 8;
  (* - *)
  CONJ_TAC;
  MP_TAC plane_graph_image_v THEN DISCH_THEN_FULL_REWRITE;
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;INJ;]);
  USE 16 (REWRITE_RULE[top2_unions]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t ))  [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
  IMATCH_MP_TAC  EQ_EXT;
  EQ_TAC;
  TYPE_THEN `x`  UNABBREV_TAC ;
  TYPE_THEN `e` UNABBREV_TAC;
  REWRITE_TAC[INTER];
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  TSPEC `e'` 11;
  REWR 10;
  USE 10 (REWRITE_RULE[INTER]);
  REWRITE_TAC[IMAGE];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE];
  TYPE_THEN `v'` EXISTS_TAC;
  TH_INTRO_TAC [`G`;`e'`] graph_inc_subset;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  USE 8 (REWRITE_RULE[IMAGE2]);
  TYPE_THEN `FF = IMAGE f` ABBREV_TAC ;
  USE 8 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x'` EXISTS_TAC;
  USE 10 (REWRITE_RULE[INTER]);
  TYPE_THEN `FF`  UNABBREV_TAC;
  USE 10 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `x''` EXISTS_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  REWRITE_TAC[INTER];
  USE 13 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x''  =x` SUBAGOAL_TAC;
  USE 2(REWRITE_RULE[homeomorphism;BIJ;INJ;top2_unions]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  TSPEC `x'` 5;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* C- *)
  (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t ))  [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
  USE 10 (REWRITE_RULE[IMAGE2]);
  USE 11 (REWRITE_RULE[IMAGE2]);
  TYPE_THEN `FF = IMAGE f` ABBREV_TAC ;
  USE 10 (REWRITE_RULE[IMAGE]);
  USE 11 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  TH_INTRO_TAC [`f`;`euclid 2`;`euclid 2`;`x'`;`x`] (GSYM inj_inter);
  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]);
  TYPE_THEN `FF` UNABBREV_TAC;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
  TYPEL_THEN [`x'`;`x`] (fun t-> UND 1 THEN DISCH_THEN (TH_INTRO_TAC t));
  DISCH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  ]);;
  (* }}} *)

(* state MP *)

let h_compat = jordan_def `h_compat f <=> !x y. (SND x = SND y) ==>
   (IMAGE f (mk_line (point x) (point y)) =
          mk_line (f (point x)) (f (point y)))`;;

let v_compat = jordan_def `v_compat f <=> !x y. (FST x = FST y) ==>
   (IMAGE f (mk_line (point x) (point y)) =
          mk_line (f (point x)) (f (point y)))`;;

let h_translate = jordan_def `h_translate r p = p + r *# e1`;;

let v_translate = jordan_def `v_translate r p = p + r *# e2`;;

let r_scale = jordan_def `r_scale r p =
        if ( &.0 < p 0) then (point (r * p 0, p 1)) else p`;;

let u_scale = jordan_def `u_scale r p =
        if ( &.0 < p 1) then (point ( p 0, r * p 1)) else p`;;

let cont_domain = 
prove_by_refinement(
  `!(f:A->B) g U V. (continuous f U V) /\ (!x. UNIONS U x ==> (f x = g x))
    ==> (continuous g U V)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[preimage;continuous;];
  TYPE_THEN `{x | UNIONS U x /\ v (g x)} = {x | UNIONS U x /\ v (f x)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)

let h_translate_bij = 
prove_by_refinement(
  `!r. BIJ (h_translate r) (euclid 2) (euclid 2)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[BIJ;INJ;h_translate];
  SUBCONJ_TAC;
  CONJ_TAC;
  ASM_SIMP_TAC[euclid_add_closure;e1;point_scale;euclid_point];
  RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e1]);
  IMATCH_MP_TAC  EQ_EXT;
  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x'` 0;
  UND 0 THEN REAL_ARITH_TAC;
  REWRITE_TAC[SURJ;h_translate];
  REP_BASIC_TAC;
  TYPE_THEN `x - (r *# e1)` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[point_scale;e1];
  ASM_SIMP_TAC[euclid_sub_closure;euclid_point];
  REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  REAL_ARITH_TAC;
  (* Tue Sep  7 10:15:46 EDT 2004 *)

  ]);;
  (* }}} *)

let v_translate_bij = 
prove_by_refinement(
  `!r. BIJ (v_translate r) (euclid 2) (euclid 2)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[BIJ;INJ;v_translate];
  SUBCONJ_TAC;
  CONJ_TAC;
  ASM_SIMP_TAC[euclid_add_closure;e2;point_scale;euclid_point];
  RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e2]);
  IMATCH_MP_TAC  EQ_EXT;
  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x'` 0;
  UND 0 THEN REAL_ARITH_TAC;
  REWRITE_TAC[SURJ;v_translate];
  REP_BASIC_TAC;
  TYPE_THEN `x - (r *# e2)` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[point_scale;e2];
  ASM_SIMP_TAC[euclid_sub_closure;euclid_point];
  REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  REAL_ARITH_TAC;
  (* Tue Sep  7 10:16:38 EDT 2004 *)

  ]);;
  (* }}} *)

extend_simp_rewrites [euclid_point];;
extend_simp_rewrites [coord01];;

let r_scale_bij = 
prove_by_refinement(
  `!r. (&0 < r) ==> BIJ (r_scale r) (euclid 2) (euclid 2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[BIJ;INJ;r_scale;];
  SUBCONJ_TAC;
  CONJ_TAC;
  COND_CASES_TAC;
  REWRITE_TAC[euclid_point];
  USE 2 (MATCH_MP   point_onto);
  USE 3 (MATCH_MP   point_onto);
  REWRITE_TAC[point_inj];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
  UND 1 THEN COND_CASES_TAC;
  UND 1 THEN COND_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
  RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]);
  UND 4 THEN UND 0 THEN REAL_ARITH_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
  TYPE_THEN `FST p` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 3 THEN REWRITE_TAC[];
  REWRITE_TAC[real_gt];
  IMATCH_MP_TAC  REAL_LT_MUL;
  UND 1 THEN COND_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]);
  TYPE_THEN `FST p'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 2 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LT_MUL;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
  KILL 1;
  REWRITE_TAC[SURJ;r_scale];
  KILL 2;
  USE 1 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `&0 < FST p` ASM_CASES_TAC;
  TYPE_THEN `point ((&1/r)* FST p, SND p)` EXISTS_TAC;
  TYPE_THEN `&0 < &1/ r  * FST p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  IMATCH_MP_TAC  REAL_LT_DIV;
  ASM_REWRITE_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC];
  TYPE_THEN `(r * &1/r) * FST p = &1 * FST p` SUBAGOAL_TAC;
  AP_THM_TAC;
  AP_TERM_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
  REDUCE_TAC;
  TYPE_THEN `point p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Tue Sep  7 10:55:54 EDT 2004 *)

  ]);;
  (* }}} *)

let u_scale_bij = 
prove_by_refinement(
  `!r. (&0 < r) ==> BIJ (u_scale r) (euclid 2) (euclid 2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[BIJ;INJ;u_scale;];
  SUBCONJ_TAC;
  CONJ_TAC;
  COND_CASES_TAC;
  USE 2 (MATCH_MP   point_onto);
  USE 3 (MATCH_MP   point_onto);
  REWRITE_TAC[point_inj];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
  UND 1 THEN COND_CASES_TAC;
  UND 1 THEN COND_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
  RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]);
  UND 1 THEN UND 0 THEN REAL_ARITH_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
  TYPE_THEN `SND p` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 3 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LT_MUL;
  UND 1 THEN COND_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]);
  TYPE_THEN `SND p'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 2 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LT_MUL;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
  KILL 1;
  REWRITE_TAC[SURJ;u_scale];
  KILL 2;
  USE 1 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `&0 < SND  p` ASM_CASES_TAC;
  TYPE_THEN `point (FST p, (&1/r)* SND  p)` EXISTS_TAC;
  TYPE_THEN `&0 < &1/ r  * SND  p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  IMATCH_MP_TAC  REAL_LT_DIV;
  ASM_REWRITE_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC];
  TYPE_THEN `(r * &1/r) * SND  p = &1 * SND  p` SUBAGOAL_TAC;
  AP_THM_TAC;
  AP_TERM_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
  REDUCE_TAC;
  TYPE_THEN `point p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Tue Sep  7 11:01:53 EDT 2004 *)

  ]);;
  (* }}} *)

let h_translate_inv = 
prove_by_refinement(
  `!r x. (euclid 2 x) ==>
   (h_translate (--. r) x = INV (h_translate r) (euclid 2) (euclid 2) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_SYM;
  TH_INTRO_TAC[`h_translate r`;`euclid 2`;`euclid 2`;`h_translate (--. r) x`;`x`] INVERSE_XY;
  ASM_REWRITE_TAC[h_translate_bij;h_translate;e1;point_scale];
  ASM_SIMP_TAC[euclid_add_closure;euclid_point];
  REWRITE_TAC[h_translate;euclid_plus;e1;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  REAL_ARITH_TAC;
  (* Tue Sep  7 11:11:17 EDT 2004 *)
  ]);;
  (* }}} *)

let v_translate_inv = 
prove_by_refinement(
  `!r x. (euclid 2 x) ==>
   (v_translate (--. r) x = INV (v_translate r) (euclid 2) (euclid 2) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_SYM;
  TH_INTRO_TAC[`v_translate r`;`euclid 2`;`euclid 2`;`v_translate (--. r) x`;`x`] INVERSE_XY;
  ASM_REWRITE_TAC[v_translate_bij;v_translate;e2;point_scale];
  ASM_SIMP_TAC[euclid_add_closure;euclid_point];
  REWRITE_TAC[v_translate;euclid_plus;e2;euclid_scale];
  IMATCH_MP_TAC  EQ_EXT;
  REAL_ARITH_TAC;
  (* Tue Sep  7 11:12:42 EDT 2004 *)
  ]);;
  (* }}} *)

extend_simp_rewrites[prove_by_refinement(
  `!x r. (&0 < r) ==> (r * (&1/r) * x = x)`,
  (* {{{ proof *)
  [
  REWRITE_TAC [REAL_MUL_ASSOC];
  TYPE_THEN `(r * &1/r) * x = &1 * x` SUBAGOAL_TAC;
  AP_THM_TAC;
  AP_TERM_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 1 THEN UND 0 THEN REAL_ARITH_TAC;
  REDUCE_TAC;
  ])];;
  (* }}} *)

extend_simp_rewrites[ prove_by_refinement(
  `!r. (&0 < r) ==> (&0 < &1 / r)`,
  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  ])];;
  (* }}} *)

extend_simp_rewrites[ REAL_LE_POW_2];;

extend_simp_rewrites[ prove_by_refinement(
  `!x y. &0 <= x pow 2 + y pow 2`,
  (* {{{ proof *)
  [
  ALL_TAC;
  IMATCH_MP_TAC  REAL_LE_ADD;
  ])];;
  (* }}} *)

let r_scale_inv = 
prove_by_refinement(
  `!r x. (&0 < r) /\ (euclid 2 x) ==>
   (r_scale (&1/r) x = INV (r_scale r) (euclid 2) (euclid 2) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_SYM;
  TH_INTRO_TAC[`r_scale r`;`euclid 2`;`euclid 2`;`r_scale (&1/r) x`;`x`] INVERSE_XY;
  ASM_SIMP_TAC [r_scale_bij];
  TH_INTRO_TAC[`&1/r`] r_scale_bij;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REWRITE_TAC[r_scale];
  USE 0 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `&0 < FST p` ASM_CASES_TAC;
  REWRITE_TAC[coord01];
  TYPE_THEN `&0 < (&1 / r) * FST p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* Tue Sep  7 11:40:41 EDT 2004 *)

  ]);;
  (* }}} *)

let u_scale_inv = 
prove_by_refinement(
  `!r x. (&0 < r) /\ (euclid 2 x) ==>
   (u_scale (&1/r) x = INV (u_scale r) (euclid 2) (euclid 2) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_SYM;
  TH_INTRO_TAC[`u_scale r`;`euclid 2`;`euclid 2`;`u_scale (&1/r) x`;`x`] INVERSE_XY;
  ASM_SIMP_TAC [u_scale_bij];
  TH_INTRO_TAC[`&1/r`] u_scale_bij;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REWRITE_TAC[u_scale];
  USE 0 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `&0 < SND p` ASM_CASES_TAC;
  REWRITE_TAC[coord01];
  TYPE_THEN `&0 < (&1 / r) * SND  p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* Tue Sep  7 11:56:05 EDT 2004 *)


  ]);;
  (* }}} *)

let metric_continuous_continuous_top2 = 
prove_by_refinement(
  `!f. (IMAGE f (euclid 2) SUBSET (euclid 2) ==>
     (continuous f top2 top2 =
         metric_continuous f (euclid 2,d_euclid) (euclid 2,d_euclid)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  metric_continuous_continuous;
  ]);;
  (* }}} *)

let h_translate_cont = 
prove_by_refinement(
  `!r. continuous (h_translate r) (top2) (top2)`,

  (* {{{ proof *)
  [
  ALL_TAC;
  TH_INTRO_TAC [`h_translate r`] metric_continuous_continuous_top2;
  ASSUME_TAC h_translate_bij;
  TSPEC `r` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  TYPE_THEN `epsilon` EXISTS_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[h_translate];
  TH_INTRO_TAC[`2`;`x`;`y`;`r *# e1`] metric_translate;
  REWRITE_TAC[e1;point_scale];
  (* Tue Sep  7 12:09:30 EDT 2004 *)

  ]);;
  (* }}} *)

let v_translate_cont = 
prove_by_refinement(
  `!r. continuous (v_translate r) (top2) (top2)`,

  (* {{{ proof *)
  [
  ALL_TAC;
  TH_INTRO_TAC [`v_translate r`] metric_continuous_continuous_top2;
  ASSUME_TAC v_translate_bij;
  TSPEC `r` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  TYPE_THEN `epsilon` EXISTS_TAC;
  REP_BASIC_TAC;
  REWRITE_TAC[v_translate];
  TH_INTRO_TAC[`2`;`x`;`y`;`r *# e2`] metric_translate;
  REWRITE_TAC[e2;point_scale];
  (* Tue Sep  7 12:10:54 EDT 2004 *)
  ]);;
  (* }}} *)

let r_scale_cont = 
prove_by_refinement(
  `!r. (&0 < r) ==> (continuous (r_scale r) top2 top2)`,

  (* {{{ proof *)
  [
  ALL_TAC;
  TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC;
  UND 0 THEN REAL_ARITH_TAC;
  TH_INTRO_TAC[`r_scale r`] metric_continuous_continuous_top2;
  ASSUME_TAC r_scale_bij;
  TSPEC `r` 2;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC;
  TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ;
  TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC;
  TYPE_THEN `epsilon'` UNABBREV_TAC;
  TYPE_THEN `epsilon` UNABBREV_TAC;
  KILL 4;
  SUBCONJ_TAC;
  ASM_MESON_TAC[REAL_PROP_POS_LMUL];
  USE 5(MATCH_MP point_onto);
  TYPE_THEN `y` UNABBREV_TAC;
  USE 6(MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ];
  IMATCH_MP_TAC  REAL_LE_RMUL;
  REWRITE_TAC[REAL_POW_2];
  IMATCH_MP_TAC  ABS_SQUARE_LE;
  UND 0 THEN REAL_ARITH_TAC;
  REWRITE_TAC[GSYM REAL_POW_MUL];
  (* - *)
  TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_RMUL;
  REWRITE_TAC[REAL_POW_2];
  IMATCH_MP_TAC  ABS_SQUARE_LE;
  UND 0 THEN  REAL_ARITH_TAC;
  UND 6 THEN REDUCE_TAC;
  (* - *)
  TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM REAL_POW_MUL];
  REWRITE_TAC[REAL_POW_2];
  IMATCH_MP_TAC  ABS_SQUARE_LE;
  TYPE_THEN `abs  (r*x' + y') = r*x' + y'` SUBAGOAL_TAC;
  REWRITE_TAC[ABS_REFL];
  IMATCH_MP_TAC  REAL_LE_ADD;
  ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`];
  ineq_le_tac `(r*x' + y') + x' + r*y'  = (&1 + r)*(x' + y')` ;
  (* A - *)
  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC;
  TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  POW_2_SQRT;
  IMATCH_MP_TAC  REAL_LE_MUL;
  UND 7 THEN UND 1 THEN REAL_ARITH_TAC;
  UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]);
  IMATCH_MP_TAC SQRT_MONO_LT;
  REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ];
  REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ];
  IMATCH_MP_TAC  REAL_LT_LMUL;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_PROP_POS_POW;
  TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT);
  TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  POW_2_SQRT;
  UND 7 THEN REAL_ARITH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]);
  (* - *)
  IMATCH_MP_TAC  REAL_LET_TRANS;
  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC;
  (* B- *)
  REWRITE_TAC[r_scale];
  COND_CASES_TAC THEN COND_CASES_TAC;
  UND 4 THEN  REWRITE_TAC[d_euclid_point];
  IMATCH_MP_TAC  SQRT_MONO_LE;
  (*  IMATCH_MP_TAC  REAL_LET_TRANS; *)
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  (* 3 LEFT *)
  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
  TYPE_THEN `u = --. (FST p)` ABBREV_TAC ;
  TYPE_THEN `FST p = -- u` SUBAGOAL_TAC;
  UND 12 THEN REAL_ARITH_TAC;
  REWRITE_TAC[REAL_ARITH `x - --. y = x + y`];
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
  (* 2 LEFT *)
  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
  TYPE_THEN `u = --. (FST p')` ABBREV_TAC ;
  TYPE_THEN `FST p' = -- u` SUBAGOAL_TAC;
  UND 12 THEN REAL_ARITH_TAC;
  REWRITE_TAC[REAL_ARITH `-- x -  v = -- (v + x)`;REAL_POW_NEG;EVEN2 ];
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
  (* 1 LEFT *)
  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  (* Tue Sep  7 15:33:59 EDT 2004 *)

  ]);;
  (* }}} *)

let u_scale_cont = 
prove_by_refinement(
  `!r. (&0 < r) ==> (continuous (u_scale r) top2 top2)`,

  (* {{{ proof *)
  [
  ALL_TAC;
  TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC;
  UND 0 THEN REAL_ARITH_TAC;
  TH_INTRO_TAC[`u_scale r`] metric_continuous_continuous_top2;
  ASSUME_TAC u_scale_bij;
  TSPEC `r` 2;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC;
  TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ;
  TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC;
  TYPE_THEN `epsilon'` UNABBREV_TAC;
  TYPE_THEN `epsilon` UNABBREV_TAC;
  KILL 4;
  SUBCONJ_TAC;
  ASM_MESON_TAC[REAL_PROP_POS_LMUL];
  USE 5(MATCH_MP point_onto);
  TYPE_THEN `y` UNABBREV_TAC;
  USE 6(MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ];
  IMATCH_MP_TAC  REAL_LE_RMUL;
  REWRITE_TAC[REAL_POW_2];
  IMATCH_MP_TAC  ABS_SQUARE_LE;
  UND 0 THEN REAL_ARITH_TAC;
  REWRITE_TAC[GSYM REAL_POW_MUL];
  (* - *)
  TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_RMUL;
  REWRITE_TAC[REAL_POW_2];
  IMATCH_MP_TAC  ABS_SQUARE_LE;
  UND 0 THEN  REAL_ARITH_TAC;
  UND 6 THEN REDUCE_TAC;
  (* - *)
  TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM REAL_POW_MUL];
  REWRITE_TAC[REAL_POW_2];
  IMATCH_MP_TAC  ABS_SQUARE_LE;
  TYPE_THEN `abs  (r*x' + y') = r*x' + y'` SUBAGOAL_TAC;
  REWRITE_TAC[ABS_REFL];
  IMATCH_MP_TAC  REAL_LE_ADD;
  ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`];
  ineq_le_tac `(r*x' + y') + x' + r*y'  = (&1 + r)*(x' + y')` ;
  (* A - *)
  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC;
  TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  POW_2_SQRT;
  IMATCH_MP_TAC  REAL_LE_MUL;
  UND 7 THEN UND 1 THEN REAL_ARITH_TAC;
  UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]);
  IMATCH_MP_TAC SQRT_MONO_LT;
  REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ];
  REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ];
  IMATCH_MP_TAC  REAL_LT_LMUL;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_PROP_POS_POW;
  TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT);
  TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  POW_2_SQRT;
  UND 7 THEN REAL_ARITH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]);
  (* - *)
  IMATCH_MP_TAC  REAL_LET_TRANS;
  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC;
  (* B- *)
  REWRITE_TAC[u_scale];
  COND_CASES_TAC THEN COND_CASES_TAC;
  UND 4 THEN  REWRITE_TAC[d_euclid_point];
  IMATCH_MP_TAC  SQRT_MONO_LE;
  (*  IMATCH_MP_TAC  REAL_LET_TRANS; *)
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  (* 3 LEFT *)
  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
  TYPE_THEN `u = --. (SND p)` ABBREV_TAC ;
  TYPE_THEN `SND p = -- u` SUBAGOAL_TAC;
  UND 12 THEN REAL_ARITH_TAC;
  REWRITE_TAC[REAL_ARITH `x - --. y = x + y`];
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
  (* 2 LEFT *)
  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
  TYPE_THEN `u = --. (SND p')` ABBREV_TAC ;
  TYPE_THEN `SND p' = -- u` SUBAGOAL_TAC;
  UND 12 THEN REAL_ARITH_TAC;
  REWRITE_TAC[REAL_ARITH `-- x -  v = -- (v + x)`;REAL_POW_NEG;EVEN2 ];
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
  (* 1 LEFT *)
  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REWRITE_TAC[REAL_LDISTRIB];
  IMATCH_MP_TAC  REAL_LE_ADD2;
  (* Tue Sep  7 15:40:34 EDT 2004 *)
  ]);;
  (* }}} *)

let h_translate_hom = 
prove_by_refinement(
  `!r. (homeomorphism (h_translate r) top2 top2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  bicont_homeomorphism;
  REWRITE_TAC[top2_unions;h_translate_bij;h_translate_cont];
  IMATCH_MP_TAC  cont_domain;
  REWRITE_TAC[top2_unions];
  TYPE_THEN `h_translate (-- r)` EXISTS_TAC;
  REWRITE_TAC[h_translate_inv;h_translate_cont];
  (* Tue Sep  7 15:56:20 EDT 2004 *)

  ]);;
  (* }}} *)

let v_translate_hom = 
prove_by_refinement(
  `!r. (homeomorphism (v_translate r) top2 top2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  bicont_homeomorphism;
  REWRITE_TAC[top2_unions;v_translate_bij;v_translate_cont];
  IMATCH_MP_TAC  cont_domain;
  REWRITE_TAC[top2_unions];
  TYPE_THEN `v_translate (-- r)` EXISTS_TAC;
  REWRITE_TAC[v_translate_inv;v_translate_cont];
  (* Tue Sep  7 15:57:06 EDT 2004 *)
  ]);;
  (* }}} *)

let r_scale_hom = 
prove_by_refinement(
  `!r. (&0 < r) ==> (homeomorphism (r_scale r) top2 top2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  bicont_homeomorphism;
  ASM_SIMP_TAC [top2_unions;r_scale_bij;r_scale_cont];
  IMATCH_MP_TAC  cont_domain;
  REWRITE_TAC[top2_unions];
  TYPE_THEN `r_scale (&1/r)` EXISTS_TAC;
  TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC;
  ASM_SIMP_TAC [r_scale_inv;r_scale_cont];
  (* Tue Sep  7 16:00:14 EDT 2004 *)

  ]);;
  (* }}} *)

let u_scale_hom = 
prove_by_refinement(
  `!r. (&0 < r) ==> (homeomorphism (u_scale r) top2 top2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  bicont_homeomorphism;
  ASM_SIMP_TAC [top2_unions;u_scale_bij;u_scale_cont];
  IMATCH_MP_TAC  cont_domain;
  REWRITE_TAC[top2_unions];
  TYPE_THEN `u_scale (&1/r)` EXISTS_TAC;
  TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC;
  ASM_SIMP_TAC [u_scale_inv;u_scale_cont];
  (* Tue Sep  7 16:01:04 EDT 2004 *)


  ]);;
  (* }}} *)

let h_translate_h = 
prove_by_refinement(
  `!r. (h_compat (h_translate r))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[h_compat;h_translate;e1;point_scale;mk_line;IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  EQ_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  REDUCE_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  CONV_TAC (dropq_conv "x");
  CONV_TAC (dropq_conv "x''");
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  (* Tue Sep  7 16:13:50 EDT 2004 *)

  ]);;
  (* }}} *)

let v_translate_v = 
prove_by_refinement(
  `!r. (v_compat (v_translate r))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[v_compat;v_translate;e2;point_scale;mk_line;IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  EQ_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  REDUCE_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  CONV_TAC (dropq_conv "x");
  CONV_TAC (dropq_conv "x''");
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  (* Tue Sep  7 16:15:33 EDT 2004 *)


  ]);;
  (* }}} *)

let h_translate_v = 
prove_by_refinement(
  `!r. (v_compat (h_translate r))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[v_compat;h_translate;e1;point_scale;mk_line;IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  EQ_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  REDUCE_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  CONV_TAC (dropq_conv "x");
  CONV_TAC (dropq_conv "x''");
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  (* Tue Sep  7 16:17:13 EDT 2004 *)
  ]);;
  (* }}} *)

let v_translate_h = 
prove_by_refinement(
  `!r. (h_compat (v_translate r))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[h_compat;v_translate;e2;point_scale;mk_line;IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  EQ_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  REDUCE_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  CONV_TAC (dropq_conv "x");
  CONV_TAC (dropq_conv "x''");
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  REAL_ARITH_TAC;
  (* Tue Sep  7 16:18:12 EDT 2004 *)

  ]);;
  (* }}} *)

let lin_solve_x = 
prove_by_refinement(
  `!a  c. ~(c = &0) ==> (?t. c*t = a)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `a/c` EXISTS_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let mk_line_pt = 
prove_by_refinement(
  `!x. mk_line x x = {x}`,

  (* {{{ proof *)
  [
  REWRITE_TAC[mk_line;trivial_lin_combo];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING];
  ]);;
  (* }}} *)

let h_compat_bij = 
prove_by_refinement(
  `!f t. (BIJ f (euclid 2) (euclid 2) /\
          (!x. f (point x) 1 = t + SND x) ==>
    h_compat f)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;h_compat];
  TYPE_THEN `x = y` ASM_CASES_TAC;
  REWRITE_TAC[mk_line_pt];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE;INR IN_SING];
  EQ_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN`point y` EXISTS_TAC;
  (* - *)
  TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, t + SND x ))` SUBAGOAL_TAC;
  TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
  USE 5 (MATCH_MP point_onto);
  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
  TSPEC `x'` 1;
  REWR 1;
  UND 1 THEN REWRITE_TAC[coord01];
  (* A- *)
  UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  TYPE_THEN `x'` UNABBREV_TAC;
  UND 7 THEN REWRITE_TAC[mk_line];
  TYPE_THEN `x''` UNABBREV_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  TYPE_THEN `x' = (t' * FST x + (&1 - t') * FST y,t' * SND y + (&1 - t') * SND y)` ABBREV_TAC ;
  TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  REAL_ARITH_TAC;
  KILL 8;
  COPY 5;
  TSPEC `x'` 5;
  UND 5 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
  TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x;
  TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
  UND 8 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
  REWRITE_TAC[point_inj ;PAIR_SPLIT ];
  UND 5 THEN REAL_ARITH_TAC;
  UND 4 THEN REWRITE_TAC[];
  ONCE_REWRITE_TAC[GSYM point_inj];
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `t'` EXISTS_TAC;
  CONJ_TAC;
  UND 5 THEN REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  (* - *)
  REWRITE_TAC[mk_line;SUBSET;IMAGE];
  CONV_TAC (dropq_conv "x''");
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `?u. (euclid_plus (t' *# point (f (point x) 0,t + SND y))  ((&1 - t') *# point (f (point y) 0,t + SND y))) = point (u , t + SND y)` SUBAGOAL_TAC;
  REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
  CONV_TAC (dropq_conv "u");
  REAL_ARITH_TAC;
  KILL 6;
  (* - *)
  TYPE_THEN `?x'. point(u, t + SND y) = f (point x')` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
  TSPEC `point (u,t + SND y)` 2;
  RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
  USE 7 (MATCH_MP point_onto);
  TYPE_THEN `y'` UNABBREV_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  (* - *)
  TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x;
  UND 4 THEN REWRITE_TAC[PAIR_SPLIT ];
  UND 7 THEN REAL_ARITH_TAC;
  TYPE_THEN `t'` EXISTS_TAC;
  AP_TERM_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
  CONJ_TAC;
  UND 7 THEN REAL_ARITH_TAC;
  (* - *)
  TSPEC `x'` 5;
  TYPE_THEN `f (point x')` UNABBREV_TAC;
  USE 5 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
  UND 5 THEN REAL_ARITH_TAC;
  (* Tue Sep  7 22:08:48 EDT 2004 *)

  ]);;
  (* }}} *)

let r_scale_h = 
prove_by_refinement(
  `!r. (&0 < r) ==> (h_compat (r_scale r))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  h_compat_bij;
  TYPE_THEN `&0` EXISTS_TAC;
  REDUCE_TAC;
  ASM_SIMP_TAC [r_scale_bij];
  REWRITE_TAC[r_scale];
  COND_CASES_TAC;
  (* Tue Sep  7 22:11:42 EDT 2004 *)

  ]);;
  (* }}} *)

let h_compat_bij2 = 
prove_by_refinement(
  `!f s. (BIJ f (euclid 2) (euclid 2) /\
          (!x. f (point x) 1 = s(SND x)) /\ (INJ s UNIV UNIV) ==>
    h_compat f)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;h_compat];
  TYPE_THEN `x = y` ASM_CASES_TAC;
  REWRITE_TAC[mk_line_pt];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE;INR IN_SING];
  EQ_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN`point y` EXISTS_TAC;
  (* - *)
  TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, s(SND x) ))` SUBAGOAL_TAC;
  TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
  USE 6 (MATCH_MP point_onto);
  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
  TSPEC `x'` 2;
  REWR 2;
  UND 2 THEN REWRITE_TAC[coord01];
  (* A- *)
  UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  TYPE_THEN `x'` UNABBREV_TAC;
  UND 8 THEN REWRITE_TAC[mk_line];
  TYPE_THEN `x''` UNABBREV_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  TYPE_THEN `x' = (t * FST x + (&1 - t) * FST y,t * SND y + (&1 - t) * SND y)` ABBREV_TAC ;
  TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  REAL_ARITH_TAC;
  KILL 9;
  COPY 6;
  TSPEC `x'` 6;
  UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
  TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x;
  TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
  UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
  REWRITE_TAC[point_inj ;PAIR_SPLIT ];
  UND 6 THEN REAL_ARITH_TAC;
  UND 5 THEN REWRITE_TAC[];
  ONCE_REWRITE_TAC[GSYM point_inj];
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `t` EXISTS_TAC;
  CONJ_TAC;
  UND 6 THEN REAL_ARITH_TAC;
  REAL_ARITH_TAC;
  (* - *)
  REWRITE_TAC[mk_line;SUBSET;IMAGE];
  CONV_TAC (dropq_conv "x''");
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `?u. (euclid_plus (t *# point (f (point x) 0,s(SND y)))  ((&1 - t) *# point (f (point y) 0,s(SND y)))) = point (u , s(SND y))` SUBAGOAL_TAC;
  REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
  CONV_TAC (dropq_conv "u");
  REAL_ARITH_TAC;
  ONCE_ASM_REWRITE_TAC [];
  UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  (* - *)
  TYPE_THEN `?x'. point(u, s(SND y)) = f (point x')` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
  TSPEC `point (u,s(SND y))` 3;
  RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
  USE 8 (MATCH_MP point_onto);
  TYPE_THEN `y'` UNABBREV_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  (* B- *)
  TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x;
  UND 5 THEN REWRITE_TAC[PAIR_SPLIT ];
  UND 8 THEN REAL_ARITH_TAC;

  TYPE_THEN `t` EXISTS_TAC;
  AP_TERM_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
  CONJ_TAC;
  UND 8 THEN REAL_ARITH_TAC;
  (* - *)
  TSPEC `x'` 6;
  TYPE_THEN `f (point x')` UNABBREV_TAC;
  USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
  TYPE_THEN `SND y = SND x'` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 12 THEN REAL_ARITH_TAC;
  (* Wed Sep  8 20:04:34 EDT 2004 *)

  ]);;
  (* }}} *)

let u_scale_h = 
prove_by_refinement(
  `!r. (&0 < r) ==> (h_compat (u_scale r))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  h_compat_bij2;
  TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC;
  ASM_SIMP_TAC[u_scale_bij];
  CONJ_TAC;
  REWRITE_TAC[u_scale];
  TYPE_THEN `&0 < SND x` ASM_CASES_TAC;
  REWRITE_TAC[coord01];
  TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC;
  REWRITE_TAC[INJ];
  UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC;
  IMATCH_MP_TAC  REAL_EQ_LMUL_IMP;
  UNIFY_EXISTS_TAC;
  UND 0 THEN REAL_ARITH_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 2 THEN REWRITE_TAC[];
  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
  TYPE_THEN `x` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 3 THEN REWRITE_TAC[];
  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
  ]);;
  (* }}} *)

let v_compat_bij2 = 
prove_by_refinement(
  `!f s. (BIJ f (euclid 2) (euclid 2) /\
          (!x. f (point x) 0 = s(FST  x)) /\ (INJ s UNIV UNIV) ==>
    v_compat f)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;v_compat];
  TYPE_THEN `x = y` ASM_CASES_TAC;
  REWRITE_TAC[mk_line_pt];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE;INR IN_SING];
  EQ_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN`point y` EXISTS_TAC;
  (* - *)
  TYPE_THEN `!x. f (point x) = point(s(FST x),  (f (point x)) 1 )` SUBAGOAL_TAC;
  TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
  USE 6 (MATCH_MP point_onto);
  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
  TSPEC `x'` 2;
  REWR 2;
  UND 2 THEN REWRITE_TAC[coord01];
  (* A- *)
  UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET;];
  TYPE_THEN `x'` UNABBREV_TAC;
  UND 8 THEN REWRITE_TAC[mk_line];
  TYPE_THEN `x''` UNABBREV_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
  TYPE_THEN `x' = (t * FST y + (&1 - t) * FST y,t * SND x + (&1 - t) * SND y)` ABBREV_TAC ;
  TYPE_THEN `FST  x' = FST  y` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  REAL_ARITH_TAC;
  KILL 9;
  COPY 6;
  TSPEC `x'` 6;
  UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
  TH_INTRO_TAC[`f (point x') 1 - f(point y) 1`;`f (point x) 1 - f (point y) 1`] lin_solve_x;
  TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
  UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
  REWRITE_TAC[point_inj ;PAIR_SPLIT ];
  UND 6 THEN REAL_ARITH_TAC;
  UND 5 THEN REWRITE_TAC[];
  ONCE_REWRITE_TAC[GSYM point_inj];
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `t` EXISTS_TAC;
  CONJ_TAC;
  UND 6 THEN REAL_ARITH_TAC;
  UND 6 THEN REAL_ARITH_TAC;
  (* - *)
  REWRITE_TAC[mk_line;SUBSET;IMAGE];
  CONV_TAC (dropq_conv "x''");
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `?u. (euclid_plus (t *# (f (point x)))  ((&1 - t) *# (f (point y)))) = point ( s(FST  y), u)` SUBAGOAL_TAC;
  ONCE_ASM_REWRITE_TAC[];
  REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
  CONV_TAC (dropq_conv "u");
    REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `?x'. point( s(FST  y),u) = f (point x')` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
  TSPEC `point (s(FST  y),u)` 3;
  RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
  USE 9 (MATCH_MP point_onto);
  TYPE_THEN `y'` UNABBREV_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  (* B- *)
  TH_INTRO_TAC[`SND  x' - SND  y`;`SND  x - SND  y`] lin_solve_x;
  UND 5 THEN REWRITE_TAC[PAIR_SPLIT ];
  UND 9 THEN REAL_ARITH_TAC;
  TYPE_THEN `t'` EXISTS_TAC;
  AP_TERM_TAC;
  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
  TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC;
  UND 9 THEN REAL_ARITH_TAC;
  (* - *)
  TSPEC `x'` 6;
  TYPE_THEN `f (point x')` UNABBREV_TAC;
  USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
  TYPE_THEN `FST  y = FST  x'` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 13 THEN REAL_ARITH_TAC;
  (* Wed Sep  8 21:10:34 EDT 2004 *)


  ]);;
  (* }}} *)

let r_scale_v = 
prove_by_refinement(
  `!r. (&0 < r) ==> (v_compat (r_scale r))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  v_compat_bij2;
  TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC;
  ASM_SIMP_TAC[r_scale_bij];
  CONJ_TAC;
  REWRITE_TAC[r_scale];
  TYPE_THEN `&0 < FST  x` ASM_CASES_TAC;
  REWRITE_TAC[coord01];
  TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC;
  REWRITE_TAC[INJ];
  UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC;
  IMATCH_MP_TAC  REAL_EQ_LMUL_IMP;
  UNIFY_EXISTS_TAC;
  UND 0 THEN REAL_ARITH_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 2 THEN REWRITE_TAC[];
  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
  TYPE_THEN `x` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 3 THEN REWRITE_TAC[];
  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
  ]);;
  (* }}} *)

let u_scale_v = 
prove_by_refinement(
  `!r. (&0 < r) ==> (v_compat (u_scale r))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  v_compat_bij2;
  TYPE_THEN `(\ z.  &0 + z)` EXISTS_TAC;
  ASM_SIMP_TAC[u_scale_bij];
  REDUCE_TAC;
  CONJ_TAC;
  REWRITE_TAC[u_scale];
  COND_CASES_TAC;
  REWRITE_TAC[INJ];
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* SECTION Q *)
(* ------------------------------------------------------------------ *)

let mk_line_hyper2_fst = 
prove_by_refinement(
  `!x y. (FST x = FST y) ==> (mk_line (point x) (point y) SUBSET
    hyperplane 2 e1 (FST x))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[];
  TYPE_THEN `x = y` ASM_CASES_TAC;
  REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ];
  REWRITE_TAC[e1;GSYM line2D_F;SUBSET;mk_line;];
  TYPE_THEN `y` EXISTS_TAC;
  (* - *)
  IMATCH_MP_TAC  (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]]));
  REWRITE_TAC[GSYM mk_line_hyper2_e1];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  IMATCH_MP_TAC  mk_line_2;
  REWRITE_TAC[mk_line_hyper2_e1;];
  REWRITE_TAC[e1;GSYM line2D_F;point_inj;PAIR_SPLIT];
  CONJ_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `y` EXISTS_TAC;
  UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT];
  (* Thu Sep  9 10:13:23 EDT 2004 *)

  ]);;
  (* }}} *)

let mk_line_hyper2_snd = 
prove_by_refinement(
  `!x y. (SND x = SND y) ==> (mk_line (point x) (point y) SUBSET
    hyperplane 2 e2 (SND x))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[];
  TYPE_THEN `x = y` ASM_CASES_TAC;
  REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ];
  REWRITE_TAC[e2;GSYM line2D_S;SUBSET;mk_line;];
  TYPE_THEN `y` EXISTS_TAC;
  (* - *)
  IMATCH_MP_TAC  (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]]));
  REWRITE_TAC[GSYM mk_line_hyper2_e2];
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  IMATCH_MP_TAC  mk_line_2;
  REWRITE_TAC[mk_line_hyper2_e2;];
  REWRITE_TAC[e2;GSYM line2D_S;point_inj;PAIR_SPLIT];
  CONJ_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `y` EXISTS_TAC;
  UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT];
  (* Thu Sep  9 10:16:19 EDT 2004 *)
  ]);;
  (* }}} *)

let hv_line_hyper = 
prove_by_refinement(
  `!E e. hv_line E /\ E e ==> (?z.
     (e SUBSET hyperplane 2 e1 z) \/ (e SUBSET  hyperplane 2 e2 z))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[hv_line];
  TSPEC `e` 1;
  REP_BASIC_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `FST y` EXISTS_TAC;
  DISJ1_TAC;
  USE 3 SYM;
  IMATCH_MP_TAC  mk_line_hyper2_fst;
  TYPE_THEN `SND x` EXISTS_TAC;
  USE 3 SYM;
  DISJ2_TAC;
  IMATCH_MP_TAC  mk_line_hyper2_snd;
  (* Thu Sep  9 10:20:05 EDT 2004 *)

  ]);;
  (* }}} *)

let hv_line_hyper2 = 
prove_by_refinement(
  `!E. hv_line E /\ FINITE E ==> (?E'.
   (UNIONS E SUBSET UNIONS E') /\ (FINITE E') /\
   (!e. E' e ==>
     (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!e. ?h. (E e ==> (e SUBSET h /\ (?z. (h = hyperplane 2 e1 z) \/ (h =  hyperplane 2 e2 z))))` SUBAGOAL_TAC;
  RIGHT_TAC "h";
  TH_INTRO_TAC[`E`;`e`] hv_line_hyper;
  FIRST_ASSUM DISJ_CASES_TAC;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  LEFT 2 "h";
  TYPE_THEN `IMAGE h E` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[UNIONS;SUBSET;IMAGE];
  CONV_TAC (dropq_conv "u");
  NAME_CONFLICT_TAC;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[ISUBSET];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
  ASM_MESON_TAC[];
  (* Thu Sep  9 10:32:28 EDT 2004 *)

  ]);;
  (* }}} *)

let finite_graph_edge = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_edge G) /\
    graph_isomorphic G H ==> FINITE (graph_edge H)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_isomorphic;graph_iso];
  ASM_MESON_TAC[FINITE_BIJ];
  ]);;
  (* }}} *)

let finite_graph_vertex = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_vertex G) /\
    graph_isomorphic G H ==> FINITE (graph_vertex H)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_isomorphic;graph_iso];
  ASM_MESON_TAC[FINITE_BIJ];
  ]);;
  (* }}} *)

let graph_edge_nonempty = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (H:(A',B')graph_t). ~(graph_edge G = EMPTY ) /\
    graph_isomorphic G H ==> ~(graph_edge H  = EMPTY )`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_isomorphic;graph_iso];
  USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
  UND 0 THEN (REWRITE_TAC [EMPTY_EXISTS]);
  TYPE_THEN `v u'` EXISTS_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  ]);;
  (* }}} *)

let graph_edge_around_finite = 
prove_by_refinement(
  `!(G:(A,B)graph_t) v.
        (FINITE (graph_edge G)) ==> (FINITE (graph_edge_around G v))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_edge_around];
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET];
  ]);;
  (* }}} *)

let graph_edge_around4 = 
prove_by_refinement(
  `!(G:(A,B)graph_t) (H:(A',B')graph_t). (graph G) /\
        (FINITE (graph_edge G)) /\
        (!v. CARD (graph_edge_around G v) <=| 4)  /\
    graph_isomorphic G H ==> (!v. CARD (graph_edge_around H v) <=| 4)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `graph_vertex H v` ASM_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE [graph_isomorphic]);
  TYPE_THEN `?v'. (graph_vertex G v' /\ ((FST f) v' = v))` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT ;graph_iso]);
  USE 6 (REWRITE_RULE[BIJ;SURJ]);
  TYPE_THEN `v` UNABBREV_TAC;
  TH_INTRO_TAC[`G`;`H`;`f`;`v'`] graph_iso_around;
  TH_INTRO_TAC[`SND f`; `(graph_edge_around G v')`] CARD_IMAGE_LE;
  IMATCH_MP_TAC  graph_edge_around_finite;
  IMATCH_MP_TAC  LE_TRANS;
  UNIFY_EXISTS_TAC;
  ASM_MESON_TAC [ARITH_RULE `0 <=| 4`; CARD_CLAUSES;graph_isomorphic_graph;graph_edge_around_empty];
  (* Thu Sep  9 11:49:01 EDT 2004 *)

  ]);;
  (* }}} *)

let graph_near_support = 
prove_by_refinement(
  `!(G:(A,B)graph_t). (planar_graph G) /\
         FINITE (graph_edge G) /\
         FINITE (graph_vertex G) /\
         ~(graph_edge G = {}) /\
         (!v. CARD (graph_edge_around G v) <=| 4)
         ==> (?H E. graph_isomorphic G H /\
           (FINITE E) /\ (good_plane_graph H) /\
        (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
        (!v. (graph_vertex H v ==>
         E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\
         (!e. (E e ==>
            (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z)))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TH_INTRO_TAC[`G`] planar_graph_hv;
  TYPE_THEN `H` EXISTS_TAC;
  TYPE_THEN `A = IMAGE (\ v. hyperplane 2 e1 (v 0)) (graph_vertex H)` ABBREV_TAC ;
  TYPE_THEN `B = IMAGE (\ v. hyperplane 2 e2 (v 1)) (graph_vertex H)` ABBREV_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]);
  LEFT 5 "E";
  LEFT 5 "E";
  TYPE_THEN `?E'. !e. (graph_edge H e ==> (e SUBSET UNIONS (E' e)) /\ (FINITE (E' e)) /\ (!e'. E' e e' ==> (?z. (e' = hyperplane 2 e1 z) \/ (e' = hyperplane 2 e2 z))))` SUBAGOAL_TAC;
  LEFT_TAC "e";
  RIGHT_TAC "E'";
  TSPEC `e` 5;
  TH_INTRO_TAC[`E e`] hv_line_hyper2;
  TYPE_THEN `E'` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  (* - *)
  TYPE_THEN `C = UNIONS (IMAGE E' (graph_edge H))` ABBREV_TAC ;
  TYPE_THEN `A UNION B UNION C` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[FINITE_UNION];
  CONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  IMATCH_MP_TAC  finite_graph_vertex;
  UNIFY_EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  IMATCH_MP_TAC  finite_graph_vertex;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  TH_INTRO_TAC[`IMAGE E' (graph_edge H)`] FINITE_FINITE_UNIONS;
  IMATCH_MP_TAC  FINITE_IMAGE;
  IMATCH_MP_TAC  finite_graph_edge;
  UNIFY_EXISTS_TAC;
  USE 11 (REWRITE_RULE[IMAGE]);
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[UNIONS_UNION];
  IMATCH_MP_TAC  in_union;
  DISJ2_TAC;
  IMATCH_MP_TAC  in_union;
  DISJ2_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  TSPEC `e` 10;
  REP_BASIC_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  IMATCH_MP_TAC  UNIONS_UNIONS;
  REWRITE_TAC[SUBSET;UNIONS;IMAGE;];
  CONV_TAC (dropq_conv "u");
  UNIFY_EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[UNION];
  TYPE_THEN  `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  CONJ_TAC;
  DISJ1_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  DISJ2_TAC;
  DISJ1_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  USE 12 (REWRITE_RULE[UNION]);
  UND 12 THEN REP_CASES_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  USE 12 (REWRITE_RULE[IMAGE]);
  MESON_TAC[];
  TYPE_THEN `B` UNABBREV_TAC;
  USE 12 (REWRITE_RULE[IMAGE]);
  MESON_TAC[];
  TYPE_THEN `C` UNABBREV_TAC;
  USE 12 (REWRITE_RULE[IMAGE;UNIONS]);
  TYPE_THEN `u` UNABBREV_TAC;
  TSPEC `x` 10;
  (* Thu Sep  9 12:12:51 EDT 2004 *)

  ]);;
  (* }}} *)

let h_translate_point = 
prove_by_refinement(
  `!u v r. (h_translate r (point (u,v)) = point (u+r,v))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[h_translate;e1;point_scale;point_add];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let v_translate_point = 
prove_by_refinement(
  `!u v r. (v_translate r (point (u,v)) = point (u,v + r))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[v_translate;e2;point_scale;point_add];
  REDUCE_TAC;
  ]);;
  (* }}} *)

let hyperplane1_h_translate = 
prove_by_refinement(
  `!z r. (IMAGE (h_translate r) (hyperplane 2 e1 z) =
            (hyperplane 2 e1 (z + r)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e1];
  ASSUME_TAC v_compat;
  TSPEC `(h_translate r)` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[h_translate_v]);
  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`z, &0`;`z, &1`]));
  REWRITE_TAC[h_translate_point];
  ]);;
  (* }}} *)

let hyperplane2_h_translate = 
prove_by_refinement(
  `!z r. (IMAGE (h_translate r) (hyperplane 2 e2 z) =
            (hyperplane 2 e2 z))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e2];
  ASSUME_TAC h_compat;
  TSPEC `(h_translate r)` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[h_translate_h]);
  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;` &1,z`]));
  REWRITE_TAC[h_translate_point];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  mk_line_2;
  REWRITE_TAC[mk_line_hyper2_e2;];
  REWRITE_TAC[GSYM line2D_S;e2;point_inj ];
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]);
  UND 1 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let hyperplane2_v_translate = 
prove_by_refinement(
  `!z r. (IMAGE (v_translate r) (hyperplane 2 e2 z) =
            (hyperplane 2 e2 (z + r)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e2];
  ASSUME_TAC h_compat;
  TSPEC `(v_translate r)` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[v_translate_h]);
  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`]));
  REWRITE_TAC[v_translate_point];
  ]);;
  (* }}} *)

let hyperplane1_v_translate = 
prove_by_refinement(
  `!z r. (IMAGE (v_translate r) (hyperplane 2 e1 z) =
            (hyperplane 2 e1 z))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e1];
  ASSUME_TAC v_compat;
  TSPEC `(v_translate r)` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[v_translate_v]);
  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`]));
  REWRITE_TAC[v_translate_point];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  mk_line_2;
  REWRITE_TAC[mk_line_hyper2_e1;];
  REWRITE_TAC[GSYM line2D_F;e1;point_inj ];
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]);
  UND 1 THEN REAL_ARITH_TAC;
  (* Thu Sep  9 13:43:45 EDT 2004 *)

  ]);;
  (* }}} *)

let r_scale_point = 
prove_by_refinement(
  `!r u v. (r_scale r (point (u,v))) =
  point ((if (&0 < u) then r*u else u),v)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[r_scale];
  TYPE_THEN `&0  < u` ASM_CASES_TAC;
  ]);;
  (* }}} *)

let u_scale_point = 
prove_by_refinement(
  `!r u v. (u_scale r (point (u,v))) =
  point (u,(if (&0 < v) then r*v else v))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[u_scale];
  TYPE_THEN `&0  < v` ASM_CASES_TAC;
  ]);;
  (* }}} *)

let hyperplane2_r_scale = 
prove_by_refinement(
  `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e2 z) =
             (hyperplane 2 e2 z))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e2];
  ASSUME_TAC h_compat;
  TSPEC `(r_scale r)` 1;
  TYPE_THEN `h_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_h];ALL_TAC];
  REWR 1;
  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;`&1,z`]));
  REWRITE_TAC[r_scale_point];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  mk_line_2;
  REWRITE_TAC[REAL_ARITH `~(&0 < &0)`];
  REWRITE_TAC[mk_line_hyper2_e2;];
  REWRITE_TAC[GSYM line2D_S;e2;point_inj ];
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]);
  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let hyperplane1_r_scale = 
prove_by_refinement(
  `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e1 z) =
             (hyperplane 2 e1 (if &0 < z then r*z else z)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e1];
  ASSUME_TAC v_compat;
  TSPEC `(r_scale r)` 1;
  TYPE_THEN `v_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_v];ALL_TAC];
  REWR 1;
  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`z,&0`;`z,&1`]));
  REWRITE_TAC[r_scale_point];
  ]);;
  (* }}} *)

let hyperplane1_u_scale = 
prove_by_refinement(
  `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e1 z) =
             (hyperplane 2 e1 z))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e1];
  ASSUME_TAC v_compat;
  TSPEC `(u_scale r)` 1;
  TYPE_THEN `v_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_v];ALL_TAC];
  REWR 1;
  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`]));
  REWRITE_TAC[u_scale_point];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  mk_line_2;
  REWRITE_TAC[REAL_ARITH `~(&0 < &0)`];
  REWRITE_TAC[mk_line_hyper2_e1;];
  REWRITE_TAC[GSYM line2D_F;e1;point_inj ];
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
  CONJ_TAC;
  CONV_TAC (dropq_conv "p");
  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]);
  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let hyperplane2_u_scale = 
prove_by_refinement(
  `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e2 z) =
             (hyperplane 2 e2 (if &0 < z then r*z else z)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM mk_line_hyper2_e2];
  ASSUME_TAC h_compat;
  TSPEC `(u_scale r)` 1;
  TYPE_THEN `h_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_h];ALL_TAC];
  REWR 1;
  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`]));
  REWRITE_TAC[u_scale_point];
  (* Thu Sep  9 14:04:58 EDT 2004 *)

  ]);;
  (* }}} *)

let homeomorphism_compose = 
prove_by_refinement(
  `!U V W (f:A->B) (g:B->C). homeomorphism f U V /\ homeomorphism g V W
   ==>
   homeomorphism (g o f) U W`,

  (* {{{ proof *)
  [
  REWRITE_TAC[homeomorphism];
  SUBCONJ_TAC;
  REWRITE_TAC[comp_comp];
  IMATCH_MP_TAC  COMP_BIJ;
  UNIFY_EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  continuous_comp;
  UNIFY_EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  REWRITE_TAC[IMAGE_o];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)

let hyperplane1_inj = 
prove_by_refinement(
  `!z w. (hyperplane 2 e1 z = hyperplane 2 e1 w) ==> (z = w)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[e1; GSYM line2D_F];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[]);
  TSPEC `point(z,&0)` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
  USE 0 SYM;
  TYPE_THEN `(?p. (z,&0 = p) /\ (FST p = z))` SUBAGOAL_TAC;
  CONV_TAC (dropq_conv "p");
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let hyperplane2_inj = 
prove_by_refinement(
  `!z w. (hyperplane 2 e2 z = hyperplane 2 e2 w) ==> (z = w)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[e2; GSYM line2D_S];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[]);
  TSPEC `point(z,z)` 0;
  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
  USE 0 SYM;
  TYPE_THEN `(?p. (z,z = p) /\ (SND p = z))` SUBAGOAL_TAC;
  CONV_TAC (dropq_conv "p");
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let graph_support_init = 
prove_by_refinement(
  `!(G:(A,B)graph_t). (planar_graph G) /\
         FINITE (graph_edge G) /\
         FINITE (graph_vertex G) /\
         ~(graph_edge G = {}) /\
         (!v. CARD (graph_edge_around G v) <=| 4)
         ==> (?H E. graph_isomorphic G H /\
           (FINITE E) /\ (good_plane_graph H) /\
        (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
        (!v. (graph_vertex H v ==>
         E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\
         (!e. (E e ==>
            (?z. (&0 < z) /\
               ((e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TH_INTRO_TAC[`G`] graph_near_support;
  TYPE_THEN `EH = E INTER { h | ?z. (h = hyperplane 2 e1 z) }` ABBREV_TAC ;
  TYPE_THEN `EV = E INTER {h | ?z. (h = hyperplane 2 e2 z) }` ABBREV_TAC ;
  TYPE_THEN `E = EH UNION EV` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `EH` UNABBREV_TAC;
  TYPE_THEN `EV` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;INTER;UNION];
  ASM_MESON_TAC[];
  REWRITE_TAC[UNION;SUBSET];
  TYPE_THEN `EH` UNABBREV_TAC;
  TYPE_THEN `EV` UNABBREV_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER;GSYM LEFT_AND_OVER_OR]);
  (* - *)
  TYPE_THEN `FINITE EH /\ FINITE EV` SUBAGOAL_TAC;
  USE 13 SYM;
  USE 13 (MATCH_MP union_imp_subset);
  ASM_MESON_TAC[FINITE_SUBSET];
(*** Modified by JRH for new theorem name
  TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE;
 ***)
  TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE_IMP;
  TYPE_THEN `EH` UNABBREV_TAC;
  REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV];
(*** Modified by JRH for new theorem name
  TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE;
 ***)
  TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE_IMP;
  TYPE_THEN `EV` UNABBREV_TAC;
  REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV];
  (* - *)
  WITH 21 (MATCH_MP finite_LB);
  WITH 18 (MATCH_MP finite_LB);
  TYPE_THEN `f = (h_translate (&1 - t')) o (v_translate (&1 - t))` ABBREV_TAC ;
  TYPE_THEN `plane_graph_image f H` EXISTS_TAC;
  TYPE_THEN `IMAGE2 f E` EXISTS_TAC;
  (* A- *)
  TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  IMATCH_MP_TAC  homeomorphism_compose;
  TYPE_THEN `top2` EXISTS_TAC;
  REWRITE_TAC[v_translate_hom;h_translate_hom];
  (* - *)
  TYPE_THEN `graph_isomorphic H (plane_graph_image f H)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  plane_graph_image_iso;
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph]);
  (* - *)
  CONJ_TAC;
  TH_INTRO_TAC[`G`;`H`;`plane_graph_image f H`] graph_isomorphic_trans;
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  FINITE_IMAGE;
  ASM_REWRITE_TAC[FINITE_UNION];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  plane_graph_image_plane;
  (* B- *)
  TYPE_THEN `!z. IMAGE  f (hyperplane 2 e1 z) = hyperplane 2 e1 (z - t' + &1)` SUBAGOAL_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  REWRITE_TAC[IMAGE_o;hyperplane1_v_translate;hyperplane1_h_translate];
  AP_TERM_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `!z. IMAGE f (hyperplane 2 e2 z) = hyperplane 2 e2 (z - t + &1)` SUBAGOAL_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  REWRITE_TAC[IMAGE_o;hyperplane2_v_translate;hyperplane2_h_translate];
  AP_TERM_TAC;
  REAL_ARITH_TAC;
  REWRITE_TAC[IMAGE2;GSYM image_unions;];
  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;IMAGE2];
  (* - *)
  CONJ_TAC;
  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
  USE 29 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `g` UNABBREV_TAC;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  USE 13 GSYM;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* C- *)
  USE 13 GSYM;
  CONJ_TAC;
  USE 29 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
  USE 31 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  TYPE_THEN `f (point p) = point(FST p - t' + &1 , SND p  - t + &1)` SUBAGOAL_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  TYPE_THEN `p = FST p,SND p` SUBAGOAL_TAC;
  PURE_ONCE_ASM_REWRITE_TAC[] THEN  PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;];
  PURE_ONCE_ASM_REWRITE_TAC[] THEN  PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;];
  REWRITE_TAC[point_inj ;PAIR_SPLIT];
  REAL_ARITH_TAC;
  USE 28 GSYM ;
  USE 27 GSYM;
  TSPEC `point p` 6;
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
  IMATCH_MP_TAC  image_imp;
  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
  (* D- *)
  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
  USE 29 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `EH x \/ EV x` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `EH` UNABBREV_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `z - t' + &1` EXISTS_TAC;
  TYPE_THEN `s' z` SUBAGOAL_TAC;
  USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
  TSPEC `x` 16;
  REWR 16;
  LEFT 16 "z'";
  TSPEC `z` 16;
  REWR 16;
  TYPE_THEN `z = x'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  hyperplane1_inj;
  ASM_REWRITE_TAC[];
  TSPEC `z` 23;
  UND 23 THEN REAL_ARITH_TAC;
  TYPE_THEN `EV` UNABBREV_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `z - t + &1` EXISTS_TAC;
  TYPE_THEN `s'' z` SUBAGOAL_TAC;
  USE 19 (REWRITE_RULE[SUBSET;IMAGE]);
  TSPEC `x` 19;
  REWR 19;
  LEFT 19 "z'";
  TSPEC `z` 19;
  REWR 19;
  TYPE_THEN `z = x'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  hyperplane2_inj;
  ASM_REWRITE_TAC[];
  TSPEC `z` 22;
  UND 22 THEN REAL_ARITH_TAC;
  (* Thu Sep  9 17:00:37 EDT 2004 *)

  ]);;
  (* }}} *)

let hyperplane_ne = 
prove_by_refinement(
  `!z z'. ~(hyperplane 2 e1 z = hyperplane 2 e2 z')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM line2D_F];
  RULE_ASSUM_TAC (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `point(z, z'+ &1)` 0;
  REWR 0;
  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;point_inj]);
  USE 0 SYM;
  TYPE_THEN `(?p. ((z = FST p) /\ (z' + &1 = SND p)) /\ (FST p = z))` SUBAGOAL_TAC;
  TYPE_THEN `(z,z' + &1)` EXISTS_TAC;
  ASSUME_TAC (REAL_ARITH `~(z' + &1 = z')`);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)


(* ------------------------------------------------------------------ *)
(* SECTION R *)
(* ------------------------------------------------------------------ *)


extend_simp_rewrites[UNION_EMPTY ];;

let inductive_set_restrict = 
prove_by_refinement(
  `!G A S. inductive_set G S /\
     ~(S INTER A = EMPTY) /\
     segment A /\ A SUBSET G ==> inductive_set A (S INTER A)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[inductive_set];
  CONJ_TAC;
  REWRITE_TAC[INTER;SUBSET];
  REWRITE_TAC[INTER];
  FIRST_ASSUM IMATCH_MP_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
  UNIFY_EXISTS_TAC;
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let inductive_set_adj = 
prove_by_refinement(
  `!A B S m. inductive_set (A UNION B) S /\ (endpoint B m) /\
   (FINITE A) /\ (FINITE B) /\
   (endpoint A m) /\ (A SUBSET S) ==> (~(S INTER B = EMPTY)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?e. A e /\ closure top2 e (pointI m)` SUBAGOAL_TAC;
  TYPE_THEN `terminal_edge A m` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  TYPE_THEN `?e'. B e' /\ closure top2 e' (pointI m)` SUBAGOAL_TAC;
  TYPE_THEN `terminal_edge B m` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  RULE_ASSUM_TAC (REWRITE_RULE[inductive_set]);
  TSPEC `e` 6;
  TSPEC `e'` 6;
  (* - *)
  TYPE_THEN `e = e'` ASM_CASES_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET ;EQ_EMPTY;INTER; ]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `S e /\ (A UNION B) e' /\ adj e e'` SUBAGOAL_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[ISUBSET];
  CONJ_TAC;
  REWRITE_TAC[UNION];
  REWRITE_TAC[adj];
  REWRITE_TAC[EMPTY_EXISTS;INTER;];
  UNIFY_EXISTS_TAC;
  REWR 6;
  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY ;INTER]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let inductive_set_join = 
prove_by_refinement(
  `!A B S . ~(S INTER A = EMPTY) /\ (segment B) /\ (segment A) /\
      (?m. endpoint A m /\ endpoint B m) /\
      (inductive_set (A UNION B) S)  ==>
    (S = (A UNION B))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TH_INTRO_TAC[`A UNION B`;`A`;`S`] inductive_set_restrict;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `(S INTER A) = A` SUBAGOAL_TAC;
  USE 6 (REWRITE_RULE[inductive_set]);
  USE 3 (REWRITE_RULE[segment]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `A SUBSET S` SUBAGOAL_TAC;
  UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
  REWRITE_TAC[INTER;SUBSET];
  (* - *)
  TH_INTRO_TAC [`A`;`B`;`S`;`m`] inductive_set_adj;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  (* - *)
  TH_INTRO_TAC[`A UNION B`;`B`;`S`] inductive_set_restrict;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `(S INTER B) = B` SUBAGOAL_TAC;
  USE 10 (REWRITE_RULE[inductive_set]);
  USE 4 (REWRITE_RULE[segment]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `B SUBSET S` SUBAGOAL_TAC;
  UND 11 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
  REWRITE_TAC[INTER;SUBSET];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  USE 0 (REWRITE_RULE[inductive_set]);
  REWRITE_TAC[union_subset];
  ]);;
  (* }}} *)

let segment_union = 
prove_by_refinement(
  `!A B m. segment A /\ segment B /\
     endpoint A m /\ endpoint B m /\
     (A INTER B = EMPTY) /\
  (!n. (0 < num_closure A (pointI n)) /\
          (0 < num_closure B (pointI n)) ==> (n = m) )
    ==>
    segment (A UNION B)` ,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* - *)
  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  (* - *)
  REWRITE_TAC[segment];
  ASM_REWRITE_TAC[FINITE_UNION];
  (* - *)
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
  UND 8 THEN REWRITE_TAC[EMPTY_EXISTS;UNION];
  TYPE_THEN `u` EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  (* - *)
  TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  TYPE_THEN `A x` ASM_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]);
  TSPEC `x` 1;
  REWR 1;
  TYPE_THEN `!m. num_closure(A UNION B) (pointI m) =  num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC;
  REWRITE_TAC[num_closure];
  IMATCH_MP_TAC  (CARD_UNION);
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `A` EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  REWRITE_TAC[SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `B` EXISTS_TAC;
  REWRITE_TAC[SUBSET];
  REWRITE_TAC[EQ_EMPTY ];
  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]);
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC;
  REDUCE_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC;
  REDUCE_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  UND 10 THEN UND 11 THEN REWRITE_TAC [ARITH_RULE  `~(x = 0) <=> (0 < x)`];
  TYPE_THEN `m' = m` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[endpoint]);
  REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT];
  (* -A *)
  TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC;
  REWRITE_TAC[inductive_set];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC;
  (* -- cut here *)
  IMATCH_MP_TAC  inductive_set_join;
  UNIFY_EXISTS_TAC;
  REWR 14;
  TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC;
  UND 15 THEN UND 14 THEN UND 11 THEN UND 12 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[];
  (* - *)
  ONCE_REWRITE_TAC [UNION_COMM];
  IMATCH_MP_TAC  inductive_set_join;
  ONCE_REWRITE_TAC [UNION_COMM];
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let two_endpoint_segment = 
prove_by_refinement(
  `!C p q m. segment C /\ endpoint C q /\ endpoint C p /\ endpoint C m /\
     ~(m = p) ==>
      (q = m) \/ (q = p)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `psegment C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  endpoint_psegment;
  UNIFY_EXISTS_TAC;
  (* - *)
  TH_INTRO_TAC[`C`] endpoint_size2;
  IMATCH_MP_TAC  (TAUT `(~A ==> B) ==> (A \/ B)`);
  IMATCH_MP_TAC  two_exclusion;
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let EQ_ANTISYM = 
prove_by_refinement(
  `!A B. (A ==>B) /\ (B ==> A) ==> (A = B)`,

  (* {{{ proof *)
  [
  MESON_TAC[];
  ]);;
  (* }}} *)

let segment_union2 = 
prove_by_refinement(
  `!A B m p. segment A /\ segment B /\ ~(m = p) /\
     endpoint A m /\ endpoint B m /\
     endpoint A p /\ endpoint B p /\
     (A INTER B = EMPTY) /\
  (!n. (0 < num_closure A (pointI n)) /\ (0 < num_closure B (pointI n)) <=>
          (((n = m ) \/ (n = p) )))
    ==>
    rectagon (A UNION B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  (* - *)
  REWRITE_TAC[rectagon];
  ASM_REWRITE_TAC[FINITE_UNION];
  (* - *)
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
  UND 11 THEN REWRITE_TAC[EMPTY_EXISTS;UNION];
  TYPE_THEN `u` EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  (* - *)
  TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  TYPE_THEN `A x` ASM_CASES_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]);
  TSPEC `x` 1;
  REWR 1;
  (* - *)
  TYPE_THEN `!m. num_closure(A UNION B) (pointI m) =  num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC;
  REWRITE_TAC[num_closure];
  IMATCH_MP_TAC  (CARD_UNION);
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `A` EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  REWRITE_TAC[SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `B` EXISTS_TAC;
  REWRITE_TAC[SUBSET];
  REWRITE_TAC[EQ_EMPTY ];
  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!q. endpoint A q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC;
  IMATCH_MP_TAC two_endpoint_segment;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `!q. endpoint B q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC;
  IMATCH_MP_TAC two_endpoint_segment;
  TYPE_THEN  `B` EXISTS_TAC;
  UNIFY_EXISTS_TAC;
  (* -A *)
  TYPE_THEN `!m. (num_closure A (pointI m) = 1) <=> (num_closure B (pointI m) = 1)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  RULE_ASSUM_TAC (REWRITE_RULE[endpoint]);
  CONJ_TAC;
  TSPEC `m'` 13;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  TSPEC `m'` 14;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  FULL_REWRITE_TAC[endpoint];
  TYPE_THEN `!x. {0, 2} x <=> {0, 1, 2} x /\ ~(x = 1)` SUBAGOAL_TAC;
  REWRITE_TAC[INSERT];
  ARITH_TAC;
  KILL 16;
  TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC;
  REDUCE_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  TSPEC `m'` 15;
  REWR 25;
  UND 25 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC;
  REDUCE_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
  ARITH_TAC;
  FULL_REWRITE_TAC [ARITH_RULE  `~(x = 0) <=> (0 < x)`];
  TYPE_THEN `(m' = m) \/ (m' = p)` SUBAGOAL_TAC;
  TSPEC `m'` 0;
  REWR 0;
  TYPE_THEN `num_closure A (pointI m') = 1` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  TYPE_THEN `num_closure B (pointI m') = 1` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT;ARITH_RULE `~(2 = 1)`];
  (* - *)
  TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC;
  REWRITE_TAC[inductive_set];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC;
  (* -- *)
  IMATCH_MP_TAC  inductive_set_join;
  UNIFY_EXISTS_TAC;
  REWR 20;
  TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC;
  UND 20 THEN UND 21 THEN UND 17 THEN UND 18 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[];
  (* - *)
  ONCE_REWRITE_TAC [UNION_COMM];
  IMATCH_MP_TAC  inductive_set_join;
  ONCE_REWRITE_TAC [UNION_COMM];
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let card_inj = 
prove_by_refinement(
  `!(f:A->B) A B. INJ f A B /\ FINITE B ==> (CARD A <= CARD B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `CARD (IMAGE f A) = CARD A` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_IMAGE_INJ;
  CONJ_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  FINITE_INJ;
  ASM_MESON_TAC[];
  USE 2 GSYM;
  IMATCH_MP_TAC  CARD_SUBSET;
  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
  REWRITE_TAC[IMAGE;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)

let inj_bij_size = 
prove_by_refinement(
  `!A B (f:A->B). INJ f A B /\ B HAS_SIZE (CARD A) ==> BIJ f A B`,

  (* {{{ proof *)
  [
  REWRITE_TAC[HAS_SIZE];
  TH_INTRO_TAC [`f`;`A`] inj_bij;
  FULL_REWRITE_TAC[INJ];
  ASM_MESON_TAC[];
  TYPE_THEN `IMAGE f A = B` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET_EQ;
  CONJ_TAC;
  FULL_REWRITE_TAC[INJ];
  REWRITE_TAC[IMAGE;SUBSET];
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  EQ_SYM;
  IMATCH_MP_TAC  BIJ_CARD;
  UNIFY_EXISTS_TAC;
  ASM_MESON_TAC[FINITE_INJ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let bij_empty = 
prove_by_refinement(
  `!(f:A->B). BIJ f EMPTY EMPTY `,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;INJ;SURJ];
  ]);;
  (* }}} *)

let bij_sing = 
prove_by_refinement(
  `!(f:A->B) a b. BIJ f {a} {b} <=> (f a = b)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[BIJ;INJ;SURJ;INR IN_SING ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let card_sing = 
prove_by_refinement(
  `!(a:A). (CARD {a} = 1)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`a`;`EMPTY:A->bool`] card_suc_insert;
  REWRITE_TAC[FINITE_RULES];
  FULL_REWRITE_TAC[CARD_CLAUSES];
  TYPE_THEN `CARD {a}` UNABBREV_TAC;
  ARITH_TAC;
  ]);;
  (* }}} *)

let pair_indistinct = 
prove_by_refinement(
  `!(a:A). {a,a} = {a}`,

  (* {{{ proof *)
  [
  MESON_TAC[INR ABSORPTION;INR COMPONENT];
  ]);;
  (* }}} *)

let has_size2_distinct = 
prove_by_refinement(
  `!(a:A) b. {a,b} HAS_SIZE 2 ==> ~(a = b)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `b` UNABBREV_TAC;
  FULL_REWRITE_TAC [pair_indistinct];
  THM_INTRO_TAC[`a`] sing_has_size1;
  FULL_REWRITE_TAC[HAS_SIZE];
  UND 0 THEN UND 2 THEN ARITH_TAC;
  ]);;
  (* }}} *)

let has_size2_subset = 
prove_by_refinement(
  `!X (a:A) b. X HAS_SIZE 2 /\ X SUBSET {a,b} ==> (X = {a,b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  FULL_REWRITE_TAC [has_size2];
  TYPE_THEN `X` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  FULL_REWRITE_TAC[SUBSET;in_pair];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  COPY 0;
  TSPEC `b'` 0;
  TSPEC `a'` 3;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let inj_subset2 = 
prove_by_refinement(
  `!t t' s (f:A->B). INJ f s t /\ t SUBSET t' ==> INJ f s t'`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;SUBSET;];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)

let terminal_adj = 
prove_by_refinement(
  `!E b. segment E /\ endpoint E b /\ ~(SING E) ==>
    (?!e.  E e /\ adj (terminal_edge E b) e )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[EXISTS_UNIQUE_ALT];
  THM_INTRO_TAC[`E`;`b`] terminal_endpoint;
  FULL_REWRITE_TAC[segment];
  (* - *)
  THM_INTRO_TAC[`terminal_edge E b`] two_endpoint;
  FULL_REWRITE_TAC[segment;ISUBSET];
  (* - *)
  FULL_REWRITE_TAC[has_size2];
  USE 6 (REWRITE_RULE[FUN_EQ_THM]);
  TYPE_THEN `?x. !y. (closure top2 (terminal_edge E b) (pointI y) <=> ((y = x) \/ (y = b)))` SUBAGOAL_TAC;
  USE 6 (REWRITE_RULE[in_pair]);
  REWRITE_TAC[in_pair];
  TYPE_THEN `(b = b') \/ (b = a)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC  ;
  TYPE_THEN  `a` EXISTS_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `b'` EXISTS_TAC;
  (* - *)
  TYPE_THEN `!e. (adj (terminal_edge E b) e /\ (E e) ==> (closure top2 e (pointI x)))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`terminal_edge E b`;`e`] edge_inter;
  ASM_MESON_TAC[segment;ISUBSET];
  FULL_REWRITE_TAC[INTER;eq_sing];
  TSPEC `m` 7;
  REWR 7;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`E`;`(pointI b)`] num_closure1;
  FULL_REWRITE_TAC[segment];
  REWR 14;
  COPY 14;
  TSPEC `terminal_edge E b` 15;
  TSPEC `e` 14;
  TYPE_THEN `e' = terminal_edge E b` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e' = e` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[adj];
  UND 18 THEN UND 17 THEN UND 16 THEN MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`E`;`terminal_edge E b`] midpoint_exists;
  FULL_REWRITE_TAC[SING];
  LEFT 0 "x" ;
  TSPEC `terminal_edge E b` 0;
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[midpoint];
  THM_INTRO_TAC[`E`;`(pointI m)`] num_closure2;
  FULL_REWRITE_TAC[segment];
  REWR 11;
  (* -DD *)
  TYPE_THEN `?c. ~(terminal_edge E b = c) /\ (E c) /\ (closure top2 c (pointI m))` SUBAGOAL_TAC;
  COPY 12;
  TSPEC `terminal_edge E b` 11;
  REWR 11;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `b''` EXISTS_TAC;
  TYPE_THEN `a'` EXISTS_TAC;
  (* - *)
  TYPE_THEN `c` EXISTS_TAC;
  COPY 7;
  TSPEC `m` 16;
  REWR 16;
  TYPE_THEN `adj (terminal_edge E b) c` SUBAGOAL_TAC;
  REWRITE_TAC[adj];
  REWRITE_TAC[EMPTY_EXISTS;INTER;];
  TYPE_THEN `pointI m` EXISTS_TAC;
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM ;
  CONJ_TAC;
  TYPE_THEN `closure top2 y (pointI x)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `closure top2 c (pointI x)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  KILL 6;
  TYPE_THEN `closure top2 (terminal_edge E b) (pointI x)` SUBAGOAL_TAC;
  TYPE_THEN `({0,1,2} (num_closure E (pointI x)))` SUBAGOAL_TAC;
  UND 2 THEN MESON_TAC[segment];
  FULL_REWRITE_TAC[INSERT;];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  THM_INTRO_TAC[`E`;`(pointI x)`] num_closure0;
  REWR 22;
  THM_INTRO_TAC[`E`;`(pointI x)`] num_closure1;
  THM_INTRO_TAC[`E`;`(pointI x)`] num_closure2;
  REWR 22;
  UND 22 THEN REP_CASES_TAC ;
  TYPE_THEN `(terminal_edge E b = a'') \/ (terminal_edge E b = b''')` SUBAGOAL_TAC;
  TSPEC `terminal_edge E b` 22;
  REWR 22;
  TYPE_THEN `(c = a'') \/ (c = b''')` SUBAGOAL_TAC;
  TSPEC `c` 22;
  REWR 22;
  TYPE_THEN `(y = a'') \/ (y = b''')` SUBAGOAL_TAC;
  TSPEC `y` 22;
  REWR 22;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `a''` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  REWR 29;
  TYPE_THEN `b'''` UNABBREV_TAC;
  USE 18(REWRITE_RULE[adj]);
  UND 29 THEN UND 15 THEN UND 28 THEN MESON_TAC[];
  TYPE_THEN `b'''` UNABBREV_TAC;
  USE 18 (REWRITE_RULE[adj]);
  UND 31 THEN UND 15 THEN UND 29 THEN UND 28 THEN MESON_TAC[];
  (* --- *)
  UND 20 THEN UND 21 THEN UND 14 THEN UND 19 THEN UND 22 THEN MESON_TAC[];
  UND 22 THEN UND 19 THEN UND 20 THEN MESON_TAC[];
  (* - *)
  TYPE_THEN `y` UNABBREV_TAC;
  ]);;
  (* }}} *)

let psegment_order_induct_lemma = 
prove_by_refinement(
  `!n. !E a b. psegment E /\ (CARD E = n) /\ (endpoint E a) /\
    (endpoint E b) /\ ~(a = b) ==>
    (?f. (BIJ f { p | p < n} E) /\ (f 0 = terminal_edge E a) /\
      ((0 < n) ==> (f (n - 1) = terminal_edge E b)) /\
      (!i j. (i < CARD E /\ j < CARD E) ==>
             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,

  (* {{{ proof *)
  [
  INDUCT_TAC;
  (* -- 0 case *)
  TYPE_THEN `f = (\ (x:num). terminal_edge E a)` ABBREV_TAC ;
  TYPE_THEN `f` EXISTS_TAC;
  TYPE_THEN `{ p | p < 0} = EMPTY` SUBAGOAL_TAC;
  REWRITE_TAC[EQ_EMPTY];
  UND 6 THEN ARITH_TAC;
  TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC;
  REWRITE_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[psegment;segment];
  FULL_REWRITE_TAC[HAS_SIZE_0];
  REWRITE_TAC[ARITH_RULE `~(k <| 0)`;bij_empty];
  EXPAND_TAC "f";
  (* - 1 case *)
  REWRITE_TAC[ARITH_RULE `0 <| SUC n /\ (SUC n - 1 = n)`];
  TYPE_THEN `n = 0` ASM_CASES_TAC;
  KILL 5;
  REWRITE_TAC[ARITH_RULE `i <| SUC 0 <=> (i = 0)`;];
  REWRITE_TAC[ARITH_RULE `~(SUC 0 = 0)`;adj];
  TYPE_THEN `n` UNABBREV_TAC;
  FULL_REWRITE_TAC[ARITH_RULE `SUC 0 = 1`];
  TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[HAS_SIZE;psegment;segment];
  USE 5(MATCH_MP   CARD_SING_CONV);
  FULL_REWRITE_TAC[SING];
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `f = (\ (y:num). x )` ABBREV_TAC ;
  TYPE_THEN `f` EXISTS_TAC;
  TYPE_THEN `FINITE {x}` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  TYPE_THEN `{p | p = 0} = {0}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING];
  KILL 7;
  TYPE_THEN `f 0 = x` SUBAGOAL_TAC;
  EXPAND_TAC "f";
  REWRITE_TAC[bij_sing];
  TH_INTRO_TAC[`{x}`;`a`] terminal_endpoint;
  TH_INTRO_TAC[`{x}`;`b`] terminal_endpoint;
  FULL_REWRITE_TAC[INR IN_SING];
  (* - A2 and above *)
  TYPE_THEN `e = terminal_edge E b` ABBREV_TAC ;
  TYPE_THEN `b' = other_end e b` ABBREV_TAC ;
  TYPE_THEN `E' = E DELETE e` ABBREV_TAC ;
  (* - *)
  TYPE_THEN `E e /\ closure top2 e (pointI b)` SUBAGOAL_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  RULE_ASSUM_TAC (REWRITE_RULE[psegment;segment]);
  (* - *)
  TYPE_THEN `psegment E'` SUBAGOAL_TAC;
  REWRITE_TAC[psegment];
  CONJ_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  IMATCH_MP_TAC  segment_delete;
  TYPE_THEN `b` EXISTS_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[psegment]);
  REWRITE_TAC[];
  TYPE_THEN `E` UNABBREV_TAC;
  THM_INTRO_TAC [`e`] sing_has_size1;
  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
  UND 12 THEN UND 3 THEN UND 6 THEN ARITH_TAC;
  THM_INTRO_TAC [`E'`;`E`] rectagon_subset;
  RULE_ASSUM_TAC (REWRITE_RULE[psegment]);
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[DELETE;SUBSET];
  TYPE_THEN `E'` UNABBREV_TAC;
  UND 13 THEN UND 11 THEN MESON_TAC[INR DELETE_NON_ELEMENT];
  (* - *)
  TYPE_THEN `SUC (CARD E') = SUC n` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  TYPE_THEN `SUC n` UNABBREV_TAC;
  IMATCH_MP_TAC  CARD_SUC_DELETE;
  FULL_REWRITE_TAC[psegment;segment];
  FULL_REWRITE_TAC[SUC_INJ];
  (* -B *)
  THM_INTRO_TAC [`E`;`b`;`e`] psegment_delete_end;
  REWRITE_TAC[];
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[card_sing];
  UND 3 THEN UND 6 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `endpoint E' = {a,b'}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  has_size2_subset;
  CONJ_TAC;
  IMATCH_MP_TAC  endpoint_size2;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;INSERT;DELETE];
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC [`E`;`x`;`a`;`b`] two_endpoint_segment;
  FULL_REWRITE_TAC[psegment];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`e`;`b`] other_end_prop;
  UND 4 THEN REWRITE_TAC[psegment;segment;SUBSET;];
  (* - *)
  TYPE_THEN `{a,b'} HAS_SIZE 2` SUBAGOAL_TAC;
  TYPE_THEN `{a,b'}` UNABBREV_TAC;
  IMATCH_MP_TAC  endpoint_size2;
  USE 16 (MATCH_MP has_size2_distinct);
  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`a`;`b'`]);
  REWRITE_TAC[in_pair];
  (* - *)
  TYPE_THEN `g = (\ i.  if (i <| n) then f i else e)` ABBREV_TAC ;
  TYPE_THEN `!i. (i <| n) ==> (g i = f i)` SUBAGOAL_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `g n = e` SUBAGOAL_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  REWRITE_TAC[ARITH_RULE `~(n <| n)`];
  TYPE_THEN `g` EXISTS_TAC;
  (* - FINAL PUSH *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  inj_bij_size;
  REWRITE_TAC[CARD_NUMSEG_LT];
  CONJ_TAC;
  TYPE_THEN `{p | p <| SUC n} = {p | p <| n} UNION {n}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING];
  ARITH_TAC;
  IMATCH_MP_TAC  inj_split;
  CONJ_TAC;
  TYPE_THEN `INJ g {p | p <| n} E = INJ f {p | p <| n} E` SUBAGOAL_TAC;
  IMATCH_MP_TAC  inj_domain_sub;
  USE 24 (REWRITE_RULE[]);
  RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
  (* --- temp *)
  IMATCH_MP_TAC  inj_subset2;
  UNIFY_EXISTS_TAC;
  UND 9 THEN REWRITE_TAC[SUBSET;DELETE];
  TYPE_THEN `E'` UNABBREV_TAC;
  CONJ_TAC;
  REWRITE_TAC[INJ;INR IN_SING;];
  REP_BASIC_TAC;
  REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING ];
  TYPE_THEN `x''` UNABBREV_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `g n` UNABBREV_TAC;
  TSPEC `x'` 21;
  TYPE_THEN `g x'` UNABBREV_TAC;
  FULL_REWRITE_TAC[BIJ;SURJ];
  TSPEC `x'` 22;
  TYPE_THEN `E'` UNABBREV_TAC;
  FULL_REWRITE_TAC[DELETE];
  ASM_MESON_TAC[];
  UND 4 THEN ASM_REWRITE_TAC[HAS_SIZE;psegment;segment;rectagon];
  (* - C*)
  TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[DELETE;SUBSET];
  (* - *)
  TSPEC `0` 21;
  TYPE_THEN `0 <| n` SUBAGOAL_TAC;
  UND 6 THEN ARITH_TAC;
  TYPE_THEN `f 0` UNABBREV_TAC;
  CONJ_TAC;
  TYPE_THEN `e' = terminal_edge E' a` ABBREV_TAC ;
  THM_INTRO_TAC[`E'`;`a`;`e'`] terminal_unique;
  REWRITE_TAC[INR in_pair];
  UND 12 THEN REWRITE_TAC[psegment;segment];
  TYPE_THEN `e'` UNABBREV_TAC;
  TYPE_THEN `g 0 ` UNABBREV_TAC;
  THM_INTRO_TAC[`E`;`a`;`terminal_edge E' a`] terminal_unique;
  UND 4 THEN (REWRITE_TAC[psegment;segment]);
  REWR 26;
  ASM_MESON_TAC[ISUBSET];
  (* -D *)
  TYPE_THEN `E' (terminal_edge E' b')` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E'`;`b'`] terminal_endpoint;
  FULL_REWRITE_TAC[psegment;segment;INR in_pair ];
  (* - *)
  TYPE_THEN `~(E' (terminal_edge E b))` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  FULL_REWRITE_TAC[DELETE];
  TYPE_THEN `terminal_edge E b` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `adj e (g (n - 1))` SUBAGOAL_TAC;
  TYPE_THEN `g (n - 1) = f (n-1 )` SUBAGOAL_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `n - 1 < n` SUBAGOAL_TAC;
  UND 21 THEN ARITH_TAC;
  TYPE_THEN `f (n - 1)` UNABBREV_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  REWRITE_TAC[adj];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  CONJ_TAC;
   TYPE_THEN `g n` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `pointI b'` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `b'` UNABBREV_TAC;
  THM_INTRO_TAC[`terminal_edge E b`;`b`]other_end_prop;
  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
  THM_INTRO_TAC  [`E'`;`b'`] terminal_endpoint;
  FULL_REWRITE_TAC[psegment;segment;in_pair];
  (* - *)
  TYPE_THEN `!i. (i <| SUC n) ==> (adj (g n) (g i) = (SUC i = n))` SUBAGOAL_TAC;
  TYPE_THEN `( i' = n) \/ (i' <| n)` SUBAGOAL_TAC;
  UND 30 THEN ARITH_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  REWRITE_TAC[adj];
  ARITH_TAC;
  (* -- *)
  THM_INTRO_TAC[`E`;`b`] terminal_adj;
  FULL_REWRITE_TAC[psegment];
  REWRITE_TAC[];
  USE 35 (MATCH_MP CARD_SING);
  TYPE_THEN `CARD E` UNABBREV_TAC;
  UND 3 THEN UND 21 THEN ARITH_TAC;
  FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT];
  TYPE_THEN `!i'. (i' <| n) ==> (adj e (g i') = (e' = (g i')))` SUBAGOAL_TAC;
  TSPEC  `g (i'')`33;
  TYPE_THEN `E (g i'')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;SURJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 34 THEN ARITH_TAC;
  REWR 33;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  TSPEC `n - 1` 34;
  TYPE_THEN `n - 1 < n` SUBAGOAL_TAC;
  UND 21 THEN ARITH_TAC;
  TYPE_THEN `(g i' = g (n - 1)) ==> (SUC i' = n)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC [BIJ;INJ];
  IMATCH_MP_TAC  (ARITH_RULE  `((i' = n - 1) /\ (0 < n)) ==> (SUC i' = n)` );
  FIRST_ASSUM IMATCH_MP_TAC ;
  ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWR 34;
  (* -- *)
  TYPE_THEN `i' = n - 1` SUBAGOAL_TAC;
  UND 35 THEN UND 21 THEN ARITH_TAC;
  TSPEC `i'` 34;
  TYPE_THEN `i'` UNABBREV_TAC;
  REWR 32;
  (* -E *)
  TYPE_THEN `(i = n) \/ (i <| n)` SUBAGOAL_TAC;
  UND 26 THEN ARITH_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TSPEC `j` 30;
  UND 30 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `(j = n) \/ (j <| n)` SUBAGOAL_TAC;
  UND 25 THEN ARITH_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ONCE_REWRITE_TAC [adj_symm];
  UND 26 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `g` UNABBREV_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];

  ]);;
  (* }}} *)

(* a couple of variants *)
let psegment_order = 
prove_by_refinement(
  `!E a b. psegment E /\ (endpoint E a) /\
    (endpoint E b) /\ ~(a = b) ==>
    (?f. (BIJ f { p | p < CARD E} E) /\ (f 0 = terminal_edge E a) /\
      ((0 < CARD E) ==> (f (CARD E - 1) = terminal_edge E b)) /\
      (!i j. (i < CARD E /\ j < CARD E) ==>
             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`CARD E`;`E`;`a`;`b`] psegment_order_induct_lemma;
  REWRITE_TAC[];
  ]);;
  (* }}} *)

let psegment_order' = 
prove_by_refinement(
  `!A m. psegment A /\ endpoint A m  ==>
    (?f. BIJ f {p | p < CARD A} A /\
        (f 0 = terminal_edge A m) /\
        (!i j. (i < CARD A /\ j < CARD A) ==>
             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`A`] endpoint_size2;
  FULL_REWRITE_TAC[has_size2];
  TYPE_THEN `?n. (endpoint A n) /\ ~(m = n)` SUBAGOAL_TAC;
  REWR 0;
  FULL_REWRITE_TAC[in_pair];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  THM_INTRO_TAC[`A`;`m`;`n`] psegment_order;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
    ]);;
  (* }}} *)

let order_imp_psegment = 
prove_by_refinement(
  `!f n. (INJ f { p | p < n} (edge)) /\ (0 < n) /\
     (!i j. (i < n /\ j < n) ==>
             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))) ==>
    (psegment (IMAGE f { p | p < n}))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `E = IMAGE f {p | p <| n}` ABBREV_TAC ;
  IMATCH_MP_TAC  endpoint_psegment;
  REWRITE_TAC[segment;];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  REWRITE_TAC[FINITE_NUMSEG_LT];
  (* - *)
  TYPE_THEN `~(E = {})` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[image_empty];
  FULL_REWRITE_TAC[EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[IMAGE;INJ;SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  TYPE_THEN `E (f 0)` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `edge (f 0)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  (* -A *)
  TYPE_THEN `?m. endpoint E m` SUBAGOAL_TAC;
  REWRITE_TAC[endpoint];
  ASM_SIMP_TAC[num_closure1];
  LEFT_TAC "e";
  TYPE_THEN `f 0 ` EXISTS_TAC;
  THM_INTRO_TAC[`f 0`] two_endpoint;
  FULL_REWRITE_TAC[has_size2];
  ASM_CASES_TAC `n =1`;
  TYPE_THEN `a` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `n` UNABBREV_TAC;
  FULL_REWRITE_TAC[IMAGE];
  TYPE_THEN `(x' = 0) /\ (x = 0)` SUBAGOAL_TAC;
  UND 7 THEN UND 13 THEN ARITH_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `a` 10;
  FULL_REWRITE_TAC[in_pair];
  (* -- *)
  TYPE_THEN `E (f 1)` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `1` EXISTS_TAC;
  UND 11 THEN UND 1 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `edge (f 1)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  (* -- *)
  TYPE_THEN `adj (f 0 ) (f 1)` SUBAGOAL_TAC;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`;`1`]);
  UND 11 THEN UND 1 THEN ARITH_TAC;
  ARITH_TAC;
  THM_INTRO_TAC[`f 0`;`f 1`] edge_inter;
  FULL_REWRITE_TAC[INTER;INR eq_sing  ];
  (* -- *)
  TYPE_THEN `?r. closure top2 (f 0) (pointI r) /\ ~(r = m)` SUBAGOAL_TAC;
  USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  FULL_REWRITE_TAC[in_pair];
  TYPE_THEN `m = a` ASM_CASES_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN`?j. (j <| n) /\ (e' = f j)` SUBAGOAL_TAC;
  TYPE_THEN`E` UNABBREV_TAC;
  FULL_REWRITE_TAC[IMAGE];
  TYPE_THEN`x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `adj (f 0) (f j)` SUBAGOAL_TAC;
  REWRITE_TAC[adj;EMPTY_EXISTS;INTER ];
  TYPE_THEN`pointI r` EXISTS_TAC;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[` 0`;` j`] );
  REWR 0;
  TYPE_THEN `j = 1` SUBAGOAL_TAC;
  UND 0 THEN ARITH_TAC;
  TYPE_THEN `j` UNABBREV_TAC;
  TSPEC `pointI r` 15;
  REWR 15;
  FULL_REWRITE_TAC[pointI_inj];
  ASM_MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  CONJ_TAC;
  UNIFY_EXISTS_TAC;
  (* -B *)
  TYPE_THEN `!e. (E e ==> ?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[IMAGE];
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[INSERT];
  ASM_SIMP_TAC [num_closure0;num_closure1;num_closure2];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  LEFT 11 "e";
  LEFT 12 "e";
  TSPEC `e` 12;
  LEFT 12 "e'";
  FULL_REWRITE_TAC[NOT_IMP];
  TYPE_THEN `E e' /\ closure top2 e' (pointI m') /\ ~(e = e')` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `adj e e'` SUBAGOAL_TAC;
  REWRITE_TAC[adj;EMPTY_EXISTS;INTER;];
  UNIFY_EXISTS_TAC;
  TYPE_THEN `(?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC;
  TYPE_THEN `(?j. (j <| n) /\ (e' = f j))` SUBAGOAL_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  TYPE_THEN `(SUC i = j) \/ (SUC j = i)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  LEFT 13 "a";
  TSPEC `f i` 13;
  LEFT 13 "b";
  TSPEC `f j` 13;
  UND 13 THEN REWRITE_TAC[];
  REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `?k. (k <| n) /\ (e'' = f k)` SUBAGOAL_TAC;
  TYPE_THEN `e''` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  TYPE_THEN `adj (f i) (f k) /\ adj (f j) (f k)` SUBAGOAL_TAC;
  REWRITE_TAC[adj];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  LEFT_TAC "u";
  UNIFY_EXISTS_TAC;
  TYPE_THEN `(SUC j = k) \/ (SUC k = j)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `(SUC i = k) \/ (SUC k = i)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
   UND 29 THEN UND 28 THEN UND 19 THEN ARITH_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -C *)
  TYPE_THEN `X = {p | p <| n /\ S (f p)}` ABBREV_TAC ;
  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET];
  TYPE_THEN `E u` SUBAGOAL_TAC;
  TYPE_THEN `(?i. (i <| n) /\ (u = f i))` SUBAGOAL_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  UNDF `EMPTY` THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `!j k. X j /\ (k <| n) /\ ((SUC j = k) \/ (SUC k = j)) ==> (X k)` SUBAGOAL_TAC;
  TYPE_THEN `j = k` ASM_CASES_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `S (f j)` SUBAGOAL_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  TYPE_THEN `E (f k)` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `k` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `adj (f j) (f k)` SUBAGOAL_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `S (f k)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `X` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `(?i. X i /\ (!m. m <| i ==> ~X m))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[num_WOP];
  TYPE_THEN `i = 0` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `?j. SUC j = i` SUBAGOAL_TAC;
  TYPE_THEN `i - 1` EXISTS_TAC;
  UND 19 THEN ARITH_TAC;
  TSPEC `j` 17;
  UND 17 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UND 20 THEN ARITH_TAC;
  UND 17 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  UND 17 THEN UND 20 THEN ARITH_TAC;
  TYPE_THEN `i` UNABBREV_TAC;
  (* -D *)
  TYPE_THEN `X = { p | p <| n }` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp_eq;
  CONJ_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `Z = ({p | p <| n} DIFF X)` ABBREV_TAC ;
  TYPE_THEN `?n. Z n /\ (!m. m <| n ==> ~Z m)` SUBAGOAL_TAC;
  UND 19 THEN MESON_TAC[num_WOP];
  TYPE_THEN `Z` UNABBREV_TAC;
  FULL_REWRITE_TAC[DIFF];
  TSPEC `n' - 1` 21;
  TYPE_THEN `~(n' = 0)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `n' - 1 <| n'` SUBAGOAL_TAC;
  UND 24 THEN ARITH_TAC;
  TYPE_THEN `n' - 1 <| n` SUBAGOAL_TAC;
  UND 20 THEN ARITH_TAC;
  REWR 21;
  UND 19 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `n' - 1` EXISTS_TAC;
  UND 24 THEN ARITH_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  REWRITE_TAC[SUBSET];
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  USE 20 (REWRITE_RULE[IMAGE]);
  USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x'` 19;
  FULL_REWRITE_TAC[];
  REWR 19;
  ]);;
  (* }}} *)

let rectagon_nonsing = 
prove_by_refinement(
  `!G. rectagon G ==> ~SING G`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectagon;SING];
  TYPE_THEN `G` UNABBREV_TAC;
  THM_INTRO_TAC [`x`] two_endpoint;
  FULL_REWRITE_TAC[SUBSET;INR IN_SING;];
  FULL_REWRITE_TAC[has_size2];
  USE 6 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
  FULL_REWRITE_TAC[in_pair];
  TSPEC `b` 6;
  REWR 6;
  TSPEC `b` 2;
  THM_INTRO_TAC[`{x}`;`pointI b`] num_closure0;
  FULL_REWRITE_TAC[INR IN_SING];
  REWR 2;
  LEFT 2 "e" ;
  TSPEC  `x` 2;
  REWR 2;
  THM_INTRO_TAC[`{x}`;`pointI b`] num_closure2;
  REWR 8;
  FULL_REWRITE_TAC[INR IN_SING];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let rectagon_2 = 
prove_by_refinement(
  `!G S. rectagon G /\ S SUBSET G /\ ~(S = EMPTY) /\
    (!m. {0,2} (num_closure S (pointI m))) ==> (S = G)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `Tx = { A | ~(A = EMPTY) /\ A SUBSET S /\ (!m. {0,2} (num_closure A (pointI m))) }` ABBREV_TAC ;
  TYPE_THEN `~(Tx = EMPTY)` SUBAGOAL_TAC;
  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `S` EXISTS_TAC;
  TYPE_THEN `Tx` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  USE 5 (MATCH_MP select_card_min);
  (* - *)
  TYPE_THEN `z SUBSET G` SUBAGOAL_TAC;
  TYPE_THEN `Tx` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  (* - *)
  TYPE_THEN `(z = G) ==> (S = G)` SUBAGOAL_TAC;
  TYPE_THEN `Tx` UNABBREV_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  FULL_REWRITE_TAC [ISUBSET];
  ASM_MESON_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  KILL 8;
  (* - *)
  IMATCH_MP_TAC  rectagon_subset;
  TYPE_THEN `segment G` SUBAGOAL_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  (* - *)
  REWRITE_TAC[rectagon];
  TYPE_THEN `Tx` UNABBREV_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  FULL_REWRITE_TAC[rectagon];
  CONJ_TAC;
  FULL_REWRITE_TAC[rectagon];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G` EXISTS_TAC;
  (* -A1 *)
  IMATCH_MP_TAC  CARD_SUBSET_LE;
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  KILL 5;
  KILL 0;
  TSPEC `m` 4;
  FULL_REWRITE_TAC[INSERT];
  USE 0 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono;
  UND 4 THEN UND 5 THEN ARITH_TAC;
  KILL 0;
  (* - *)
  TYPE_THEN `~(num_closure S' (pointI m) = 1)` ASM_CASES_TAC;
  THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono;
  UND 5 THEN UND 0 THEN UND 4 THEN ARITH_TAC;
  REWR 0;
  (* - *)
  THM_INTRO_TAC[`S'`;`(pointI m)`] num_closure1;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  REWR 5;
  (* - *)
  THM_INTRO_TAC[`z`;`pointI m`] num_closure2;
  REWR 14;
  COPY 14;
  TSPEC `e` 16;
  COPY 5;
  TSPEC `e` 5;
  USE 5 (REWRITE_RULE[]);
  TYPE_THEN `z e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[ISUBSET];
  TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILL 16;
  (* -B1 *)
  TYPE_THEN `?e'. (closure top2 e' (pointI m)) /\ z e' /\ ~(e = e')` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `a` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* - *)
  UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`e`;`e'`]);
  REWRITE_TAC[adj;INTER;EMPTY_EXISTS;];
  TYPE_THEN `pointI m` EXISTS_TAC;
  TSPEC  `e'` 17 ;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let closure_imp_adj = 
prove_by_refinement(
  `!X Y m. (closure top2 X (pointI m) /\ closure top2 Y (pointI m) /\
      ~(X = Y) ==> adj X Y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[adj];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let inductive_set_endpoint = 
prove_by_refinement(
  `!G S. FINITE G /\ inductive_set G S ==>
     (endpoint S SUBSET endpoint G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[inductive_set];
  REWRITE_TAC[SUBSET;endpoint];
  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  THM_INTRO_TAC[`S`;`pointI x`] num_closure1;
  REWR 6;
  ASM_SIMP_TAC[num_closure1];
  TYPE_THEN `e` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  COPY 6;
  TSPEC `e'` 6;
  TSPEC `e` 9;
  REWR 6;
  REWR 9;
  PROOF_BY_CONTR_TAC;
  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`e`;`e'`]);
  IMATCH_MP_TAC  closure_imp_adj;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `e'` UNABBREV_TAC;
  TSPEC `e` 6;
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let endpoint_closure = 
prove_by_refinement(
  `!e. (edge e) ==> (endpoint {e} = {m | closure top2 e (pointI m)})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
  REWRITE_TAC[FINITE_SING];
  REWRITE_TAC[INR IN_SING];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `e = e'` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let rectagon_delete = 
prove_by_refinement(
  `!E e. (rectagon E) /\ (E e) ==> (psegment (E DELETE e))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[psegment];
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC;
  THM_INTRO_TAC[`E DELETE e`;`E`] rectagon_subset;
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  REWRITE_TAC[DELETE;SUBSET];
  ASM_MESON_TAC[INR DELETE_NON_ELEMENT];
  (* - *)
  REWRITE_TAC[segment];
  CONJ_TAC;
  FULL_REWRITE_TAC[rectagon];
  REWRITE_TAC[FINITE_DELETE];
  (* - *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[delete_empty];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 1 (MATCH_MP rectagon_nonsing);
  FULL_REWRITE_TAC[SING];
  ASM_MESON_TAC[];
  (* - *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `E` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[DELETE;SUBSET];
  FULL_REWRITE_TAC[rectagon];
  (* - *)
  SUBCONJ_TAC;
  THM_INTRO_TAC[`E DELETE e`;`E`;`pointI m`] num_closure_mono;
  FULL_REWRITE_TAC[rectagon;DELETE;SUBSET];
  FULL_REWRITE_TAC[rectagon];
  UND 5 THEN UND 4 THEN (REWRITE_TAC[INSERT]) ;
  TSPEC `m` 4;
  UND 4 THEN UND 5 THEN ARITH_TAC;
  (* -A *)
  TYPE_THEN `~S e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET;DELETE];
  ASM_MESON_TAC[];
  TYPE_THEN `(e INSERT S = E) ==> (S = E DELETE e)` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC [DELETE_INSERT];
  ASM_MESON_TAC[INR DELETE_NON_ELEMENT];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  FULL_REWRITE_TAC[rectagon];
  REWRITE_TAC[DELETE;SUBSET];
  (* - *)
  THM_INTRO_TAC[`E DELETE e`;`S`] inductive_set_endpoint;
  REWRITE_TAC[inductive_set];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  rectagon_2;
  CONJ_TAC;
  REWRITE_TAC[INSERT_SUBSET];
  UND 6 THEN REWRITE_TAC[SUBSET;DELETE];
  (* - *)
  CONJ_TAC;
  FULL_REWRITE_TAC[EQ_EMPTY;INSERT;];
  ASM_MESON_TAC[];
  (* -B *)
  TYPE_THEN `e INSERT S SUBSET E` SUBAGOAL_TAC;
  UND 6 THEN REWRITE_TAC[INSERT;DELETE;SUBSET];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`e INSERT S`;`E`;`pointI m`] num_closure_mono;
  FULL_REWRITE_TAC[rectagon];
  TYPE_THEN `~(num_closure (e INSERT S) (pointI m) = 1)` ASM_CASES_TAC;
  TYPE_THEN `S' = e INSERT S` ABBREV_TAC ;
  KILL 15;
  FULL_REWRITE_TAC[INSERT;rectagon];
  TSPEC `m` 15;
  UND 15 THEN UND 14 THEN UND 13 THEN ARITH_TAC;
  REWR 14;
  PROOF_BY_CONTR_TAC;
  KILL 13;
  KILL 15;
  KILL 9;
  (* - *)
  TYPE_THEN `!A x. (A SUBSET E) /\ (num_closure A (pointI x) = 1) ==> (num_closure E (pointI x) = 2)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  TSPEC `x` 15;
  USE 15 (REWRITE_RULE[INSERT]);
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`A`;`E`;`pointI x`] num_closure_mono;
  UND 20 THEN UND 19 THEN UND 9 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `endpoint (E DELETE e) SUBSET  endpoint {e}` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET;endpoint];
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`E DELETE e`;`x`]);
  REWRITE_TAC[SUBSET;DELETE];
  THM_INTRO_TAC[`E`;`pointI x`] num_closure2;
  FULL_REWRITE_TAC[rectagon];
  REWR 15;
  THM_INTRO_TAC[`E DELETE e`;`pointI x`] num_closure1;
  REWR 17;
  USE 17 (REWRITE_RULE[DELETE]);
  THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
  REWRITE_TAC[FINITE_SING];
  REWRITE_TAC[INR IN_SING];
  TYPE_THEN `e` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  REWRITE_TAC[];
  TYPE_THEN `e''` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `E a /\ closure top2 a (pointI x)` SUBAGOAL_TAC;
  TYPE_THEN `E b /\ closure top2 b (pointI x)` SUBAGOAL_TAC;
  TSPEC `e` 15;
  UND 15 THEN ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC ;
  USE 15 (REWRITE_RULE[DE_MORGAN_THM]);
  COPY 17;
  TSPEC `a` 17;
  TSPEC `b` 25;
  KILL 18;
  KILL 4;
  KILL 7;
  TYPE_THEN `e' = b` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILL 25;
  TYPE_THEN `e' = a` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  UND 7 THEN UND 4 THEN UND 16 THEN MESON_TAC[];
  (* -C *)
  TYPE_THEN `endpoint S SUBSET endpoint {e}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  KILL 13;
  KILL 11;
  (* - *)
  THM_INTRO_TAC[`S`;`E`] endpoint_even;
  SUBCONJ_TAC;
  ASM_MESON_TAC[rectagon_segment];
  SUBCONJ_TAC;
  UND 12 THEN REWRITE_TAC[INSERT;SUBSET] THEN MESON_TAC[];
  THM_INTRO_TAC[`S`;`E`] rectagon_subset;
  TYPE_THEN `S` UNABBREV_TAC;
  UND 8 THEN REWRITE_TAC[];
  (* - *)
  TYPE_THEN `X = {S' | ?e. S e /\ (S' = segment_of S e)}` ABBREV_TAC ;
  TYPE_THEN `FINITE X` SUBAGOAL_TAC;
  THM_INTRO_TAC[`segment_of S`;`S`] FINITE_IMAGE;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E DELETE e` EXISTS_TAC;
  TYPE_THEN `X = IMAGE (segment_of S) S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  TYPE_THEN `X` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
  USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
  UND 17 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `segment_of S u` EXISTS_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[HAS_SIZE];
  (* -D *)
  TYPE_THEN `edge e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[ISUBSET];
  THM_INTRO_TAC[`e`] endpoint_closure;
  THM_INTRO_TAC[`e`] two_endpoint;
  FULL_REWRITE_TAC[HAS_SIZE];
  (* - *)
  TYPE_THEN `endpoint S = endpoint {e}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET_LE;
  CONJ_TAC;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  (ARITH_RULE  `~(CARD X = 0) ==> 2 <= 2 * CARD X`);
  TYPE_THEN `X HAS_SIZE 0` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[HAS_SIZE_0];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`e INSERT S`;`pointI m`] num_closure1;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  FULL_REWRITE_TAC[rectagon];
  REWR 24;
  USE 24 (REWRITE_RULE[INSERT]);
  TYPE_THEN `closure top2 e (pointI m)` ASM_CASES_TAC;
  TYPE_THEN `e' = e` SUBAGOAL_TAC;
  TSPEC `e` 24;
  ASM_MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  TYPE_THEN `endpoint S m` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`S`;`m`]endpoint_edge;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E DELETE e` EXISTS_TAC ;
  FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT];
  TSPEC  `e''` 27;
  TSPEC  `e''` 24;
  TYPE_THEN `e = e''` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e''` UNABBREV_TAC;
  KILL 9;
  KILL 20;
  KILL 7;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `~endpoint S m` SUBAGOAL_TAC;
  UND 26 THEN ASM_REWRITE_TAC[];
  (* - *)
  USE 26 (REWRITE_RULE[endpoint]);
  THM_INTRO_TAC[`S`;`E`;`pointI m`] num_closure_mono;
  FULL_REWRITE_TAC[rectagon];
  UND 6 THEN REWRITE_TAC[DELETE;SUBSET];
  TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET ;
  TYPE_THEN `E DELETE e` EXISTS_TAC;
  TYPE_THEN `~(num_closure S (pointI m) = 0)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`S`;`pointI m`] num_closure0;
  REWR 30;
  TSPEC `e'` 30;
  COPY 24;
  TSPEC `e` 32;
  TSPEC `e'` 24;
  REWR 24;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  KILL 4;
  KILL 9;
  ASM_MESON_TAC[];
  (* - *)
  USE 28 (REWRITE_RULE [INSERT]);
  USE 28 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
  FIRST_ASSUM DISJ_CASES_TAC;
  UND 27 THEN UND 31 THEN UND 30 THEN ARITH_TAC;
  KILL 28;
  TYPE_THEN `num_closure S (pointI m) = 2` SUBAGOAL_TAC;
  UND 31 THEN UND 30 THEN UND 26 THEN UND 27 THEN ARITH_TAC;
  KILL 31;
  KILL 9;
  KILL 4;
  KILL 7;
  KILL 30;
  (* -E *)
  THM_INTRO_TAC[`S`;`pointI m`] num_closure2;
  REWR 4;
  TYPE_THEN `S a /\ closure top2 a (pointI m)` SUBAGOAL_TAC;
  TYPE_THEN `S b /\ closure top2 b (pointI m)` SUBAGOAL_TAC;
  KILL 4;
  TYPE_THEN `e' = a` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e' =b` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  UND 7 THEN REWRITE_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  ]);;
  (* }}} *)

let rectagon_adj = 
prove_by_refinement(
  `!E e f. (rectagon E) /\ E e /\ E f ==>
         (adj e f <=>
    (?a. endpoint (E DELETE e) a /\ (f = terminal_edge (E DELETE e) a)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[DELETE;SUBSET];
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  IMATCH_MP_TAC  (TAUT `A /\ b ==> b /\ A`);
  CONJ_TAC;
  IMATCH_MP_TAC closure_imp_adj;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  FULL_REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`E DELETE e`;`pointI a`] num_closure1;
  REWR 5;
  USE 5 (REWRITE_RULE[DELETE]);
  TYPE_THEN `{0,2} (num_closure E (pointI a))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  USE 7 (REWRITE_RULE[INSERT]);
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`E`;`pointI a`] num_closure2;
  REWR 9;
  TYPE_THEN `E a' /\ closure top2 a' (pointI a)` SUBAGOAL_TAC;
  TYPE_THEN `E b /\ closure top2 b (pointI a)` SUBAGOAL_TAC;
  SUBCONJ_TAC;
  PROOF_BY_CONTR_TAC;
  TSPEC `e` 9;
  UND 9 THEN ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 9(REWRITE_RULE[DE_MORGAN_THM]);
  COPY 5;
  TSPEC `a'` 5;
  TSPEC `b` 17;
  TYPE_THEN `e' = b` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`E DELETE e`;`a`]terminal_endpoint;
  REWRITE_TAC[endpoint];
  UND 17 THEN REWRITE_TAC[DELETE] THEN MESON_TAC[];
  (* -- case 0 *)
  THM_INTRO_TAC[`E`;`pointI a`] num_closure0;
  REWR 9;
  ASM_MESON_TAC[];
  (* -A *)
  THM_INTRO_TAC[`e`;`f`] edge_inter;
  FULL_REWRITE_TAC[rectagon;ISUBSET];
  FULL_REWRITE_TAC[INTER;INR eq_sing];
  TYPE_THEN `m` EXISTS_TAC;
  SUBCONJ_TAC;
  REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1;
  KILL 9;
  TYPE_THEN `f` EXISTS_TAC;
  REWRITE_TAC[DELETE];
  IMATCH_MP_TAC  EQ_ANTISYM;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  TYPE_THEN `e''` UNABBREV_TAC;
  FULL_REWRITE_TAC[adj];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `{0, 2} (num_closure E (pointI m))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[INSERT];
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`E`;`pointI m`]num_closure2;
  REWR 14;
  PROOF_BY_CONTR_TAC;
  COPY 14;
  COPY 14;
  TSPEC `e` 14;
  TSPEC `f` 18;
  TSPEC `e''` 17;
  KILL 13;
  KILL 12;
  KILL 6;
  TYPE_THEN `e'' = a` ASM_CASES_TAC ;
  TYPE_THEN `e''` UNABBREV_TAC;
  TYPE_THEN `(f = b)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `f` UNABBREV_TAC;
  TYPE_THEN `e = b` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e` UNABBREV_TAC;
  FULL_REWRITE_TAC[adj];
  TYPE_THEN `e'' = b` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e''` UNABBREV_TAC;
  TYPE_THEN `f = a` SUBAGOAL_TAC;
  KILL 14;
  ASM_MESON_TAC[];
  TYPE_THEN `f` UNABBREV_TAC ;
  FULL_REWRITE_TAC[adj];
  ASM_MESON_TAC[];
  (* -- 0 case -- *)
  THM_INTRO_TAC[`E`;`pointI m`] num_closure0;
  REWR 14;
  KILL 6;
  ASM_MESON_TAC[];
  (* -B *)
  THM_INTRO_TAC[`E DELETE e`;`m`;`f`] terminal_unique;
  USE 10 (ONCE_REWRITE_RULE [EQ_SYM_EQ]);
  ASM_REWRITE_TAC[DELETE];
  ASM_MESON_TAC[adj];
  ]);;
  (* }}} *)

let rectagon_delete_end = 
prove_by_refinement(
  `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==>
       endpoint (E DELETE e ) m`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[DELETE;SUBSET];
  THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1;
  KILL 5;
  REWRITE_TAC[DELETE];
  (* - *)
  TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[INSERT];
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  KILL 5;
  THM_INTRO_TAC[`E`;`pointI m`] num_closure2;
  REWR 5;
  TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `?c. (E c /\ ~(c = e) /\ closure top2 c (pointI m)) /\ (!e'. E e' /\ closure top2 e' (pointI m) <=> (e' = e) \/ (e' = c))` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `a` EXISTS_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `c` EXISTS_TAC;
  TYPE_THEN `c = e''` ASM_CASES_TAC;
  TYPE_THEN `e''` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  REWR 14;
  KILL 5;
  TSPEC `e''` 9;
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`E`;`pointI m`] num_closure0;
  REWR 7;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let rectagon_order = 
prove_by_refinement(
  `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==>
     (?f. BIJ f { p | p < CARD E } E /\
         (f (CARD E - 1) = e) /\ (closure top2 (f 0) (pointI m)) /\
      (!i j. (i < CARD E /\ j < CARD E) ==>
            (adj (f i) (f j) <=> ((SUC i = j) \/ (SUC j = i) \/
   ((i = 0) /\ (j = (CARD E -1))) \/ ((i = CARD E -1) /\ (j = 0))))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`;`e`] rectagon_delete;
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
  IMATCH_MP_TAC   FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[DELETE;SUBSET];
  TYPE_THEN `endpoint (E DELETE e) m` SUBAGOAL_TAC;
  IMATCH_MP_TAC  rectagon_delete_end;
  (* - *)
  TYPE_THEN `?n. (endpoint (E DELETE e) n) /\ ~(n = m)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E DELETE e`] endpoint_size2;
  FULL_REWRITE_TAC[has_size2];
  TYPE_THEN `m = a` ASM_CASES_TAC ;
  TYPE_THEN `b` EXISTS_TAC;
  REWRITE_TAC[INR in_pair];
  TYPE_THEN `a` EXISTS_TAC;
  REWRITE_TAC[INR in_pair];
  (* - *)
  THM_INTRO_TAC[`E DELETE e`;`m`;`n`] psegment_order;
  THM_INTRO_TAC[`e`;`E`;] CARD_SUC_DELETE;
  TYPE_THEN `~(CARD E = 0)` SUBAGOAL_TAC;
  TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC;
  REWRITE_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY];
  ASM_MESON_TAC[];
  TYPE_THEN `CARD (E DELETE e) = CARD (E) - 1` SUBAGOAL_TAC;
  UND 14 THEN UND 13 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `g = \ (i:num). if (i < CARD E - 1) then f i else e` ABBREV_TAC ;
  TYPE_THEN `(g (CARD E - 1) = e)` SUBAGOAL_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  REWRITE_TAC[ARITH_RULE `~(x <| x)`];
  TYPE_THEN `(!i. (i < CARD E -| 1) ==> (g i = f i))` SUBAGOAL_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  KILL 16;
  TYPE_THEN `g` EXISTS_TAC;
  (* -A *)
  TYPE_THEN `{p | p < CARD E - 1} UNION {(CARD E - 1)} = {p | p <| CARD E}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING ];
  UND 14 THEN ARITH_TAC;
  (* - *)
  SUBCONJ_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  USE 16 (SYM);
  IMATCH_MP_TAC  inj_split;
  CONJ_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  TYPE_THEN `CARD (E DELETE e)` UNABBREV_TAC;
  CONJ_TAC;
  UND 20 THEN REWRITE_TAC[DELETE] THEN UND 15 THEN MESON_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 15 THEN UND 21 THEN UND 22 THEN UND 18 THEN MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[INJ;INR IN_SING ];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING  ];
  TYPE_THEN `x` UNABBREV_TAC ;
  TYPE_THEN `x''` UNABBREV_TAC;
  REWR 19;
  TYPE_THEN `g x' = f x'` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `g x'` UNABBREV_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  TYPE_THEN `CARD(E DELETE e)` UNABBREV_TAC;
  USE 21(REWRITE_RULE[DELETE]);
  ASM_MESON_TAC[];
  (* -- SURJ -- *)
  REWRITE_TAC[SURJ];
  USE 19 (REWRITE_RULE[INJ]);
  REWRITE_TAC[];
  TYPE_THEN `x = e` ASM_CASES_TAC;
  TYPE_THEN `CARD E - 1` EXISTS_TAC;
  UND 14 THEN ARITH_TAC;
  TYPE_THEN `(E DELETE e) x` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[DELETE];
  FULL_REWRITE_TAC[BIJ;SURJ];
  TSPEC `x` 12;
  REWR 12;
  TYPE_THEN `y` EXISTS_TAC;
  CONJ_TAC;
  UND 26 THEN ARITH_TAC;
  (* -B *)
  TYPE_THEN `~(SING E)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SING];
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR IN_SING];
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  UND 22 THEN ASM_REWRITE_TAC[DELETE;INR IN_SING];
  ASM_MESON_TAC[];
  TYPE_THEN `~(CARD E = 1)` SUBAGOAL_TAC;
  TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[HAS_SIZE];
  ASM_MESON_TAC[CARD_SING_CONV];
  (* - *)
  TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC;
  UND 21 THEN UND 14 THEN ARITH_TAC;
  COPY 18 ;
  TSPEC `0` 23;
  (* - *)
  SUBCONJ_TAC;
  THM_INTRO_TAC[`E DELETE e`;`m`]terminal_endpoint;
  (* -C *)
  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `CARD (E DELETE e) - 1 = CARD E - 2` SUBAGOAL_TAC;
  UND 23 THEN ARITH_TAC;
  REWR 10;
  (* - *)
  TYPE_THEN `!k. endpoint (E DELETE e) k  ==> (k = n) \/ (k = m)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 29 (REWRITE_RULE[DE_MORGAN_THM]);
  THM_INTRO_TAC[`E DELETE e`] endpoint_size2;
  THM_INTRO_TAC[`endpoint(E DELETE e)`;`n`;`m`;`k`]two_exclusion;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!j. (j <| CARD E - 1) ==> (adj e (g j) <=> (j = 0) \/ (j = CARD E - 2))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`;`e`;`g j'`] rectagon_adj;
  TSPEC `j'` 18;
  TYPE_THEN `f j'` UNABBREV_TAC;
  USE 19 (REWRITE_RULE[BIJ;SURJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 29 THEN ARITH_TAC;
  (* -- *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`j'`]);
  TYPE_THEN `g j'` UNABBREV_TAC;
  REWR 30;
  TSPEC  `a` 28;
  FIRST_ASSUM DISJ_CASES_TAC ;
  TYPE_THEN `a` UNABBREV_TAC;
  DISJ2_TAC;
  TYPE_THEN `f j' = f (CARD E -| 2)` SUBAGOAL_TAC;
  USE 12(REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 29 THEN UND 23 THEN ARITH_TAC;
  TYPE_THEN `a` UNABBREV_TAC;
  DISJ1_TAC;
  TYPE_THEN `f j' = f 0` SUBAGOAL_TAC;
  USE 12 (REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* -- *)
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`E`;`e`;`f 0`] rectagon_adj;
  TYPE_THEN `terminal_edge (E DELETE e) m` UNABBREV_TAC;
  USE 22 SYM;
  USE 19 (REWRITE_RULE[BIJ;SURJ]);
  TSPEC `0` 22;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 23 THEN ARITH_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`E`;`e`;`f (CARD E - 2)`] rectagon_adj;
  TYPE_THEN `terminal_edge (E DELETE e) n` UNABBREV_TAC;
  UND 18 THEN DISCH_THEN  (THM_INTRO_TAC[`CARD E -2`]);
  UND 23 THEN ARITH_TAC;
  USE 10 GSYM;
  USE 19 (REWRITE_RULE[BIJ;SURJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 23 THEN ARITH_TAC;
  REWR 33;
  TYPE_THEN `n` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `i  = CARD E - 1` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[adj];
  UND 32 THEN UND 23 THEN ARITH_TAC;
  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
  UND 31 THEN UND 24 THEN ARITH_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `j` UNABBREV_TAC;
  DISJ2_TAC;
  DISJ1_TAC;
  UND 23 THEN ARITH_TAC;
  UND 32 THEN REP_CASES_TAC;
  TYPE_THEN `j` UNABBREV_TAC;
  UND 24 THEN ARITH_TAC;
  DISJ2_TAC;
  UND 32 THEN UND 23 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC [adj_symm];
  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  UND 30 THEN UND 25 THEN ARITH_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC ;
  UND 23 THEN ARITH_TAC;
  UND 32 THEN REP_CASES_TAC;
  UND 32 THEN UND 23 THEN ARITH_TAC;
  TYPE_THEN `i` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 25 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `i < CARD E - 1 /\ j < CARD E - 1` SUBAGOAL_TAC;
  UND 31 THEN UND 30 THEN UND 24 THEN UND 25 THEN ARITH_TAC;
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)


let order_imp_psegment_shift = 
prove_by_refinement(
  `! f m n.
     INJ f { p | m <= p /\ p < n} edge /\
       m <| n /\
       (! i j. m <= i /\ i < n /\ m <= j /\ j < n ==>
         (adj (f i) (f j) <=> (SUC i = j) \/ (SUC j = i))) ==>
      psegment (IMAGE f {p | m <= p /\ p < n})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `g = \ (i: num). f (i + m)` ABBREV_TAC ;
  TYPE_THEN `IMAGE f {p | m <=| p /\ p < n} = IMAGE g {p | p < n - m}` SUBAGOAL_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `x' -| m` EXISTS_TAC;
  CONJ_TAC;
  UND 5 THEN UND 6 THEN ARITH_TAC;
  AP_TERM_TAC;
  UND 6 THEN ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `x' +| m` EXISTS_TAC;
  UND 5 THEN UND 1 THEN ARITH_TAC;
  IMATCH_MP_TAC  order_imp_psegment;
  (* - *)
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  TYPE_THEN`g`UNABBREV_TAC;
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 5 THEN UND 1 THEN ARITH_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `((x +| m) = (y + m)) ==> (x = y)`);
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC;
  (* - *)
  CONJ_TAC;
  UND 1 THEN ARITH_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i +| m`;`j +| m`]);
  UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC;
  REWRITE_TAC[ARITH_RULE `(SUC(i + m) = (j +| m)) <=> (SUC i = j)`];
  ]);;
  (* }}} *)

let cls = jordan_def
  `cls E = {m | ?e. E e /\ closure top2 e (pointI m)}`;;

let cls_edge = 
prove_by_refinement(
  `!e. (cls {e} = {m | closure top2 e (pointI m)})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls;INR IN_SING ;];
  IMATCH_MP_TAC  EQ_EXT;
  MESON_TAC[];
  ]);;
  (* }}} *)

let cls_inj_lemma_v = 
prove_by_refinement(
  `!m n. (cls {(v_edge m)} = cls {(v_edge n)}) ==> (m = n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls_edge;INR IN_SING;];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INR IN_SING]);
  FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
  SUBCONJ_TAC;
  TSPEC `m` 0;
  ASM_MESON_TAC[];
  TYPE_THEN `FST n` UNABBREV_TAC;
  COPY 0;
  TSPEC `m` 1;
  TSPEC `(FST m, SND n)` 0;
  REWR 0;
  REWR 1;
  UND 0 THEN UND 1 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let cls_inj_lemma_h = 
prove_by_refinement(
  `!m n. (cls {(h_edge m)} = cls {(h_edge n)}) ==> (m = n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls_edge;INR IN_SING;];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INR IN_SING]);
  FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  SUBCONJ_TAC;
  TSPEC `m` 0;
  ASM_MESON_TAC[];
  TYPE_THEN `SND  n` UNABBREV_TAC;
  COPY 0;
  TSPEC `m` 1;
  TSPEC `(FST n, SND m)` 0;
  REWR 0;
  REWR 1;
  UND 0 THEN UND 1 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let cls_inj_lemma_hv = 
prove_by_refinement(
  `!m n. ~(cls {(h_edge m)} = cls {(v_edge n)})` ,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls_edge;];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INR IN_SING]);
  FULL_REWRITE_TAC[v_edge_closure;vc_edge;h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
  COPY 0;
  TSPEC  `n` 0;
  TSPEC `(FST n, SND n +: &:1)` 1;
  REWR 0;
  REWR 1;
  TYPE_THEN `SND n = SND m` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `SND m` UNABBREV_TAC;
  UND 1 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let cls_inj = 
prove_by_refinement(
  `!e f . (edge e /\ edge f /\ (cls {e} = cls {f}) ==> (e = f))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  JOIN 1 2 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  UND 1 THEN REP_CASES_TAC THEN REWR 0 THEN REWRITE_TAC[v_edge_inj;h_edge_inj];
  IMATCH_MP_TAC cls_inj_lemma_v;
  ASM_MESON_TAC[cls_inj_lemma_hv];
  ASM_MESON_TAC[cls_inj_lemma_hv];
  IMATCH_MP_TAC  cls_inj_lemma_h;
  ]);;
  (* }}} *)

let adjv = jordan_def
  `adjv e f = @m. (closure top2 e (pointI m)) /\
                  (closure top2 f (pointI m))` ;;

let adjv_adj = 
prove_by_refinement(
  `!e f. edge e /\ edge f /\ adj e f ==>
        closure top2 e (pointI (adjv e f))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[adjv];
  SELECT_TAC ;
  THM_INTRO_TAC[`e`;`f`] edge_inter;
  FULL_REWRITE_TAC [INTER;INR eq_sing;];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let adjv_adj2 = 
prove_by_refinement(
  `!e f. edge e /\ edge f /\ adj e f ==>
        closure top2 f (pointI (adjv e f))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[adjv];
  SELECT_TAC ;
  THM_INTRO_TAC[`e`;`f`] edge_inter;
  FULL_REWRITE_TAC [INTER;INR eq_sing;];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let has_size2_pair = 
prove_by_refinement(
  `!(X:A->bool) a b. (X HAS_SIZE 2) /\ X a /\ X b /\ ~(a = b) ==>
      (X = {a,b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  CARD_SUBSET_EQ;
  FULL_REWRITE_TAC[HAS_SIZE];
  REWRITE_TAC[SUBSET;INR in_pair];
  ASM_MESON_TAC[pair_size_2;HAS_SIZE];
  ]);;
  (* }}} *)

let adjv_unique = 
prove_by_refinement(
  `!e f n. edge e /\ edge f /\ adj e f /\ closure top2 e (pointI n) /\
      closure top2 f (pointI n) ==> (n = adjv e f)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[adjv];
  SELECT_TAC;
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`e`] two_endpoint;
  THM_INTRO_TAC[`f`] two_endpoint;
  THM_INTRO_TAC[ `{m | closure top2 f (pointI m)}`;`n`;`t`] has_size2_pair;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[ `{m | closure top2 e (pointI m)}`;`n`;`t`] has_size2_pair;
  ASM_REWRITE_TAC[];
  TYPE_THEN `cls {e} = cls {f}` SUBAGOAL_TAC;
  REWRITE_TAC[cls_edge;INR IN_SING ];
  THM_INTRO_TAC[`e`;`f`] cls_inj;
  TYPE_THEN`f` UNABBREV_TAC;
  FULL_REWRITE_TAC[adj];
  (* - *)
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let adjv_symm = 
prove_by_refinement(
  `!e f. edge e /\ edge f /\ adj e f ==>
    (adjv f e = adjv e f)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  adjv_unique;
  THM_INTRO_TAC[`f`;`e`] adjv_adj;
  ASM_MESON_TAC[adj_symm];
  THM_INTRO_TAC[`f`;`e`] adjv_adj2;
  ASM_MESON_TAC[adj_symm];
  ]);;
  (* }}} *)

let adjv_segment  = 
prove_by_refinement(
  `!E e f. segment E /\ E e /\ E f /\ adj e f ==>
     ({C| E C /\ closure top2 C (pointI (adjv e f))} = {e,f} ) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  has_size2_pair;
  TYPE_THEN `~(e = f)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[adj];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `edge e /\ edge f` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment;ISUBSET];
  (* - *)
  TYPE_THEN `closure top2 e (pointI (adjv e f))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  adjv_adj;
  TYPE_THEN `closure top2 f (pointI (adjv e f))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  adjv_adj2;
  (* - *)
  TYPE_THEN `{0,1,2} (num_closure E (pointI (adjv e f)))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  FULL_REWRITE_TAC[INSERT];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  UND 9 THEN REP_CASES_TAC;
  THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure_size;
  REWR 11;
  (* -- *)
  THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure1;
  REWR 11;
  COPY 11;
  TSPEC `f` 11;
  TSPEC `e` 12;
  REWR 11;
  REWR 12;
  (* - *)
  THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure0;
  REWR 11;
  TSPEC  `e` 11;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let num_closure_elt = 
prove_by_refinement(
  `!S m. (0 <| num_closure S m) ==> (?e. S e /\ closure top2 e m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[num_closure];
  TYPE_THEN `~({C | S C /\ closure top2 C m} = EMPTY)` SUBAGOAL_TAC;
  REWR 0;
  FULL_REWRITE_TAC[CARD_CLAUSES];
  UND 0 THEN ARITH_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

(* I shouldn't need three minor variations of the same
   thing here, but here they are *)

let rectagon_subset_endpoint = 
prove_by_refinement(
  `!E S k. rectagon E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\
   (0 <| num_closure (E DIFF S) (pointI k)) ==>
   (endpoint S k)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono;
  TYPE_THEN `{0,2} (num_closure E (pointI k))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[INSERT];
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC ;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC;
  REWR 5;
  UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC;
  TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET_EQ;
  USE 9 (REWRITE_RULE[num_closure]);
  USE 7 (REWRITE_RULE[num_closure]);
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET;];
  REWRITE_TAC[SUBSET;];
  FULL_REWRITE_TAC[ISUBSET];
  (* -- *)
  USE 0 (REWRITE_RULE[num_closure]);
  USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`));
  TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC;
  REWRITE_TAC[EQ_EMPTY ];
  USE 12 (REWRITE_RULE[DIFF]);
  USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
  TSPEC `x` 10;
  REWR 10;
  UND 0 THEN ASM_REWRITE_TAC[];
  REWRITE_TAC[CARD_CLAUSES];
  UND 7 THEN UND 5 THEN UND 1 THEN ARITH_TAC;
  ]);;
  (* }}} *)

let psegment_subset_endpoint = 
prove_by_refinement(
  `!E S k. psegment E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\
   (0 <| num_closure (E DIFF S) (pointI k)) ==>
   (endpoint S k)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono;
  TYPE_THEN `{0,1,2} (num_closure E (pointI k))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  FULL_REWRITE_TAC[INSERT];
  (* - *)
  FULL_REWRITE_TAC[DISJ_ACI];
  FIRST_ASSUM DISJ_CASES_TAC ;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC;
  REWR 5;
  UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC;
  TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET_EQ;
  USE 9 (REWRITE_RULE[num_closure]);
  USE 7 (REWRITE_RULE[num_closure]);
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET;];
  REWRITE_TAC[SUBSET;];
  FULL_REWRITE_TAC[ISUBSET];
  (* -- *)
  USE 0 (REWRITE_RULE[num_closure]);
  USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`));
  TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC;
  REWRITE_TAC[EQ_EMPTY ];
  USE 12 (REWRITE_RULE[DIFF]);
  USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
  TSPEC `x` 10;
  REWR 10;
  UND 0 THEN ASM_REWRITE_TAC[];
  REWRITE_TAC[CARD_CLAUSES];
  (* - *)
  KILL 6;
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`E`;`pointI k`] num_closure1;
  REWR 8;
  USE 0 (MATCH_MP num_closure_elt);
  FULL_REWRITE_TAC[DIFF];
  USE 1 (MATCH_MP num_closure_elt);
  COPY 8;
  TSPEC `e'` 12;
  TSPEC `e''` 8;
  FULL_REWRITE_TAC[ISUBSET];
  ASM_MESON_TAC[];
  (* - *)
  UND 6 THEN UND 5 THEN UND 1 THEN ARITH_TAC;
  ]);;
  (* }}} *)


let num_closure_pos = 
prove_by_refinement(
  `!G m.
      FINITE G /\ (?e. G e /\ closure top2 e (pointI m)) ==>
         (0 <| (num_closure G (pointI m)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC ;
  TYPE_THEN `num_closure G (pointI m) = 0` SUBAGOAL_TAC;
  UND 3 THEN ARITH_TAC;
  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
  REWR 5;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let cut_rectagon = 
prove_by_refinement(
  `!E m n. (rectagon E) /\ (0 < num_closure E (pointI m)) /\
     (0 < num_closure E (pointI n)) /\ ~(m = n) ==>
    (?A B. psegment A /\ psegment B /\ (E = A UNION B) /\
       (A INTER B = EMPTY) /\ (endpoint A = {m,n}) /\
       (endpoint B = {m,n}) /\
       (!k. (0 < num_closure A (pointI k)) /\
          (0 < num_closure B (pointI k)) ==> (k = m) \/ (k = n) ))
    `,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  THM_INTRO_TAC[`E`;`pointI m`] num_closure_size;
  TYPE_THEN `~({C | E C /\ closure top2 C (pointI m)} = EMPTY)` SUBAGOAL_TAC;
  USE 6 SYM;
  FULL_REWRITE_TAC[HAS_SIZE];
  USE 6 (AP_TERM `CARD:(((num->real)->bool)->bool)->num`);
  USE 6 (REWRITE_RULE[CARD_CLAUSES]);
(**** Changed by JRH because of new ARITH_RULE's inability to handle alpha equivs
  UND 6 THEN UND 5 THEN UND 2 THEN ARITH_TAC;
 ****)
  UND 6 THEN UND 5 THEN UND 2 THEN REWRITE_TAC[ARITH_RULE `0 < x ==> (y = x) ==> (0 = y) ==> F`];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  (* - *)
  THM_INTRO_TAC[`E`;`u`;`m`] rectagon_order;
  TYPE_THEN `!n. (0 <| num_closure E (pointI n)) ==> (num_closure E (pointI n) = 2)` SUBAGOAL_TAC ;
  TYPE_THEN `{0,2} (num_closure E (pointI n'))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[INSERT];
  FIRST_ASSUM DISJ_CASES_TAC;
  UND 14 THEN UND 12 THEN ARITH_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  (* -A *)
  TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `num_closure E (pointI m) = 2` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`;`pointI m`] num_closure;
  REWR 14;
  THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI m)}`;`E`] CARD_SUBSET;
  REWRITE_TAC[SUBSET];
  USE 14 SYM ;
  REWR 15;
  UND 15 THEN UND 10 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `!m. (closure top2 (f 0) (pointI m)) /\ (closure top2 (f (CARD E - 1)) (pointI m)) ==> (m = adjv (f 0) (f (CARD E -| 1)))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  adjv_unique;
  FULL_REWRITE_TAC[BIJ;INJ;rectagon;ISUBSET ];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC  ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 10 THEN ARITH_TAC;
  REWRITE_TAC[adj;EMPTY_EXISTS;INTER;];
  CONJ_TAC;
  TYPE_THEN `0 = (CARD E -| 1)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 10 THEN ARITH_TAC;
  UND 22 THEN UND 10 THEN ARITH_TAC;
  TYPE_THEN `pointI m'` EXISTS_TAC;
  (* -B *)
  TYPE_THEN `num_closure E (pointI n) = 2` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`;`pointI n`] num_closure2;
  REWR 15;
  TYPE_THEN `E a /\ closure top2 a (pointI n)` SUBAGOAL_TAC;
  TYPE_THEN `E b /\ closure top2 b (pointI n)` SUBAGOAL_TAC;
  TYPE_THEN `?i. (i < CARD E) /\ (f i = a)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;SURJ];
  TYPE_THEN `a` UNABBREV_TAC;
  TYPE_THEN `?j. (j < CARD E) /\ (f j = b)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;SURJ];
  TYPE_THEN `b` UNABBREV_TAC;
  COPY 8;
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  (* - *)
  TYPE_THEN `adj (f i) (f j)` SUBAGOAL_TAC THEN REWRITE_TAC[adj];
  REWRITE_TAC[INTER;EMPTY_EXISTS ];
  UNIFY_EXISTS_TAC;
  REWR 8;
  (* -C *)
  TYPE_THEN `edge (f i)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon;ISUBSET];
  TYPE_THEN `edge (f j)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon;ISUBSET];
  TYPE_THEN `?k. (k < CARD E -| 1) /\ (n = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `i` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 27 THEN UND 23 THEN ARITH_TAC;
  IMATCH_MP_TAC  adjv_unique;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  UND 28 THEN UND 22 THEN ARITH_TAC;
  IMATCH_MP_TAC  adjv_unique;
  USE 24 (ONCE_REWRITE_RULE[adj_symm]);
  (* -- *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `i` UNABBREV_TAC;
  TYPE_THEN `j` UNABBREV_TAC;
  COPY 13;
  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]);
  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]);
  PROOF_BY_CONTR_TAC;
  UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[];
  TYPE_THEN `i` UNABBREV_TAC;
  TYPE_THEN `j` UNABBREV_TAC;
  COPY 13;
  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]);
  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]);
  PROOF_BY_CONTR_TAC;
  UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[];
  (* - *)
  TYPE_THEN `A = IMAGE f {p | p <| SUC(k)}` ABBREV_TAC ;
  TYPE_THEN `B = IMAGE f {p | SUC(k) <=| p /\ p < CARD E}` ABBREV_TAC ;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  (* -D , now prove properties *)
  KILL 26;
  KILL 25;
  KILL 8;
  KILL 24;
  KILL 23;
  KILL 22;
  KILL 19;
  KILL 20;
  KILL 17;
  KILL 18;
  KILL 15;
  KILL 16;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  order_imp_psegment;
  REWRITE_TAC[ARITH_RULE `0 <| SUC k`];
  (* -- *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon;ISUBSET];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 17 THEN UND 28 THEN ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 18 THEN UND 19 THEN UND 28 THEN ARITH_TAC;
  (* -- *)
  UND 21 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`j`]);
  UND 8 THEN UND 15 THEN UND 28 THEN ARITH_TAC;
  TYPE_THEN `~(j = CARD E -| 1)` SUBAGOAL_TAC;
  UND 18 THEN UND 8 THEN UND 28 THEN ARITH_TAC;
  TYPE_THEN `~(i = CARD E -| 1)` SUBAGOAL_TAC;
  UND 19 THEN UND 15 THEN UND 28 THEN ARITH_TAC;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  IMATCH_MP_TAC  order_imp_psegment_shift;
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon;ISUBSET];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  UND 28 THEN ARITH_TAC;
  (* -- *)
  UND 21 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`j`]);
  TYPE_THEN `~(j = 0)` SUBAGOAL_TAC;
  UND 21 THEN UND 17 THEN ARITH_TAC;
  TYPE_THEN `~(i = 0)` SUBAGOAL_TAC;
  UND 22 THEN UND 19 THEN ARITH_TAC;
  (* -E *)
  SUBCONJ_TAC;
  TYPE_THEN `(IMAGE f {p | p <| CARD E} = E)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  bij_imp_image;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[GSYM IMAGE_UNION];
  TYPE_THEN `cE = CARD E` ABBREV_TAC ;
  UND 16 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UND 28 THEN ARITH_TAC;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  PROOF_BY_CONTR_TAC ;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `u'` UNABBREV_TAC;
  TYPE_THEN `x = x'` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 22 THEN UND 28 THEN ARITH_TAC;
  UND 20 THEN UND 19 THEN UND 22 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC;
  UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
  TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC;
  UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
  (* - finite A ,B *)
  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* -F *)
  TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon;ISUBSET];
  KILL 16;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 11 (REWRITE_RULE[BIJ;SURJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN ARITH_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 11 (REWRITE_RULE[BIJ;SURJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN ARITH_TAC;
  UND 21 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]);
  UND 28 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `0 <| num_closure A (pointI n)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  TYPE_THEN `f k` EXISTS_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  CONJ_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `k` EXISTS_TAC;
  ARITH_TAC;
  IMATCH_MP_TAC  adjv_adj;
  (* - *)
  TYPE_THEN `0 <| num_closure B (pointI n)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  TYPE_THEN `f (SUC k)` EXISTS_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  CONJ_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `SUC k` EXISTS_TAC;
  UND 28 THEN ARITH_TAC;
  IMATCH_MP_TAC  adjv_adj2;
  (* - *)
  TYPE_THEN `0 <| num_closure A (pointI m)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  TYPE_THEN `f 0` EXISTS_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `0` EXISTS_TAC;
  ARITH_TAC;
  (* - *)
  TYPE_THEN `0 <| num_closure B (pointI m)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  KILL 16;
  TYPE_THEN `f (CARD E -| 1)` EXISTS_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `CARD E -| 1` EXISTS_TAC;
  UND 28 THEN ARITH_TAC;
  (* -G *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  has_size2_pair;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  endpoint_size2;
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_subset_endpoint;
  UNIFY_EXISTS_TAC ;
  ASM_REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_subset_endpoint;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `n` UNABBREV_TAC;
  UND 34 THEN UND 27 THEN UND 0 THEN MESON_TAC[];
  (* - *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  has_size2_pair;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  endpoint_size2;
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_subset_endpoint;
  UNIFY_EXISTS_TAC ;
  ASM_REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_subset_endpoint;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `n` UNABBREV_TAC;
  UND 35 THEN UND 27 THEN UND 0 THEN MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`E`;`A`;`k'`] rectagon_subset_endpoint;
  ASM_REWRITE_TAC[SUBSET;UNION];
  REWR 38;
  USE 38 (REWRITE_RULE[INR in_pair]);
  UND 38 THEN MESON_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION S *)
(* ------------------------------------------------------------------ *)

(* 2 - connected *)


(* -------------- MOVE TO TACTICS,  *)
(* proves ineqs of the form a + (&:0)*c <= b.
   This handles ineqs such as a <=: a + &:(SUC n) that
   INT_ARITH_TAC can't do.  *)

let int_le_mp = 
prove_by_refinement(
  `!a b c. (a +: c = b) /\ (&:0 <=: c) ==> (a + (&:0)*c <=: b)`,

  (* {{{ proof *)
  [
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

(* rewrites assumptions as 0 <= A, breaks 0 <= A + B into 2,
   then breaks 0 <= A*B into 2, and tries rewriting and INT_ARITH_TAC *)

let int_le_tac = RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM INT_SUB_LE]) THEN
             IMATCH_MP_TAC  int_le_mp THEN
             CONJ_TAC THENL [TRY INT_ARITH_TAC;ALL_TAC] THEN
             ASM_REWRITE_TAC[INT_POS] THEN
             REPEAT (IMATCH_MP_TAC  INT_LE_ADD THEN CONJ_TAC THEN
             ASM_REWRITE_TAC[INT_POS]) THEN
             REPEAT (IMATCH_MP_TAC  INT_LE_MUL THEN CONJ_TAC THEN
             ASM_REWRITE_TAC[INT_POS]) THEN
             ASM_REWRITE_TAC[INT_POS] THEN
             TRY INT_ARITH_TAC;;


let clean_int_le_tac = FULL_REWRITE_TAC[INT_MUL_LZERO;INT_ADD_RID];;

let test_case_int_le_tac = 
prove_by_refinement(
  `!a b n. a +: &:(SUC n) <= b ==> a <= b`,

  (* {{{ proof *)
  [
  (* INT_ARITH_TAC fails *)
  REP_BASIC_TAC;
  TYPE_THEN `a + (&:0)*((b - (a +: &:(SUC n))) + (&:(SUC n))) <=: b` SUBAGOAL_TAC;
  int_le_tac;
  clean_int_le_tac;
  ]);;
  (* }}} *)




(* -------------- *)

let segment_end = jordan_def `segment_end S a b <=>
   psegment S /\ (endpoint S = {a,b})`;;

let conn = jordan_def `conn E <=> (!a b.
   (cls E a /\ cls E b /\ ~(a = b) ==>
        (?S. (S SUBSET E /\ segment_end S a b))))`;;

let conn2 = jordan_def `conn2 E <=> (FINITE E) /\
   (2 <=| CARD E) /\ (!a b c. cls E a /\ cls E b /\
   ~(a = b) /\ ~(b = c) /\ ~(a = c) ==>
   (?S. (S SUBSET E /\ segment_end S a b /\ ~(cls S c))))`;;

let segment_end_symm = 
prove_by_refinement(
  `!S a b. (segment_end S a b = segment_end S b a)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment_end];
  TYPE_THEN `{a,b} = {b,a}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR in_pair];
  MESON_TAC[];
  ]);;
  (* }}} *)

let segment_end_disj = 
prove_by_refinement(
  `!S a b. segment_end S a b ==> ~(a = b)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment_end];
  THM_INTRO_TAC[`S`] endpoint_size2;
  USE 3 (REWRITE_RULE[has_size2]);
  TYPE_THEN `endpoint S` UNABBREV_TAC;
  USE 1 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  FULL_REWRITE_TAC[INR in_pair];
  COPY 1;
  TSPEC `a'` 4;
  TSPEC `b'` 1;
  REWR 1;
  REWR 4;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let cut_psegment = 
prove_by_refinement(
  `!E a b c. segment_end E a b /\ cls E c /\ ~(c = a) /\ ~(c = b) ==>
    (?A B. (E = (A UNION B)) /\ (A INTER B = EMPTY) /\
     (cls A INTER cls B = {c}) /\
     segment_end A a c /\ segment_end B c b)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `~(a = b)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`;`a`;`b`] segment_end_disj;
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[segment_end];
  FULL_REWRITE_TAC[cls];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  REWRITE_TAC[INR eq_sing;INTER;EQ_EMPTY  ];
  REWRITE_TAC[CONJ_ACI];
  (* - *)
  THM_INTRO_TAC[`E`;`a`;`b`] psegment_order;
  REWRITE_TAC[INR in_pair];
  TYPE_THEN `num_closure E (pointI c) = 2` SUBAGOAL_TAC;
  TYPE_THEN `{0,1,2} (num_closure E (pointI c))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  FULL_REWRITE_TAC[INSERT;DISJ_ACI];
  FIRST_ASSUM DISJ_CASES_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 3 SYM;
  TYPE_THEN `endpoint E c` SUBAGOAL_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `endpoint E` UNABBREV_TAC;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`E`;`pointI c`] num_closure0;
  REWR 15;
  TSPEC `e` 15;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `?k. (k < CARD E -| 1) /\ (c = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`;`pointI c`] num_closure2;
  REWR 13;
  TYPE_THEN `E a' /\ closure top2 a' (pointI c)` SUBAGOAL_TAC;
  TYPE_THEN `?i'.  (i' <| CARD E) /\ ( f i' = a')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;SURJ];
  TYPE_THEN `a'` UNABBREV_TAC;
  TYPE_THEN `E b' /\ closure top2 b' (pointI c)` SUBAGOAL_TAC;
  TYPE_THEN `?j'.  (j' <| CARD E) /\ ( f j' = b')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;SURJ];
  TYPE_THEN `b'` UNABBREV_TAC;
  UND 8 THEN DISCH_THEN (  THM_INTRO_TAC[`i'`;`j'`]);
  USE 8 SYM;
  TYPE_THEN `adj (f i') (f j')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  closure_imp_adj;
  UNIFY_EXISTS_TAC;
  REWR 8;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN  `i'` EXISTS_TAC;
  CONJ_TAC;
  UND 22 THEN UND 21 THEN ARITH_TAC;
  IMATCH_MP_TAC  adjv_unique;
  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
  TYPE_THEN `j'` EXISTS_TAC;
  CONJ_TAC;
  UND 22 THEN UND 18 THEN ARITH_TAC;
  IMATCH_MP_TAC  adjv_unique;
  USE 20 (ONCE_REWRITE_RULE[adj_symm]);
  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
  (* -A *)
  TYPE_THEN `c` UNABBREV_TAC;
  TYPE_THEN `A = IMAGE f { p | p <| SUC k}` ABBREV_TAC ;
  TYPE_THEN `B = IMAGE f { p | SUC k <=| p /\ p < CARD E}` ABBREV_TAC ;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  (* - now prove properties *)
  TYPE_THEN `psegment A` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  order_imp_psegment;
  CONJ_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 18 THEN UND 14 THEN ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 19 THEN UND 20 THEN UND 14 THEN ARITH_TAC;
  CONJ_TAC;
  ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 13 THEN UND 16 THEN UND 14 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `psegment B` SUBAGOAL_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  IMATCH_MP_TAC  order_imp_psegment_shift;
  CONJ_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  UND 14 THEN ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  FULL_REWRITE_TAC[IMAGE];
  TYPE_THEN`x` UNABBREV_TAC;
  TYPE_THEN `x' = x''` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 15 THEN UND 14 THEN ARITH_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  UND 15 THEN UND 20 THEN ARITH_TAC;
  (* -B *)
  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
  (* - *)
  TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[BIJ;SURJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 14 THEN ARITH_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[BIJ;SURJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 14 THEN ARITH_TAC;
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]);
  UND 14 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `(?e. A e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC;
  TYPE_THEN `f k` EXISTS_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  CONJ_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `k` EXISTS_TAC;
  ARITH_TAC;
  IMATCH_MP_TAC  adjv_adj;
  (* - *)
  TYPE_THEN `(?e. B e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC;
  TYPE_THEN `f (SUC k)` EXISTS_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  CONJ_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `SUC k` EXISTS_TAC;
  UND 14 THEN ARITH_TAC;
  IMATCH_MP_TAC  adjv_adj2;
  (* - *)
  TYPE_THEN `IMAGE f {p | p <| CARD E} = E` SUBAGOAL_TAC;
  IMATCH_MP_TAC bij_imp_image;
  (* - *)
  TYPE_THEN `A UNION B = E` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[GSYM IMAGE_UNION];
  TYPE_THEN `cE = CARD E` ABBREV_TAC ;
  UND 27 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t])) THEN AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UND 14 THEN ARITH_TAC;
  (* -C *)
  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  USE 28 SYM;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  USE 28 SYM;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC;
  USE 28 SYM;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;DIFF];
  UND 18 THEN MESON_TAC[];
  (* - *)
  TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC;
  USE 28 SYM;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;DIFF];
  UND 18 THEN MESON_TAC[];
  (* - *)
  TYPE_THEN `endpoint A (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  psegment_subset_endpoint;
  UNIFY_EXISTS_TAC;
  USE 28 (SYM);
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`];
  CONJ_TAC;
  THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
  REWR 34;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
  REWR 34;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `endpoint B (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  psegment_subset_endpoint;
  UNIFY_EXISTS_TAC;
  USE 28 (SYM);
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`];
  CONJ_TAC;
  THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
  REWR 35;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
  REWR 35;
  ASM_MESON_TAC[];
  (* -D *)
  TYPE_THEN `endpoint A a` SUBAGOAL_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `endpoint E a` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  THM_INTRO_TAC[`A`;`E`;`pointI a`] num_closure_mono;
  USE 28 SYM;
  REWRITE_TAC[SUBSET;UNION];
  USE 35 (REWRITE_RULE[endpoint]);
  REWR 36;
  USE 36 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]);
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`A`;`pointI a`] num_closure0;
  REWR 38;
  TSPEC `f 0` 38 ;
  USE 10 SYM;
  UND 38 THEN DISCH_THEN (THM_INTRO_TAC[]);
  TYPE_THEN`A` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `0` EXISTS_TAC;
  ARITH_TAC;
  THM_INTRO_TAC[`E`;`a`] terminal_endpoint;
  REWRITE_TAC[INR in_pair];
  UND 39 THEN ASM_REWRITE_TAC[];
  (* -E *)
  TYPE_THEN `endpoint B b` SUBAGOAL_TAC;
  REWRITE_TAC[endpoint];
  TYPE_THEN `endpoint E b` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  THM_INTRO_TAC[`B`;`E`;`pointI b`] num_closure_mono;
  USE 28 SYM;
  REWRITE_TAC[SUBSET;UNION];
  USE 36 (REWRITE_RULE[endpoint]);
  REWR 37;
  USE 37 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]);
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`B`;`pointI b`] num_closure0;
  REWR 39;
  TSPEC `f (CARD E -| 1)` 39 ;
  UND 39 THEN DISCH_THEN (THM_INTRO_TAC[]);
  TYPE_THEN`B` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `CARD E -| 1` EXISTS_TAC;
  UND 14 THEN ARITH_TAC;
  THM_INTRO_TAC[`E`;`b`] terminal_endpoint;
  REWRITE_TAC[INR in_pair];
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UND 14 THEN ARITH_TAC;
  UND 39 THEN ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `endpoint A = {a, (adjv (f k) (f (SUC k)))}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  has_size2_pair;
  IMATCH_MP_TAC  endpoint_size2;
  TYPE_THEN `endpoint B = {(adjv (f k) (f (SUC k))), b}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  has_size2_pair;
  IMATCH_MP_TAC  endpoint_size2;
  (* - *)
  CONJ_TAC;
  USE 37 SYM;
  TYPE_THEN `endpoint A u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  psegment_subset_endpoint;
  UNIFY_EXISTS_TAC;
  CONJ_TAC;
  USE 28 SYM;
  REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  UNIFY_EXISTS_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  TYPE_THEN `e''''` EXISTS_TAC ;
  USE 38 SYM;
  TYPE_THEN `endpoint B u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  psegment_subset_endpoint;
  UNIFY_EXISTS_TAC;
  CONJ_TAC;
  USE 28 SYM;
  REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  TYPE_THEN `e''''` EXISTS_TAC ;
  IMATCH_MP_TAC  num_closure_pos;
  TYPE_THEN `e'''` EXISTS_TAC ;
  TYPE_THEN `endpoint A` UNABBREV_TAC;
  TYPE_THEN `endpoint B` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR in_pair];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  TYPE_THEN `e'` EXISTS_TAC;
  TYPE_THEN `e''` EXISTS_TAC;
  ]);;
  (* }}} *)

let segment_end_inj = 
prove_by_refinement(
  `!S a b c. (segment_end S a b /\ segment_end S a c) ==> (b = c)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`S`;`a`;`b`] segment_end_disj;
  THM_INTRO_TAC[`S`;`a`;`c`] segment_end_disj;
  FULL_REWRITE_TAC[segment_end];
  TYPE_THEN `endpoint S` UNABBREV_TAC;
  USE 0 (ONCE_REWRITE_RULE  [FUN_EQ_THM]);
  TSPEC `b` 0;
  FULL_REWRITE_TAC[INR in_pair];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_end_finite = 
prove_by_refinement(
  `!S a b. segment_end S a b ==> FINITE S`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment_end;psegment;segment];
  ]);;
  (* }}} *)

let segment_superset_endpoint = 
prove_by_refinement(
  `!E S k. segment E /\ S SUBSET E /\ (endpoint S k) /\
     (num_closure (E DIFF S) (pointI k) = 0) ==>
     (endpoint E k) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[endpoint];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  ASM_SIMP_TAC[num_closure1];
  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  THM_INTRO_TAC[`S`;`pointI k`] num_closure1;
  REWR 6;
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `S e /\ closure top2 e (pointI k)` SUBAGOAL_TAC;
  TYPE_THEN `S e'` ASM_CASES_TAC;
  FULL_REWRITE_TAC[ISUBSET];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`S`;`pointI k`] num_closure0;
  REWR 10;
  FULL_REWRITE_TAC[ARITH_RULE `~(1=0)`];
  TYPE_THEN `~(e = e')` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[];
  USE 0 (REWRITE_RULE[ARITH_RULE `(x = 0) <=> ~(0 <| x)`]);
  UND 0 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  num_closure_pos;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  TYPE_THEN `e'` EXISTS_TAC;
  REWRITE_TAC[DIFF];
  ]);;
  (* }}} *)

let segment_end_union_lemma = 
prove_by_refinement(
  `!A B a b c. segment_end A a b /\ segment_end B b c /\
     (A INTER B = EMPTY) /\ (cls A INTER cls B = {b}) ==>
    segment_end (A UNION B) a c `,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`A`;`a`;`b`] segment_end_disj;
  THM_INTRO_TAC[`B`;`b`;`c`] segment_end_disj;
  FULL_REWRITE_TAC[cls;segment_end];
  TYPE_THEN `segment (A UNION B) /\ (endpoint (A UNION B) = {a,c})  ==> psegment (A UNION B) /\ (endpoint (A UNION B) = {a, c})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  endpoint_psegment;
  TYPE_THEN `a` EXISTS_TAC;
  REWRITE_TAC[INR in_pair];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  segment_union;
  TYPE_THEN `b` EXISTS_TAC;
  REWRITE_TAC[INR in_pair];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  FULL_REWRITE_TAC[INR IN_SING;INTER;];
  TSPEC `n` 0;
  ASM_MESON_TAC[num_closure_elt];
  (* - *)
  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment;segment];
  TYPE_THEN `FINITE (A UNION B)` SUBAGOAL_TAC;
  REWRITE_TAC[FINITE_UNION];
  (* -A *)
  TYPE_THEN `endpoint (A UNION B) a` SUBAGOAL_TAC;
  IMATCH_MP_TAC  segment_superset_endpoint;
  TYPE_THEN `A` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION ];
  REWRITE_TAC[INR in_pair];
  TYPE_THEN `(A UNION B) DIFF A = B` SUBAGOAL_TAC;
  UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
  ASM_SIMP_TAC[num_closure0];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
  TSPEC `a` 0;
  TYPE_THEN `(?e. A e /\ closure top2 e (pointI a))` SUBAGOAL_TAC;
  TYPE_THEN `terminal_edge A a` EXISTS_TAC;
  TYPE_THEN `endpoint A a` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  IMATCH_MP_TAC  terminal_endpoint;
  ASM_MESON_TAC[];
  TYPE_THEN `psegment (A UNION B)` SUBAGOAL_TAC;
  ASM_MESON_TAC[endpoint_psegment];
  IMATCH_MP_TAC  has_size2_pair;
  (* - *)
  TYPE_THEN `endpoint (A UNION B) c` SUBAGOAL_TAC;
  IMATCH_MP_TAC  segment_superset_endpoint;
  TYPE_THEN `B` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION ];
  REWRITE_TAC[INR in_pair];
  TYPE_THEN `(A UNION B) DIFF B = A` SUBAGOAL_TAC;
  UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
  ASM_SIMP_TAC[num_closure0];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
  TSPEC `c` 0;
  TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
  TYPE_THEN `terminal_edge B c` EXISTS_TAC;
  TYPE_THEN `endpoint B c` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  IMATCH_MP_TAC  terminal_endpoint;
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  endpoint_size2;
  (* - *)
  TYPE_THEN`a` UNABBREV_TAC;
  TYPE_THEN `endpoint B c /\ endpoint A c` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
  TSPEC `c` 0;
  TYPE_THEN `(?e. A e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
  TYPE_THEN `terminal_edge A c` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
  TYPE_THEN `terminal_edge B c` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let cls_subset = 
prove_by_refinement(
  `!A B. A SUBSET B ==> cls A SUBSET cls B`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls];
  REWRITE_TAC[SUBSET];
  TYPE_THEN `e` EXISTS_TAC;
  ASM_MESON_TAC[ISUBSET];
  ]);;
  (* }}} *)

let segment_end_union = 
prove_by_refinement(
  `!A B a b c. segment_end A a b /\ segment_end B b c /\
     (cls A INTER cls B = {b}) ==>
    segment_end (A UNION B) a c`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  segment_end_union_lemma;
  TYPE_THEN `b` EXISTS_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER ];
  TYPE_THEN `edge u` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end;psegment;segment;ISUBSET];
  TYPE_THEN `(cls {u} ) HAS_SIZE 2` SUBAGOAL_TAC;
  REWRITE_TAC[cls_edge];
  IMATCH_MP_TAC  two_endpoint;
  FULL_REWRITE_TAC[has_size2];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0 (REWRITE_RULE[INR IN_SING ]);
  COPY 0;
  TSPEC  `a'` 8;
  TSPEC `b'` 0;
  TYPE_THEN `cls {u} a' /\ cls {u} b'` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  KILL 7;
  TYPE_THEN `cls {u} SUBSET cls A` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;INR IN_SING];
  TYPE_THEN `cls {u} SUBSET cls B` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;INR IN_SING];
  FULL_REWRITE_TAC[ISUBSET];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_end_cls = 
prove_by_refinement(
  `!A a b. segment_end A a b ==> cls A a`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls;segment_end];
  TYPE_THEN `terminal_edge A a` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  FULL_REWRITE_TAC[INR in_pair;psegment;segment];
  ]);;
  (* }}} *)

let segment_end_cls2 = 
prove_by_refinement(
  `!A a b. segment_end A a b ==> cls A b`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls;segment_end];
  TYPE_THEN `terminal_edge A b` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  FULL_REWRITE_TAC[INR in_pair;psegment;segment];
  ]);;
  (* }}} *)

let card_subset_lt = 
prove_by_refinement(
  `!(a:A->bool) b. a SUBSET b /\ ~(a = b) /\ FINITE b ==>
          (CARD a < CARD b)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  (ARITH_RULE (`x <=| y /\ ~( x = y) ==> (x < y)`));
  CONJ_TAC;
  IMATCH_MP_TAC  CARD_SUBSET;
  UND 1 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  CARD_SUBSET_EQ;
  ]);;
  (* }}} *)

let segment_end_trans = 
prove_by_refinement(
  `!R S a b c. segment_end R a b /\ segment_end S b c /\ ~(a = c) ==>
     (?U. segment_end U a c /\ (U SUBSET (R UNION S)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN`SS = { (U,V,b') | segment_end U a b' /\ segment_end V b' c /\ (U SUBSET (R UNION S) /\ V SUBSET (R UNION S) ) }` ABBREV_TAC ;
  TYPE_THEN `~(SS = EMPTY)` SUBAGOAL_TAC;
  UND 4 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `(R,S,b)` EXISTS_TAC;
  TYPE_THEN `SS` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "U");
  CONV_TAC (dropq_conv "V");
  TYPE_THEN `b` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `FINITE R` SUBAGOAL_TAC;
  IMATCH_MP_TAC  segment_end_finite;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  segment_end_finite;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `FINITE (R UNION S)` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[FINITE_UNION];
  (* - *)
  TYPE_THEN `f = (\ ((U,V,b):((((num->real)->bool)->bool)#((((num->real)->bool)->bool)#(int#int))) ). (CARD U) + (CARD V))` ABBREV_TAC ;
  THM_INTRO_TAC[`SS`;`f`] select_image_num_min;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `?Um Vm bm. z = (Um,Vm,bm)` SUBAGOAL_TAC ;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `!U' V' b''. (SS (U',V',b'') ==> f (Um,Vm,bm) <=| f (U',V',b''))` SUBAGOAL_TAC;
  KILL 9;
  TYPE_THEN `SS` UNABBREV_TAC;
  KILL 4;
  (* - *)
  USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
  REWR 4;
  TYPE_THEN `U` UNABBREV_TAC;
  USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
  REWR 4;
  TYPE_THEN `V` UNABBREV_TAC;
  TYPE_THEN `b'` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `! U V b'. f (U,V,b') = CARD U +| CARD V` SUBAGOAL_TAC;
  USE 8 SYM;
  GBETA_TAC;
  KILL 8;
  REWR 11;
  KILL 3;
  USE 4 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
  REWR 3;
  USE 3 (CONV_RULE (dropq_conv "U"));
  USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
  REWR 3;
  USE 3 (CONV_RULE (dropq_conv "V"));
  USE 3 (CONV_RULE (dropq_conv "b''"));
  (* - *)
  TYPE_THEN `FINITE Vm` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `FINITE Um` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  (* -A *)
  THM_INTRO_TAC[`S`;`b`;`c`] segment_end_disj;
  THM_INTRO_TAC[`R`;`a`;`b`] segment_end_disj;
  TYPE_THEN `cls Vm a` ASM_CASES_TAC;
  THM_INTRO_TAC[`Vm`;`bm`;`c`;`a`] cut_psegment;
  THM_INTRO_TAC[`Um`;`a`;`bm`] segment_end_disj;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Vm` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `cls Um c` ASM_CASES_TAC;
  THM_INTRO_TAC[`Um`;`a`;`bm`;`c`] cut_psegment;
  THM_INTRO_TAC[`Vm`;`bm`;`c`] segment_end_disj;
  TYPE_THEN `A` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Um` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `Um UNION Vm` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT ` a /\ b ==> b /\ a`);
  SUBCONJ_TAC;
  REWRITE_TAC[union_subset];
  (* - *)
  IMATCH_MP_TAC  segment_end_union;
  TYPE_THEN `bm` EXISTS_TAC;
  REWRITE_TAC[INTER;eq_sing];
  TYPE_THEN `cls Um bm /\ cls Vm bm` SUBAGOAL_TAC;
  ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  (* -B *)
  TYPE_THEN `~(u = a)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `~(u = c)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`Vm`;`bm`;`c`;`u`] cut_psegment;
  THM_INTRO_TAC[`Um`;`a`;`bm`;`u`] cut_psegment;
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`A'`;`B`;`u`]);
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Um` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Vm` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `FINITE A'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `Um` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `Vm` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* -C *)
  USE 34 SYM;
  TYPE_THEN `CARD A' < CARD Um` SUBAGOAL_TAC;
  IMATCH_MP_TAC  card_subset_lt;
  USE 34 SYM;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `B' = EMPTY` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY];
  USE 37(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 37;
  FULL_REWRITE_TAC[];
  ASM_MESON_TAC[];
  TYPE_THEN`B'` UNABBREV_TAC;
  FULL_REWRITE_TAC[segment_end;segment;psegment];
  (* - *)
  USE 29 SYM;
  TYPE_THEN `CARD B < CARD Vm` SUBAGOAL_TAC;
  IMATCH_MP_TAC  card_subset_lt;
  USE 29 SYM;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `A = EMPTY` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY];
  USE 38(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 38;
  FULL_REWRITE_TAC[];
  ASM_MESON_TAC[];
  TYPE_THEN`A` UNABBREV_TAC;
  FULL_REWRITE_TAC[segment_end;segment;psegment];
  (* - *)
  UND 38 THEN UND 37 THEN UND 3 THEN ARITH_TAC;
  ]);;
  (* }}} *)

let cls_union = 
prove_by_refinement(
  `!A B. cls(A UNION B) = cls A UNION cls B`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls;UNION ];
  IMATCH_MP_TAC  EQ_EXT;
  MESON_TAC[];
  ]);;
  (* }}} *)

let conn_union = 
prove_by_refinement(
  `!E E'. conn E /\ conn E' /\ ~(cls E INTER cls E' = EMPTY) ==>
    conn (E UNION E')`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[conn;cls_union];
  RULE_ASSUM_TAC (REWRITE_RULE[UNION]);
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `!E E' a b u. ~(a = b) /\ ~cls E b /\ ~cls E' a /\ cls E a /\ cls E' b /\ (conn E) /\ (conn E') /\ cls E u /\ cls E' u ==> (?S. S SUBSET (E UNION E') /\  segment_end S a b)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn];
  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`u'`]);
  ASM_MESON_TAC [];
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`u'`;`b'`]);
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`S`;`S'`;`a'`;`u'`;`b'`] segment_end_trans;
  TYPE_THEN `U` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `S UNION S'` EXISTS_TAC;
  IMATCH_MP_TAC  subset_union_pair;
  (* - *)
  TYPE_THEN `cls E a /\ cls E b` ASM_CASES_TAC;
  USE 2 (REWRITE_RULE[conn]);
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
  TYPE_THEN `S` EXISTS_TAC;
  UND 10 THEN REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `cls E' a /\ cls E' b` ASM_CASES_TAC;
  USE 1 (REWRITE_RULE[conn]);
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
  TYPE_THEN `S` EXISTS_TAC;
  UND 11 THEN REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `cls E a /\ cls E' b` ASM_CASES_TAC;
  REWR 9;
  REWR 8;
  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E`;`E'`;`a`;`b`;`u`]);
  (* - *)
  TYPE_THEN `cls E' a /\ cls E b` ASM_CASES_TAC;
  REWR 9;
  REWR 8;
  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`E`;`a`;`b`;`u`]);
  TYPE_THEN `S` EXISTS_TAC;
  UND 13 THEN REWRITE_TAC[SUBSET;UNION];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let cls_empty = 
prove_by_refinement(
  `cls EMPTY  = EMPTY `,

  (* {{{ proof *)
  [
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[cls];
  ]);;
  (* }}} *)

let finite_cls = 
prove_by_refinement(
  `!E. FINITE E  ==> (E SUBSET edge ==> FINITE (cls E))`,

  (* {{{ proof *)
  [
  IMATCH_MP_TAC  FINITE_INDUCT_STRONG;
  REWRITE_TAC[cls_empty;FINITE_RULES ];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `cls (E UNION {x})` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[cls_union;FINITE_UNION;];
  (* -- *)
  TYPE_THEN `edge x /\ E SUBSET edge` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INSERT;SUBSET];
  ASM_MESON_TAC[];
  REWRITE_TAC[cls_edge];
  USE 5 (MATCH_MP two_endpoint);
  FULL_REWRITE_TAC[HAS_SIZE];
  (* - *)
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[INSERT;SUBSET;INR IN_SING;UNION ];
  ]);;
  (* }}} *)

let infinite_int = 
prove_by_refinement(
  `INFINITE (UNIV:int->bool)`,

  (* {{{ proof *)
  [
  IMATCH_MP_TAC  infinite_subset;
  TYPE_THEN `IMAGE (&:) UNIV` EXISTS_TAC;
  THM_INTRO_TAC[`(&:)`] INFINITE_IMAGE_INJ;
  ASM_MESON_TAC[INT_OF_NUM_EQ];
  TSPEC  `UNIV:num->bool` 0;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[num_INFINITE];
  ]);;
  (* }}} *)

let infinite_intpair = 
prove_by_refinement(
  `INFINITE (UNIV:int#int->bool)`,

  (* {{{ proof *)
  [
  IMATCH_MP_TAC  infinite_subset;
  TYPE_THEN `IMAGE (\ (i:int) . (i,&:0)) UNIV` EXISTS_TAC;
  THM_INTRO_TAC[`(\ (i:int) . (i,&:0))`] INFINITE_IMAGE_INJ;
  FULL_REWRITE_TAC[PAIR_SPLIT];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[infinite_int];
  ]);;
  (* }}} *)

let not_cls_exists = 
prove_by_refinement(
  `!E. ?c. (FINITE E /\ E SUBSET edge) ==>   ~cls E c`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  RIGHT_TAC "c";
  THM_INTRO_TAC[`E`] finite_cls;
  FULL_REWRITE_TAC[cls];
  TYPE_THEN `INFINITE (UNIV DIFF {m | ?e. E e /\ closure top2 e (pointI m)})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
  REWRITE_TAC[infinite_intpair];
  (* - *)
  USE 3 (MATCH_MP INFINITE_NONEMPTY);
  USE 3 (REWRITE_RULE[EMPTY_EXISTS;DIFF]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let conn2_imp_conn = 
prove_by_refinement(
  `!E. (E SUBSET edge ) /\ conn2 E ==> conn E`,

  (* {{{ proof *)
  [
  REWRITE_TAC[conn;conn2];
  THM_INTRO_TAC[`E`] finite_cls;
  THM_INTRO_TAC[`E`] not_cls_exists;
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let has_size1 = 
prove_by_refinement(
  `!(X:A -> bool). X HAS_SIZE 1 <=> SING X`,

  (* {{{ proof *)
  [
  REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_ANTISYM;
  ASM_REWRITE_TAC[CARD_SING_CONV];
  FULL_REWRITE_TAC[SING];
  REWRITE_TAC[sing_has_size1];
  ]);;
  (* }}} *)

let card_gt_3 = 
prove_by_refinement(
  `!(X:A->bool). FINITE X ==> ( 3 <= CARD X <=>
     (?a b c. X a /\ X b /\ X c /\ ~(a = b) /\ ~(a = c) /\ ~( b = c)))`,

  (* {{{ proof *)
  [
  FULL_REWRITE_TAC[ARITH_RULE `(3 <= x) <=> ~(x = 0) /\ ~(x = 1) /\ ~(x = 2)`];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `~(X HAS_SIZE 0)` SUBAGOAL_TAC;
  ASM_MESON_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[HAS_SIZE_0 ;EMPTY_EXISTS ];
  TYPE_THEN `~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2)` SUBAGOAL_TAC;
  ASM_MESON_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[has_size1 ;SING;has_size2;INR eq_sing ];
  TYPE_THEN `?v. (X v /\ ~(v = u))` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  LEFT 5 "a";
  TSPEC `u` 5;
  LEFT 5 "b";
  TSPEC `v` 5;
  USE 5 (REWRITE_RULE[DE_MORGAN_THM]);
  REWR 5;
  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  LEFT 5 "x";
  FULL_REWRITE_TAC[INR in_pair];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `~(X HAS_SIZE 0) /\ ~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2) ==> ~(CARD X = 0) /\ ~(CARD X = 1) /\ ~(CARD X = 2)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[HAS_SIZE];
  ASM_MESON_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  KILL 7;
  REWRITE_TAC[HAS_SIZE_0;has_size1;SING;EMPTY_EXISTS ];
  CONJ_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR IN_SING];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`X`;`a`;`b`;`c`] two_exclusion;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let card_has_subset = 
prove_by_refinement(
  `!(A:A->bool) n. FINITE A /\ (n <= CARD A) ==>
       (?B. B SUBSET A /\ (B HAS_SIZE n))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `A HAS_SIZE CARD A` SUBAGOAL_TAC;
  REWRITE_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[has_size_bij];
  TYPE_THEN `IMAGE f {m | m <| n}` EXISTS_TAC;
  CONJ_TAC;
  FULL_REWRITE_TAC[IMAGE;SUBSET;BIJ;SURJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 3 THEN UND 0 THEN ARITH_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  IMATCH_MP_TAC  inj_bij;
  FULL_REWRITE_TAC[INJ;BIJ;];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 3 THEN UND 4 THEN UND 0 THEN ARITH_TAC;
  ]);;
  (* }}} *)

let cls_edge_size2 = 
prove_by_refinement(
  `!e. (edge e) ==> (cls {e} HAS_SIZE 2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls_edge];
  IMATCH_MP_TAC  two_endpoint;
  ]);;
  (* }}} *)

let conn2_cls3 = 
prove_by_refinement(
  `!E. (E SUBSET edge) /\ conn2 E ==> (3 <= CARD (cls E))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`] finite_cls;
  FULL_REWRITE_TAC[conn2];
  ASM_SIMP_TAC[card_gt_3];
  FULL_REWRITE_TAC[conn2];
  THM_INTRO_TAC[`E`;`2`] card_has_subset;
  FULL_REWRITE_TAC[has_size2];
  TYPE_THEN `B` UNABBREV_TAC;
  USE 6(REWRITE_RULE[SUBSET;INR in_pair]);
  TYPE_THEN `E b` SUBAGOAL_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `E a` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  USE 2(REWRITE_RULE[SUBSET]);
  TYPE_THEN `edge a /\ edge b` SUBAGOAL_TAC;
  (* - *)
  TYPE_THEN `cls {a} HAS_SIZE 2 /\ cls {b} HAS_SIZE 2` SUBAGOAL_TAC;
  ASM_MESON_TAC[cls_edge_size2];
  FULL_REWRITE_TAC[has_size2];
  USE 12 SYM;
  USE 14 SYM;
  TYPE_THEN `cls {a} SUBSET cls E` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;INR IN_SING];
  TYPE_THEN `cls {b} SUBSET cls E` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;INR IN_SING];
  (* - *)
  TYPE_THEN `cls E a' /\ cls E b' /\ cls E a'' /\ cls E b''` SUBAGOAL_TAC;
  USE 12 GSYM;
  USE 14 SYM;
  REWR 15;
  REWR 16;
  FULL_REWRITE_TAC[SUBSET;INR in_pair];
  ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN `a'` EXISTS_TAC;
  TYPE_THEN `b'` EXISTS_TAC;
  (* - *)
  TYPE_THEN `~(cls {a} = cls {b})` SUBAGOAL_TAC;
  THM_INTRO_TAC[`a`;`b`] cls_inj;
  ASM_MESON_TAC[];
  USE 14 SYM;
  TYPE_THEN `cls {b} a''` ASM_CASES_TAC;
  REWR 22;
  FULL_REWRITE_TAC[INR in_pair ];
  TYPE_THEN `b''` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `b''` UNABBREV_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `a''` UNABBREV_TAC;
  TYPE_THEN `cls {b}` UNABBREV_TAC;
  TYPE_THEN `cls {a}` UNABBREV_TAC;
  UND 21 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INSERT];
  MESON_TAC[];
  TYPE_THEN `a''` UNABBREV_TAC;
  (* -- *)
  TYPE_THEN `b''` UNABBREV_TAC;
  FIRST_ASSUM DISJ_CASES_TAC  ;
  TYPE_THEN `a''` UNABBREV_TAC;
  TYPE_THEN `a''` UNABBREV_TAC;
  TYPE_THEN `cls {b}` UNABBREV_TAC;
  TYPE_THEN `cls {a}` UNABBREV_TAC;
  (* -B *)
  TYPE_THEN `a''` EXISTS_TAC;
  REWR 22;
  FULL_REWRITE_TAC[INR in_pair];
  UND 22 THEN MESON_TAC[];
  ]);;
  (* }}} *)

let has_size2_subset_ne = 
prove_by_refinement(
  `!X (a:A) b. X HAS_SIZE 2 /\ {a,b} SUBSET X /\ ~(a = b) ==>
           (X = {a,b})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  IMATCH_MP_TAC  CARD_SUBSET_EQ;
  THM_INTRO_TAC[`a`;`b`] pair_size_2;
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[HAS_SIZE];
  ]);;
  (* }}} *)

let segment_end_sing = 
prove_by_refinement(
  `!a b e. closure top2 e (pointI a) /\ closure top2 e (pointI b) /\
     ~(a = b) /\ (edge e) ==> segment_end {e} a b`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment_end];
  CONJ_TAC ;
  IMATCH_MP_TAC  psegment_edge;
  (* - *)
  IMATCH_MP_TAC has_size2_subset_ne;
  CONJ_TAC;
  IMATCH_MP_TAC  endpoint_size2;
  IMATCH_MP_TAC  psegment_edge;
  (* - *)
  REWRITE_TAC[endpoint;SUBSET];
  FULL_REWRITE_TAC[INR in_pair];
  THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
  REWRITE_TAC[FINITE_SING];
  KILL 5;
  TYPE_THEN `e` EXISTS_TAC;
  REWRITE_TAC[INR IN_SING];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let conn2_no1 = 
prove_by_refinement(
  `!E. (E SUBSET edge) /\ conn2 E ==>
         (!m. ~(num_closure E (pointI m) = 1))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
    TYPE_THEN `FINITE E` SUBAGOAL_TAC ;
  FULL_REWRITE_TAC[conn2];
  TYPE_THEN `?e. E e /\ closure top2 e (pointI m)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`;`pointI m`] num_closure1;
  REWR 4;
  MESON_TAC[];
  THM_INTRO_TAC[`e`] cls_edge_size2;
  ASM_MESON_TAC[ISUBSET];
  TYPE_THEN `?n. closure top2 e (pointI n) /\ ~(n = m)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[has_size2];
  USE 7 SYM;
  TYPE_THEN `cls {e} m` SUBAGOAL_TAC;
  REWRITE_TAC[cls;INR IN_SING ];
  ASM_MESON_TAC[];
  USE 7 SYM;
  REWR 8;
  FULL_REWRITE_TAC[INR in_pair];
  FIRST_ASSUM DISJ_CASES_TAC ;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `cls{e} a` SUBAGOAL_TAC;
  REWRITE_TAC[INSERT];
  FULL_REWRITE_TAC[cls;INR IN_SING ];
  ASM_MESON_TAC[];
  TYPE_THEN `b` EXISTS_TAC;
  TYPE_THEN `cls{e} b` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INR in_pair;cls; INR IN_SING];
  FULL_REWRITE_TAC[cls;INR IN_SING];
  ASM_MESON_TAC[];
  TYPE_THEN `edge e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  (* -A *)
  TYPE_THEN`?c. cls E c /\ ~(c = m) /\ ~(c = n)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`] conn2_cls3;
  THM_INTRO_TAC[`E`] finite_cls;
  THM_INTRO_TAC[`cls E`] card_gt_3;
  REWR 12;
  TYPE_THEN `~(a = m) /\ ~(a = n)` ASM_CASES_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `~(b = m) /\ ~(b = n)` ASM_CASES_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  TYPE_THEN `~(c = m) /\ ~(c = n)` ASM_CASES_TAC;
  TYPE_THEN `c` EXISTS_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[conn2];
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`c`;`n`]);
  REWRITE_TAC[cls];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `cls {e} n` SUBAGOAL_TAC;
  REWRITE_TAC[cls;INR IN_SING ];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `~S e` SUBAGOAL_TAC;
  TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;INR IN_SING];
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`S`;`m`] terminal_endpoint;
  FULL_REWRITE_TAC[segment_end];
  FULL_REWRITE_TAC[psegment;segment;INR in_pair];
  THM_INTRO_TAC[`E`;`pointI m`] num_closure1;
  REWR 21;
  COPY 21;
  TSPEC  `e` 21;
  TYPE_THEN `e = e'` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  TSPEC  `(terminal_edge S m)` 22;
  REWR 22;
  USE 22 SYM;
  TYPE_THEN `E (terminal_edge S m)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[ISUBSET];
  REWR 22;
  TYPE_THEN `e` UNABBREV_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let conn2_union = 
prove_by_refinement(
  `!A B. (A SUBSET edge) /\ (B SUBSET edge) /\ (conn2 A) /\ (conn2 B) /\
    (?a b. ~(a = b) /\ ({a,b} SUBSET (cls A INTER cls B))) ==>
    (conn2 (A UNION B))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[conn2];
  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  SUBCONJ_TAC;
  REWRITE_TAC[FINITE_UNION];
  (* - *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  LE_TRANS;
  TYPE_THEN `CARD A` EXISTS_TAC;
  FULL_REWRITE_TAC[conn2];
  IMATCH_MP_TAC  CARD_SUBSET;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `cls A a' /\ cls A b'` ASM_CASES_TAC;
  FULL_REWRITE_TAC[conn2];
  UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]);
  TYPE_THEN`S` EXISTS_TAC;
  UND 22 THEN REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `cls B a' /\ cls B b'` ASM_CASES_TAC;
  FULL_REWRITE_TAC[conn2];
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]);
  TYPE_THEN`S` EXISTS_TAC;
  UND 23 THEN REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `?d. cls A d /\ cls B d /\ ~(c = d)` SUBAGOAL_TAC;
  TYPE_THEN `c = a` ASM_CASES_TAC;
  TYPE_THEN `c` UNABBREV_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair];
  ASM_MESON_TAC[];
  TYPE_THEN `a` EXISTS_TAC;
  FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair];
  ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN `!m n. cls A m /\ ~cls B m /\ ~cls A n /\ cls B n /\ ~(m = n) /\ ~(m = c) /\ ~(n = c) ==> (?S. S SUBSET A UNION B /\ segment_end S m n /\ ~cls S c)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  UND 28 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`d`;`c`]);
  REWRITE_TAC[];
  TYPE_THEN `m` UNABBREV_TAC;
  ASM_MESON_TAC[];
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`d`;`n`;`c`]);
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`S`;`S'`;`m`;`d`;`n`] segment_end_trans;
  TYPE_THEN `U` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `S UNION S'` EXISTS_TAC ;
  IMATCH_MP_TAC  subset_union_pair;
  TYPE_THEN `cls U SUBSET cls (S UNION S')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  FULL_REWRITE_TAC[cls_union ];
  FULL_REWRITE_TAC[ISUBSET];
  TSPEC `c` 38;
  USE 37 (REWRITE_RULE[UNION]);
  ASM_MESON_TAC[];
  (* -B *)
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  FULL_REWRITE_TAC[cls_union ];
  USE 12(REWRITE_RULE[UNION]);
  USE 13 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  REWR 15;
  REWR 12;
  REWR 16;
  UND 20 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`]);
  (* - *)
  REWR 16;
  REWR 12;
  REWR 15;
  UND 20 THEN DISCH_THEN  (THM_INTRO_TAC[`b'`;`a'`]);
  TYPE_THEN `S` EXISTS_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  ]);;
  (* }}} *)

let cut_rectagon_cls = 
prove_by_refinement(
  `!E m n. rectagon E /\ ~(m = n) /\ cls E m /\ cls E n ==>
    (?A B. segment_end A m n /\ segment_end B m n /\
        (E = A UNION B) /\ (A INTER B = EMPTY) /\
         (cls A INTER cls B = {m,n}))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[segment_end;cls;];
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon;segment;psegment];
  THM_INTRO_TAC[`E`;`m`;`n`] cut_rectagon;
  CONJ_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  num_closure_pos;
  ASM_MESON_TAC[];
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR in_pair];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  (TAUT `a \/ b ==> b \/ a`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  ASM_MESON_TAC[psegment;segment];
  IMATCH_MP_TAC  num_closure_pos;
  ASM_MESON_TAC[psegment;segment];
  (* - *)
  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `endpoint A m /\ endpoint A n /\ endpoint B m /\ endpoint B n` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  CONJ_TAC;
  TYPE_THEN  `terminal_edge A n` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  TYPE_THEN  `terminal_edge B n` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  CONJ_TAC;
  TYPE_THEN  `terminal_edge A m` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  TYPE_THEN  `terminal_edge B m` EXISTS_TAC;
  IMATCH_MP_TAC  terminal_endpoint;
  ]);;
  (* }}} *)

let conn2_rectagon = 
prove_by_refinement(
  `!E. rectagon E ==> conn2 E`,

  (* {{{ proof *)
  [
  FULL_REWRITE_TAC[conn2];
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[rectagon];
  SUBCONJ_TAC;
  THM_INTRO_TAC[`E`] rectagon_h_edge;
  THM_INTRO_TAC[`E`] rectagon_v_edge;
  TYPE_THEN `~(h_edge m = v_edge m')` SUBAGOAL_TAC;
  ASM_MESON_TAC[hv_edgeV2];
  TYPE_THEN `CARD {(h_edge m),(v_edge m')} <= CARD E` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET;
  REWRITE_TAC[SUBSET;INR in_pair];
  ASM_MESON_TAC[];
  TYPE_THEN `{(h_edge m),(v_edge m')} HAS_SIZE 2` SUBAGOAL_TAC;
  IMATCH_MP_TAC  pair_size_2;
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[HAS_SIZE];
  REWR 5;
  (* - *)
  THM_INTRO_TAC[`E`;`a`;`b`] cut_rectagon_cls;
  TYPE_THEN `~cls A c` ASM_CASES_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  REWR 13;
  (* - *)
  TYPE_THEN `~cls B c ` SUBAGOAL_TAC;
  USE 8 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `c` 8;
  FULL_REWRITE_TAC[INTER;INR in_pair];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `B` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  ]);;
  (* }}} *)

let rectangle_grid = jordan_def
  `rectangle_grid p q = { e |
     (?m. (e = h_edge m) /\ FST p <= FST m /\ (FST m +: &:1 <=: FST q) /\
                          SND p <= SND m /\ SND m <=: SND q) \/
     (?m. (e = v_edge m) /\ FST p <= FST m /\ FST m <= FST q /\
                          SND p <= SND m /\ SND m +: &:1 <=: SND q) }`;;

let rectangle_grid_h = 
prove_by_refinement(
  `!p q m. rectangle_grid p q (h_edge m) <=>
        (FST p <=: FST m) /\ (FST m +: &:1 <=: FST q) /\
        (SND p <=: SND m) /\ (SND m <=: SND q)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectangle_grid];
  REWRITE_TAC[cell_clauses;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let rectangle_grid_v = 
prove_by_refinement(
  `!p q m. rectangle_grid p q (v_edge m) <=>
        (FST p <= FST m /\ FST m <= FST q /\
                 SND p <= SND m /\ SND m +: &:1 <=: SND q)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectangle_grid];
  REWRITE_TAC[cell_clauses;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let rectangle_grid_edge = 
prove_by_refinement(
  `!p q. rectangle_grid p q SUBSET edge`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;rectangle_grid;edge];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let rectangle_grid_sq = 
prove_by_refinement(
  `!p.  (rectangle_grid p (FST p +: &:1, SND p +: &:1)) =
         {(h_edge p), (h_edge (up p)), (v_edge p), (v_edge (right  p))}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `E = rectangle_grid p (FST p +: &:1, SND p +: &:1)` ABBREV_TAC ;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INSERT];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `edge x` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
  (* - *)
  FULL_REWRITE_TAC[edge];
  FIRST_ASSUM DISJ_CASES_TAC ;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_v;PAIR_SPLIT];
  REWRITE_TAC[cell_clauses];
  REWRITE_TAC[PAIR_SPLIT;right ];
  UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_h;PAIR_SPLIT];
  REWRITE_TAC[cell_clauses];
  REWRITE_TAC[PAIR_SPLIT;up ];
  UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
  (* - *)
  TYPE_THEN `E` UNABBREV_TAC;
  UND 1 THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[rectangle_grid_v;rectangle_grid_h;up;right ;] THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let rectangle_grid_sq_cls = 
prove_by_refinement(
  `!p. cls (rectangle_grid p (FST p +: &:1, SND p +: &:1)) =
     {(p),(right  p),(up p),  (up (right  p))}`,

  (* {{{ proof *)

  [
  REWRITE_TAC[cls];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[rectangle_grid_sq];
  REWRITE_TAC[INSERT];
  IMATCH_MP_TAC  EQ_ANTISYM;
  (* - *)
  CONJ_TAC;
  FULL_REWRITE_TAC[right ;up;];
  UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `e` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;] THEN ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[right ;up;];
  TYPE_THEN `closure top2 (h_edge p) (pointI x) \/ closure top2 (h_edge (FST p,SND p +: &:1)) (pointI x)` SUBAGOAL_TAC;
  UND 0 THEN REP_CASES_TAC THEN (TYPE_THEN`x` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;];
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_end_union_rectagon = 
prove_by_refinement(
  `!A B m p. segment_end A m p /\ segment_end B m p /\
       (A INTER B = EMPTY) /\ (cls A INTER cls B = {m,p}) ==>
       (rectagon (A UNION B))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`A`;`m`;`p`] segment_end_disj;
  IMATCH_MP_TAC  segment_union2;
  TYPE_THEN `m` EXISTS_TAC;
  TYPE_THEN `p` EXISTS_TAC;
  FULL_REWRITE_TAC[segment_end;INR in_pair];
  REWRITE_TAC[INR in_pair];
  FULL_REWRITE_TAC[psegment];
  REP_BASIC_TAC;
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `n` 0;
  USE 0 (REWRITE_RULE[INR in_pair;INTER;cls]);
  IMATCH_MP_TAC  (TAUT `a \/ b ==> b \/ a`);
  USE 0 SYM;
  CONJ_TAC;
  USE 10 (MATCH_MP num_closure_elt);
  ASM_MESON_TAC[];
  USE 9 (MATCH_MP num_closure_elt);
  ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  TYPE_THEN `endpoint B m /\ endpoint B p /\ endpoint A m /\ endpoint A p` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  CONJ_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`A`;`m`] terminal_endpoint;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`A`;`p`] terminal_endpoint;
  ASM_MESON_TAC[];
    IMATCH_MP_TAC  num_closure_pos;
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`B`;`m`] terminal_endpoint;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`B`;`p`] terminal_endpoint;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let cls_h = 
prove_by_refinement(
  `!m. (cls {(h_edge m)} = {m, (right  m)})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR in_pair;INR IN_SING;];
  CONV_TAC (dropq_conv "e");
  REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right  ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let cls_v = 
prove_by_refinement(
  `!m. (cls {(v_edge m)} = {m, (up  m)})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cls];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR in_pair;INR IN_SING;];
  CONV_TAC (dropq_conv "e");
  REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right  ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let rectagon_rectangle_grid_sq = 
prove_by_refinement(
  `!p. rectagon ((rectangle_grid p (FST p +: &:1, SND p +: &:1)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `E = rectagon (rectangle_grid p (FST p +: &:1,SND p +: &:1))` ABBREV_TAC ;
  TYPE_THEN `segment_end {(h_edge p)} p (right  p) /\ segment_end {(v_edge p)} p (up p) /\ segment_end { (h_edge (up p)) } (up p) (right  (up p)) /\ segment_end {(v_edge (right  p))} (right  p) (right  (up p))` SUBAGOAL_TAC;
  (REPEAT CONJ_TAC) THEN IMATCH_MP_TAC  segment_end_sing THEN REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right  ;up; vc_edge;hc_edge; UNION ;plus_e12; INR IN_SING; PAIR_SPLIT ] THEN INT_ARITH_TAC ;
  (* - *)
  THM_INTRO_TAC[`{(h_edge p)}`;`{(v_edge (right  p))}`;`p`;`right  p`;`right  (up p)`] segment_end_union;
  THM_INTRO_TAC[`p`] cls_h;
  THM_INTRO_TAC[`right  p`] cls_v;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING;];
  REWRITE_TAC[INR in_pair;right  ;up; PAIR_SPLIT ];
  INT_ARITH_TAC;
  (* - *)
  THM_INTRO_TAC[`{(v_edge p)}`;`{(h_edge (up p))}`;`p`;`up p`;`right  (up p)`] segment_end_union;
  THM_INTRO_TAC[`p`] cls_v;
  THM_INTRO_TAC[`up  p`] cls_h;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR IN_SING;];
  REWRITE_TAC[INR in_pair;right  ;up; PAIR_SPLIT ];
  INT_ARITH_TAC;
  (* - *)
  THM_INTRO_TAC[`{(v_edge p)} UNION {(h_edge (up p))}`;`{(h_edge p)} UNION {(v_edge (right p))}`;`p`;`right  (up p)`] segment_end_union_rectagon;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 7(REWRITE_RULE[INTER;UNION;INR IN_SING]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses;up;PAIR_SPLIT ];
  UND 8 THEN INT_ARITH_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses;up; right  ;PAIR_SPLIT ];
  UND 8 THEN INT_ARITH_TAC;
  REWRITE_TAC[cls_h;cls_v;cls_union];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[up; right ; INTER; UNION;];
  REWRITE_TAC[INR in_pair];
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `FST x = FST p` ASM_CASES_TAC;
  REWRITE_TAC[INT_ARITH `~(FST p = FST p +: &:1)`];
  INT_ARITH_TAC;
  INT_ARITH_TAC;
  (* - *)
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `{(h_edge p), (h_edge (up p)), (v_edge p),( v_edge (right p))} = (({(v_edge p)} UNION {(h_edge (up p))}) UNION {(h_edge p)} UNION  {(v_edge (right p))})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  REWRITE_TAC[INR IN_SING];
  REWRITE_TAC[INSERT];
  MESON_TAC[];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let conn2_union_edge = 
prove_by_refinement(
  `!A B. A SUBSET edge /\ B SUBSET edge /\ conn2 A /\ conn2 B /\
    (~(A INTER B = EMPTY)) ==> conn2 (A UNION B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  conn2_union;
  USE 0 (REWRITE_RULE [EMPTY_EXISTS;INTER;]);
  TYPE_THEN `edge u` SUBAGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  USE 6 (MATCH_MP cls_edge_size2);
  FULL_REWRITE_TAC[has_size2];
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  USE 7 SYM;
  REWRITE_TAC[SUBSET_INTER];
  CONJ_TAC;
  IMATCH_MP_TAC  cls_subset;
  ASM_REWRITE_TAC[SUBSET;INR IN_SING];
  IMATCH_MP_TAC  cls_subset;
  ASM_REWRITE_TAC[SUBSET;INR IN_SING];
  ]);;
  (* }}} *)

let rectangle_grid_h_conn2 = 
prove_by_refinement(
  `!n p. conn2 (rectangle_grid p (FST p +: &:(SUC n), SND p +: &:1))`,

  (* {{{ proof *)
  [
  INDUCT_TAC;
  REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ;
  IMATCH_MP_TAC  conn2_rectagon;
  REWRITE_TAC[rectagon_rectangle_grid_sq];
  (* - *)
  TYPE_THEN `rectangle_grid p (FST p +: &:(SUC (SUC n)),SND p +: &:1) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:1) UNION rectangle_grid (FST p +: &:(SUC n),SND p) (FST p +: &:(SUC (SUC n)),SND p +: &:1)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `edge x` SUBAGOAL_TAC;
  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
  FULL_REWRITE_TAC [edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_v];
  UND 4 THEN UND 5 THEN INT_ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_h];
  UND 4 THEN UND 5 THEN INT_ARITH_TAC;
  (* -- *)
  TYPE_THEN `edge x` SUBAGOAL_TAC;
  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
  FULL_REWRITE_TAC [edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_v];
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
  UND 5 THEN INT_ARITH_TAC;
  TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC;
  int_le_tac;
  clean_int_le_tac;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_h];
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
  UND 5 THEN INT_ARITH_TAC;
  TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC;
  int_le_tac;
  clean_int_le_tac;
  (* -A *)
  IMATCH_MP_TAC  conn2_union_edge;
  REWRITE_TAC[rectangle_grid_edge];
  CONJ_TAC;
  IMATCH_MP_TAC  conn2_rectagon;
  THM_INTRO_TAC[`FST p +: &:(SUC n),SND p`] rectagon_rectangle_grid_sq;
  TYPE_THEN `(FST p +: &:(SUC (SUC n)),SND p +: &:1) = (FST (FST p +: &:(SUC n),SND p) +: &:1, SND (FST p +: &:(SUC n),SND p) +: &:1)` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT;GSYM INT_OF_NUM_SUC];
  INT_ARITH_TAC;
  REWR 2;
  UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;];
  TYPE_THEN `v_edge (FST p +: &:(SUC n),SND p)` EXISTS_TAC;
  REWRITE_TAC[rectangle_grid_v];
  REPEAT CONJ_TAC THEN (TRY INT_ARITH_TAC);
  TYPE_THEN `FST p + (&:0)*(&:(SUC n)) <=: FST p + &: (SUC n)` SUBAGOAL_TAC;
  int_le_tac;
  clean_int_le_tac;
  REWRITE_TAC[GSYM INT_OF_NUM_SUC];
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let rectangle_grid_conn2 = 
prove_by_refinement(
  `!m n p. conn2
        (rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)))`,

  (* {{{ proof *)
  [
  INDUCT_TAC;
  REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ;
  REWRITE_TAC[rectangle_grid_h_conn2];
  (* - *)
  TYPE_THEN `rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)) UNION rectangle_grid (FST p ,SND p + &:(SUC m)) (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m)))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `edge x` SUBAGOAL_TAC;
  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
  FULL_REWRITE_TAC [edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_v];
  UND 1 THEN UND 3 THEN INT_ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_h];
  UND 1 THEN UND 3 THEN INT_ARITH_TAC;
  (* -- *)
  TYPE_THEN `edge x` SUBAGOAL_TAC;
  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
  FULL_REWRITE_TAC [edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_v];
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
  UND 3 THEN INT_ARITH_TAC;
  TYPE_THEN `(SND p +: (&:0)*((SND  m' - (SND  p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC;
  int_le_tac;
  clean_int_le_tac;
  (* -- *)
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[rectangle_grid_h];
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
  UND 3 THEN INT_ARITH_TAC;
  TYPE_THEN `(SND  p +: (&:0)*((SND  m' - (SND  p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC;
  int_le_tac;
  clean_int_le_tac;
  (* -A *)
  IMATCH_MP_TAC  conn2_union_edge;
  REWRITE_TAC[rectangle_grid_edge];
  CONJ_TAC;
  THM_INTRO_TAC[`n`;`(FST p,SND p +: &:(SUC m))` ] rectangle_grid_h_conn2;
  TYPE_THEN `(FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = (FST (FST p,SND p +: &:(SUC m)) +: &:(SUC n), SND (FST p,SND p +: &:(SUC m)) +: &:1)` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM INT_OF_NUM_SUC;PAIR_SPLIT ];
  INT_ARITH_TAC;
  REWR 2;
  (* - // *)
  UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;];
  TYPE_THEN `h_edge (FST p ,SND p + &:(SUC m))` EXISTS_TAC;
  REWRITE_TAC[rectangle_grid_h];
  REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC  INT_LE_LADD_IMP)) THEN (REWRITE_TAC[INT_OF_NUM_LE;INT_LE_ADDR ]) THEN (TRY INT_ARITH_TAC) THEN (TRY ARITH_TAC);
  ]);;
  (* }}} *)

let conn2_has_rectagon = 
prove_by_refinement(
  `!E. (E SUBSET edge) /\ (conn2 E) ==> (?B. (B SUBSET E) /\ rectagon B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?e. E e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  THM_INTRO_TAC[`E`;`1`] card_has_subset;
  UND 2 THEN ARITH_TAC;
  FULL_REWRITE_TAC[has_size1;SING ];
  TYPE_THEN `B` UNABBREV_TAC;
  FULL_REWRITE_TAC[SUBSET;INR IN_SING];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `edge e` SUBAGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  USE 3 (MATCH_MP cls_edge_size2);
  FULL_REWRITE_TAC[has_size2];
  (* - *)
  TYPE_THEN `2 <=| num_closure E (pointI a)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `~(x = 0) /\ ~(x = 1) ==> 2 <= x`);
  CONJ_TAC;
  THM_INTRO_TAC[`E`;`pointI a`] num_closure0;
  FULL_REWRITE_TAC[conn2];
  REWR 6;
  TYPE_THEN `cls {e} a` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  FULL_REWRITE_TAC[cls;INR IN_SING ];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[conn2_no1];
  FULL_REWRITE_TAC[num_closure];
  THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI a)}`;`2`] card_has_subset;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  FULL_REWRITE_TAC[conn2];
  REWRITE_TAC[SUBSET];
  FULL_REWRITE_TAC[has_size2];
  TYPE_THEN `B` UNABBREV_TAC;
  USE 7(REWRITE_RULE[SUBSET;INR in_pair ]);
  (* - *)
  TYPE_THEN `?e' . (E e' /\ closure top2 e' (pointI a) /\ ~(e = e'))` SUBAGOAL_TAC;
  TYPE_THEN `e = a'` ASM_CASES_TAC;
  TYPE_THEN `b'` EXISTS_TAC;
  TYPE_THEN `a'` UNABBREV_TAC;
  TSPEC `b'` 7;
  ASM_MESON_TAC[];
  TYPE_THEN `a'` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN`?c. (cls {e'} = {a,c}) /\ ~(c = a) ` SUBAGOAL_TAC;
  TYPE_THEN `edge e'` SUBAGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  USE 11 (MATCH_MP cls_edge_size2);
  FULL_REWRITE_TAC[has_size2];
  USE 12 SYM;
  TYPE_THEN `cls{e'} a` SUBAGOAL_TAC;
  REWRITE_TAC[cls;INR IN_SING ];
  ASM_MESON_TAC[];
  TYPE_THEN `cls {e'}` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR in_pair];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `b''` UNABBREV_TAC;
  TYPE_THEN `a''` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR in_pair];
  MESON_TAC[];
  TYPE_THEN `a''` UNABBREV_TAC;
  TYPE_THEN `b''` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* -B *)
  TYPE_THEN `~(c = b)` SUBAGOAL_TAC;
  TYPE_THEN`c` UNABBREV_TAC;
  TYPE_THEN `cls{e} = cls{e'}` SUBAGOAL_TAC;
  ASM_MESON_TAC[cls_inj;ISUBSET];
  (* - *)
  TYPE_THEN `?S. S SUBSET E /\ segment_end S b c /\ ~cls S a` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `cls {e} b /\ cls {e'} c` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  USE 12 SYM;
  USE 4 SYM;
  TYPE_THEN `cls {e} SUBSET cls E /\ cls {e'} SUBSET cls E` SUBAGOAL_TAC;
  CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
  ASM_MESON_TAC[ISUBSET];
  (* -C *)
  THM_INTRO_TAC[`b`;`a`;`e`] segment_end_sing;
  TYPE_THEN `cls {e} a /\ cls {e} b` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  FULL_REWRITE_TAC[cls;INR IN_SING ];
  ASM_MESON_TAC[ISUBSET];
  THM_INTRO_TAC[`a`;`c`;`e'`] segment_end_sing;
  TYPE_THEN `cls {e'} a /\ cls {e'} c` SUBAGOAL_TAC;
  REWRITE_TAC[INR in_pair];
  FULL_REWRITE_TAC[cls;INR IN_SING ];
  ASM_MESON_TAC[ISUBSET];
  (* - *)
  THM_INTRO_TAC[`{e}`;`{e'}`;`b`;`a`;`c`] segment_end_union;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR in_pair;INR IN_SING];
  ASM_MESON_TAC[];
  (* -D *)
  THM_INTRO_TAC[`S`;`{e} UNION {e'}`;`b`;`c`] segment_end_union_rectagon;
  REWRITE_TAC[cls_union; UNION_OVER_INTER; EMPTY_UNION; ];
  CONJ_TAC;
  REWRITE_TAC[EQ_EMPTY;INTER ;INR IN_SING ];
  CONJ_TAC ;
  TYPE_THEN `x` UNABBREV_TAC;
  USE 4 SYM;
  TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  ASM_MESON_TAC[ISUBSET;INR IN_SING];
  USE 20 (REWRITE_RULE[SUBSET]);
  TSPEC `a` 20;
  TYPE_THEN `cls {e}` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR in_pair];
  ASM_MESON_TAC[];
  USE 12 SYM;
  TYPE_THEN `cls {e'} SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  ASM_MESON_TAC[ISUBSET;INR IN_SING];
  USE 22 (REWRITE_RULE[SUBSET]);
  TSPEC `a` 22;
  TYPE_THEN `cls {e'}` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR in_pair];
  ASM_MESON_TAC[];
  (* --E *)
  REWRITE_TAC[GSYM UNION_OVER_INTER];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair];
  TYPE_THEN `((x = c) \/ (x = b)) \/ (x = a)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair];
  TYPE_THEN `cls S b /\ cls S c` SUBAGOAL_TAC;
  ASM_MESON_TAC[segment_end_cls2;segment_end_cls];
  ASM_MESON_TAC[];
  TYPE_THEN `(S UNION {e} UNION {e'})` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  REWRITE_TAC[SUBSET;INR IN_SING];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION T *)
(* ------------------------------------------------------------------ *)


(* 1.0.6 rectagon components *)

(* redo some results from E that USE the segment hypothesis *)

let curve_cell_h_ver2 = 
prove_by_refinement(
  `!G n.  (curve_cell G (h_edge n) = G (h_edge n))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI];
  ]);;
  (* }}} *)

let curve_cell_v_ver2 = 
prove_by_refinement(
  `!G n. (curve_cell G (v_edge n) = G (v_edge n))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI];
  ]);;
  (* }}} *)

let curve_closure_ver2 = 
prove_by_refinement(
  `!G. (FINITE  G) /\ (G SUBSET edge)  ==>
    (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC top2_top;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  ASM_SIMP_TAC[closure_unions];
  REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ];
  TYPE_THEN `edge x'` SUBGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  FULL_REWRITE_TAC [edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `t` UNABBREV_TAC;
  FULL_REWRITE_TAC [v_edge_closure;vc_edge;UNION ;INR IN_SING ];
  UND 3 THEN   REP_CASES_TAC;
  TYPE_THEN `v_edge m` EXISTS_TAC;
  ASM_SIMP_TAC [curve_cell_v_ver2];
  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
  (* ---- *)
  ASM_SIMP_TAC [curve_cell_point];
  REWRITE_TAC[INR IN_SING];
  UNIFY_EXISTS_TAC;
  REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ];
  TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC;
  ASM_SIMP_TAC [curve_cell_point];
  REWRITE_TAC[INR IN_SING;plus_e12];
  TYPE_THEN `v_edge m` EXISTS_TAC;
  REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ];
  (* dt2 , down to 2 goals *)
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `t` UNABBREV_TAC;
  FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING];
  UND 3 THEN REP_CASES_TAC;
  TYPE_THEN `h_edge m` EXISTS_TAC;
  ASM_SIMP_TAC[curve_cell_h_ver2];
  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
  TYPE_THEN `h_edge m` EXISTS_TAC;
  FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING];
  TYPE_THEN `{x}` EXISTS_TAC;
  ASM_REWRITE_TAC[INR IN_SING];
  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING;plus_e12 ];
  TYPE_THEN `h_edge m` EXISTS_TAC;
  FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING;plus_e12];
  (* dt1 *)
  REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset];
  ASM_SIMP_TAC[closure_unions];
  CONJ_TAC;
  REWRITE_TAC[SUBSET;IMAGE;UNIONS];
  DISCH_ALL_TAC;
  CONV_TAC (dropq_conv "u");
  NAME_CONFLICT_TAC;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[subset_closure;ISUBSET ];
  (* // *)
  TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ;
  REWRITE_TAC[UNIONS;SUBSET ];
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC [INR IN_SING];
  ASM_MESON_TAC [];
  ]);;
  (* }}} *)

let curve_cell_h_inter_ver2 = 
prove_by_refinement(
  `!G m.  (FINITE  G) /\ (G SUBSET edge) ==>
     (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
         (~(G (h_edge m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ONCE_REWRITE_TAC [GSYM curve_cell_h_ver2];
  IMATCH_MP_TAC  cell_inter;
  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
  ASM_MESON_TAC[segment;curve_cell_cell];
  ]);;
  (* }}} *)

let curve_cell_v_inter_ver2 = 
prove_by_refinement(
  `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
     (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
         (~(G (v_edge m))))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ONCE_REWRITE_TAC [GSYM curve_cell_v_ver2];
  IMATCH_MP_TAC  cell_inter;
  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
  ASM_MESON_TAC[segment;curve_cell_cell];
  ]);;
  (* }}} *)

let curve_cell_squ_ver2 = 
prove_by_refinement(
  `!G m. (FINITE  G) /\ (G SUBSET edge) ==> ~curve_cell G (squ m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment];
  FULL_REWRITE_TAC [SUBSET; edge];
  TSPEC `squ m` 1;
  USE 0(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;cell_clauses]);
  ]);;
  (* }}} *)

let curve_cell_squ_inter_ver2 = 
prove_by_refinement(
  `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
     (((squ m) INTER (UNIONS (curve_cell G)) = {}))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `cell (squ m)` SUBGOAL_TAC;
  REWRITE_TAC[cell_rules];
  TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC;
  ASM_MESON_TAC[curve_cell_cell;segment];
  ASM_SIMP_TAC [cell_inter];
  ASM_MESON_TAC [curve_cell_squ_ver2];
  ]);;
  (* }}} *)

let curve_point_unions_ver2 = 
prove_by_refinement(
  `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
     (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC;
  REWRITE_TAC[REWRITE_RULE[not_eq] single_inter];
  REWRITE_TAC [not_eq];
  IMATCH_MP_TAC  cell_inter;
  ASM_MESON_TAC[cell_rules;curve_cell_cell];
  ]);;
  (* }}} *)

let curve_cell_not_point_ver2 = 
prove_by_refinement(
  `!G m. (FINITE  G) /\ (G SUBSET edge) ==> ((curve_cell G {(pointI m)} <=>
     ~(num_closure G (pointI m) = 0)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[curve_cell_point;num_closure0];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let curve_closed_ver2 = 
prove_by_refinement(
  `!G. (FINITE  G) /\ (G SUBSET edge) ==>
       (closed_ top2 (UNIONS (curve_cell G)))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  ASM_SIMP_TAC[GSYM curve_closure_ver2];
  IMATCH_MP_TAC  closure_closed;
  REWRITE_TAC[top2_top];
  IMATCH_MP_TAC  UNIONS_SUBSET;
  FULL_REWRITE_TAC [SUBSET;top2_unions;edge;  ];
  ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid];
  ]);;
  (* }}} *)

let ctop_top2_ver2 = 
prove_by_refinement(
  `!G A. (FINITE  G) /\ (G SUBSET edge) /\ ctop G A ==> top2 A`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ctop;induced_top;IMAGE ;];
  TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ;
  TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC;
  TYPE_THEN `U` UNABBREV_TAC;
  ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
  IMATCH_MP_TAC  top_inter;
  ASM_REWRITE_TAC[top2_top;];
  ASM_SIMP_TAC[GSYM curve_closure_ver2;top2];
  IMATCH_MP_TAC  (REWRITE_RULE[open_DEF] closed_open);
  IMATCH_MP_TAC  closure_closed;
  CONJ_TAC;
  TYPE_THEN `U` UNABBREV_TAC;
  ASM_MESON_TAC[top_of_metric_top;metric_euclid];
  USE 5(GSYM);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  UNIONS_SUBSET;
  FULL_REWRITE_TAC [edge;ISUBSET;];
  TSPEC `A'` 2;
  REWRITE_TAC[];
  FIRST_ASSUM  DISJ_CASES_TAC;
  ASM_MESON_TAC[ (REWRITE_RULE[ISUBSET;] v_edge_euclid)];
  ASM_MESON_TAC [(REWRITE_RULE[ISUBSET;] h_edge_euclid)];
  ]);;
  (* }}} *)

let convex_connected_ver2 = 
prove_by_refinement(
  `!G Z. (FINITE  G) /\ (G SUBSET edge) /\ convex Z /\
         (Z SUBSET (UNIONS (ctop G))) ==>
            (connected (ctop G) Z)`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  REWRITE_TAC[connected];
  DISCH_ALL_TAC;
  ASM_REWRITE_TAC[];
  DISCH_ALL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 8 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
  LEFT 8 "x";
  LEFT 9 "x";
  TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC;
  FULL_REWRITE_TAC [convex];
  ASM_MESON_TAC[ISUBSET];
  TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC;
  IMATCH_MP_TAC  connected_mk_segment;
  USE 3(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]);
  (* - *)
  FULL_REWRITE_TAC [connected];
  TYPEL_THEN [`A`;`B`] (USE 13 o ISPECL);
  REWR 13;
  TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC;
  REWRITE_TAC[GSYM top2];
  ASM_MESON_TAC[ctop_top2_ver2;top2];
  UND 13 THEN   ASM_REWRITE_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  (* -- *)
  UND 9 THEN REWRITE_TAC[];
  UND 8 THEN ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  ASM_MESON_TAC[mk_segment_end;ISUBSET];
  ASM_MESON_TAC [mk_segment_end;ISUBSET ];
  ]);;
  (* }}} *)

let convex_component_ver2 = 
prove_by_refinement(
  `!G Z x. (FINITE  G) /\ (G SUBSET edge) /\ convex Z /\
       (Z SUBSET (UNIONS (ctop G))) /\
     (~(Z INTER (component  (ctop G) x ) = EMPTY))  ==>
        (Z SUBSET (component  (ctop G) x))  `,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC;
  ASM_SIMP_TAC[convex_connected_ver2];
  USE 4(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
  USE 4(MATCH_MP component_replace);
  IMATCH_MP_TAC  connected_component;
  ]);;
  (* }}} *)

let unions_cell_of_ver2 = 
prove_by_refinement(
  `!G x. ((FINITE  G) /\ (G SUBSET edge) ==>
     (UNIONS (cell_of (component  (ctop G) x)) =
           component  (ctop G) x))`,

  (* {{{ proof *)
  [
  DISCH_ALL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  REWRITE_TAC [UNIONS;SUBSET;cell_of];
  CONJ_TAC;
  TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC;
  UND 2 THEN REWRITE_TAC[component_DEF   ;connected;SUBSET ;ctop_unions;DIFF ];
  USE 3 (MATCH_MP point_onto);
  TYPE_THEN `x'` UNABBREV_TAC;
  ASSUME_TAC cell_unions;
  TSPEC `p` 3;
  USE 3 (REWRITE_RULE[UNIONS]);
  TYPE_THEN `u` EXISTS_TAC;
  (* - *)
  DISCH_ALL_TAC;
  TYPE_THEN `u SUBSET (component  (ctop G) x)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  convex_component_ver2 ;
  ASM_REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  ASM_MESON_TAC[cell_convex];
  CONJ_TAC;
  REWRITE_TAC[ctop_unions];
  REWRITE_TAC[DIFF;SUBSET ];
  CONJ_TAC;
  ASM_MESON_TAC[cell_euclid;ISUBSET];
  FULL_REWRITE_TAC[UNIONS];
  USE 1 (MATCH_MP   curve_cell_cell);
  USE 1 (REWRITE_RULE[ISUBSET]);
  TSPEC `u'` 1;
  TYPE_THEN `u = u'` SUBGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  ASM_MESON_TAC[];
  (* --- *)
  USE 2 (REWRITE_RULE[component_DEF;connected;SUBSET ]);
  TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC;
  USE 12(REWRITE_RULE[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ]);
  ASM_MESON_TAC[];
  TYPE_THEN `point p` EXISTS_TAC;
  ASM_REWRITE_TAC [INTER];
  (* - *)
  FULL_REWRITE_TAC [ISUBSET];
  ]);;
  (* }}} *)

let unbounded = jordan_def `unbounded C <=>
  (?r. !s. (r <=. s) ==> C (point(s,&.0)))`;;

let curve_cell_empty = 
prove_by_refinement(
  `curve_cell EMPTY = EMPTY `,

  (* {{{ proof *)
  [
  REWRITE_TAC[curve_cell];
  REWRITE_TAC[EQ_EMPTY];
  THM_INTRO_TAC[`top2`] closure_empty;
  REWRITE_TAC[top2_top];
  REWR 0;
  ]);;
  (* }}} *)

let curve_cell_union = 
prove_by_refinement(
  `!A B. curve_cell (A UNION B) = curve_cell A UNION curve_cell B`,

  (* {{{ proof *)
  [
  REWRITE_TAC[curve_cell];
  FULL_REWRITE_TAC[UNIONS_UNION;];
  ASM_SIMP_TAC[top2_top;closure_union];
  TYPE_THEN `{z | ?n. (z = {(pointI n)}) /\  (closure top2 (UNIONS A) UNION closure top2 (UNIONS B)) (pointI n)} = ( {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}) UNION ({z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  MESON_TAC[];
  TYPE_THEN `C = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}` ABBREV_TAC ;
  TYPE_THEN `D = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)}` ABBREV_TAC ;
  REWRITE_TAC[UNION_ACI];
  ]);;
  (* }}} *)

let insert_sing = 
prove_by_refinement(
  `!A (x:A). x INSERT A = {x} UNION A`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INSERT;UNION;INR IN_SING];
  MESON_TAC[];
  ]);;
  (* }}} *)

let curve_cell_sing = 
prove_by_refinement(
  `!e. (edge e) ==> (UNIONS (curve_cell {e}) = closure top2 e)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[curve_cell;UNIONS_UNION];
  FULL_REWRITE_TAC[edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  REWRITE_TAC[v_edge_closure;vc_edge;plus_e12];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;UNIONS];
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj];
  RIGHT_TAC "n";
  TYPE_THEN `v_edge m x` ASM_CASES_TAC;
  MESON_TAC[];
  (* - *)
  REWRITE_TAC[h_edge_closure;hc_edge;plus_e12];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;UNIONS];
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj];
  RIGHT_TAC "n";
  TYPE_THEN `h_edge m x` ASM_CASES_TAC;
  MESON_TAC[];
  ]);;
  (* }}} *)

let unbounded_elt = 
prove_by_refinement(
  `!G. (FINITE G) /\ (G SUBSET edge) ==>
     (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r))`,

  (* {{{ proof *)
  [
  TYPE_THEN `!G. (FINITE G) ==> ((G SUBSET edge) ==> (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r)))` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  FINITE_INDUCT_STRONG ;ASM_MESON_TAC[]];
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[curve_cell_empty];
  (* - *)
  ASSUME_TAC top2_top;
  ONCE_REWRITE_TAC[insert_sing];
  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
  REWRITE_TAC[UNION;];
  NAME_CONFLICT_TAC;
  THM_INTRO_TAC[`x`] curve_cell_sing;
  FULL_REWRITE_TAC[INSERT;SUBSET];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `G SUBSET edge` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[ISUBSET;INSERT];
  ASM_MESON_TAC[];
  REP_BASIC_TAC;
  (* - *)
  TYPE_THEN `edge x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INSERT;SUBSET;];
  ASM_MESON_TAC[];
  TYPE_THEN `?r. !x'. closure top2 x x' ==> x' 0 < r` SUBAGOAL_TAC;
  USE 7(REWRITE_RULE[edge]);
  FIRST_ASSUM DISJ_CASES_TAC;
  REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING;plus_e12 ];
  TYPE_THEN  `real_of_int (FST m) + (&1)`  EXISTS_TAC;
  FULL_REWRITE_TAC[pointI];
  UND 9 THEN REP_CASES_TAC THEN   FULL_REWRITE_TAC[v_edge;coord01];
  FULL_REWRITE_TAC[v_edge;coord01];
  REAL_ARITH_TAC;
  REWRITE_TAC[coord01];
  REAL_ARITH_TAC;
  REWRITE_TAC[coord01;pointI];
  REAL_ARITH_TAC;
  (* --A *)
  REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING;plus_e12 ];
  TYPE_THEN  `real_of_int (FST m) + (&2)`  EXISTS_TAC;
  UND 9 THEN REP_CASES_TAC;
  FULL_REWRITE_TAC[h_edge;coord01];
  FULL_REWRITE_TAC[h_edge;coord01];
  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
  UND 10 THEN REAL_ARITH_TAC;
  REWRITE_TAC[pointI];
  REAL_ARITH_TAC;
  REWRITE_TAC[pointI];
  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
  REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `max_real r r'` EXISTS_TAC;
  TSPEC `x'` 3;
  FIRST_ASSUM DISJ_CASES_TAC;
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `r'` EXISTS_TAC;
  ASM_REWRITE_TAC[max_real_le];
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `r` EXISTS_TAC;
  REWRITE_TAC[max_real_le];
  ]);;
  (* }}} *)

let mk_segment_convex = 
prove_by_refinement(
  `!x y. convex (mk_segment x y)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[convex];
  FULL_REWRITE_TAC[mk_segment;SUBSET;];
  REP_BASIC_TAC;
  REWRITE_TAC[euclid_ldistrib];
  ONCE_REWRITE_TAC[euclid_plus_pair];
  REWRITE_TAC[euclid_scale_act];
  REWRITE_TAC[GSYM euclid_rdistrib];
  TYPE_THEN `(a * a'' + (&1 - a) * a')` EXISTS_TAC;
  CONJ_TAC;
  ineq_le_tac `(&0) + (a * a'') + (&1 - a)* a' = (a * a'' + (&1 - a)*a')`;
  CONJ_TAC;
  ineq_le_tac `(a * a'' + (&1 - a) * a') + ((&1 - a)*(&1 - a')) + a*(&1 - a'') = &1`;
  AP_TERM_TAC;
  AP_THM_TAC;
  AP_TERM_TAC;
  real_poly_tac;
  ]);;
  (* }}} *)

let mk_segment_h = 
prove_by_refinement(
  `!r s b x. (r <= s) ==> (mk_segment (point(r,b)) (point(s,b)) x <=> (?t. (r <= t /\ t <= s /\ (x = point(t,b)))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[mk_segment];
  REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC;
  CONJ_TAC;
  ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`;
  ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`;
  TYPE_THEN `s = r` ASM_CASES_TAC;
  REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`];
  TYPE_THEN `&0` EXISTS_TAC;
  UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC;
  REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ;
  TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  REWRITE_TAC[GSYM real_div_assoc];
  REDUCE_TAC;
  IMATCH_MP_TAC  REAL_DIV_REFL;
  UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
  TYPE_THEN `v*(s - t)` EXISTS_TAC;
  TYPE_THEN `&0 < v` SUBAGOAL_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_MUL;
  UND 7 THEN UND 2 THEN REAL_ARITH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
  TYPE_THEN `(s - r)` EXISTS_TAC;
  CONJ_TAC;
  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
  REWRITE_TAC[REAL_MUL_ASSOC];
  REDUCE_TAC;
  UND 3 THEN REAL_ARITH_TAC;
  TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC];
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;

  ]);;
  (* }}} *)

let unbounded_comp = 
prove_by_refinement(
  `!G. (FINITE G) /\ (G SUBSET edge) ==>
      (?x. unbounded (component  (ctop G) x))` ,

  (* {{{ proof *)
  [
  REWRITE_TAC[unbounded];
  THM_INTRO_TAC[`G`] unbounded_elt;
  TYPE_THEN `point(r, &0)` EXISTS_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  TYPE_THEN `Z = mk_segment (point(r, &0)) (point(s, &0))` ABBREV_TAC ;
  THM_INTRO_TAC[`G`;`Z`;`(point(r, &0))`] convex_component_ver2;
  CONJ_TAC;
  TYPE_THEN `Z` UNABBREV_TAC;
  REWRITE_TAC[mk_segment_convex];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `Z` UNABBREV_TAC;
  REWRITE_TAC[ctop_unions];
  REWRITE_TAC[SUBSET;DIFF];
  THM_INTRO_TAC[`r`;`s`;`&0`;`x`] mk_segment_h;
  REWR 5;
  REWRITE_TAC[euclid_point];
  TSPEC `(point (t ,&0))` 2;
  FULL_REWRITE_TAC[coord01];
  UND 2 THEN UND 7 THEN REAL_ARITH_TAC;
  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `(point(r,&0))` EXISTS_TAC;
  REWRITE_TAC[INTER];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `Z` UNABBREV_TAC;
  THM_INTRO_TAC[`r`;`s`;`&0`;`point(r,&0)`] mk_segment_h;
  TYPE_THEN `r` EXISTS_TAC;
  UND 3 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  component_refl;
  REWRITE_TAC[ctop_unions];
  REWRITE_TAC[DIFF;euclid_point];
  TSPEC  `(point(r,&0))` 2;
  FULL_REWRITE_TAC[coord01];
  UND 2 THEN REAL_ARITH_TAC;
  (* -A *)
  FULL_REWRITE_TAC[SUBSET];
  TSPEC  `(point(s,&0))` 5;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `Z` UNABBREV_TAC;
  REWRITE_TAC[mk_segment_end];
  ]);;
  (* }}} *)

let unbounded_comp_unique = 
prove_by_refinement(
  `!G x y. (FINITE G) /\ (G SUBSET edge) /\
      (unbounded (component  (ctop G) x)) /\
       (unbounded(component  (ctop G) y)) ==>
         (component  (ctop G) x = component  (ctop G) y) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[unbounded];
  TSPEC  `max_real r r'` 0;
  TSPEC `max_real r r'` 1;
  FULL_REWRITE_TAC[max_real_le];
  ASM_MESON_TAC[component_replace];
  ]);;
  (* }}} *)

let unbounded_set = jordan_def
  `unbounded_set G x = unbounded(component  (ctop G) x)`;;

let bounded_set = jordan_def
   `bounded_set G x <=> ~(component  (ctop G) x = EMPTY) /\
      ~(unbounded (component  (ctop G) x))`;;

let bounded_unbounded_disj = 
prove_by_refinement(
  `!G. bounded_set G INTER unbounded_set G = EMPTY `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[EQ_EMPTY];
  FULL_REWRITE_TAC[INTER;bounded_set;unbounded_set];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let bounded_unbounded_union = 
prove_by_refinement(
  `!G. bounded_set G UNION unbounded_set G = UNIONS (ctop G)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;bounded_set;unbounded_set];
  THM_INTRO_TAC[`G`] ctop_top;
  TYPE_THEN `component  (ctop G) x = EMPTY` ASM_CASES_TAC;
  THM_INTRO_TAC[`ctop G`;`x`] component_empty;
  REWR 2;
  REWRITE_TAC[unbounded];
  TSPEC `r + &1` 3;
  UND 3 THEN REAL_ARITH_TAC;
  REWRITE_TAC[TAUT `~A \/ A`];
  ASM_MESON_TAC[component_empty];
  ]);;
  (* }}} *)

let bounded_subset_unions = 
prove_by_refinement(
  `!G x. (bounded_set G x ==> UNIONS (ctop G) x) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[GSYM bounded_unbounded_union;UNION];
  ]);;
  (* }}} *)

let unbounded_subset_unions = 
prove_by_refinement(
  `!G x. (unbounded_set G x ==> UNIONS (ctop G) x) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[GSYM bounded_unbounded_union;UNION];
  ]);;
  (* }}} *)

let unbounded_set_nonempty = 
prove_by_refinement(
  `!G. (FINITE G) /\ (G SUBSET edge) ==>
        ~(unbounded_set G = EMPTY)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[unbounded_set];
  THM_INTRO_TAC[`G`] unbounded_comp;
  ]);;
  (* }}} *)

let unbounded_set_comp = 
prove_by_refinement(
  `!G. (FINITE G) /\ (G SUBSET edge) ==>
      (?x. unbounded_set G = component  (ctop G) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`] unbounded_comp;
  TYPE_THEN `x` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  USE 3(REWRITE_RULE[SUBSET]);
  LEFT 3 "x'";
  UND 3 THEN REWRITE_TAC[];
  THM_INTRO_TAC[`G`;`x`;`x'`] unbounded_comp_unique;
  FULL_REWRITE_TAC[unbounded_set];
  IMATCH_MP_TAC  component_refl;
  FULL_REWRITE_TAC[unbounded_set];
  FULL_REWRITE_TAC[unbounded];
  TSPEC  `r` 3;
  FULL_REWRITE_TAC[ARITH_RULE `r <= r`];
  TYPE_THEN `~(component  (ctop G) x' = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[EQ_EMPTY];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`ctop G`;`x'`] component_empty;
  REWRITE_TAC[ctop_top];
  ASM_MESON_TAC[];
  (* - *)
  REWRITE_TAC[SUBSET];
  REWRITE_TAC[unbounded_set];
  TYPE_THEN `component  (ctop G) x = component  (ctop G) x'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  component_replace;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let unbounded_set_comp_elt = 
prove_by_refinement(
  `!G x. (FINITE G) /\ (G SUBSET edge) /\
        (unbounded_set G = component  (ctop G) x) ==>
           (unbounded_set G x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC ;
  THM_INTRO_TAC[`G`]unbounded_set_nonempty;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  REWR 3;
  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[EQ_EMPTY ];
  ASM_MESON_TAC[];
  ASSUME_TAC ctop_top;
  TYPE_THEN `(UNIONS (ctop G) x)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`ctop G`;`x`] component_empty;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[component_refl];
  ]);;
  (* }}} *)

let unbounded_even_subset = 
prove_by_refinement(
  `!G. rectagon G ==> (unbounded_set G SUBSET UNIONS (par_cell T G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  THM_INTRO_TAC[`G`] unbounded_set_comp;
  THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp;
  FIRST_ASSUM DISJ_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  KILL 6;
  KILL 4;
  THM_INTRO_TAC[`G`;`x`] unbounded_set_comp_elt;
  USE 4 (REWRITE_RULE[unbounded_set;unbounded]);
  THM_INTRO_TAC[`G`] unbounded_elt;
  TYPE_THEN `s =  floor (max_real r r') + &:1` ABBREV_TAC ;
  TYPE_THEN `r < real_of_int s /\ r' < real_of_int s` SUBAGOAL_TAC;
  TYPE_THEN `s` UNABBREV_TAC;
  TYPE_THEN `!t u. t <= u ==> t <. real_of_int( floor u + &:1)` SUBAGOAL_TAC;
  REWRITE_TAC[int_add_th ; int_of_num_th];
  IMATCH_MP_TAC  REAL_LET_TRANS;
  TYPE_THEN `u` EXISTS_TAC;
  REWRITE_TAC[floor_ineq];
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[max_real_le] ;
  (* -A *)
  TYPE_THEN `~(UNIONS (curve_cell G) (pointI (s, &:0)))` SUBAGOAL_TAC;
  TSPEC `pointI (s, &:0)` 6;
  USE 6 (REWRITE_RULE[pointI;coord01]);
  UND 6 THEN UND 8 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`G`] rectagon_segment;
  THM_INTRO_TAC[`G`;`(s,&:0)`] curve_point_unions;
  UND 12 THEN ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  (* - *)
  TYPE_THEN `par_cell T G {(pointI (s, &:0))}` SUBAGOAL_TAC;
  THM_INTRO_TAC[`G`;`(s, &:0)`;`T`] par_cell_point;
  CONJ_TAC;
  ASM_MESON_TAC[curve_cell_not_point];
  REWRITE_TAC[num_lower];
  TYPE_THEN `{m | G (h_edge m) /\ (FST m = s) /\ SND m <=: &:0} = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 6(REWRITE_RULE[UNIONS]);
  LEFT 6 "u";
  LEFT 6 "u";
  TSPEC  `h_edge u` 6;
  THM_INTRO_TAC[`G`;`u`] curve_cell_h;
  REWR 6;
  USE 6(REWRITE_RULE[h_edge]);
  REWR 6;
  USE 6 (CONV_RULE (dropq_conv "x"));
  USE 6 (REWRITE_RULE[coord01]);
  USE 6 (CONV_RULE (dropq_conv "v"));
  TSPEC `real_of_int s + &1/ (&2)` 6;
  USE 6(REWRITE_RULE[int_add_th;int_of_num_th; REAL_LT_ADDR; REAL_LT_LADD; ]);
  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
  IMATCH_MP_TAC  half_pos;
  TYPE_THEN `real_of_int s < r'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LT_TRANS;
  TYPE_THEN `real_of_int s + &1 / &2` EXISTS_TAC;
  REWRITE_TAC[REAL_LT_ADDR; REAL_LT_HALF1];
  UND 18 THEN UND 8 THEN REAL_ARITH_TAC;
  REWRITE_TAC[CARD_CLAUSES;EVEN2];
  (* -B *)
  TYPE_THEN `UNIONS (par_cell F G) (pointI (s,&:0))` SUBAGOAL_TAC;
  USE 5 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[pointI;int_of_num_th];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 9 THEN REAL_ARITH_TAC ;
  TYPE_THEN `UNIONS (par_cell T G) (pointI (s,&:0))` SUBAGOAL_TAC;
  REWRITE_TAC[UNIONS];
  TYPE_THEN `{(pointI (s,&:0))}` EXISTS_TAC ;
  REWRITE_TAC[INR IN_SING];
  (* - *)
  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
  USE 16(REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let odd_bounded_subset = 
prove_by_refinement(
  `!G. rectagon G ==> (UNIONS (par_cell F G) SUBSET  bounded_set G)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* - *)
  REWRITE_TAC[SUBSET];
  THM_INTRO_TAC[`G`] unbounded_even_subset;
  FULL_REWRITE_TAC[SUBSET];
  TSPEC `x` 2;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[bounded_set;unbounded_set;DE_MORGAN_THM ];
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`G`] ctop_top;
  THM_INTRO_TAC[`ctop G`;`x`] component_empty;
  UND 6 THEN ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`G`]rectagon_segment;
  THM_INTRO_TAC[`G`;`T`] par_cell_partition;
  USE 7(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 7;
  FULL_REWRITE_TAC[UNION];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
  UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let unique_bounded = 
prove_by_refinement(
  `!G x y. (rectagon G) /\ bounded_set G x /\ bounded_set G y ==>
   (component  (ctop G) x = component  (ctop G) y) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`;`x`] bounded_subset_unions;
  THM_INTRO_TAC[`G`;`y`] bounded_subset_unions;
  TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[rectagon];
  THM_INTRO_TAC[`G`] unbounded_set_nonempty;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`G`;`u`] unbounded_subset_unions;
  THM_INTRO_TAC[`G`] rectagon_h_edge;
  THM_INTRO_TAC[`G`] ctop_top;
  TYPE_THEN `~(component  (ctop G) x = EMPTY) /\ ~(component  (ctop G) u = EMPTY) /\ ~(component  (ctop G) y = EMPTY)` SUBAGOAL_TAC;
  ASM_MESON_TAC[component_empty];
  TYPE_THEN `segment G` SUBAGOAL_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  THM_INTRO_TAC[`G`;`x`;`h_edge m`] along_lemma11;
  THM_INTRO_TAC[`G`;`y`;`h_edge m`] along_lemma11;
  THM_INTRO_TAC[`G`;`u`;`h_edge m`] along_lemma11;
  USE 16 (MATCH_MP squc_h);
  USE 18 (MATCH_MP squc_h);
  USE 20 (MATCH_MP squc_h);
  TYPE_THEN `(p'' = p) \/ (p'' = p') \/ (p' = p)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `!p a b. squ p SUBSET component  (ctop G) a /\ squ p SUBSET component  (ctop G) b ==> (component  (ctop G) a = component  (ctop G) b)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  THM_INTRO_TAC[`squ p'''`] cell_nonempty;
  REWRITE_TAC[cell_rules];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TSPEC `u'` 22;
  TSPEC `u'` 23;
  KILL 19 THEN KILL 17 THEN KILL 15 THEN KILL 5;
  ASM_MESON_TAC[component_replace];
  (* - *)
  TYPE_THEN `!a. bounded_set G a ==> ~(component  (ctop G) a = component  (ctop G) u)` SUBAGOAL_TAC;
  TYPE_THEN `unbounded_set G a` SUBAGOAL_TAC;
  REWRITE_TAC[unbounded_set];
  REWRITE_TAC[GSYM unbounded_set];
  THM_INTRO_TAC[`G`] bounded_unbounded_disj;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  UND 21 THEN REP_CASES_TAC;
  TYPE_THEN `p''` UNABBREV_TAC;
  UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p`;`u`;`x`]);
  UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  ASM_MESON_TAC[];
  TYPE_THEN `p''` UNABBREV_TAC;
  UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p'`;`u`;`y`]);
  UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`y`]);
  ASM_MESON_TAC[];
  TYPE_THEN `p'` UNABBREV_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let odd_bounded = 
prove_by_refinement(
  `!G. rectagon G ==> (UNIONS (par_cell F G) =  bounded_set G)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  odd_bounded_subset;
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`G`;`F`] par_cell_nonempty;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `?y. UNIONS (par_cell F G) y` SUBAGOAL_TAC;
  REWRITE_TAC[UNIONS];
  LEFT_TAC "u";
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `cell u` SUBAGOAL_TAC;
  THM_INTRO_TAC[`G`;`F`] par_cell_cell;
  ASM_MESON_TAC[ISUBSET];
  USE 4 (MATCH_MP cell_nonempty);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`G`] odd_bounded_subset;
  TYPE_THEN `bounded_set G y` SUBAGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  (* - *)
  THM_INTRO_TAC[`G`;`x`;`y`] unique_bounded;
  TYPE_THEN `component  (ctop G) y SUBSET UNIONS (par_cell F G)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`G`;`F`;`y`] par_cell_comp;
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 9 (REWRITE_RULE[SUBSET]);
  TSPEC `y` 9;
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
  IMATCH_MP_TAC  component_refl;
  IMATCH_MP_TAC  bounded_subset_unions;
  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  USE 7 SYM;
  REWR 8;
  USE 8 (REWRITE_RULE[SUBSET]);
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  IMATCH_MP_TAC  component_refl;
  IMATCH_MP_TAC  bounded_subset_unions;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let unbounded_even = 
prove_by_refinement(
  `!G. rectagon G ==> (unbounded_set G = UNIONS (par_cell T G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  THM_INTRO_TAC[`G`] unbounded_even_subset;
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`G`] odd_bounded;
  USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 4;
  (* - *)
  TYPE_THEN `segment G` SUBAGOAL_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC;
  THM_INTRO_TAC[`G`;`T`] par_cell_partition;
  USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 6;
  USE 6 (REWRITE_RULE[UNION]);
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`G`] bounded_unbounded_union;
  USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  FULL_REWRITE_TAC[UNION];
  TYPE_THEN `bounded_set G x` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  REWR 4;
  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_union_comp = 
prove_by_refinement(
  `!G eps x. (rectagon G) /\ (UNIONS (par_cell eps G) x) ==>
      (UNIONS (par_cell eps G) = component  (ctop G) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `eps = T` ASM_CASES_TAC;
  TYPE_THEN `UNIONS (par_cell T G) = unbounded_set G` SUBAGOAL_TAC;
  ASM_MESON_TAC[unbounded_even];
  TYPE_THEN `eps` UNABBREV_TAC;
  REWR 0;
  THM_INTRO_TAC[`G`]unbounded_set_comp;
  FULL_REWRITE_TAC[rectagon];
  REWR 0;
  ASM_MESON_TAC[component_replace];
  (* - *)
  TYPE_THEN `eps = F` ASM_CASES_TAC;
  TYPE_THEN `eps` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`G`;`x`;`x'`] unique_bounded;
  ASM_MESON_TAC[odd_bounded];
  UND 4 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  component_refl;
  IMATCH_MP_TAC  bounded_subset_unions;
  ASM_MESON_TAC[odd_bounded];
  THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp;
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 4 (REWRITE_RULE [SUBSET]);
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  IMATCH_MP_TAC  component_refl;
  IMATCH_MP_TAC   bounded_subset_unions;
  ASM_MESON_TAC[odd_bounded];
  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

(* 1.0.7 Adding segments *)

let edge_cell = 
prove_by_refinement(
  `!e. (edge e) ==> (cell e)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  ASM_MESON_TAC[cell_rules];
  ]);;
  (* }}} *)

let edge_subset_ctop = 
prove_by_refinement(
  `!G A. FINITE G /\ G SUBSET edge /\ A SUBSET edge /\
        (A INTER G = EMPTY) ==> (UNIONS A SUBSET UNIONS (ctop G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[ctop_unions;DIFF_SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS edge` EXISTS_TAC ;
  CONJ_TAC;
  IMATCH_MP_TAC  UNIONS_UNIONS;
  FULL_REWRITE_TAC[segment];
  REWRITE_TAC[UNIONS;SUBSET];
  USE 5 (MATCH_MP edge_euclid2);
  FULL_REWRITE_TAC[SUBSET];
  (* - *)
  REWRITE_TAC[UNIONS;INTER;EQ_EMPTY];
  FULL_REWRITE_TAC[EQ_EMPTY];
  TSPEC `u` 0;
  USE 0(REWRITE_RULE[INTER]);
  UND 0 THEN ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `cell u /\ cell u'` SUBAGOAL_TAC;
  THM_INTRO_TAC[`G`] curve_cell_cell;
  THM_INTRO_TAC[`u`] edge_cell;
  FULL_REWRITE_TAC[ISUBSET];
  FULL_REWRITE_TAC[ISUBSET];
  (* - *)
  TYPE_THEN `u = u'` SUBAGOAL_TAC ;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  ASM_MESON_TAC[];
  TYPE_THEN `u'` UNABBREV_TAC;
  TYPE_THEN `edge u` SUBAGOAL_TAC;
  ASM_MESON_TAC[ISUBSET];
  FULL_REWRITE_TAC[edge];
  ASM_MESON_TAC[curve_cell_h_ver2;curve_cell_v_ver2];
  ]);;
  (* }}} *)

let par_cell_pointI = 
prove_by_refinement(
  `!G eps m.
     (par_cell eps G {(pointI m)} =
         UNIONS (par_cell eps G) (pointI m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[UNIONS];
  TYPE_THEN `!u. cell u /\ u (pointI m) ==> ( u = {(pointI m)})` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[cell];
  UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `u` UNABBREV_TAC) THEN (FULL_REWRITE_TAC[cell_clauses;INR IN_SING;pointI_inj]);
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
  REWRITE_TAC[INR IN_SING];
  TYPE_THEN `u = {(pointI m)}` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[par_cell_cell;subset_imp];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_pointI_trichot = 
prove_by_refinement(
  `!G eps m. (rectagon G) ==>
    ((par_cell eps G {(pointI m)}) \/ (par_cell (~eps) G {(pointI m)})
        \/ (cls G m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `UNIONS (ctop G) (pointI m)` ASM_CASES_TAC;
  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
  IMATCH_MP_TAC  rectagon_segment;
  USE 2 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC  `pointI m` 2;
  REWR 2;
  USE 2(REWRITE_RULE[UNION]);
  USE 2 (REWRITE_RULE[GSYM par_cell_pointI]);
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`G`] rectagon_segment;
  (* - *)
  DISJ2_TAC;
  DISJ2_TAC;
  REWRITE_TAC[cls];
  FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM ];
  THM_INTRO_TAC[`G`;`m`] curve_point_unions;
  REWR 1;
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[pointI;euclid_point];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`G`;`m`] curve_cell_not_point;
  REWR 4;
  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
  FULL_REWRITE_TAC[rectagon];
  REWR 6;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_nbd = 
prove_by_refinement(
  `!G eps m e. (rectagon G) /\ (par_cell eps G {(pointI m)}) /\ edge e
     /\ closure top2 e (pointI m) ==> (par_cell eps G e)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  FULL_REWRITE_TAC[edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_v;
  TYPE_THEN `e` UNABBREV_TAC;
  FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `m'` UNABBREV_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  TYPE_THEN `down (FST m',SND m' +: &:1) = m'` SUBAGOAL_TAC;
  REWRITE_TAC[down;PAIR_SPLIT];
  INT_ARITH_TAC;
  REWR 5;
  (* - *)
  TYPE_THEN `e` UNABBREV_TAC;
  THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_h;
  FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `m'` UNABBREV_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  TYPE_THEN `left (FST m' +: &:1,SND m') = m'` SUBAGOAL_TAC;
  REWRITE_TAC[left  ;PAIR_SPLIT];
  INT_ARITH_TAC;
  REWR 4;
  ]);;
  (* }}} *)

let segment_in_comp = 
prove_by_refinement(
  `!G A. rectagon G /\ segment A /\ (A INTER G = EMPTY) /\
     (cls G INTER cls A SUBSET  endpoint A)
   ==> (?eps. A SUBSET par_cell eps G)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `?e. A e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment;EMPTY_EXISTS ];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`G`;`A`] edge_subset_ctop;
  FULL_REWRITE_TAC[segment;rectagon];
  (* - *)
  THM_INTRO_TAC[`G`] rectagon_segment;
  TYPE_THEN`edge e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET;segment];
  THM_INTRO_TAC[`e`] edge_cell;
  THM_INTRO_TAC[`e`] cell_nonempty;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  (* - *)
  TYPE_THEN `?eps. ~(e INTER (UNIONS (par_cell eps G)) = EMPTY)` SUBAGOAL_TAC;
  REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`G`;`T`] par_cell_partition;
  USE 10(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `u` 10;
  TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `UNIONS A` EXISTS_TAC;
  REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  REWR 10;
  USE 10 (REWRITE_RULE[SUBSET ;UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `T` EXISTS_TAC;
  TYPE_THEN `u` EXISTS_TAC;
  REWRITE_TAC[INTER];
  REWRITE_TAC[INTER];
  ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN `eps` EXISTS_TAC;
  (* - *)
  USE 10 (REWRITE_RULE [EMPTY_EXISTS;INTER;UNIONS]);
  TYPE_THEN `u'' = e` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  ASM_MESON_TAC[par_cell_cell;subset_imp ];
  TYPE_THEN `u''` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `S = A INTER par_cell eps G` ABBREV_TAC ;
  TYPE_THEN `inductive_set A S` BACK_TAC ;  (* // *)
  FULL_REWRITE_TAC[inductive_set;segment];
  TYPE_THEN `S = A` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 2 THEN MESON_TAC[];
  KILL 15 THEN KILL 20 THEN KILL 16 THEN KILL 21;
  TYPE_THEN `S` UNABBREV_TAC;
  ASM_MESON_TAC[SUBSET_INTER_ABSORPTION];
  (* -// *)
  REWRITE_TAC[inductive_set];
  SUBCONJ_TAC;
  TYPE_THEN `S` UNABBREV_TAC ;
  REWRITE_TAC[INTER;SUBSET];
  REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `S` UNABBREV_TAC;
  REWRITE_TAC[INTER];
  (* -B *)
  USE 13(REWRITE_RULE[INTER]);
  TYPE_THEN `S` UNABBREV_TAC;
  THM_INTRO_TAC[`C`;`C'`] adjv_adj;
  FULL_REWRITE_TAC[segment];
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `m = adjv C C'` ABBREV_TAC ;
  (* - *)
  TYPE_THEN `FINITE G /\ FINITE A` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  TYPE_THEN `~endpoint A m` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`A`;`pointI m`] num_closure1;
  REWR 23;
  COPY 23;
  TSPEC `C` 23;
  TSPEC `C'` 24;
  TYPE_THEN `e' = C` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  THM_INTRO_TAC[`C`;`C'`] adjv_adj2;
  USE 2(REWRITE_RULE[segment]);
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `C = C'` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[adj];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `cls A m` SUBAGOAL_TAC;
  REWRITE_TAC[cls];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `~cls G m` SUBAGOAL_TAC;
  USE 0 (REWRITE_RULE[SUBSET;INTER]);
  ASM_MESON_TAC[];
  (* -C *)
  TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC;
  USE 2(REWRITE_RULE[segment]);
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`G`;`eps`;`m`] par_cell_pointI_trichot;
  REWR 27;
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`G`;`eps`;`m`;`C'`] par_cell_nbd;
  TYPE_THEN `m` UNABBREV_TAC;
  IMATCH_MP_TAC  adjv_adj2;
  (* - *)
  THM_INTRO_TAC[`G`;`~eps`;`m`;`C`] par_cell_nbd;
  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let segment_end_select = 
prove_by_refinement(
  `!E A a b. (E SUBSET edge) /\ segment_end A a b /\
        ~cls E a /\ cls E b ==>
    (?B c. segment_end B a c /\ cls E c /\ B SUBSET A /\
            (cls B INTER cls E = {c}))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `EE  = { (B,c) | segment_end B a c /\ cls E c /\ B SUBSET A }` ABBREV_TAC ;
  (* - *)
  TYPE_THEN `~(EE = EMPTY)` SUBAGOAL_TAC;
  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `(A,b)` EXISTS_TAC;
  TYPE_THEN `EE` UNABBREV_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET_REFL];
  (* - *)
  THM_INTRO_TAC[`EE`;`(CARD o FST):((((num->real)->bool)->bool)#(int#int))->num`] select_image_num_min;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `?Bm cm. (z = (Bm,cm))` SUBAGOAL_TAC;
  ONCE_REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `Bm` EXISTS_TAC;
  TYPE_THEN `cm` EXISTS_TAC;
  TYPE_THEN `EE` UNABBREV_TAC;
  FULL_REWRITE_TAC[o_DEF];
  USE 4(ONCE_REWRITE_RULE[PAIR_SPLIT]);
  USE 4(REWRITE_RULE[]);
  TYPE_THEN `c` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  (* - *)
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  FULL_REWRITE_TAC[SUBSET;INR IN_SING;INTER];
  IMATCH_MP_TAC  segment_end_cls2;
  ASM_MESON_TAC[];
  (* - *)
  REWRITE_TAC[SUBSET;INTER;INR IN_SING];
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`Bm`;`a`;`cm`;`x`] cut_psegment;
  DISCH_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TSPEC `(A',x)` 6;
  USE 6 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
  REWR 6;
  USE 6 (CONV_RULE (dropq_conv "B"));
  USE 6 (CONV_RULE (dropq_conv "c"));
  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Bm` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  USE 6(MATCH_MP (ARITH_RULE `x <=| y ==> ~( y < x)`));
  UND 6 THEN REWRITE_TAC[];
  (* - *)
  IMATCH_MP_TAC  card_subset_lt;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  REWRITE_TAC[FINITE_UNION];
  FULL_REWRITE_TAC[segment_end;segment;psegment];
  (* - *)
  TYPE_THEN `~(B' = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end;segment;psegment];
  UND 17 THEN UND 19 THEN MESON_TAC[];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  FULL_REWRITE_TAC[EQ_EMPTY;INTER ];
  TSPEC `u` 15;
  USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `u` 6;
  FULL_REWRITE_TAC[UNION];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let endpoint_cls = 
prove_by_refinement(
  `!G. FINITE G ==> (endpoint G SUBSET cls G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[endpoint;SUBSET;cls];
  THM_INTRO_TAC[`G`;`pointI x`] num_closure1;
  REWR 2;
  MESON_TAC[];
  ]);;
  (* }}} *)

let conn2_proper = 
prove_by_refinement(
  `!G H .  (G SUBSET edge) /\
        conn2 G /\ conn2 H /\ H SUBSET G /\ ~(H = G)  ==>
     (?A. A SUBSET G /\ (A INTER H = EMPTY) /\ psegment A /\
         (cls H INTER cls A = endpoint A))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* - *)
  TYPE_THEN `cls G SUBSET cls H` ASM_CASES_TAC;
  TYPE_THEN `?e. G e /\ ~H e` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  UND 0 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `edge e` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `{e}` EXISTS_TAC;
  CONJ_TAC;
  ASM_REWRITE_TAC[SUBSET;INR IN_SING];
  CONJ_TAC;
  ASM_REWRITE_TAC[EQ_EMPTY;INR IN_SING;INTER];
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  psegment_edge;
  TYPE_THEN `endpoint{e} = cls{e}` SUBAGOAL_TAC;
  ASM_SIMP_TAC[endpoint_closure;cls_edge];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_INTER_ABSORPTION];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `cls G` EXISTS_TAC;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;INR IN_SING];
  (* -A *)
  TYPE_THEN `?a. cls G a /\ ~cls H a` SUBAGOAL_TAC;
  USE 5(REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `FINITE H /\ H SUBSET edge` SUBAGOAL_TAC;
  CONJ_TAC;
  FULL_REWRITE_TAC[conn2];
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  (* - *)
  TYPE_THEN `?b c. cls H b /\ cls H c /\ ~(b = c)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`H`] conn2_cls3;
  THM_INTRO_TAC[`cls H`;`2`] card_has_subset;
  CONJ_TAC;
  ASM_MESON_TAC[finite_cls];
  UND 10 THEN ARITH_TAC;
  FULL_REWRITE_TAC[has_size2];
  TYPE_THEN `B` UNABBREV_TAC;
  FULL_REWRITE_TAC[SUBSET;INR in_pair];
  TYPE_THEN `a'` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* -B *)
  TYPE_THEN `cls H SUBSET cls G` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  TYPE_THEN `~(a = b) /\ ~(a = c)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `(?U. U SUBSET G /\ segment_end U a b /\ ~cls U c)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`H`;`U`;`a`;`b`] segment_end_select;
  TYPE_THEN `B SUBSET G` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `U` EXISTS_TAC;
  TYPE_THEN `~cls B c` SUBAGOAL_TAC;
  TYPE_THEN `cls B SUBSET cls U` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  USE 25 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  KILL 20 THEN KILL 16 THEN KILL 17 THEN KILL 18 THEN KILL 15 THEN KILL 10;
  KILL 12;
  TYPE_THEN `~(a = c')` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `~(c = c')` SUBAGOAL_TAC;
  TYPE_THEN`c'` UNABBREV_TAC;
  USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC  `c` 12;
  USE 12 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `(?V. V SUBSET G /\ segment_end V a c /\ ~cls V c')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`H`;`V`;`a`;`c`] segment_end_select;
  (* -C *)
  TYPE_THEN `B' SUBSET G` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `V` EXISTS_TAC;
  TYPE_THEN `~cls B' c'` SUBAGOAL_TAC;
  TYPE_THEN `cls B' SUBSET cls V` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  USE 29 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  KILL 20 THEN KILL 16 THEN KILL 17;
  KILL 15;
  KILL 12 THEN KILL 24 THEN KILL 14;
  (* - *)
  TYPE_THEN `~(c'' = c')` SUBAGOAL_TAC;
  TYPE_THEN `c''` UNABBREV_TAC;
  USE 18 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC  `c'` 12;
  USE 12 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `B INTER H = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 14(REWRITE_RULE[INTER]);
  USE 19 SYM;
  TYPE_THEN `cls {u} SUBSET cls B INTER cls H` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET_INTER];
  CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
  USE 16 SYM;
  REWR 17;
  THM_INTRO_TAC[`u`] cls_edge_size2;
  FULL_REWRITE_TAC[SUBSET];
  FULL_REWRITE_TAC[has_size2];
  REWR 17;
  USE 17 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]);
  COPY 17;
  TSPEC `a'` 17;
  TSPEC `b` 24;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `B' INTER H = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 15(REWRITE_RULE[INTER]);
  USE 18 SYM;
  TYPE_THEN `cls {u} SUBSET cls B' INTER cls H` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET_INTER];
  CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
  USE 17 SYM;
  REWR 18;
  THM_INTRO_TAC[`u`] cls_edge_size2;
  FULL_REWRITE_TAC[SUBSET];
  FULL_REWRITE_TAC[has_size2];
  REWR 18;
  USE 18 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]);
  COPY 18;
  TSPEC `a'` 18;
  TSPEC `b` 29;
  ASM_MESON_TAC[];
  (* -D *)
  USE 22 (ONCE_REWRITE_RULE[segment_end_symm]);
  THM_INTRO_TAC[`B`;`B'`;`c'`;`a`;`c''`] segment_end_trans;
  TYPE_THEN `U` EXISTS_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `B UNION B'` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  (* - *)
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ];
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  USE 20(REWRITE_RULE[segment_end]);
  (* -// *)
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[INTER;SUBSET];
  USE 20 (REWRITE_RULE[segment_end]);
  REWRITE_TAC[INR in_pair];
  TYPE_THEN `cls U SUBSET cls(B UNION B')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  USE 31(REWRITE_RULE[SUBSET;cls_union]);
  USE 31(REWRITE_RULE[UNION]);
  TSPEC `x` 31;
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 19(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 19;
  USE 19 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_MESON_TAC[];
  USE 18(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 18;
  USE 18 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_MESON_TAC[];
  (* -E *)
  USE 20(REWRITE_RULE[segment_end]);
  REWRITE_TAC[SUBSET;INTER;INR in_pair];
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `FINITE U` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  (* - *)
  USE 20 SYM;
  TYPE_THEN `endpoint U SUBSET cls U` SUBAGOAL_TAC;
  IMATCH_MP_TAC  endpoint_cls;
  USE 31(REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 20 SYM;
  REWRITE_TAC[INR in_pair];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION U *)
(* ------------------------------------------------------------------ *)


(* EVEN and ODD components.  1.0.8, Nov 28, 2004, 9am *)

let parity_select  = jordan_def
  `parity G C = @eps. par_cell eps G C`;;

let cell_ununion = 
prove_by_refinement(
  `!V C u. cell C /\ C u /\ (V SUBSET cell) /\ (UNIONS V) u ==> V C`,

  (* {{{ proof *)
  [
  REWRITE_TAC[UNIONS];
  TYPE_THEN `u' = C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  CONJ_TAC;
  ASM_MESON_TAC[subset_imp];
  UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_cell_partition = 
prove_by_refinement(
  `!G eps C. segment G /\ cell C ==>
      (par_cell eps G C \/ par_cell (~eps) G C \/ curve_cell G C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `curve_cell G C` ASM_CASES_TAC;
  THM_INTRO_TAC[`C`] cell_nonempty;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC;
  REWRITE_TAC[ctop_unions;DIFF;UNIONS  ];
  CONJ_TAC;
  THM_INTRO_TAC[`C`] cell_euclid;
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`curve_cell G`;`C`;`u`] cell_ununion;
  CONJ_TAC;
  IMATCH_MP_TAC  curve_cell_cell;
  FULL_REWRITE_TAC[segment];
  REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `u` 5;
  REWR 5;
  USE 5(REWRITE_RULE[UNION]);
  THM_INTRO_TAC[`G`] par_cell_cell;
  FIRST_ASSUM DISJ_CASES_TAC;
  DISJ1_TAC;
  IMATCH_MP_TAC  cell_ununion;
  ASM_MESON_TAC[];
  DISJ2_TAC;
  IMATCH_MP_TAC  cell_ununion;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_curve_cell_disj = 
prove_by_refinement(
  `!G  eps. (G SUBSET edge) ==>
   (par_cell eps G  INTER curve_cell G = EMPTY )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[INTER;EQ_EMPTY];
  USE 2(MATCH_MP par_cell_curve_disj);
  UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;UNIONS ];
  TYPE_THEN `cell x` SUBAGOAL_TAC;
  ASM_MESON_TAC[curve_cell_cell;subset_imp];
  USE 2 (MATCH_MP cell_nonempty);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let curve_cell_edge = 
prove_by_refinement(
  `!G e . edge e ==> (curve_cell G e = G e) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ];
  REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ];
  ]);;
  (* }}} *)

let parity = 
prove_by_refinement(
  `!G C. segment G /\ cell C /\ ~curve_cell G C ==>
        par_cell (parity G C) G C`,

  (* {{{ proof *)
  [
  REWRITE_TAC[parity_select];
  SELECT_TAC;
  THM_INTRO_TAC[`G`;`T`;`C`] par_cell_cell_partition;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let parity_unique = 
prove_by_refinement(
  `!G C eps. segment G  /\
        par_cell eps G C ==> (eps = parity G C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `cell C /\ ~curve_cell G C` SUBAGOAL_TAC;
  SUBCONJ_TAC;
  ASM_MESON_TAC[par_cell_cell;subset_imp];
  THM_INTRO_TAC[`G`;`eps`] par_cell_curve_cell_disj;
  FULL_REWRITE_TAC[segment];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`G`;`C`] parity;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN`parity G C = ~eps` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `parity G C` UNABBREV_TAC;
  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let unions_curve_cell = 
prove_by_refinement(
  `!G C. (G SUBSET edge) /\ cell C ==>
     ((C INTER UNIONS (curve_cell G) = EMPTY) = (~curve_cell G C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  USE 3(REWRITE_RULE[INTER;UNIONS;EQ_EMPTY]);
  USE 0 (MATCH_MP cell_nonempty);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[];
  (* - *)
  REWRITE_TAC[EQ_EMPTY;INTER];
  UND 2 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  cell_ununion;
  UNIFY_EXISTS_TAC;
  IMATCH_MP_TAC  curve_cell_cell;
  ]);;
  (* }}} *)

let even_num_lower_union = 
prove_by_refinement(
  `!A B m. FINITE A /\ FINITE B /\ (A INTER B = EMPTY) ==>
    (EVEN (num_lower (A UNION B) m) <=>
        (EVEN (num_lower A m) = EVEN (num_lower B m)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[num_lower_set];
  THM_INTRO_TAC[`set_lower A m`;`set_lower B m`] even_card_even;
  REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC finite_set_lower));
  REWRITE_TAC[EQ_EMPTY;INTER;set_lower];
  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
  ASM_MESON_TAC[];
  (* - *)
  AP_TERM_TAC;
  AP_TERM_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[set_lower;UNION];
  TYPE_THEN `C <=> (FST x = FST m) /\ SND x <=: SND m` ABBREV_TAC ;
  USE 0 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `h_edge x` 0;
  UND 0 THEN MESON_TAC[];
  ]);;
  (* }}} *)

let eq_pair_exchange = 
prove_by_refinement(
  `!(a:bool) b c d. ((a = b) <=> (c = d)) <=> ((a = c) <=> (b = d))`,

  (* {{{ proof *)
  [
  MESON_TAC[];
  ]);;
  (* }}} *)

let parity_point = 
prove_by_refinement(
  `!A p. segment A /\ ~(curve_cell A {(pointI p)}) ==>
        (parity A {(pointI p)} = EVEN (num_lower A p))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  parity_unique;
  REWRITE_TAC[par_cell;cell_clauses];
  THM_INTRO_TAC[`A`;`{(pointI p)}`] unions_curve_cell;
  FULL_REWRITE_TAC[cell_rules;segment];
  MESON_TAC[];
  ]);;
  (* }}} *)

let parity_h = 
prove_by_refinement(
  `!A p. segment A /\ ~A (h_edge p) ==>
       (parity A (h_edge p) <=> EVEN (num_lower A p))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  parity_unique;
  REWRITE_TAC[par_cell;cell_clauses];
  THM_INTRO_TAC[`A`;`h_edge p`] unions_curve_cell;
  FULL_REWRITE_TAC[cell_rules;segment];
  THM_INTRO_TAC[`A`;`h_edge p`] curve_cell_edge;
  REWRITE_TAC[edge_h];
  MESON_TAC[];
  ]);;
  (* }}} *)

let parity_v = 
prove_by_refinement(
  `!A p. segment A /\ ~A (v_edge p) ==>
       (parity A (v_edge p) <=> EVEN (num_lower A p))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  parity_unique;
  REWRITE_TAC[par_cell;cell_clauses];
  THM_INTRO_TAC[`A`;`v_edge p`] unions_curve_cell;
  FULL_REWRITE_TAC[cell_rules;segment];
  THM_INTRO_TAC[`A`;`v_edge p`] curve_cell_edge;
  REWRITE_TAC[edge_v];
  MESON_TAC[];
  ]);;
  (* }}} *)

let parity_squ = 
prove_by_refinement(
  `!A p. segment A  ==>
       (parity A (squ p) <=> EVEN (num_lower A p))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  parity_unique;
  REWRITE_TAC[par_cell;cell_clauses];
  THM_INTRO_TAC[`A`;`squ p`] unions_curve_cell;
  FULL_REWRITE_TAC[cell_rules;segment];
  THM_INTRO_TAC[`A`;`p`] curve_cell_squ;
  MESON_TAC[];
  ]);;
  (* }}} *)

let parity_union = 
prove_by_refinement(
  `!A B C. segment A /\ segment B /\ segment (A UNION B) /\
    (A INTER B = EMPTY) /\
    cell C /\ ~curve_cell A C /\  ~curve_cell B C ==>
         (parity (A UNION B) C  <=> (parity A C = parity B C))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  parity_unique;
  REWRITE_TAC[par_cell];
  TYPE_THEN `A UNION B SUBSET edge` SUBAGOAL_TAC;
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[segment];
  ASM_SIMP_TAC[unions_curve_cell];
  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  ASM_SIMP_TAC[even_num_lower_union];
  ONCE_REWRITE_TAC[eq_pair_exchange];
  (* -A *)
  REWRITE_TAC[curve_cell_union];
  REWRITE_TAC[UNION];
  (* - *)
  WITH 2(REWRITE_RULE[cell_mem]);
  UND 10 THEN REP_CASES_TAC ;
  (* --cases-- *)
  REWRITE_TAC[cell_clauses];
  TYPE_THEN`p` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
  TYPE_THEN `C` UNABBREV_TAC;
  CONJ_TAC THEN (IMATCH_MP_TAC  parity_point);
  REWRITE_TAC[cell_clauses];
  TYPE_THEN`p` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
  TYPE_THEN `C` UNABBREV_TAC;
  CONJ_TAC THEN (IMATCH_MP_TAC  parity_h) THEN ASM_MESON_TAC[curve_cell_h_ver2];
  REWRITE_TAC[cell_clauses];
  TYPE_THEN`p` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
  TYPE_THEN `C` UNABBREV_TAC;
  CONJ_TAC THEN (IMATCH_MP_TAC  parity_v) THEN ASM_MESON_TAC[curve_cell_v_ver2];
  REWRITE_TAC[cell_clauses];
  TYPE_THEN`p` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
  TYPE_THEN `C` UNABBREV_TAC;
  CONJ_TAC THEN (IMATCH_MP_TAC  parity_squ) ;
  ]);;
  (* }}} *)

(* extraneous fact *)
let component_simple_arc = 
prove_by_refinement(
  `!G x y. (FINITE G /\ G SUBSET edge ) /\ ~(x = y) ==>
      ((component  (ctop G) x y) <=>
        (?C. simple_arc_end C x y /\
             (C INTER (UNIONS (curve_cell G)) = EMPTY)))`,

  (* {{{ proof *)
  [
  (*
   string together :component-imp-connected, connected-induced2,
                    p_conn_conn, p_conn_hv_finite;
   other_direction : simple_arc_connected, connected-induced,
                    connected-component; *)
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`] ctop_top;
  ASSUME_TAC top2_top;
  THM_INTRO_TAC[`G`] curve_closed_ver2;
  TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC;
  USE 5 (MATCH_MP closed_open);
  FULL_REWRITE_TAC[top2_unions;open_DEF ];
  TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ;
  TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC;
  TYPE_THEN`A` UNABBREV_TAC;
  REWRITE_TAC[ctop_unions];
  TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC;
  REWRITE_TAC[ctop];
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected;
  THM_INTRO_TAC[`(top2)`;`A`;`(component  (ctop G) x)`] connected_induced2;
  REWRITE_TAC[top2_unions];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
  CONJ_TAC;
  KILL 7;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[component_unions];
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  REWR 12;
  (* --A *)
  TYPE_THEN `B = component  (ctop G) x` ABBREV_TAC ;
  TYPE_THEN `B x /\ B y` SUBAGOAL_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  THM_INTRO_TAC[`(ctop G)`;`x`;`y`] component_replace;
  IMATCH_MP_TAC  component_symm;
  (* -- *)
  ASSUME_TAC loc_path_conn_top2;
  TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC;
  REWRITE_TAC[ctop];
  REWRITE_TAC[top2];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  top_of_metric_induced;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  (* -- *)
  TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
  FULL_REWRITE_TAC[top2];
  ASM_MESON_TAC[];
  (* -- *)
  THM_INTRO_TAC[`top2`] loc_path_conn;
  REWR 20;
  TSPEC `A` 20;
  REWR 20;
  TSPEC `x` 20;
  TYPE_THEN `A x` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `top2 B` SUBAGOAL_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  ASM_MESON_TAC[path_eq_conn];
  (* --B *)
  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn;
  (* -- *)
  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite;
  ASM_MESON_TAC[];
  REWR 24;
  TYPE_THEN `C` EXISTS_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `u` 7;
  FULL_REWRITE_TAC[DIFF];
  TYPE_THEN `B u` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `A u` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  REWR 7;
  (* -C *)
  (* other_direction : simple_arc_connected, connected-induced,
                    connected-component; *)
  THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple;
  THM_INTRO_TAC[`C`] simple_arc_connected;
  TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_euclid;
  THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
  REWRITE_TAC[top2_unions];
  REWR 15;
  (* - *)
  TYPE_THEN `C SUBSET A` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DIFF_SUBSET];
  REWR 15;
  (* - *)
  THM_INTRO_TAC[`(ctop G)`;`C`;`x`] connected_component;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  USE 17(REWRITE_RULE[SUBSET]);
  TSPEC `y` 17;
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let ctop_comp_open = 
prove_by_refinement(
  `!G x . (FINITE G /\ G SUBSET edge ) ==>
         top2 (component  (ctop G) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`] ctop_top;
  ASSUME_TAC top2_top;
  THM_INTRO_TAC[`G`] curve_closed_ver2;
  TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC;
  USE 4 (MATCH_MP closed_open);
  FULL_REWRITE_TAC[top2_unions;open_DEF ];
  TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ;
  TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC;
  TYPE_THEN`A` UNABBREV_TAC;
  REWRITE_TAC[ctop_unions];
  TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC;
  REWRITE_TAC[ctop];
  (* - *)
  TYPE_THEN `B = component  (ctop G) x` ABBREV_TAC ;
  TYPE_THEN `B = EMPTY` ASM_CASES_TAC;
  THM_INTRO_TAC[`top2`] open_EMPTY;
  FULL_REWRITE_TAC[open_DEF];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  (* - *)
  THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected;
  THM_INTRO_TAC[`(top2)`;`A`;`(component  (ctop G) x)`] connected_induced2;
  REWRITE_TAC[top2_unions];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
  CONJ_TAC;
  KILL 6;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[component_unions];
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  REWR 12;
  (* --A *)
  TYPE_THEN `B x /\ B u` SUBAGOAL_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  THM_INTRO_TAC[`(ctop G)`;`x`;`u`] component_replace;
  IMATCH_MP_TAC  component_symm;
  (* -- *)
  ASSUME_TAC loc_path_conn_top2;
  TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC;
  REWRITE_TAC[ctop];
  REWRITE_TAC[top2];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  top_of_metric_induced;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  (* -- *)
  TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
  FULL_REWRITE_TAC[top2];
  ASM_MESON_TAC[];
  (* -- *)
  THM_INTRO_TAC[`top2`] loc_path_conn;
  REWR 18;
  TSPEC `A` 18;
  REWR 18;
  TSPEC `x` 18;
  TYPE_THEN `A x` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `B` UNABBREV_TAC;
  ASM_MESON_TAC[path_eq_conn];
  (* --B *)
  ]);;
  (* }}} *)

let psegment_triple = jordan_def
  `psegment_triple A B C <=>
       psegment A /\ psegment B /\ psegment C /\
           rectagon (A UNION B) /\ rectagon (A UNION C) /\
             rectagon(B UNION C) /\
          (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\
          (B INTER C = EMPTY) /\
          (cls A INTER cls B = endpoint A) /\
          (cls B INTER cls C = endpoint A) /\
          (cls A INTER cls C = endpoint A) /\
          (endpoint A = endpoint B) /\ (endpoint B = endpoint C)`;;

let psegment_triple3 = 
prove_by_refinement(
  `!A B C. psegment_triple A B C ==> psegment_triple B C A`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM;INTER_COMM];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let psegment_triple2 = 
prove_by_refinement(
  `!A B C. psegment_triple A B C ==> psegment_triple C B A`,

  (* {{{ proof *)
  [
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM;INTER_COMM];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let unions_empty_imp_empty  = 
prove_by_refinement(
  `!(A:(A->bool)->bool) B. (UNIONS A INTER UNIONS B = EMPTY) /\
       (!C. A C ==> ~(C = EMPTY)) ==>
           (A INTER B = EMPTY)  `,

  (* {{{ proof *)
  [
  REWRITE_TAC[EQ_EMPTY;INTER;UNIONS];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_closure = 
prove_by_refinement(
  `!G A eps.
       FINITE A /\ A SUBSET edge /\ rectagon G /\
         A SUBSET par_cell eps G ==>
       (curve_cell A INTER par_cell (~eps) G = EMPTY)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  unions_empty_imp_empty;
  ASSUME_TAC top2_top;
  TYPE_THEN `(par_cell (~eps) G) = EMPTY` ASM_CASES_TAC;
  REWRITE_TAC[INTER_EMPTY];
  FULL_REWRITE_TAC[curve_cell;UNION];
  TYPE_THEN `C` UNABBREV_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[SUBSET];
  TYPE_THEN `edge {}` SUBAGOAL_TAC;
  TYPE_THEN `cell {}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  edge_cell;
  USE 9 (MATCH_MP cell_nonempty);
  ASM_MESON_TAC[];
  USE 8 SYM;
  FULL_REWRITE_TAC[EQ_EMPTY;INR IN_SING ];
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `~(UNIONS (par_cell (~eps) G)  = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[UNIONS;EQ_EMPTY];
  TYPE_THEN `~ (u = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  THM_INTRO_TAC[`G`;`~eps`] par_cell_cell;
  FULL_REWRITE_TAC[SUBSET];
  TYPE_THEN `cell {}` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  USE 8 (MATCH_MP cell_nonempty);
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TSPEC `u'` 6;
  ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed;
  REWRITE_TAC[open_DEF];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`G`;`~eps`;`u'`] par_cell_union_comp;
  IMATCH_MP_TAC ctop_comp_open ;
  ASM_MESON_TAC[rectagon];
  FULL_REWRITE_TAC[top2_unions];
  (* -B *)
  THM_INTRO_TAC[`A`] curve_closure_ver2;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  THM_INTRO_TAC[`A`] curve_cell_cell;
  USE 10 (REWRITE_RULE[SUBSET]);
  TSPEC `C` 10;
  USE 9 (MATCH_MP cell_nonempty);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN`UNIONS (curve_cell A) SUBSET (euclid 2 DIFF UNIONS (par_cell (~eps) G))` SUBAGOAL_TAC;
  USE 8 GSYM;
  IMATCH_MP_TAC  closure_subset;
  REWRITE_TAC[DIFF_SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS edge` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  UNIONS_UNIONS;
  REWRITE_TAC[UNIONS;SUBSET];
  THM_INTRO_TAC[`u'`] edge_euclid2;
  ASM_MESON_TAC[subset_imp];
  REWRITE_TAC[INTER;EQ_EMPTY];
  COPY 10;
  USE 11(REWRITE_RULE[UNIONS]);
  THM_INTRO_TAC[`par_cell (~eps) G`;`u'`;`x`] cell_ununion;
  TYPE_THEN`edge u'` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC [par_cell_cell;edge_cell];
  USE 0 (REWRITE_RULE[SUBSET]);
  TSPEC `u'` 0;
  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[DIFF_SUBSET];
  ]);;
  (* }}} *)

let cell_unions_disj = 
prove_by_refinement(
  `!U V. U SUBSET cell /\ V SUBSET cell ==> ((U INTER V = EMPTY) <=>
      (UNIONS U INTER UNIONS V = EMPTY))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 3(REWRITE_RULE[INTER]);
  TYPE_THEN `?C. V C /\ C u` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  TYPE_THEN `cell C` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `U C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cell_ununion;
  ASM_MESON_TAC[];
  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  (* - *)
  IMATCH_MP_TAC  unions_empty_imp_empty;
  REP_BASIC_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  TYPE_THEN `cell EMPTY ` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC[cell_nonempty];
  ]);;
  (* }}} *)

let unions_curve_cell_par_cell_disj = 
prove_by_refinement(
  `!G eps. (G SUBSET edge) ==>
    (UNIONS (par_cell eps G) INTER UNIONS (curve_cell G) = EMPTY)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`par_cell eps G`;`curve_cell G`] cell_unions_disj;
  THM_INTRO_TAC[`G`] curve_cell_cell;
  REWRITE_TAC[par_cell_cell];
  USE 1 SYM;
  IMATCH_MP_TAC  par_cell_curve_cell_disj;
  ]);;
  (* }}} *)

let par_cell_simple_arc = 
prove_by_refinement(
  `!G eps x y. rectagon G /\ ~(x = y) ==>
      ((UNIONS (par_cell eps G) x /\ UNIONS (par_cell eps G) y) <=>
        (?C. simple_arc_end C x y /\
             (C SUBSET (UNIONS (par_cell eps G)))) )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  THM_INTRO_TAC[`G`;`eps`;`x`] par_cell_union_comp;
  THM_INTRO_TAC[`G`;`x`;`y`] component_simple_arc;
  FULL_REWRITE_TAC[rectagon];
  REWR 2;
  TYPE_THEN `C` EXISTS_TAC;
  USE 4 SYM;
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  (* -- *)
  THM_INTRO_TAC[`C`;`x`;`y`;`x'`] simple_arc_end_cut;
  CONJ_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `x'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  THM_INTRO_TAC[`G`;`x`;`x'`] component_simple_arc;
  FULL_REWRITE_TAC[rectagon];
  REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `~component (ctop G) x x'` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  UND 13 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `C'` EXISTS_TAC;
  FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ]SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C INTER UNIONS (curve_cell G)` EXISTS_TAC;
  IMATCH_MP_TAC subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* -A *)
  TYPE_THEN `C x /\ C y` SUBAGOAL_TAC;
  CONJ_TAC THEN   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let trap_triple_seg = 
prove_by_refinement(
  `!A B C eps eps'. psegment_triple A B C /\
      C SUBSET par_cell (~eps) (A UNION B)
      ==>
     (par_cell eps (A UNION B) SUBSET par_cell eps' (A UNION C) \/
      par_cell eps (A UNION B) SUBSET par_cell (~eps') (A UNION C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  USE 2 (REWRITE_RULE[SUBSET]);
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  LEFT 2 "x";
  LEFT 3 "x";
  UND 2 THEN REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  UND 3 THEN REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN`cell x' /\ cell x` SUBAGOAL_TAC;
  ASM_MESON_TAC[par_cell_cell;subset_imp];
  (* - *)
  TYPE_THEN `!x. cell x /\ par_cell eps (A UNION B) x ==> par_cell eps' (A UNION C) x \/ par_cell (~eps') (A UNION C) x` SUBAGOAL_TAC;
  THM_INTRO_TAC[`A UNION C`;`eps'`;`x''`] par_cell_cell_partition;
  IMATCH_MP_TAC  rectagon_segment;
  FULL_REWRITE_TAC[psegment_triple];
  USE 10 (REWRITE_RULE[curve_cell_union]);
  UND 10 THEN REP_CASES_TAC;
  USE 10 (REWRITE_RULE[UNION]);
  (* -- *)
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`A UNION B`;`eps`] par_cell_curve_cell_disj;
  FULL_REWRITE_TAC[psegment_triple];
  USE 21 (REWRITE_RULE[rectagon]);
  USE 12 (REWRITE_RULE[INTER;EQ_EMPTY;curve_cell_union;DE_MORGAN_THM ]);
  TSPEC `x''` 12;
  REWR 12;
  USE 12 (REWRITE_RULE[UNION;DE_MORGAN_THM ]);
  ASM_MESON_TAC[];
  (* -- *)
  THM_INTRO_TAC[`A UNION B`;`C`;`~eps`;] par_cell_closure;
  FULL_REWRITE_TAC[psegment_triple];
  USE 22(REWRITE_RULE[psegment;segment]);
  USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  (* - *)
  COPY 8;
  TSPEC `x` 8;
  TSPEC `x'` 9;
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWR 8;
  REWR 9;
  (* - *)
  USE 6 (MATCH_MP cell_nonempty);
  USE 7(MATCH_MP cell_nonempty);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `UNIONS (par_cell eps (A UNION B)) u /\ UNIONS (par_cell eps (A UNION B)) u'` SUBAGOAL_TAC;
  REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `u = u'` ASM_CASES_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  TYPE_THEN `cell x /\ cell x'` SUBAGOAL_TAC;
  ASM_MESON_TAC[par_cell_cell;subset_imp];
  TYPE_THEN `x = x'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  ASM_MESON_TAC[];
  TYPE_THEN `x'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* -B *)
  THM_INTRO_TAC[`A UNION B`;`eps`;`u`;`u'`]par_cell_simple_arc;
  FULL_REWRITE_TAC[psegment_triple];
  REWR 13;
  (* - *)
  TYPE_THEN `C' INTER UNIONS (curve_cell A) = EMPTY` SUBAGOAL_TAC;
  REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL;curve_cell_union;UNIONS_UNION];
  REWRITE_TAC[SUBSET;UNION];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (par_cell eps (A UNION B)) INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET_EMPTY];
  IMATCH_MP_TAC  unions_curve_cell_par_cell_disj ;
  FULL_REWRITE_TAC[psegment_triple];
  USE 24 (REWRITE_RULE[rectagon]);
  (* -C *)
  THM_INTRO_TAC[`A UNION B`;`C`;`~eps`] par_cell_closure;
  FULL_REWRITE_TAC[psegment_triple];
  USE 26(REWRITE_RULE[psegment;segment]);
  REWR 16;
  THM_INTRO_TAC[`curve_cell C`;`par_cell eps (A UNION B)`] cell_unions_disj;
  CONJ_TAC;
  IMATCH_MP_TAC  curve_cell_cell;
  FULL_REWRITE_TAC[psegment_triple];
  USE 27(REWRITE_RULE[psegment;segment]);
  REWRITE_TAC[par_cell_cell];
  REWR 17;
  TYPE_THEN `UNIONS (curve_cell C) INTER C' = EMPTY` SUBAGOAL_TAC ;
    REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY];
  USE 17 SYM;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  (* - *)
  TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION C)) = EMPTY` SUBAGOAL_TAC;
  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
  REWRITE_TAC[UNION_OVER_INTER; UNION_EMPTY];
  REWRITE_TAC[UNION_EMPTY];
  ONCE_REWRITE_TAC[INTER_COMM];
  (* -D *)
  THM_INTRO_TAC[`A UNION C`;`u`;`u'`] component_simple_arc;
  FULL_REWRITE_TAC[psegment_triple];
  USE 28(REWRITE_RULE[rectagon]);
  (* - *)
  TYPE_THEN `component  (ctop (A UNION C)) u u'` SUBAGOAL_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  REWR 20;
  TYPE_THEN `UNIONS (par_cell (eps') (A UNION C)) u'` SUBAGOAL_TAC;
  REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C)) u` SUBAGOAL_TAC;
  REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC [`A UNION C`;`eps'`]  par_cell_union_disjoint;
  THM_INTRO_TAC[`A UNION C`;`eps'`;`u'`] par_cell_union_comp;
  FULL_REWRITE_TAC[psegment_triple];
  THM_INTRO_TAC[`A UNION C`;`~eps'`;`u`] par_cell_union_comp;
  FULL_REWRITE_TAC[psegment_triple];
  TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C))` UNABBREV_TAC;
  TYPE_THEN `UNIONS (par_cell eps' (A UNION C))` UNABBREV_TAC;
  USE 25 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC  `u'` 25;
  REWR 25;
  ]);;
  (* }}} *)

let parity_even_cell = 
prove_by_refinement(
  `!G m. (rectagon G) ==> (parity G (squ m) = even_cell G (squ m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`;`m`] parity_squ;
  IMATCH_MP_TAC  rectagon_segment;
  REWRITE_TAC[parity_squ;even_cell_squ];
  ]);;
  (* }}} *)

let par_cell_squ_neg = 
prove_by_refinement(
  `!G m eps. segment G ==>
    (par_cell (~eps) G (squ m) <=> ~(par_cell eps G (squ m)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`G`;`eps`;`squ m`] par_cell_cell_partition;
  REWRITE_TAC[cell_rules];
  ASM_MESON_TAC[curve_cell_squ];
  ]);;
  (* }}} *)

let triple_par_cell_distinct = 
prove_by_refinement(
  `!A B C eps eps'. psegment_triple A B C ==>
     ~(par_cell eps (A UNION B) = par_cell eps' (A UNION C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `s = (eps = eps')` ABBREV_TAC ;
  TYPE_THEN `!m. (parity (A UNION B) (squ m) = parity(A UNION C) (squ m)) = s` SUBAGOAL_TAC;
  TYPE_THEN `s` UNABBREV_TAC;
  REWRITE_TAC[EQ_SYM_EQ];
  ONCE_REWRITE_TAC[eq_pair_exchange];
  TYPE_THEN `eps = parity (A UNION B) (squ m)` ASM_CASES_TAC;
  IMATCH_MP_TAC  parity_unique;
  USE 0 SYM;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  IMATCH_MP_TAC  parity;
  REWRITE_TAC[cell_rules;];
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  ASM_MESON_TAC[curve_cell_squ];
  (* -- *)
  TYPE_THEN `!m. par_cell (~eps) (A UNION B) (squ m)  = par_cell (~eps') (A UNION C) (squ m)` SUBAGOAL_TAC;
  TYPE_THEN `segment (A UNION B) /\ segment(A UNION C)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC THEN IMATCH_MP_TAC  rectagon_segment;
  ASM_SIMP_TAC [par_cell_squ_neg];
  TYPE_THEN `~eps = parity (A UNION B) (squ m)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILL 2;
  TYPE_THEN `~(~eps' = parity (A UNION C) (squ m))` SUBAGOAL_TAC;
  TYPE_THEN `eps'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  KILL 3;
  UND 2 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  parity_unique;
  TSPEC `m` 4;
  USE 2 SYM;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  IMATCH_MP_TAC  parity;
  REWRITE_TAC[cell_rules;];
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  ASM_MESON_TAC[curve_cell_squ];
  (* -A *)
  THM_INTRO_TAC[`A UNION B`] parity_even_cell;
  RIGHT 4 "m";
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]);
  FULL_REWRITE_TAC[psegment_triple];
  REWR 3;
  THM_INTRO_TAC[`A UNION C`] parity_even_cell;
  RIGHT 5 "m";
  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]);
  FULL_REWRITE_TAC[psegment_triple];
  REWR 3;
  (* - *)
  TYPE_THEN `?e. B e /\ ~C e /\ ~A e` SUBAGOAL_TAC;
  TYPE_THEN `~(B = EMPTY)` SUBAGOAL_TAC ;
  TYPE_THEN `B` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  USE 17( REWRITE_RULE[psegment;segment]);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  REWRITE_TAC[GSYM DE_MORGAN_THM];
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `edge e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  USE 20 (REWRITE_RULE[psegment;segment]);
  ASM_MESON_TAC[subset_imp];
  FULL_REWRITE_TAC[edge];
  TYPE_THEN `rectagon (A UNION B) /\ rectagon (A UNION C)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  (* - *)
  KILL 5;
  KILL 4;
  KILL 0;
  KILL 2;
  TYPE_THEN `~(A UNION C) e /\ (A UNION B) e` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[UNION];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  THM_INTRO_TAC[`(A UNION B)`;`m`] squ_left_odd;
  THM_INTRO_TAC[`(A UNION C)`;`m`] squ_left_even;
  ASM_MESON_TAC[];
  TYPE_THEN `e` UNABBREV_TAC;
  THM_INTRO_TAC[`A UNION B`;`m`] squ_down;
  FULL_REWRITE_TAC[rectagon];
  THM_INTRO_TAC[`A UNION C`;`m`] squ_down;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[set_lower_n];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let triple_in_comp = 
prove_by_refinement(
  `!A B C eps. psegment_triple A B C /\
     ~(C SUBSET par_cell eps (A UNION B)) ==>
    (C SUBSET par_cell (~eps) (A UNION B)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
  FULL_REWRITE_TAC[psegment_triple];
  USE 12 (REWRITE_RULE[psegment]);
  REWRITE_TAC[cls_union;];
  CONJ_TAC;
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  ONCE_REWRITE_TAC[INTER_COMM];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  TYPE_THEN `endpoint A` UNABBREV_TAC;
  TYPE_THEN `endpoint B` UNABBREV_TAC;
  TYPE_THEN `endpoint C` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[SUBSET_REFL];
  TYPE_THEN `eps' = eps` ASM_CASES_TAC;
  TYPE_THEN`eps'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps'` UNABBREV_TAC;
  ]);;
  (* }}} *)

let trap_odd_cell = 
prove_by_refinement(
  `!A B C. psegment_triple A B C ==>
   (A SUBSET par_cell F (B UNION C)) \/
   (B SUBSET par_cell F (A UNION C)) \/
   (C SUBSET par_cell F (A UNION B))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  TYPE_THEN `C SUBSET par_cell (~F) (A UNION B)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
  TYPE_THEN `A SUBSET par_cell (~F) (B UNION C)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
  IMATCH_MP_TAC  psegment_triple3;
  TYPE_THEN `B SUBSET par_cell (~F) (C UNION A)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
  CONJ_TAC;
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple3;
  USE 6(ONCE_REWRITE_RULE[UNION_COMM]);
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!A B. psegment_triple A B C /\ (C SUBSET par_cell T (A UNION B)) /\ (A SUBSET par_cell T (B UNION C)) ==> (par_cell F (A UNION B) SUBSET par_cell T (B UNION C))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`T`] trap_triple_seg;
  FULL_REWRITE_TAC[UNION_COMM];
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple2;
  FULL_REWRITE_TAC[UNION_COMM];
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`B'`;`C`;`A'`;`F`;`F`] trap_triple_seg;
    IMATCH_MP_TAC  psegment_triple3;
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[UNION_COMM];
  TYPE_THEN `par_cell F (B' UNION C) = par_cell F (A' UNION B')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`F`] triple_par_cell_distinct;
    IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple2;
  FULL_REWRITE_TAC[UNION_COMM];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `par_cell F (B' UNION A') SUBSET par_cell T (B' UNION A')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[UNION_COMM];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `par_cell F (B' UNION C)` EXISTS_TAC;
  (* -- *)
  THM_INTRO_TAC[`A' UNION B'`;`F` ] par_cell_nonempty;
  USE 9(REWRITE_RULE[psegment_triple]);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`A' UNION B'`;`F`] par_cell_disjoint;
  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
  TSPEC `u` 16;
  REWR 16;
  USE 14(REWRITE_RULE[SUBSET]);
  FULL_REWRITE_TAC[UNION_COMM];
  ASM_MESON_TAC[];
  (* -A *)
  COPY 7;
  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`B`]);
   UND 8  THEN DISCH_THEN (THM_INTRO_TAC[`B`;`A`]);
  FULL_REWRITE_TAC[UNION_COMM];
    IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple2;
  (* - *)
  FULL_REWRITE_TAC[UNION_COMM];
  THM_INTRO_TAC[`A UNION B`;`F`] par_cell_nonempty;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`A UNION B`;`u`;`F`] parity_unique;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  TYPE_THEN `par_cell T (A UNION C) u /\ par_cell T (B UNION C) u` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`A UNION C`;`u`;`T`] parity_unique;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  (* -B *)
  TYPE_THEN `cell u` SUBAGOAL_TAC;
  ASM_MESON_TAC[par_cell_cell;subset_imp];
  TYPE_THEN `!A B eps. rectagon (A UNION B) /\ (par_cell eps (A UNION B) u) ==> ~curve_cell A u` SUBAGOAL_TAC;
  THM_INTRO_TAC[`A' UNION B'`;`eps`] par_cell_curve_cell_disj;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
  TSPEC `u` 19;
  USE 19 (REWRITE_RULE[curve_cell_union;DE_MORGAN_THM ]);
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  USE 20 (REWRITE_RULE[UNION]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `segment A /\ segment B /\ segment C /\ segment (A UNION B) /\ segment (B UNION C) /\ segment (A UNION C) /\ (A INTER B = EMPTY) /\ (B INTER C = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment];
  FULL_REWRITE_TAC[UNION_COMM];
  REPEAT CONJ_TAC THEN (IMATCH_MP_TAC  rectagon_segment);
  (* -C *)
  THM_INTRO_TAC[`A`;`B`;`u`] parity_union;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `F` EXISTS_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  TYPE_THEN `A` EXISTS_TAC;
  USE 10 SYM;
  TYPE_THEN `F` EXISTS_TAC;
  FULL_REWRITE_TAC[UNION_COMM];
  FULL_REWRITE_TAC[psegment_triple];
  (* - *)
  THM_INTRO_TAC[`B`;`C`;`u`] parity_union;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `T` EXISTS_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `T` EXISTS_TAC;
  FULL_REWRITE_TAC[UNION_COMM];
  FULL_REWRITE_TAC[psegment_triple];
  (* - *)
  THM_INTRO_TAC[`A`;`C`;`u`] parity_union;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `T` EXISTS_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `T` EXISTS_TAC;
  FULL_REWRITE_TAC[UNION_COMM];
  FULL_REWRITE_TAC[psegment_triple];
  REWR 28;
  REWR 27;
  ]);;
    (* }}} *)


(* ------------------------------------------------------------------ *)
(* SECTION V *)
(* ------------------------------------------------------------------ *)

(* -- more on 2-connectedness, etc. *)

let euclid_diff_par_cell = 
prove_by_refinement(
  `!G eps. (segment G) ==>
    (euclid 2 DIFF UNIONS(par_cell (~eps) G) =
         UNIONS(par_cell eps G) UNION UNIONS (curve_cell G))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[DIFF;UNION];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  USE 3(REWRITE_RULE[DE_MORGAN_THM]);
  TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[ctop_unions;DIFF];
  (* -- *)
  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
  USE 6 SYM;
  REWR 5;
  FULL_REWRITE_TAC[UNION];
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  USE 1(REWRITE_RULE[UNIONS]);
  LEFT 1 "u";
  THM_INTRO_TAC[`u`] cell_euclid;
  THM_INTRO_TAC[`G`;`eps`] par_cell_cell;
  THM_INTRO_TAC[`G`] curve_cell_cell;
  FULL_REWRITE_TAC[segment];
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC[subset_imp];
  (* - *)
  THM_INTRO_TAC[`G`;`eps`] par_cell_union_disjoint;
  USE 3(REWRITE_RULE[INTER;EQ_EMPTY]);
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`G`] ctop_unions;
  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 5;
  FULL_REWRITE_TAC[DIFF];
  TYPE_THEN `~UNIONS (ctop G )x` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
  USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  FULL_REWRITE_TAC[UNION];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_closure_cell = 
prove_by_refinement(
  `!G C d eps.
       cell C /\ cell d /\ rectagon G /\ (d SUBSET closure top2 C) /\
          par_cell eps G C ==>
       (par_cell eps G d \/ curve_cell G d)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC top2_top;
  TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed;
  REWRITE_TAC[open_DEF];
  TYPE_THEN `UNIONS (par_cell (~eps) G) = EMPTY ` ASM_CASES_TAC;
  USE 5 (MATCH_MP   (REWRITE_RULE[open_DEF]open_EMPTY));
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`G`;`~eps`;`u`] par_cell_union_comp;
  IMATCH_MP_TAC ctop_comp_open ;
  ASM_MESON_TAC[rectagon];
  FULL_REWRITE_TAC[top2_unions];
  THM_INTRO_TAC[`G`;`eps`] euclid_diff_par_cell;
  IMATCH_MP_TAC  rectagon_segment;
  REWR 6;
  KILL 7;
  (* -A *)
  TYPE_THEN `closure top2 C SUBSET (UNIONS (par_cell eps G) UNION UNIONS (curve_cell G))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  closure_subset;
  IMATCH_MP_TAC  in_union;
  DISJ1_TAC;
  IMATCH_MP_TAC  sub_union;
  (* - *)
  TYPE_THEN `d SUBSET UNIONS (par_cell eps G) UNION UNIONS (curve_cell G)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[GSYM UNIONS_UNION];
  (* - *)
  THM_INTRO_TAC[`d`] cell_nonempty;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  (* - *)
  THM_INTRO_TAC[`par_cell eps G UNION curve_cell G`;`d`;`u`] cell_ununion;
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  REWRITE_TAC [par_cell_cell];
  THM_INTRO_TAC[`G`] curve_cell_cell;
  FULL_REWRITE_TAC[rectagon];
  REWRITE_TAC[UNIONS;UNION];
  USE 8(REWRITE_RULE[SUBSET;UNIONS]);
  TSPEC `u` 8;
  USE 8 (REWRITE_RULE[UNION]);
  TYPE_THEN `u'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[UNION];
  (* Thu Dec  2 09:50:25 EST 2004 *)
  ]);;
  (* }}} *)

let rectagon_curve = 
prove_by_refinement(
  `!G C a b. FINITE G /\ G SUBSET edge /\ simple_arc_end C a b /\
      (C INTER UNIONS (curve_cell G) = EMPTY) ==>
      (C SUBSET (component  (ctop G) a))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[SUBSET];
  TYPE_THEN `a = x` ASM_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  IMATCH_MP_TAC  component_refl;
  FULL_REWRITE_TAC[ctop_unions;DIFF;EQ_EMPTY ;INTER ];
  CONJ_TAC;
  USE 1 (MATCH_MP simple_arc_end_simple);
  USE 1 (MATCH_MP simple_arc_euclid);
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`G`;`a`;`x`] component_simple_arc;
  TYPE_THEN `x = b` ASM_CASES_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  (* - *)
  THM_INTRO_TAC[`C`;`a`;`b`;`x`] simple_arc_end_cut;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `(C' UNION C'') INTER UNIONS (curve_cell G)` EXISTS_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET;UNION];
  (* Thu Dec  2 10:11:45 EST 2004 *)

  ]);;
  (* }}} *)

(*  *)
let star_avoidance_lemma1 = 
prove_by_refinement(
  `!E E' R B x. bounded_set E x /\ E SUBSET E' /\ FINITE E' /\
       E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
       ~(UNIONS (curve_cell B) x) /\
       B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
        (bounded_set (E' DIFF B) x \/ unbounded_set (E' DIFF B) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`ctop E`;`x`] component_empty;
  REWRITE_TAC[ctop_top];
  (* - *)
  TYPE_THEN `UNIONS (ctop E) x` SUBAGOAL_TAC;
  USE 9 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] not_eq]);
  FULL_REWRITE_TAC[EMPTY_EXISTS;bounded_set];
  ASM_MESON_TAC[];
  KILL 9;
  (* - *)
  TYPE_THEN `UNIONS (ctop (E' DIFF B)) x` SUBAGOAL_TAC;
  REWRITE_TAC[ctop_unions];
  TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ;
  REWRITE_TAC[DIFF];
  CONJ_TAC;
  USE 10(REWRITE_RULE[ctop_unions;DIFF]);
  TYPE_THEN `E' = E'' UNION E'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  TYPE_THEN `E''` UNABBREV_TAC;
  REWRITE_TAC[DIFF;UNION];
  MESON_TAC[];
  THM_INTRO_TAC[`E''`;`E'`] curve_cell_union;
  USE 12 SYM;
  REWR 13;
  TYPE_THEN `UNIONS (curve_cell E') = UNIONS (curve_cell E'') UNION UNIONS(curve_cell E')` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM UNIONS_UNION];
  AP_TERM_TAC;
  ASM_MESON_TAC[];
  USE 14(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 14;
  USE 14(REWRITE_RULE[UNION]);
  ASM_MESON_TAC[];
  (* -A *)
  THM_INTRO_TAC[`E' DIFF B`] bounded_unbounded_union;
  USE 11(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 11;
  REWR 11;
  USE 11(REWRITE_RULE[UNION]);
  (* - *)
  ]);;
  (* }}} *)

let curve_cell_imp_subset = 
prove_by_refinement(
  `!A B. A SUBSET B ==> curve_cell A SUBSET curve_cell B`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `B = A UNION (B DIFF A)` SUBAGOAL_TAC;
  IMATCH_MP_TAC EQ_EXT;
  FULL_REWRITE_TAC [UNION;DIFF;SUBSET ];
  ASM_MESON_TAC [];
  TYPE_THEN `C = B DIFF A` ABBREV_TAC ;
  REWRITE_TAC[curve_cell_union];
  REWRITE_TAC[SUBSET;UNION];
  ]);;
  (* }}} *)

let unbound_set_x_axis = 
prove_by_refinement(
  `!G. (FINITE G /\ G SUBSET edge ) ==>
       (?r. !s. (r <= s) ==> unbounded_set G (point(s,&0)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[unbounded_set;unbounded;];
  NAME_CONFLICT_TAC;
  LEFT_TAC "r'";
  LEFT_TAC "r'";
  THM_INTRO_TAC[`G`] unbounded_set_nonempty;
  FULL_REWRITE_TAC[EMPTY_EXISTS;unbounded_set;unbounded];
  TYPE_THEN `r` EXISTS_TAC;
  TYPE_THEN `(\ (s:real). r)` EXISTS_TAC;
  COPY 2;
  TSPEC `s'` 2;
  TSPEC  `s''` 5;
  USE 4 (MATCH_MP component_symm);
  USE 4 (MATCH_MP component_replace);
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let star_avoidance = 
prove_by_refinement(
  `!E E' R B x. unbounded_set (E' DIFF B) x /\ E SUBSET E' /\ FINITE E' /\
       E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
       FINITE B /\ B SUBSET edge /\
       ~(UNIONS (curve_cell B) x) /\
       B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
        ( unbounded_set (E) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ;
  RULE_ASSUM_TAC (REWRITE_RULE[unbounded_set;unbounded]);
  (* - *)
  THM_INTRO_TAC[`R`] unbound_set_x_axis;
  FULL_REWRITE_TAC[rectagon];
  (* - *)
  TYPE_THEN `?r. !s. (r <= s) ==> component  (ctop E'') x (point(s,&0)) /\ ~(x = (point(s,&0))) /\ unbounded_set R (point(s,&0)) ` SUBAGOAL_TAC;
  TYPE_THEN `r'' = &1 + (||. r') + (||. r) + ||. (x 0)` ABBREV_TAC ;
  TYPE_THEN `r''` EXISTS_TAC;
  TYPE_THEN `r <= s` SUBAGOAL_TAC;
  UNDF `r'' <= s` THEN UND 13 THEN REAL_ARITH_TAC;
  CONJ_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[coord01];
  UND 13 THEN UND 14 THEN REAL_ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 13 THEN UND 14 THEN REAL_ARITH_TAC;
  KILL 12;
  KILL 10;
  (* - *)
  TYPE_THEN `FINITE E'' /\ E'' SUBSET edge` SUBAGOAL_TAC;
  TYPE_THEN `E''` UNABBREV_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_DIFF;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET_DIFF];
  (* - *)
  TYPE_THEN `!s. ?C. (r'' <= s) ==> (simple_arc_end C x (point(s,&0))  /\ (C INTER UNIONS (curve_cell E'') = {}))` SUBAGOAL_TAC;
  TSPEC `s` 13;
  RIGHT_TAC "C";
  THM_INTRO_TAC[`E''`;`x`;`point(s,&0)`] component_simple_arc;
  ASM_MESON_TAC[];
  (* -A *)
  REWRITE_TAC[unbounded_set;unbounded];
  TYPE_THEN `r''` EXISTS_TAC;
  TSPEC `s` 13;
  TSPEC `s` 14;
  THM_INTRO_TAC[`E`;`x`;`point(s,&0)`] component_simple_arc;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  TYPE_THEN `C` EXISTS_TAC;
  (* - *)
  TYPE_THEN `R SUBSET E''` SUBAGOAL_TAC;
  TYPE_THEN `E''` UNABBREV_TAC;
  REWRITE_TAC[DIFF_SUBSET];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
  FULL_REWRITE_TAC[rectagon];
  USE 21(REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u` 21;
  UND 21 THEN ASM_REWRITE_TAC[];
  CONJ_TAC;
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC[curve_cell_subset;subset_imp];
  (* -B *)
  TYPE_THEN `C INTER UNIONS(curve_cell R) = EMPTY` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C INTER UNIONS (curve_cell E'')` EXISTS_TAC;
  IMATCH_MP_TAC subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  IMATCH_MP_TAC  UNIONS_UNIONS;
  IMATCH_MP_TAC  curve_cell_imp_subset;
  (* - *)
  THM_INTRO_TAC[`R`;`C`;`x`;`point(s,&0)`] rectagon_curve;
  FULL_REWRITE_TAC[rectagon];
  (* - *)
  THM_INTRO_TAC[`R`]unbounded_set_comp;
  FULL_REWRITE_TAC[rectagon];
  TYPE_THEN `component  (ctop R) x' = component  (ctop R) (point(s,&0))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  component_replace;
  USE 23 SYM;
  ASM_REWRITE_TAC[];
  TYPE_THEN `component  (ctop R) x'` UNABBREV_TAC;
  TYPE_THEN `component  (ctop R) x = component  (ctop R) (point(s,&0))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  component_replace;
  USE 22(REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* -C *)
  THM_INTRO_TAC[`R`;`B`;`F`] par_cell_closure;
  (* - *)
  TYPE_THEN `C INTER UNIONS (curve_cell B) = EMPTY` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (par_cell T R) INTER UNIONS (curve_cell B)` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  THM_INTRO_TAC[`R`] unbounded_even;
  USE 26 SYM;
  ASM_MESON_TAC[];
  ONCE_REWRITE_TAC[INTER_COMM];
  FULL_REWRITE_TAC[SUBSET_EMPTY ];
  THM_INTRO_TAC[`curve_cell B`;`par_cell T R`] cell_unions_disj;
  THM_INTRO_TAC[`B`]curve_cell_cell;
  THM_INTRO_TAC[`R`]par_cell_cell;
  USE 26 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `E SUBSET E'' UNION B` SUBAGOAL_TAC;
  TYPE_THEN `E''` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;DIFF;UNION];
  ASM_MESON_TAC[subset_imp];
  (* - *)
  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C INTER UNIONS (curve_cell (E'' UNION B))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  IMATCH_MP_TAC  UNIONS_UNIONS;
  IMATCH_MP_TAC  curve_cell_imp_subset;
  (* - *)
  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  (* Thu Dec  2 16:12:59 EST 2004 *)

  ]);;
  (* }}} *)

let star_avoidance_contrp = 
prove_by_refinement(
  `!E E' R B x. bounded_set (E) x /\ E SUBSET E' /\ FINITE E' /\
       E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
       FINITE B /\ B SUBSET edge /\
       ~(UNIONS (curve_cell B) x) /\
       B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
        ( bounded_set (E' DIFF B) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance_lemma1;
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance;
  THM_INTRO_TAC[`E`] bounded_unbounded_disj;
  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let bounded_avoidance_subset = 
prove_by_refinement(
  `!E E' x. bounded_set E x /\ E SUBSET E' /\ (E' SUBSET edge) /\
     (FINITE E') /\
           conn2 E /\
        ~(UNIONS (curve_cell E') x) ==>
       (bounded_set E' x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`] conn2_has_rectagon;
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance_contrp;
  ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty];
  FULL_REWRITE_TAC[DIFF_EMPTY];
  ]);;
  (* }}} *)

let unbounded_avoidance_subset = 
prove_by_refinement(
  `!E E' x.  (unbounded_set E' x) /\ E SUBSET E' /\ (E' SUBSET edge) /\
     (FINITE E') /\
           conn2 E /\
        ~(UNIONS (curve_cell E') x) ==> unbounded_set E x
       `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`] conn2_has_rectagon;
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance;
  ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty;DIFF_EMPTY];
  ]);;
  (* }}} *)

let diff_unchange = 
prove_by_refinement(
  `! (A:A -> bool) B. (A DIFF B = A) <=> (A INTER B = EMPTY)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  USE 0(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 0(REWRITE_RULE[DIFF]);
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[EQ_EMPTY;INTER];
  ASM_MESON_TAC[];
  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  IMATCH_MP_TAC  EQ_EXT;
  FULL_REWRITE_TAC[DIFF;INTER];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let union_diff2 = 
prove_by_refinement(
  `!(A:A->bool) B. (A UNION B) DIFF A = (B DIFF A)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;DIFF;];
  MESON_TAC[];
  ]);;
  (* }}} *)

let unbounded_triple_avoidance = 
prove_by_refinement(
  `!A B C x. psegment_triple A B C /\
       A SUBSET par_cell F (B UNION C) /\
       unbounded_set (B UNION C) x ==>
       unbounded_set (A UNION B UNION C) x`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance;
  CONJ_TAC;
  TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC;
  ONCE_REWRITE_TAC [union_diff2];
  REWRITE_TAC[diff_unchange];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[psegment_triple];
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[SUBSET_REFL];
  CONJ_TAC;
  REWRITE_TAC[FINITE_UNION];
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment;segment];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment;segment];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  USE 15 (REWRITE_RULE[segment;psegment]);
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  USE 15 (REWRITE_RULE[segment;psegment]);
  SUBCONJ_TAC;
  THM_INTRO_TAC[`(B UNION C)`;`A`;`F`] par_cell_closure;
  FULL_REWRITE_TAC[psegment_triple];
  USE 16 (REWRITE_RULE[psegment;segment]);
  THM_INTRO_TAC[`B UNION C`] unbounded_even;
  FULL_REWRITE_TAC[psegment_triple];
  REWR 0;
  KILL 5;
  FULL_REWRITE_TAC[UNIONS];
  TYPE_THEN `u = u'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cell_partition;
  REWRITE_TAC[EMPTY_EXISTS;INTER ];
  THM_INTRO_TAC[`A`] curve_cell_cell;
  FULL_REWRITE_TAC[psegment_triple];
  USE 19 (REWRITE_RULE[psegment;segment;]);
  REPEAT CONJ_TAC THEN (TRY (ASM_MESON_TAC[par_cell_cell;subset_imp]));
  TYPE_THEN`u'` UNABBREV_TAC;
  USE 4 (REWRITE_RULE [EQ_EMPTY;INTER]);
  ASM_MESON_TAC[];
  (* -A *)
  USE 3(ONCE_REWRITE_RULE[curve_cell_union; ]);
  USE 3(REWRITE_RULE[UNIONS_UNION]);
  TYPE_THEN `D =  B UNION C` ABBREV_TAC ;
  USE 3(REWRITE_RULE[UNION]);
  REWR 3;
  TYPE_THEN `D` UNABBREV_TAC;
  THM_INTRO_TAC[`B UNION C`;`T`] unions_curve_cell_par_cell_disj;
  FULL_REWRITE_TAC[psegment_triple];
  USE 12(REWRITE_RULE[rectagon]);
  THM_INTRO_TAC[`B UNION C`] unbounded_even;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let unbounded_set_comp_elt_eq = 
prove_by_refinement(
  `! G x. FINITE G /\
          G SUBSET edge /\ unbounded_set G x ==>
          (unbounded_set G = component (ctop G) x)
          `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`] unbounded_set_comp;
  IMATCH_MP_TAC  component_replace;
  REWR 0;
  ]);;
  (* }}} *)

let outer_segment_even = 
prove_by_refinement(
  `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C)
     ==> C SUBSET par_cell T (A UNION B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple;psegment;segment];
  TYPE_THEN `C` UNABBREV_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  (* - *)
  THM_INTRO_TAC[`B UNION C`] unbounded_set_nonempty;
  FULL_REWRITE_TAC[psegment_triple];
  USE 10(REWRITE_RULE [rectagon]);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  (* - *)
  THM_INTRO_TAC[`B UNION C`;`u'`] unbounded_set_comp_elt_eq;
  FULL_REWRITE_TAC[psegment_triple];
  USE 11 (REWRITE_RULE[rectagon]);
  THM_INTRO_TAC[`B UNION C`;`u'`;`u`] along_lemma11;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  rectagon_segment;
  REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[UNION];
  (* - *)
  THM_INTRO_TAC[`squ p`] cell_nonempty;
  REWRITE_TAC[cell_rules];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `unbounded_set (B UNION C) u''` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  (* -A *)
  THM_INTRO_TAC[`A`;`B`;`C`;`u''`] unbounded_triple_avoidance;
  THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`u''`] unbounded_avoidance_subset;
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  FIRST_ASSUM DISJ_CASES_TAC;
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment;segment];
  CONJ_TAC;
  REWRITE_TAC[FINITE_UNION];
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment;segment];
  CONJ_TAC;
  IMATCH_MP_TAC  conn2_rectagon;
  FULL_REWRITE_TAC[psegment_triple];
  (* --B *)
  TYPE_THEN `D = B UNION C` ABBREV_TAC ;
  USE 10(REWRITE_RULE[curve_cell_union;]);
  USE 10(REWRITE_RULE[UNIONS_UNION]);
  USE 10(REWRITE_RULE[UNION]);
  THM_INTRO_TAC[`D`] unbounded_even;
  TYPE_THEN `D` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  KILL 4;
  TYPE_THEN `unbounded_set D` UNABBREV_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`D`;`A`;`F`] par_cell_closure;
  TYPE_THEN `D` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  USE 23(REWRITE_RULE[psegment;segment]);
  THM_INTRO_TAC[`curve_cell A`;`par_cell T D`] cell_unions_disj;
  THM_INTRO_TAC[`A`] curve_cell_cell;
  FULL_REWRITE_TAC[psegment_triple];
  USE 25(REWRITE_RULE[psegment;segment]);
  THM_INTRO_TAC[`D`] par_cell_cell;
  REWR 12;
  REWR 13;
  USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  (* -- *)
  THM_INTRO_TAC[`D`;`T`]unions_curve_cell_par_cell_disj;
  FULL_REWRITE_TAC[psegment_triple];
  TYPE_THEN `D` UNABBREV_TAC;
  USE 19 (REWRITE_RULE[rectagon]);
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* -C *)
  THM_INTRO_TAC[`A UNION B`] unbounded_even;
  FULL_REWRITE_TAC[psegment_triple];
  KILL 4;
  TYPE_THEN `unbounded_set (A UNION B)` UNABBREV_TAC;
  THM_INTRO_TAC[`par_cell T (A UNION B)`;`squ p`;`u''`] cell_ununion;
  REWRITE_TAC[par_cell_cell;cell_rules];
  THM_INTRO_TAC[`A UNION B`;`squ p`;`u`;`T`] par_cell_closure_cell;
  REWRITE_TAC[cell_rules;squ_closure];
  CONJ_TAC;
  IMATCH_MP_TAC  edge_cell;
  FULL_REWRITE_TAC[psegment_triple];
  USE 21 (REWRITE_RULE[psegment;segment]);
  ASM_MESON_TAC[subset_imp];
  FULL_REWRITE_TAC[psegment_triple];
  (* - *)
  THM_INTRO_TAC[`A UNION B`;`u`] curve_cell_edge;
  FULL_REWRITE_TAC[psegment_triple];
  USE 22 (REWRITE_RULE[psegment;segment]);
  ASM_MESON_TAC[subset_imp];
  REWR 11;
  KILL 12;
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC ;
  THM_INTRO_TAC[`A UNION B`;`C`] segment_in_comp;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  CONJ_TAC;
    FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[cls_union];
  ONCE_REWRITE_TAC[INTER_COMM];
    REWRITE_TAC[UNION_OVER_INTER;union_subset];
     FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[INTER_COMM];
  ASM_MESON_TAC[SUBSET_REFL];
  (* -- *)
  TYPE_THEN `eps = T` ASM_CASES_TAC;
  TYPE_THEN `eps` UNABBREV_TAC;
  TYPE_THEN `eps = F` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint;
  USE 15(REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u` 15;
  USE 13 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  (* - *)
  USE 12 (REWRITE_RULE[UNION]);
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let meeting_lemma = 
prove_by_refinement(
  `!R B C v eps. rectagon R /\ B SUBSET par_cell eps R /\
    (C INTER R = EMPTY) /\ cls R INTER cls C SUBSET endpoint C /\
     cls C v /\ cls B v /\ ~cls R v /\ segment C /\ B SUBSET edge ==>
    C SUBSET par_cell eps R`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`R`;`C`] segment_in_comp;
  TYPE_THEN `eps' = eps` ASM_CASES_TAC ;
  TYPE_THEN `eps'` UNABBREV_TAC;
  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps'` UNABBREV_TAC;
  KILL 10;
  (* - *)
  TYPE_THEN `~(C INTER par_cell eps R = EMPTY)` BACK_TAC ;
  USE 10(REWRITE_RULE[INTER;EMPTY_EXISTS ]);
  THM_INTRO_TAC[`R`;`eps`] par_cell_disjoint;
  USE 12(REWRITE_RULE[INTER;EQ_EMPTY]);
  USE 9 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `?eC. closure top2 eC (pointI v) /\ C eC` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[cls];
  ASM_MESON_TAC[];
  TYPE_THEN `?eB. closure top2 eB (pointI v) /\ B eB` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[cls];
  ASM_MESON_TAC[];
  (* - *)
  UND 10 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `eC` EXISTS_TAC;
  IMATCH_MP_TAC  par_cell_nbd;
  TYPE_THEN `v` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  FULL_REWRITE_TAC[segment];
  ASM_MESON_TAC[subset_imp];
  (* - *)
  THM_INTRO_TAC[`R`;`eB`;`{(pointI v)}`;`eps`] par_cell_closure_cell;
  REWRITE_TAC[cell_rules;SUBSET;INR IN_SING];
  CONJ_TAC;
  IMATCH_MP_TAC  edge_cell;
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC[subset_imp];
  PROOF_BY_CONTR_TAC;
  REWR 10;
  THM_INTRO_TAC[`R`;`v`] curve_cell_not_point;
  IMATCH_MP_TAC  rectagon_segment;
  UND 16 THEN ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`R`;`pointI v`] num_closure0;
  FULL_REWRITE_TAC[rectagon];
  USE 2(REWRITE_RULE[cls]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let parity_union_triple = 
prove_by_refinement(
  `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\
      (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
     /\ (A SUBSET edge) /\  A e ==>
       (parity (B UNION C) e = (parity B e = parity C e))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `edge e` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`B`;`C`;`e`] parity_union;
  CONJ_TAC;
  IMATCH_MP_TAC  edge_cell;
  (* - *)
  TYPE_THEN `~B e /\ ~C e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  ASM_SIMP_TAC[curve_cell_edge];
  ]);;
  (* }}} *)

let parity_union_triple_even = 
prove_by_refinement(
  `!A B C e.  segment B /\ segment C /\ (segment (B UNION C)) /\
      (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
     /\ (segment A ) /\  A e /\
   A SUBSET par_cell T (B UNION C) ==> (parity B e = parity C e)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple;
  FULL_REWRITE_TAC[segment];
  USE 9(ONCE_REWRITE_RULE[EQ_SYM_EQ]);
  THM_INTRO_TAC[`B UNION C`;`e`;`T`] parity_unique;
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let parity_union_triple_odd = 
prove_by_refinement(
  `!A B C e.  segment B /\ segment C /\ (segment (B UNION C)) /\
      (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
     /\ (A SUBSET edge) /\ A e /\
   A SUBSET par_cell F (B UNION C) ==> ~(parity B e = parity C e)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple;
  REWR 10;
  THM_INTRO_TAC[`B UNION C`;`e`;`F`] parity_unique;
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let par_cell_even_imp = 
prove_by_refinement(
  `!A B C D. psegment_triple A B D /\ segment C /\
    cls (A UNION B) INTER cls C SUBSET endpoint C /\
    (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY)
    /\ C SUBSET par_cell T (B UNION D) /\ C SUBSET par_cell T (A UNION D)
   ==> C SUBSET par_cell T (A UNION B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
  REWRITE_TAC[cls_union];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  (* - *)
  TYPE_THEN `eps = T` ASM_CASES_TAC;
  TYPE_THEN `eps` UNABBREV_TAC;
  TYPE_THEN `eps = F` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  KILL 9;
  PROOF_BY_CONTR_TAC;
  (* - *)
  TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN  `u` EXISTS_TAC;
  ASM_MESON_TAC[subset_imp];
  (* - *)
  THM_INTRO_TAC[`C`;`A`;`D`;`e`]  parity_union_triple_even;
  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
  IMATCH_MP_TAC  rectagon_segment;
  THM_INTRO_TAC[`C`;`B`;`D`;`e`]  parity_union_triple_even;
  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
  IMATCH_MP_TAC  rectagon_segment;
  TYPE_THEN `parity D e` UNABBREV_TAC;
  USE 12 SYM;
  (* - *)
  THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple;
  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  USE 6(REWRITE_RULE[segment]);
  REWR 13;
  (* - *)
  THM_INTRO_TAC[`(A UNION B)`;`e`] parity;
  ASM_SIMP_TAC[curve_cell_edge];
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  CONJ_TAC;
  IMATCH_MP_TAC  edge_cell;
  USE 27 (REWRITE_RULE[UNION]);
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`A UNION B`;`parity(A UNION B) e`] par_cell_disjoint;
  USE 15(REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `e` 15;
  UND 15 THEN ASM_REWRITE_TAC[];
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let par_cell_odd_imp = 
prove_by_refinement(
  `!A B C D. psegment_triple A B D /\ segment C /\
    cls (A UNION B) INTER cls C SUBSET endpoint C /\
    (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY)
    /\ C SUBSET par_cell F (B UNION D) /\ C SUBSET par_cell T (A UNION D)
   ==> C SUBSET par_cell F (A UNION B)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
  REWRITE_TAC[cls_union];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  (* - *)
  TYPE_THEN `eps = F` ASM_CASES_TAC;
  TYPE_THEN `eps` UNABBREV_TAC;
  TYPE_THEN `eps = T` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  KILL 9;
  PROOF_BY_CONTR_TAC;
  (* - *)
  TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN  `u` EXISTS_TAC;
  ASM_MESON_TAC[subset_imp];
  (* - *)
  THM_INTRO_TAC[`C`;`A`;`D`;`e`]  parity_union_triple_even;
  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
  IMATCH_MP_TAC  rectagon_segment;
  THM_INTRO_TAC[`C`;`B`;`D`;`e`]  parity_union_triple_odd;
  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  USE 6 (REWRITE_RULE[segment]);
  TYPE_THEN `parity D e` UNABBREV_TAC;
  USE 13 GSYM;
  (* - *)
  THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple;
  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  USE 6(REWRITE_RULE[segment]);
  (* - *)
  THM_INTRO_TAC[`(A UNION B)`;`e`] parity;
  ASM_SIMP_TAC[curve_cell_edge];
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  CONJ_TAC;
  IMATCH_MP_TAC  edge_cell;
  USE 27 (REWRITE_RULE[UNION]);
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `parity(A UNION B) e = F` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILL 13 THEN REWR 14;
  UND 9 THEN ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`A UNION B`;`F`] par_cell_disjoint;
  USE 9(REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `e` 9;
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let curve_cell_cls = 
prove_by_refinement(
  `!G m. segment G ==> (curve_cell G {(pointI m)} = cls G m)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASM_SIMP_TAC[curve_cell_not_point];
  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
  FULL_REWRITE_TAC[segment];
  REWRITE_TAC[cls];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let conn2_rect_diff_inner = 
prove_by_refinement(
  `!E R. conn2 E /\ (E SUBSET edge) /\ rectagon R /\ R SUBSET E ==>
     conn2 (E DIFF (E INTER par_cell F R))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[conn2];
  TYPE_THEN `J = E INTER par_cell F R` ABBREV_TAC ;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  (* - *)
  TYPE_THEN `R SUBSET E DIFF J` SUBAGOAL_TAC;
  REWRITE_TAC[DIFF_SUBSET];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC [EMPTY_EXISTS;INTER];
  TYPE_THEN `J` UNABBREV_TAC;
  THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
  FULL_REWRITE_TAC[rectagon];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  TSPEC `u` 10;
  THM_INTRO_TAC[`R`;`u`] curve_cell_edge;
  FULL_REWRITE_TAC[rectagon];
  ASM_MESON_TAC[subset_imp];
  REWR 10;
  (* -/ *)
  THM_INTRO_TAC[`R`] conn2_rectagon;
  CONJ_TAC;
  THM_INTRO_TAC[`R`;`E DIFF J`] CARD_SUBSET;
  FULL_REWRITE_TAC[conn2];
  UND 10 THEN UND 11 THEN ARITH_TAC;
  TYPE_THEN `(E DIFF J) UNION J = E` SUBAGOAL_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[DIFF;INTER;UNION];
  MESON_TAC[];
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]);
  UND 15 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
  REWRITE_TAC[cls_union];
  REWRITE_TAC[UNION];
  (* -A *)
  TYPE_THEN `S SUBSET E DIFF J` ASM_CASES_TAC;
  TYPE_THEN `S` EXISTS_TAC;
  TYPE_THEN `~(S INTER J = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `~(S = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end;segment;psegment];
  TYPE_THEN `S` UNABBREV_TAC ;
  USE 20 (REWRITE_RULE[EMPTY_EXISTS]);
  UND 20 THEN UND 19 THEN UND 18 THEN UND 17 THEN REWRITE_TAC[EQ_EMPTY;SUBSET;INTER;DIFF] THEN MESON_TAC[];
  (* -/ *)
  THM_INTRO_TAC[`R`;`T`;`{(pointI a)}`] par_cell_cell_partition;
  REWRITE_TAC[cell_rules];
  IMATCH_MP_TAC  rectagon_segment;
  TYPE_THEN `par_cell T R {(pointI a)} \/ cls R a` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[cls];
  USE 14 (REWRITE_RULE[DIFF]);
  THM_INTRO_TAC[`R`;`F`;`a`;`e'`] par_cell_nbd;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `J` UNABBREV_TAC;
  USE 14(REWRITE_RULE[INTER]);
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`R`;`a`]curve_cell_cls;
  IMATCH_MP_TAC  rectagon_segment;
  ASM_MESON_TAC[];
  (* -B/ *)
  KILL 20;
  THM_INTRO_TAC[`R`;`T`;`{(pointI b)}`] par_cell_cell_partition;
  REWRITE_TAC[cell_rules];
  IMATCH_MP_TAC  rectagon_segment;
  (* - *)
  TYPE_THEN `par_cell T R {(pointI b)} \/ cls R b` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[cls];
  USE 25 (REWRITE_RULE[DIFF]);
  THM_INTRO_TAC[`R`;`F`;`b`;`e`] par_cell_nbd;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `J` UNABBREV_TAC;
  USE 25(REWRITE_RULE[INTER]);
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`R`;`b`]curve_cell_cls;
  IMATCH_MP_TAC  rectagon_segment;
  ASM_MESON_TAC[];
  KILL 20;
  KILL 18;
  USE 19 (REWRITE_RULE [EMPTY_EXISTS;INTER]);
  (* -C/ *)
  TYPE_THEN `~cls J a \/ cls R a` SUBAGOAL_TAC;
  UND 21 THEN DISCH_THEN DISJ_CASES_TAC;
  DISJ1_TAC;
  USE 21(REWRITE_RULE[cls]);
  THM_INTRO_TAC[`R`;`T`;`a`;`e`] par_cell_nbd;
  TYPE_THEN `J` UNABBREV_TAC;
  USE 23(REWRITE_RULE[INTER]);
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `J` UNABBREV_TAC;
  USE 23(REWRITE_RULE[INTER]);
  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
  USE 25(REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  (* -/ *)
  TYPE_THEN `~cls J b \/ cls R b` SUBAGOAL_TAC;
  UND 22 THEN DISCH_THEN DISJ_CASES_TAC;
  DISJ1_TAC;
  USE 23(REWRITE_RULE[cls]);
  THM_INTRO_TAC[`R`;`T`;`b`;`e`] par_cell_nbd;
  TYPE_THEN `J` UNABBREV_TAC;
  USE 24(REWRITE_RULE[INTER]);
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `J` UNABBREV_TAC;
  USE 24(REWRITE_RULE[INTER]);
  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
  USE 26(REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  (* -D/ *)
  TYPE_THEN `!a b S'. (S' SUBSET S) /\ segment_end S' a b /\ (cls S' INTER cls (R UNION J) = {b}) ==> cls R b /\ (S' INTER (R UNION J) = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `S' INTER (R UNION J) = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 27 (REWRITE_RULE[INTER;UNION ]);
  THM_INTRO_TAC[`u'`] two_endpoint;
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  UND 28 THEN UND 31 THEN MESON_TAC[subset_imp];
  TYPE_THEN `!n. closure top2 u' (pointI n) ==> (n = b')` SUBAGOAL_TAC;
  USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `n` 24;
  USE 24 (REWRITE_RULE[INTER;INR IN_SING]);
  USE 24 SYM;
  TYPE_THEN `{u'} SUBSET S' /\ {u'} SUBSET (R UNION J)` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET;INR IN_SING;UNION ];
  USE 31(MATCH_MP cls_subset);
  USE 32(MATCH_MP cls_subset);
  FULL_REWRITE_TAC[cls_edge];
  FULL_REWRITE_TAC[SUBSET];
  USE 29 (REWRITE_RULE[has_size2]);
  USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 31(REWRITE_RULE[INR in_pair]);
  COPY 31;
  TSPEC `a''` 32;
  TSPEC `b''` 31;
  REWR 31;
  REWR 32;
  UND 29 THEN REWRITE_TAC[];
  (* --E *)
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `cls J b'` SUBAGOAL_TAC;
  USE 24(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 24(REWRITE_RULE[INTER;INR IN_SING]);
  TSPEC `b'` 24;
  USE 24(REWRITE_RULE[cls_union]);
  USE 24(REWRITE_RULE[UNION]);
  REWR 24;
  (* --/ *)
  TYPE_THEN`par_cell F R {(pointI b')}` SUBAGOAL_TAC;
  THM_INTRO_TAC[`R`;`T`;`{(pointI b')}`] par_cell_cell_partition;
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  REWRITE_TAC[cell_rules];
  UND 30 THEN REP_CASES_TAC;
  USE 29 (REWRITE_RULE[cls]);
  THM_INTRO_TAC[`R`;`e`;`{(pointI b')}`;`F`] par_cell_closure_cell;
  REWRITE_TAC[cell_rules];
  REWRITE_TAC[SUBSET;INR IN_SING];
  TYPE_THEN `J` UNABBREV_TAC;
  USE 31 (REWRITE_RULE[INTER]);
  IMATCH_MP_TAC  edge_cell;
  UND 31 THEN UND 2 THEN MESON_TAC[subset_imp];
  FIRST_ASSUM DISJ_CASES_TAC  ;
  THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
  FULL_REWRITE_TAC[rectagon];
  THM_INTRO_TAC[`R`;`b'`] curve_cell_cls;
  IMATCH_MP_TAC  rectagon_segment;
  REWR 33;
  THM_INTRO_TAC[`R`;`b'`] curve_cell_cls;
  IMATCH_MP_TAC  rectagon_segment;
  REWR 30;
  (* --/ *)
  USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 24 (REWRITE_RULE[INR IN_SING;cls_union]);
  TSPEC `b'` 24;
  USE 24 (REWRITE_RULE[INTER;UNION]);
  USE 31(REWRITE_RULE[cls]);
  THM_INTRO_TAC[`R`;`F`;`b'`;`e`] par_cell_nbd;
  USE 16 (REWRITE_RULE[segment_end;segment;psegment]);
  UND 36 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  USE 27(REWRITE_RULE[EQ_EMPTY;INTER;UNION]);
  TSPEC `e` 27;
  UND 27 THEN ASM_REWRITE_TAC[];
  DISJ2_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[INTER];
  UND 17 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  (* -F *)
  TYPE_THEN `?m. (cls R m /\ cls S m)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`R`;`S`] segment_in_comp;
  FULL_REWRITE_TAC[segment_end;psegment];
  LEFT 25  "m" ;
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  USE 28(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
  THM_INTRO_TAC[`u'`] two_endpoint;
  UND 29 THEN UND 17 THEN UND 2 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  USE 30(REWRITE_RULE[has_size2]);
  USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `a'` 31;
  USE 31(REWRITE_RULE[INR in_pair]);
  TSPEC `a'` 25;
  USE 25(REWRITE_RULE[cls]);
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `EMPTY:((int#int)->bool)` EXISTS_TAC;
  REWRITE_TAC[SUBSET_EMPTY;EQ_EMPTY;INTER;];
  TSPEC `x` 25;
  UND 25 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `eps = T` ASM_CASES_TAC ;
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
  USE 27(REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u` 27;
  USE 26(REWRITE_RULE[SUBSET]);
  TYPE_THEN`J` UNABBREV_TAC;
  USE 18 (REWRITE_RULE[INTER]);
  UND 6 THEN UND 26 THEN UND 27 THEN UND 19 THEN MESON_TAC[];
  TYPE_THEN `eps = F` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILL 27;
  TYPE_THEN `eps` UNABBREV_TAC;
  USE 16 (REWRITE_RULE[segment_end]);
  THM_INTRO_TAC[`S`;`a`] terminal_endpoint;
  USE 16 (REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `a` 16;
  FULL_REWRITE_TAC[psegment;segment;INR in_pair];
  TYPE_THEN `e = terminal_edge S a` ABBREV_TAC ;
  USE 20 (REWRITE_RULE[cls]);
  FIRST_ASSUM DISJ_CASES_TAC;
  LEFT 31 "e";
  TSPEC `e` 31;
  TYPE_THEN `J` UNABBREV_TAC;
  USE 31(REWRITE_RULE[INTER]);
  UND 6 THEN ASM_REWRITE_TAC[];
  UND 29 THEN UND 26 THEN UND 17 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  LEFT 25 "m";
  TSPEC `a` 25;
  USE 25 (REWRITE_RULE[cls]);
  KILL 24;
  ASM_MESON_TAC[];
  (* -G/ *)
  TYPE_THEN `conn2 R` SUBAGOAL_TAC;
  USE 27(REWRITE_RULE[conn2]);
  TSPEC `m` 27;
  LEFT 27 "c";
  TSPEC `c` 27;
  (* - a case *)
  TYPE_THEN `(~(a = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' a m /\ ~cls S' c)` SUBAGOAL_TAC;
  TYPE_THEN `cls R a` ASM_CASES_TAC;
  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`a`]);
  KILL 24;
  ASM_MESON_TAC[];
  TYPE_THEN `S'` EXISTS_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `R` EXISTS_TAC;
  (* -- *)
  TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' a m` SUBAGOAL_TAC;
  TYPE_THEN `m = b` ASM_CASES_TAC;
  TYPE_THEN `S` EXISTS_TAC;
  REWRITE_TAC[SUBSET_REFL];
  THM_INTRO_TAC[`S`;`a`;`b`;`m`] cut_psegment;
  TYPE_THEN `A` EXISTS_TAC;
  REWRITE_TAC[SUBSET_UNION];
  THM_INTRO_TAC[`R UNION J`;`S'`;`a`;`m`] segment_end_select;
  REWRITE_TAC[cls_union;union_subset];
  ASM_REWRITE_TAC[UNION];
  IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  REWR 20;
  CONJ_TAC;
  FULL_REWRITE_TAC [rectagon];
  TYPE_THEN `J` UNABBREV_TAC;
  UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[];
  (* -- *)
  UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`c'`;`B`]);
  UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  TYPE_THEN `c' = m` ASM_CASES_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  CONJ_TAC;
  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
  UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
  TYPE_THEN `c'` UNABBREV_TAC;
  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  UND 39 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  (* -- *)
  TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC;
  CONJ_TAC;
  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
  UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  UND 41 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  (* -- *)
  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]);
  CONJ_TAC;
  TYPE_THEN `c'` UNABBREV_TAC;
  USE 37(MATCH_MP segment_end_cls2);
  UND 40 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `c` UNABBREV_TAC;
  USE 32 (MATCH_MP segment_end_cls2);
  TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  UND 25 THEN UND 3 THEN MESON_TAC[];
  USE 42 (ONCE_REWRITE_RULE[segment_end_symm]);
  (* -- *)
  TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `R` EXISTS_TAC;
  THM_INTRO_TAC[`B`;`S''`;`a`;`c'`;`m`] segment_end_trans;
  TYPE_THEN `U` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `B UNION S''` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  USE 48(REWRITE_RULE[cls_union]);
  UND 48 THEN UND 47 THEN UND 40 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
  (* -H *)
    TYPE_THEN `(~(b = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' b m /\ ~cls S' c)` SUBAGOAL_TAC;
  TYPE_THEN `cls R b` ASM_CASES_TAC;
  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`b`]);
  KILL 24;
  ASM_MESON_TAC[];
  TYPE_THEN `S'` EXISTS_TAC;
  USE 33(ONCE_REWRITE_RULE[segment_end_symm]);
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `R` EXISTS_TAC;
  (* -- *)
  TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' b m` SUBAGOAL_TAC;
  TYPE_THEN `m = a` ASM_CASES_TAC;
  TYPE_THEN `S` EXISTS_TAC;
  REWRITE_TAC[SUBSET_REFL];
  USE 16 (ONCE_REWRITE_RULE[segment_end_symm]);
  THM_INTRO_TAC[`S`;`b`;`a`;`m`] cut_psegment;
  USE 16 (ONCE_REWRITE_RULE[segment_end_symm]);
  TYPE_THEN `A` EXISTS_TAC;
  REWRITE_TAC[SUBSET_UNION];
  (* -- *)
  THM_INTRO_TAC[`R UNION J`;`S'`;`b`;`m`] segment_end_select;
  REWRITE_TAC[cls_union;union_subset];
  ASM_REWRITE_TAC[UNION];
  IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  REWR 23;
  CONJ_TAC;
  FULL_REWRITE_TAC [rectagon];
  TYPE_THEN `J` UNABBREV_TAC;
  UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[];
  (* -- *)
  UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`b`;`c'`;`B`]);
  UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  TYPE_THEN `c' = m` ASM_CASES_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  CONJ_TAC;
  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
  UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
  TYPE_THEN `c'` UNABBREV_TAC;
  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  UND 40 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  (* -- *)
  TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC;
  CONJ_TAC;
  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
  UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  UND 42 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
  (* -- *)
  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]);
  CONJ_TAC;
  TYPE_THEN `c'` UNABBREV_TAC;
  USE 38(MATCH_MP segment_end_cls2);
  UND 41 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `c` UNABBREV_TAC;
  USE 33 (MATCH_MP segment_end_cls2);
  TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  UND 25 THEN UND 3 THEN MESON_TAC[];
  (* -- *)
  TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `R` EXISTS_TAC;
  THM_INTRO_TAC[`B`;`S''`;`b`;`c'`;`m`] segment_end_trans;
  ONCE_REWRITE_TAC[segment_end_symm];
  TYPE_THEN `U` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `B UNION S''` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  USE 49(REWRITE_RULE[cls_union]);
  UND 49 THEN UND 48 THEN UND 41 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
  (* -I *)
  TYPE_THEN `b = m` ASM_CASES_TAC;
  TYPE_THEN`m` UNABBREV_TAC;
  TYPE_THEN `a = m` ASM_CASES_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  TYPE_THEN `S'` EXISTS_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`S''`;`S'`;`a`;`m`;`b`] segment_end_trans;
  ONCE_REWRITE_TAC[segment_end_symm];
  TYPE_THEN `U` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `S'' UNION S'` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  TYPE_THEN `cls U SUBSET cls (S'' UNION S')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  USE 41(REWRITE_RULE[SUBSET;cls_union]);
  UND 41 THEN UND 40 THEN UND 30 THEN UND 33 THEN REWRITE_TAC[UNION] THEN MESON_TAC[];
  (* Sat Dec  4 18:57:41 EST 2004 *)

  ]);;
  (* }}} *)

let conn2_psegment_triple = 
prove_by_refinement(
  `!E. conn2 E /\ (E SUBSET edge) /\
      ~(rectagon E) ==> (?A B C. psegment_triple A B C
        /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\
            A SUBSET par_cell F (B UNION C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?A B C. psegment_triple A B C /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E)` BACK_TAC;
  THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 6 (MATCH_MP psegment_triple3);
  USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]);
  ASM_MESON_TAC[];
  USE 6 (MATCH_MP psegment_triple2);
  USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]);
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`E`] conn2_has_rectagon;
  THM_INTRO_TAC[`E`;`B`] conn2_proper;
  CONJ_TAC;
  IMATCH_MP_TAC  conn2_rectagon;
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`A`] endpoint_size2;
  FULL_REWRITE_TAC[has_size2];
  THM_INTRO_TAC[`B`;`a`;`b`] cut_rectagon_cls;
  REWR 5;
  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 5 (REWRITE_RULE[INTER;INR in_pair]);
  ASM_MESON_TAC[];
  TYPE_THEN `C = A'` ABBREV_TAC ;
  TYPE_THEN `A'` UNABBREV_TAC;
  TYPE_THEN`A` EXISTS_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  TYPE_THEN `B'` EXISTS_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  REWRITE_TAC[psegment_triple];
  TYPE_THEN `psegment B' /\ psegment C` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end];
  TYPE_THEN`(A INTER B' = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  USE 5 (REWRITE_RULE[cls_union]);
  FULL_REWRITE_TAC[UNION_OVER_INTER;];
  TYPE_THEN `(endpoint B' = {a,b}) /\ (endpoint C = {a,b})` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end];
  TYPE_THEN `(cls A INTER cls B' = {a, b}) /\ (cls A INTER cls C = {a, b})` SUBAGOAL_TAC;
  TYPE_THEN `endpoint A` UNABBREV_TAC;

  USE 10 (REWRITE_RULE[FUN_EQ_THM]);
  USE 5 (REWRITE_RULE[INTER;UNION;INR in_pair]);
  CONJ_TAC THEN IMATCH_MP_TAC  EQ_EXT THEN REWRITE_TAC[INTER;INR in_pair];
  ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
  ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
  (* - *)
  FULL_REWRITE_TAC[UNION_COMM];
  (* - *)
  TYPE_THEN`segment_end A a b` SUBAGOAL_TAC;
  REWRITE_TAC[segment_end];
  CONJ_TAC ;
  ASM_MESON_TAC[segment_end_union_rectagon;segment_end_symm;INTER_COMM;UNION_COMM];
  ASM_MESON_TAC[union_subset];
  ]);;
  (* }}} *)

let rectagon_surround_conn2 = 
prove_by_refinement(
  `!G. conn2 G /\ G SUBSET edge ==>
     (?C. rectagon C /\ C SUBSET G /\
          (!x. bounded_set G x ==> bounded_set C x))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `EE = {C | conn2 C /\ (C SUBSET G) /\ (!x. bounded_set G x ==> bounded_set C x)}` ABBREV_TAC ;
  TYPE_THEN `EE G` SUBAGOAL_TAC;
  TYPE_THEN `EE` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  THM_INTRO_TAC[`EE`] select_card_min;
  UND 4 THEN REWRITE_TAC[EMPTY_EXISTS];
  ASM_MESON_TAC[];
  TYPE_THEN `C = z` ABBREV_TAC ;
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `rectagon C` BACK_TAC ;
  TYPE_THEN  `C` EXISTS_TAC;
  TYPE_THEN `EE` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `!R. rectagon R /\ R SUBSET C ==> (C INTER par_cell F R = EMPTY)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `J = (C INTER par_cell F R )` ABBREV_TAC ;
  TYPE_THEN `EE (C DIFF J)` SUBAGOAL_TAC;
  TYPE_THEN `EE` UNABBREV_TAC;
  CONJ_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  IMATCH_MP_TAC  conn2_rect_diff_inner;
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C` EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  TSPEC  `x` 2;
  THM_INTRO_TAC[`C`;`C`;`R`;`J`;`x`] star_avoidance_contrp;
  REWRITE_TAC[SUBSET_REFL];
  (* --- *)
  TYPE_THEN `FINITE G` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  TYPE_THEN `J SUBSET G` SUBAGOAL_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  UND 3 THEN REWRITE_TAC[SUBSET;INTER] THEN MESON_TAC[];
  TYPE_THEN `FINITE C /\ FINITE J` SUBAGOAL_TAC;
  CONJ_TAC THEN IMATCH_MP_TAC  FINITE_SUBSET THEN ASM_MESON_TAC[];
  TYPE_THEN `C SUBSET edge /\ J SUBSET edge` SUBAGOAL_TAC;
  CONJ_TAC THEN IMATCH_MP_TAC  SUBSET_TRANS THEN ASM_MESON_TAC[];
  TYPE_THEN `J SUBSET par_cell F R` SUBAGOAL_TAC;
  TYPE_THEN`J` UNABBREV_TAC;
  REWRITE_TAC[INTER;SUBSET];
  TYPE_THEN `~(UNIONS (curve_cell G) x)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`G`;`x`] bounded_subset_unions;
  USE 22(REWRITE_RULE[ctop_unions;DIFF ]);
  ASM_MESON_TAC[];
  TYPE_THEN `!A. A SUBSET G ==> UNIONS (curve_cell A) SUBSET UNIONS(curve_cell G)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  UNIONS_UNIONS;
  IMATCH_MP_TAC  curve_cell_imp_subset;
  ASM_MESON_TAC[subset_imp];
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`C DIFF J`]);
  USE 4(MATCH_MP (ARITH_RULE  `x <=| y ==> ~(y < x)`));
  UND 4 THEN ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  card_subset_lt;
  CONJ_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  CONJ_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  USE 9(REWRITE_RULE[EMPTY_EXISTS]);
  USE 4 (REWRITE_RULE[diff_unchange]);
  USE 4(REWRITE_RULE[EQ_EMPTY]);
  FULL_REWRITE_TAC[INTER];
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  FULL_REWRITE_TAC[conn2];
  TYPE_THEN `EE` UNABBREV_TAC;
  (* -A *)
  THM_INTRO_TAC[`C`] conn2_psegment_triple;
  TYPE_THEN `EE` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  ASM_MESON_TAC[];
  TSPEC `(B UNION C')` 7;
  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[]);
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  REWRITE_TAC[union_subset];
  UND 7 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  TYPE_THEN `A` UNABBREV_TAC;
  USE 25 (REWRITE_RULE[psegment;segment]);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let curve_cell_subset = 
prove_by_refinement(
  `!H G. (H SUBSET G) ==>
      UNIONS (curve_cell H) SUBSET UNIONS (curve_cell G)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  UNIONS_UNIONS;
  TYPE_THEN `G = H UNION (G DIFF H)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  UND 0 THEN REWRITE_TAC[SUBSET;UNION;DIFF] THEN MESON_TAC[];
  UND 1 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  REWRITE_TAC[curve_cell_union];
  REWRITE_TAC[SUBSET;UNION];
  ]);;
  (* }}} *)

let bounded_set_curve_cell_empty = 
prove_by_refinement(
  `!H G x. bounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`H`;`G`]curve_cell_subset;
  THM_INTRO_TAC[`G`] bounded_unbounded_union;
  USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 4;
  USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]);
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let unbounded_set_curve_cell_empty = 
prove_by_refinement(
  `!H G x. unbounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`H`;`G`]curve_cell_subset;
  THM_INTRO_TAC[`G`] bounded_unbounded_union;
  USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `x` 4;
  USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]);
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let bounded_triple_avoidance = 
prove_by_refinement(
  `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) ==>
       bounded_set (A UNION B UNION C) SUBSET bounded_set (B UNION C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance_lemma1;
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[FINITE_UNION;union_subset];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment;segment];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[psegment;segment];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  THM_INTRO_TAC[`A`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
  REWRITE_TAC[SUBSET;UNION];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
  REWRITE_TAC[SUBSET_REFL ];
  ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  IMATCH_MP_TAC  EQ_EXT;
  UND 10 THEN UND 11 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION;DIFF] THEN MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  REWR 6;
  REWR 6;
  (* - *)
  THM_INTRO_TAC[`A`;`B`;`C`;`x`] unbounded_triple_avoidance;
  THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY ];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let bounded_euclid = 
prove_by_refinement(
  `!G x. bounded_set G x ==> euclid 2 x`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE 0(MATCH_MP bounded_subset_unions);
  FULL_REWRITE_TAC[ctop_unions;DIFF ];
  ]);;
  (* }}} *)

let unbounded_euclid = 
prove_by_refinement(
  `!G x. unbounded_set G x ==> euclid 2 x`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE 0(MATCH_MP unbounded_subset_unions);
  FULL_REWRITE_TAC[ctop_unions;DIFF ];
  ]);;
  (* }}} *)

let bounded_triple_inner_union = 
prove_by_refinement(
  `!A B C. psegment_triple A B C ==> bounded_set (A UNION B UNION C)
       SUBSET (bounded_set (A UNION B) UNION bounded_set (B UNION C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`;`A`;`B`] trap_odd_cell;
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple3;
  UND 1 THEN REP_CASES_TAC;
  THM_INTRO_TAC[`C`;`A`;`B`] bounded_triple_avoidance;
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple3;
  FULL_REWRITE_TAC[UNION_ACI;];
  IMATCH_MP_TAC  in_union;
  THM_INTRO_TAC[`A`;`B`;`C`] bounded_triple_avoidance;
  FULL_REWRITE_TAC[UNION_ACI;];
  IMATCH_MP_TAC  in_union;
  (* - *)
  REWRITE_TAC[SUBSET];
  ONCE_REWRITE_TAC[UNION];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  THM_INTRO_TAC[`B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
  REWRITE_TAC[UNION;SUBSET];
  THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
  REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
  ASM_MESON_TAC[bounded_euclid];
  THM_INTRO_TAC[`A UNION B`] bounded_unbounded_union;
  USE 8(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 8(REWRITE_RULE[ctop_unions;DIFF]);
  TSPEC `x` 8;
  TYPE_THEN `R = A UNION B` ABBREV_TAC ;
  USE 8(REWRITE_RULE[UNION]);
  REWR 8;
  TYPE_THEN `R` UNABBREV_TAC;
  (* -A *)
  THM_INTRO_TAC[`B UNION C`] bounded_unbounded_union;
  USE 9(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 9(REWRITE_RULE[ctop_unions;DIFF]);
  TSPEC `x` 9;
  TYPE_THEN `R = B UNION C` ABBREV_TAC ;
  USE 9(REWRITE_RULE[UNION]);
  REWR 9;
  TYPE_THEN `R'` UNABBREV_TAC;
  KILL 5;
  KILL 6;
  KILL 3;
  KILL 4;
  (* - *)
  THM_INTRO_TAC[`x`] point_onto;
  TYPE_THEN `x` UNABBREV_TAC;
  THM_INTRO_TAC[`p`] cell_unions;
  USE 3(REWRITE_RULE[UNIONS]);
  THM_INTRO_TAC[`B UNION C`] unbounded_even;
  FULL_REWRITE_TAC[psegment_triple];
  REWR 9;
  KILL 5;
  THM_INTRO_TAC[`par_cell T (B UNION C)`;`u`;`point p`] cell_ununion;
  REWRITE_TAC[par_cell_cell];
  KILL 6;
  (* - *)
  THM_INTRO_TAC[`A UNION B`] unbounded_even;
  FULL_REWRITE_TAC[psegment_triple];
  REWR 8;
  KILL 6;
  THM_INTRO_TAC[`par_cell T (A UNION B)`;`u`;`point p`] cell_ununion;
  REWRITE_TAC[par_cell_cell];
  KILL 8;
  (* - *)
  TYPE_THEN `unbounded_set (A UNION B UNION C) (point p)` ASM_CASES_TAC;
  THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* -B *)
  TYPE_THEN `~unbounded_set (B UNION C UNION A) (point p)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[UNION_ACI];
  ASM_MESON_TAC[];
  UND 9 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  unbounded_triple_avoidance;
  CONJ_TAC;
  IMATCH_MP_TAC  psegment_triple3;
  (* - *)
  FULL_REWRITE_TAC[UNION_ACI];
  KILL 8;
  KILL 2;
  THM_INTRO_TAC[`A UNION C`] unbounded_even;
  FULL_REWRITE_TAC[psegment_triple];
  REWRITE_TAC[UNIONS];
  TYPE_THEN `u` EXISTS_TAC;
  KILL 2;
  (* - *)
  THM_INTRO_TAC[`A UNION B`;`u`;`T`] parity_unique;
  IMATCH_MP_TAC  rectagon_segment;
  FULL_REWRITE_TAC[psegment_triple];
  THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique;
  IMATCH_MP_TAC  rectagon_segment;
  FULL_REWRITE_TAC[psegment_triple];
  (* - *)
  TYPE_THEN `!A B. rectagon (A UNION B) /\ par_cell T (A UNION B) u ==> ~curve_cell A u` SUBAGOAL_TAC;
  THM_INTRO_TAC[`A' UNION B'`;`T`] par_cell_curve_cell_disj;
  FULL_REWRITE_TAC[rectagon];
  UND 12 THEN ASM_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `u` EXISTS_TAC;
  REWRITE_TAC[INTER];
  THM_INTRO_TAC[`A'`;`A' UNION B'`] curve_cell_imp_subset;
  REWRITE_TAC[SUBSET;UNION];
  ASM_MESON_TAC[subset_imp];
  (* - *)
  TYPE_THEN `~curve_cell A u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
  TYPE_THEN `B` EXISTS_TAC;
  FULL_REWRITE_TAC[psegment_triple;psegment;];
  TYPE_THEN `~curve_cell B u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
  TYPE_THEN `A` EXISTS_TAC;
  REWRITE_TAC[UNION_ACI];
  FULL_REWRITE_TAC[psegment_triple;psegment;];
  TYPE_THEN `~curve_cell C u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
  TYPE_THEN `B` EXISTS_TAC;
  REWRITE_TAC[UNION_ACI];
  FULL_REWRITE_TAC[psegment_triple;psegment;];
  (* -C *)
  THM_INTRO_TAC[`A`;`B`;`u`] parity_union;
  FULL_REWRITE_TAC[psegment_triple;psegment;];
  IMATCH_MP_TAC  rectagon_segment;
  REWR 13;
  (* - *)
  THM_INTRO_TAC[`B`;`C`;`u`] parity_union;
  FULL_REWRITE_TAC[psegment_triple;psegment;];
  IMATCH_MP_TAC  rectagon_segment;
  REWR 14;
  (* - *)
  TYPE_THEN `parity A u = parity C u` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILL 13;
  KILL 14;
  THM_INTRO_TAC[`A`;`C`;`u`] parity_union;
  FULL_REWRITE_TAC[psegment_triple;psegment;];
  IMATCH_MP_TAC  rectagon_segment;
  REWR 13;
  TYPE_THEN `parity (A UNION C) u = T` SUBAGOAL_TAC;
  USE 14 SYM;
  IMATCH_MP_TAC  parity;
  REWRITE_TAC[curve_cell_union];
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple;psegment;];
  IMATCH_MP_TAC  rectagon_segment;
  USE 16(REWRITE_RULE[UNION]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION W *)
(* ------------------------------------------------------------------ *)


(* back to the K3 graph *)

let rectagon_graph = jordan_def
  `rectagon_graph G  <=>
       graph G /\
       graph_edge G SUBSET psegment /\
       (!e. graph_edge G e ==> (graph_inc G e = endpoint e)) /\
       (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
             (e INTER e' = EMPTY)) /\
       (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
             (cls e INTER cls e' = endpoint e INTER endpoint e'))`;;

let rectagonal_graph = jordan_def
  `rectagonal_graph (G:(A,B)graph_t) <=>
    (?H. rectagon_graph H /\ graph_isomorphic H G)`;;

let k33_rectagon_hyp  = jordan_def
   `k33_rectagon_hyp R f <=>  rectagon R /\
   (!(i:three_t) j. ~(i = j) ==> (cls (f i) INTER (cls (f j)) = EMPTY)) /\
   (!i j. ~(i = j) ==> ((f i) INTER (f j) = EMPTY)) /\
   (!i. ?A B. (R = A UNION B) /\ psegment_triple A B (f i) /\
       (!j. ~(cls (f j) INTER cls A = EMPTY) /\
               ~(cls (f j) INTER cls B = EMPTY)) /\
       (!j. ~(i = j) ==> (cls (f j) INTER cls A INTER cls B = EMPTY)))`;;

let k33_rectagon_two_even = 
prove_by_refinement(
  `!R f i. k33_rectagon_hyp R f /\
      f i SUBSET par_cell F R  ==>
       (!j. ~(j = i) ==> (f j SUBSET par_cell T R))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  FULL_REWRITE_TAC [k33_rectagon_hyp];
  COPY 2;
  TSPEC `i` 2;
  TYPE_THEN `R` UNABBREV_TAC;
  (* - *)
  THM_INTRO_TAC[`f i`;`A`;`B`] outer_segment_even;
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple3;
  THM_INTRO_TAC[`f i`;`B`;`A`] outer_segment_even;
  FULL_REWRITE_TAC[UNION_ACI];
  IMATCH_MP_TAC  psegment_triple2;
  (* - *)
  TSPEC `j` 7;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 7 (REWRITE_RULE[INTER]);
  USE 11(REWRITE_RULE[INTER]);
  (* -A *)
  THM_INTRO_TAC[`f i UNION A`;`B`;`f j`;`u`;`T`] meeting_lemma;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  CONJ_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  TSPEC `j` 6;
  REWRITE_TAC[GSYM SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC;
  CONJ_TAC;
  USE 42 SYM;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET;UNION];
  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[cls_union];
  (* -- *)
  TSPEC `j` 2;
  REWR 2;
  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u` 2;
  REWR 2;
  COPY 4;
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  TYPE_THEN `i` UNABBREV_TAC;
  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
  TSPEC `u` 4;
  REWR 4;
  (* -- *)
  TYPE_THEN `B SUBSET edge` SUBAGOAL_TAC;
  USE 8 (REWRITE_RULE[psegment_triple]);
  USE 26(REWRITE_RULE[psegment;segment]);
  (* -- *)
  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
  TSPEC `j` 6;
  USE 17 (REWRITE_RULE[psegment_triple]);
  FULL_REWRITE_TAC[psegment];
  (* -- *)
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  USE 17 (REWRITE_RULE[UNION]);
  REWR 17;
  (* -- *)
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
  TYPE_THEN `j` UNABBREV_TAC;
  (* -- *)
  TSPEC `j` 6;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  USE 19 SYM;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;UNION];
  USE 18(REWRITE_RULE[psegment_triple]);
  REWRITE_TAC[cls_union;UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[INTER_COMM];
  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  (* -B *)
  THM_INTRO_TAC[`f i UNION B`;`A`;`f j`;`u'`;`T`] meeting_lemma;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  CONJ_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  TSPEC `j` 6;
  REWRITE_TAC[GSYM SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC;
  CONJ_TAC;
  USE 43 SYM;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET;UNION];
  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[cls_union];
  (* -- *)
  TSPEC `j` 2;
  REWR 2;
  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u'` 2;
  REWR 2;
  COPY 4;
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  TYPE_THEN `i` UNABBREV_TAC;
  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
  TSPEC `u'` 4;
  REWR 4;
  (* -- *)
  TYPE_THEN `A SUBSET edge` SUBAGOAL_TAC;
  USE 8 (REWRITE_RULE[psegment_triple]);
  USE 28(REWRITE_RULE[psegment;segment]);
  (* -- *)
  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
  TSPEC `j` 6;
  USE 18 (REWRITE_RULE[psegment_triple]);
  FULL_REWRITE_TAC[psegment];
  (* -- *)
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  USE 18 (REWRITE_RULE[UNION]);
  REWR 18;
  (* -- *)
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
  TYPE_THEN `j` UNABBREV_TAC;
  (* -- *)
  TSPEC `j` 6;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  USE 20 SYM;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;UNION];
  USE 19(REWRITE_RULE[psegment_triple]);
  REWRITE_TAC[cls_union;UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[INTER_COMM];
  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  (* -C *)
  IMATCH_MP_TAC  par_cell_even_imp;
  TYPE_THEN `f i` EXISTS_TAC;
  FULL_REWRITE_TAC[UNION_ACI];
  CONJ_TAC;
  TSPEC `j` 6;
  USE 17 (REWRITE_RULE [psegment_triple]);
  USE 29(REWRITE_RULE[psegment]);
  (* - *)
  CONJ_TAC;
  TSPEC `j` 6;
  FULL_REWRITE_TAC[psegment_triple];
  REWRITE_TAC[cls_union ;];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[INTER_COMM];
  TYPE_THEN `endpoint A'` UNABBREV_TAC;
  TYPE_THEN `endpoint B'` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
  TYPE_THEN `j` UNABBREV_TAC;
  (* - *)
  TSPEC `j` 6;
  UND 17 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC));
  TYPE_THEN `!C. C SUBSET (A' UNION B') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  FULL_REWRITE_TAC[SUBSET;UNION ];
  ASM_MESON_TAC[];
  USE 1 SYM;
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION];
  ]);;
  (* }}} *)

let psegment_triple_odd_even = 
prove_by_refinement(
  `!A B C. psegment_triple A B C /\ C SUBSET par_cell T (A UNION B) ==>
    (?A' B'. psegment_triple A' B' C /\ C SUBSET par_cell T (A' UNION B')
         /\ A' SUBSET par_cell F (B' UNION C)
         /\ B' SUBSET par_cell T (A' UNION C)
         /\ (A UNION B = A' UNION B')
         /\ (cls A INTER cls B = cls A' INTER cls B') /\
         (!P. (P A  /\ P B ) ==> P A' /\ P B'))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `A SUBSET par_cell F (B UNION C)` ASM_CASES_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  outer_segment_even;
  FULL_REWRITE_TAC[UNION_COMM];
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple2;
  THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell;
  UND 3 THEN REP_CASES_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  FULL_REWRITE_TAC[UNION_COMM;INTER_COMM;];
  CONJ_TAC;
  IMATCH_MP_TAC  psegment_triple3;
  IMATCH_MP_TAC  psegment_triple2;
  IMATCH_MP_TAC  outer_segment_even;
  FULL_REWRITE_TAC[UNION_COMM];
  IMATCH_MP_TAC  psegment_triple3;
  (* - *)
  TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  TYPE_THEN `C` UNABBREV_TAC;
  USE 15 (REWRITE_RULE[psegment;segment]);
  (* - *)
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let k33_rectagon_two_odd = 
prove_by_refinement(
  `!R f i. k33_rectagon_hyp R f /\
      f i SUBSET par_cell T R  ==>
       (!j. ~(j = i) ==> (f j SUBSET par_cell F R))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  FULL_REWRITE_TAC [k33_rectagon_hyp];
  COPY 2;
  TSPEC `i` 2;
  TYPE_THEN `R` UNABBREV_TAC;
  (* - *)
  THM_INTRO_TAC[`A`;`B`;`f i`] psegment_triple_odd_even;
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  TYPE_THEN `cls A INTER cls B` UNABBREV_TAC;
  TYPE_THEN `!j. ~(cls (f j) INTER cls A' = {}) /\ ~(cls (f j) INTER cls B' = {})` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  KILL 7; (* 7 -> 10 *)
  KILL 9;
  KILL 8;
  (* - *)
  TSPEC `j` 10;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  USE 7 (REWRITE_RULE[INTER]);
  USE 8(REWRITE_RULE[INTER]);
  (* -A *)
  THM_INTRO_TAC[`f i UNION A'`;`B'`;`f j`;`u`;`T`] meeting_lemma;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[UNION_COMM];
  CONJ_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  TSPEC `j` 6;
  FULL_REWRITE_TAC[UNION_COMM];
  REWRITE_TAC[GSYM SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC;
  CONJ_TAC;
  USE 43 SYM;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET;UNION];
  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[cls_union];
  (* -- *)
  TSPEC `j` 2;
  REWR 2;
  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u` 2;
  REWR 2;
  COPY 4;
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  TYPE_THEN `i` UNABBREV_TAC;
  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
  TSPEC `u` 4;
  REWR 4;
  (* -- *)
  TYPE_THEN `B' SUBSET edge` SUBAGOAL_TAC;
  USE 15 (REWRITE_RULE[psegment_triple]);
  USE 27(REWRITE_RULE[psegment;segment]);
  (* -- *)
  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
  TSPEC `j` 6;
  USE 18 (REWRITE_RULE[psegment_triple]);
  FULL_REWRITE_TAC[psegment];
  (* -- *)
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  USE 18 (REWRITE_RULE[UNION]);
  REWR 18;
  (* -- *)
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
  TYPE_THEN `j` UNABBREV_TAC;
  (* -- *)
  TSPEC `j` 6;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  USE 20 SYM;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;UNION];
  USE 19(REWRITE_RULE[psegment_triple]);
  REWRITE_TAC[cls_union;UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[INTER_COMM];
  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  (* -B *)
  THM_INTRO_TAC[`f i UNION B'`;`A'`;`f j`;`u'`;`F`] meeting_lemma;
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[UNION_COMM];
  CONJ_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` UNABBREV_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[UNION_COMM];
  TSPEC `j` 6;
  REWRITE_TAC[GSYM SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC;
  CONJ_TAC;
  USE 44 SYM;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET;UNION];
  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[cls_union];
  (* -- *)
  TSPEC `j` 2;
  REWR 2;
  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u'` 2;
  REWR 2;
  COPY 4;
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  TYPE_THEN `i` UNABBREV_TAC;
  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
  TSPEC `u'` 4;
  REWR 4;
  (* -- *)
  TYPE_THEN `A' SUBSET edge` SUBAGOAL_TAC;
  USE 15 (REWRITE_RULE[psegment_triple]);
  USE 29(REWRITE_RULE[psegment;segment]);
  (* -- *)
  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
  TSPEC `j` 6;
  USE 19 (REWRITE_RULE[psegment_triple]);
  FULL_REWRITE_TAC[psegment];
  (* -- *)
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  USE 19 (REWRITE_RULE[UNION]);
  REWR 19;
  (* -- *)
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  UND 16 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
  TYPE_THEN `j` UNABBREV_TAC;
  (* -- *)
  TSPEC `j` 6;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  REWRITE_TAC[SUBSET_REFL];
  USE 21 SYM;
  IMATCH_MP_TAC  cls_subset;
  REWRITE_TAC[SUBSET;UNION];
  USE 20(REWRITE_RULE[psegment_triple]);
  REWRITE_TAC[cls_union;UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[INTER_COMM];
  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  (* -C *)
  IMATCH_MP_TAC  par_cell_odd_imp;
  TYPE_THEN `f i` EXISTS_TAC;
  FULL_REWRITE_TAC[UNION_ACI];
  CONJ_TAC;
  TSPEC `j` 6;
  USE 18 (REWRITE_RULE [psegment_triple]);
  USE 30(REWRITE_RULE[psegment]);
  (* - *)
  CONJ_TAC;
  TSPEC `j` 6;
  FULL_REWRITE_TAC[psegment_triple];
  REWRITE_TAC[cls_union ;];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  FULL_REWRITE_TAC[INTER_COMM];
  TYPE_THEN `endpoint A''` UNABBREV_TAC;
  TYPE_THEN `endpoint B''` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
  TYPE_THEN `j` UNABBREV_TAC;
  (* - *)
  TSPEC `j` 6;
  UND 19 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC));
  TYPE_THEN `!C. C SUBSET (A'' UNION B'') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  FULL_REWRITE_TAC[SUBSET;UNION ];
  ASM_MESON_TAC[];
  USE 0 SYM;
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION];
  ]);;
  (* }}} *)

let ABS3_012 = 
prove_by_refinement(
  `(REP3 (ABS3 0) = 0) /\ (REP3(ABS3 1) = 1) /\ (REP3(ABS3 2) = 2)`,

  (* {{{ proof *)
  [
  ASSUME_TAC three_t;
  USE 0(ONCE_REWRITE_RULE[EQ_SYM_EQ]);
  ARITH_TAC;
  ]);;
  (* }}} *)

let three_t_not_sing = 
prove_by_refinement(
  `!i. ?(j:three_t). ~(i = j)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `i = ABS3 0` ASM_CASES_TAC;
  TYPE_THEN `ABS3 1` EXISTS_TAC;
  USE 1(AP_TERM `REP3`);
  FULL_REWRITE_TAC[ABS3_012];
  UND 1 THEN ARITH_TAC;
  TYPE_THEN `ABS3 0` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let ABS3_onto = 
prove_by_refinement(
  `!(i:three_t). ?j. (i = ABS3 j) /\ (j < 3)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `REP3 i` EXISTS_TAC;
  REWRITE_TAC[BETA_RULE three_t];
  ]);;
  (* }}} *)

let three_t_eq = 
prove_by_refinement(
  `!i j. (i = j) <=> (REP3 i = REP3 j)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  DISCH_TAC;
  USE 0(AP_TERM `ABS3`);
  FULL_REWRITE_TAC[three_t];
  ]);;
  (* }}} *)

let rep3_lt = 
prove_by_refinement(
  `!i. (REP3 i < 3)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[BETA_RULE three_t];
  ]);;
  (* }}} *)

let three_t_not_pair = 
prove_by_refinement(
  `!i j. ?(k:three_t). ~(k = i) /\ ~(k = j)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[three_t_eq];
  TYPE_THEN `?k'. (k' < 3) /\ ~(k' = REP3 i) /\ ~(k' = REP3 j)` SUBAGOAL_TAC;
  TYPE_THEN `  ~(0 = REP3 i) /\ ~(0 = REP3 j)` ASM_CASES_TAC;
  ASM_MESON_TAC[ARITH_RULE `0 < 3`];
  TYPE_THEN `  ~(1 = REP3 i) /\ ~(1 = REP3 j)` ASM_CASES_TAC;
  ASM_MESON_TAC[ARITH_RULE `1 < 3`];
  TYPE_THEN `  ~(2 = REP3 i) /\ ~(2 = REP3 j)` ASM_CASES_TAC;
  ASM_MESON_TAC[ARITH_RULE `2 < 3`];
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  PROOF_BY_CONTR_TAC;
  UND 0 THEN UND 1 THEN UND 2 THEN ARITH_TAC;
  TYPE_THEN` ABS3 k'` EXISTS_TAC;
  ASM_MESON_TAC [BETA_RULE three_t];
  ]);;
  (* }}} *)

let bool_size = 
prove_by_refinement(
  `(UNIV:bool->bool) HAS_SIZE 2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[has_size_bij2];
  TYPE_THEN `\ u.  if u then 0 else 1` EXISTS_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  COND_CASES_TAC THEN ARITH_TAC ;
  UND 0 THEN COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[ARITH_RULE `~(0 =1) /\ ~(1 = 0)`];
  FULL_REWRITE_TAC[SURJ;INJ];
  REP_BASIC_TAC;
  USE 2 (REWRITE_RULE[ARITH_RULE `x <| 2 <=> (x = 0)\/ (x = 1)`]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `T` EXISTS_TAC;
  TYPE_THEN `F` EXISTS_TAC;
  ]);;
  (* }}} *)

let three_delete_size = 
prove_by_refinement(
  `!(i:three_t). (UNIV DELETE i) HAS_SIZE 2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[HAS_SIZE;FINITE_DELETE];
  THM_INTRO_TAC[] thr_finite;
  FULL_REWRITE_TAC[HAS_SIZE];
  IMATCH_MP_TAC  (ARITH_RULE `(SUC x = 3) ==> (x = 2)`);
  USE 0 SYM;
  IMATCH_MP_TAC  CARD_SUC_DELETE;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let has_size_bij_set = 
prove_by_refinement(
  `!(A:A->bool) (B:B->bool) n. A HAS_SIZE n /\ B HAS_SIZE n ==>
          (?f. BIJ f A B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USE 0(REWRITE_RULE [has_size_bij]);
  USE 1(REWRITE_RULE[has_size_bij2]);
  TYPE_THEN `compose f  f'` EXISTS_TAC;
  IMATCH_MP_TAC  COMP_BIJ;
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let bool_three_delete_bij = 
prove_by_refinement(
  `!i. ?b. BIJ b (UNIV:bool->bool) ((UNIV:three_t->bool) DELETE i)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  has_size_bij_set;
  TYPE_THEN`2` EXISTS_TAC;
  REWRITE_TAC[bool_size;three_delete_size];
  ]);;
  (* }}} *)

let k33_rectagon_hyp_odd_exist = 
prove_by_refinement(
  `!R f. k33_rectagon_hyp R f ==>
      (?i. (f i SUBSET par_cell F R))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[k33_rectagon_hyp];
  TYPE_THEN `j = ABS3 0` ABBREV_TAC ;
  TYPE_THEN `f j SUBSET par_cell F R` ASM_CASES_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `k = ABS3 1` ABBREV_TAC ;
  TYPE_THEN `k` EXISTS_TAC;
  THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd;
  CONJ_TAC;
  ASM_REWRITE_TAC[k33_rectagon_hyp];
  THM_INTRO_TAC[`R`;`f j`] segment_in_comp;
  TSPEC `j` 0;
  USE 8 (REWRITE_RULE[psegment_triple]);
  CONJ_TAC;
  USE 20(REWRITE_RULE[psegment]);
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  FULL_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[cls_union];
  REWRITE_TAC[UNION_OVER_INTER;union_subset];
  FULL_REWRITE_TAC[INTER_COMM];
  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
  REWRITE_TAC[SUBSET_REFL];
  TYPE_THEN `eps = F` ASM_CASES_TAC;
  REWR 7;
  TYPE_THEN `eps = T` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  (* - *)
  TSPEC `k` 7;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` UNABBREV_TAC;
  TYPE_THEN `k` UNABBREV_TAC;
  USE 4 (AP_TERM `REP3`);
  FULL_REWRITE_TAC[ABS3_012];
  UND 4 THEN ARITH_TAC;
  ]);;
  (* }}} *)

let k33_rectagon_hyp_false = 
prove_by_refinement(
  `!R f. ~k33_rectagon_hyp R f`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`R`;`f`] k33_rectagon_hyp_odd_exist;
  THM_INTRO_TAC[`R`;`f`;`i`] k33_rectagon_two_even;
  THM_INTRO_TAC[`i`] three_t_not_sing;
  COPY 2;
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
  TYPE_THEN `j` UNABBREV_TAC;
  (* - *)
  THM_INTRO_TAC[`i`;`j`] three_t_not_pair;
  TSPEC `k` 2;
  THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd;
  TSPEC `k` 7;
  TYPE_THEN `~(f k = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[k33_rectagon_hyp];
  TSPEC `k` 0;
  FULL_REWRITE_TAC[psegment_triple];
  USE 25(REWRITE_RULE[psegment;segment]);
  TYPE_THEN `f k` UNABBREV_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
  FULL_REWRITE_TAC[EQ_EMPTY;INTER ];
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let k33_graph_edge = 
prove_by_refinement(
  `graph_edge (k33_graph) = cartesian UNIV UNIV`,

  (* {{{ proof *)
  [
  REWRITE_TAC[k33_graph;graph_edge_mk_graph];
  ]);;
  (* }}} *)

let k33_graph_vertex = 
prove_by_refinement(
  `graph_vertex (k33_graph) = cartesian UNIV UNIV`,

  (* {{{ proof *)
  [
  REWRITE_TAC[k33_graph;graph_vertex_mk_graph];
  ]);;
  (* }}} *)

let k33_graph_inc = 
prove_by_refinement(
  `!e v. graph_inc (k33_graph) e v <=> (v = (FST e,T)) \/ (v = (SND e,F))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[k33_graph;graph_inc_mk_graph;INR in_pair ];
  MESON_TAC[];
  ]);;
  (* }}} *)

let cartesian_univ = 
prove_by_refinement(
  `!x. cartesian (UNIV:A->bool) (UNIV:B->bool) x`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cartesian;PAIR_SPLIT];
  MESON_TAC[];
  ]);;
  (* }}} *)

let rectagonal_graph_k33 = 
prove_by_refinement(
  `rectagonal_graph k33_graph <=> (?f uA uB.
     INJ uA UNIV UNIV /\
     INJ uB UNIV UNIV /\
     (!(i:three_t#three_t).
          segment_end (f i) (uA (FST i)) (uB (SND i))) /\
     (!i j. ~(f i INTER f j = EMPTY) ==> (i = j)) /\
     (!i j. ~(i = j) ==> (cls (f i) INTER cls (f j) =
           endpoint (f i) INTER endpoint (f j))))
     `,

  (* {{{ proof *)
  [
  REWRITE_TAC[rectagonal_graph];
  IMATCH_MP_TAC  EQ_ANTISYM;
  (* - *)
  CONJ_TAC;
  THM_INTRO_TAC[`H`;`k33_graph`] graph_isomorphic_symm;
  FULL_REWRITE_TAC[rectagon_graph];
  KILL 0;
  FULL_REWRITE_TAC [graph_isomorphic;graph_iso];
  FULL_REWRITE_TAC[rectagon_graph];
  FULL_REWRITE_TAC[k33_graph_edge;k33_graph_vertex;k33_graph_inc];
  KILL 4;
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `uA = (\ i. u (i,T))` ABBREV_TAC ;
  TYPE_THEN `uB = (\ i. u (i,F))` ABBREV_TAC ;
  TYPE_THEN  `uA` EXISTS_TAC;
  TYPE_THEN `uB` EXISTS_TAC;
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[INJ];
  TYPE_THEN `uA` UNABBREV_TAC;
  USE 3(REWRITE_RULE[BIJ;INJ]);
  TYPE_THEN`(x,T) = (y,T)` BACK_TAC;
  USE 12 (REWRITE_RULE[PAIR_SPLIT]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[cartesian_univ];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[INJ];
  TYPE_THEN `uB` UNABBREV_TAC;
  USE 3(REWRITE_RULE[BIJ;INJ]);
  TYPE_THEN`(x,F) = (y,F)` BACK_TAC;
  USE 12 (REWRITE_RULE[PAIR_SPLIT]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[cartesian_univ];
  (* --A *)
  TYPE_THEN `!i. graph_edge H (v i)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[BIJ;SURJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[cartesian_univ];
  FULL_REWRITE_TAC[cartesian_univ];
  (* -- *)
  SUBCONJ_TAC;
  REWRITE_TAC[segment_end];
  CONJ_TAC;
  USE 7(REWRITE_RULE[SUBSET]);
  USE 6 GSYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE;k33_graph_inc;INR in_pair];
  TYPE_THEN `uA` UNABBREV_TAC;
  TYPE_THEN `uB` UNABBREV_TAC;
  NAME_CONFLICT_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `(SND i,F)` EXISTS_TAC;
  TYPE_THEN `(FST i,T)` EXISTS_TAC;
  (* --B *)
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`v i`;`v j`]);
  PROOF_BY_CONTR_TAC;
  UND 13 THEN REWRITE_TAC[];
  USE 2 (REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[cartesian_univ];
  ASM_MESON_TAC[];
  (* -- *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  DISCH_TAC;
  UND 12 THEN REWRITE_TAC[];
  USE 2 (REWRITE_RULE[BIJ;INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[cartesian_univ];
  (* -C *)
  TYPE_THEN `?H. rectagon_graph H /\ graph_isomorphic k33_graph H` BACK_TAC;
  TYPE_THEN `H` EXISTS_TAC;
  IMATCH_MP_TAC  graph_isomorphic_symm;
  REWRITE_TAC[k33_isgraph];
  REWRITE_TAC[rectagon_graph;graph_isomorphic;graph_iso];
  REWRITE_TAC[k33_graph_vertex;k33_graph_edge];
  TYPE_THEN `H = mk_graph_t (IMAGE uA UNIV UNION IMAGE uB UNIV ,IMAGE f (cartesian UNIV UNIV), endpoint)` ABBREV_TAC ;
  TYPE_THEN `H` EXISTS_TAC;
  TYPE_THEN `graph_edge H = IMAGE f (cartesian UNIV UNIV)` SUBAGOAL_TAC;
  TYPE_THEN `H` UNABBREV_TAC;
  REWRITE_TAC[graph_edge_mk_graph];
  TYPE_THEN `graph_vertex H = IMAGE uA UNIV UNION IMAGE uB UNIV ` SUBAGOAL_TAC;
  TYPE_THEN `H` UNABBREV_TAC;
  REWRITE_TAC[graph_vertex_mk_graph];
  TYPE_THEN `graph_inc H = endpoint` SUBAGOAL_TAC;
  TYPE_THEN `H` UNABBREV_TAC;
  REWRITE_TAC[graph_inc_mk_graph];
  (* - *)
  REWRITE_TAC[GSYM CONJ_ASSOC];
  CONJ_TAC;
  REWRITE_TAC[graph];
  REWRITE_TAC[SUBSET];
  NAME_CONFLICT_TAC;
  REWRITE_TAC[UNION];
  USE 9(REWRITE_RULE[IMAGE]);
  TYPE_THEN `x'` UNABBREV_TAC;
  CONJ_TAC;
  TSPEC `x''` 2;
  USE 2(REWRITE_RULE[segment_end]);
  REWR 10;
  USE 10 (REWRITE_RULE[INR in_pair]);
  FIRST_ASSUM DISJ_CASES_TAC;
  REWRITE_TAC[IMAGE];
  MESON_TAC[];
  REWRITE_TAC[IMAGE];
  MESON_TAC[];
  IMATCH_MP_TAC  endpoint_size2;
  TSPEC `x''` 2;
  USE 2(REWRITE_RULE[segment_end]);
  (* -D *)
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET;cartesian_univ];
  USE 2(REWRITE_RULE[segment_end]);
  (* - *)
  KILL 5;
  KILL 6;
  KILL 7;
  KILL 8;
  CONJ_TAC;
  FULL_REWRITE_TAC[IMAGE;cartesian_univ];
  PROOF_BY_CONTR_TAC;
  UND 5 THEN REWRITE_TAC[];
  AP_TERM_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  (* - *)
  CONJ_TAC;
  FULL_REWRITE_TAC[IMAGE;cartesian_univ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  LEFT_TAC "u";
  TYPE_THEN `u = (\ x. (if (SND x) then (uA (FST x)) else uB(FST x)))` ABBREV_TAC ;
  TYPE_THEN `u` EXISTS_TAC;
  LEFT_TAC "v";
  TYPE_THEN `f` EXISTS_TAC;
  TYPE_THEN `(u,f)` EXISTS_TAC;
  (* -E *)
  TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC;
  TSPEC `(i,j)` 2;
  USE 2(MATCH_MP segment_end_disj);
  UND 2 THEN ASM_REWRITE_TAC[];
  (* - *)
  SUBCONJ_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ;cartesian_univ];
  CONJ_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  COND_CASES_TAC;
  REWRITE_TAC[IMAGE;UNION];
  MESON_TAC[];
  REWRITE_TAC[IMAGE;UNION];
  MESON_TAC[];
  REWRITE_TAC[PAIR_SPLIT];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  (* ---// *)
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `!x y. (uA (x) = uA (y)) ==> (x = y)` SUBAGOAL_TAC;
  USE 4 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `!x y. (uB (x) = uB (y)) ==> (x = y)` SUBAGOAL_TAC;
  USE 3 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
  KILL 0 THEN KILL 1 THEN KILL 2;
  UND 7 THEN  COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[];
  (* -- *)
  REWRITE_TAC[SURJ];
  CONJ_TAC;
  USE 7(REWRITE_RULE[INJ]);
  REWRITE_TAC[cartesian_univ];
  TYPE_THEN `u` UNABBREV_TAC;
  USE 8 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 8(REWRITE_RULE[IMAGE]);
  TYPE_THEN `(x',T)` EXISTS_TAC;
  USE 8(REWRITE_RULE[IMAGE]);
  TYPE_THEN `(x',F)` EXISTS_TAC;
  (* -F *)
  CONJ_TAC;
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `f x` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_IDEMPOT];
  TSPEC `y` 2;
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  ASM_MESON_TAC[];
  (* - *)
  TSPEC `e` 2;
  FULL_REWRITE_TAC[segment_end];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR in_pair;IMAGE;k33_graph_inc];
  NAME_CONFLICT_TAC;
  THM_INTRO_TAC[`u`;`cartesian (UNIV:three_t->bool) (UNIV:bool->bool)`;`(IMAGE uA UNIV UNION IMAGE uB UNIV)`] bij_imp_image;
  USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USE 10 (REWRITE_RULE[IMAGE ;cartesian_univ;UNION]);
  USE 10 (CONV_RULE (NAME_CONFLICT_CONV));
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TSPEC `uB (SND e)` 10;
  USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (c ==> a)`));
  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
  MESON_TAC[];
  TYPE_THEN`(SND e,F)` EXISTS_TAC;
  TYPE_THEN `u x'` UNABBREV_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  (* -- *)
  TYPE_THEN `x` UNABBREV_TAC;
  TSPEC `uA (FST  e)` 10;
  USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (b ==> a)`));
  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
  MESON_TAC[];
  TYPE_THEN`(FST  e,T)` EXISTS_TAC;
  TYPE_THEN `u x'` UNABBREV_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC ;
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  ]);;
  (* }}} *)

let eq_exchange = 
prove_by_refinement(
  `!x a (b:A). (x = a) /\ (x = b) <=> (x = a) /\ (a = b)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  MESON_TAC[];
  ]);;
  (* }}} *)

let rectagon_graph_k33_false = 
prove_by_refinement(
  `~(rectagonal_graph k33_graph)`,

  (* {{{ proof *)
  [
  DISCH_TAC;
  FULL_REWRITE_TAC[rectagonal_graph_k33];
  ASSUME_TAC k33_rectagon_hyp_false;
  LEFT 5 "f";
  TYPE_THEN `diag  = (\ (i:three_t). f (i,i))` ABBREV_TAC ;
  TYPE_THEN `!i. diag i = f(i,i)` SUBAGOAL_TAC;
  TYPE_THEN `diag` UNABBREV_TAC;
  KILL 6;
  TSPEC `diag` 5;
  RIGHT 5 "R";
  UND 5 THEN REWRITE_TAC[];
  REWRITE_TAC[k33_rectagon_hyp];
  TYPE_THEN `R = UNIONS { e | (?i j. ~(i = j) /\ (e = f (i,j)) ) }` ABBREV_TAC ;
  TYPE_THEN  `R` EXISTS_TAC;
  (* - *)
  TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC;
  TSPEC `i,j` 2;
  USE 2(MATCH_MP segment_end_disj);
  REWR 2;
  (* - *)
  TYPE_THEN `!i j. (uA i = uA j) <=> (i = j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM ;
  USE 4 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  TYPE_THEN `!i j. (uB i = uB j) <=> (i = j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM ;
  USE 3 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* -A *)
  TYPE_THEN `(!i j. ~(i = j) ==> (cls (f (i,i)) INTER cls (f (j,j)) = {}))` SUBAGOAL_TAC;
  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,i)`;`j,j`]);
  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_MESON_TAC[];
  COPY 2;
  TSPEC `i,i` 11;
  TSPEC `j,j` 2;
  FULL_REWRITE_TAC[segment_end];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR in_pair];
  FIRST_ASSUM DISJ_CASES_TAC THEN (TYPE_THEN `x` UNABBREV_TAC);
  REWR 15;
  REWR 15;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(!i j. ~(i = j) ==> (f (i,i) INTER f (j,j) = {}))` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  UND 11 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `(i,i) = (j,j)` BACK_TAC;
  USE 11(REWRITE_RULE[PAIR_SPLIT]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  LEFT_TAC "i";
  (* -B start main reduction *)
  TYPE_THEN `?A. (cls (A T) INTER cls (A F) SUBSET endpoint (f (i,i))) /\ (A T INTER A F = EMPTY ) /\ (A T UNION A F = R) /\ (!eps. psegment (A eps)) /\ (!j eps. ~(cls (f (j,j)) INTER cls (A eps) = EMPTY)) /\ (!eps. A eps INTER (f (i,i)) = EMPTY) /\ (!eps. endpoint (A eps) = endpoint (f(i,i))) /\ (!eps. (cls (A eps) INTER cls (f(i,i)) = endpoint (f(i,i))))` BACK_TAC;
  LEFT_TAC "A";
  LEFT_TAC "B";
  TYPE_THEN `A T` EXISTS_TAC;
  TYPE_THEN `A F` EXISTS_TAC;
  TYPE_THEN `(!j. ~(i = j) ==> (cls (f (j,j)) INTER cls (A T) INTER cls (A F) = {}))` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM SUBSET_EMPTY];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `cls (f (j,j)) INTER cls(f (i,i))` EXISTS_TAC;
  REWRITE_TAC[SUBSET_EMPTY];
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  ASM_REWRITE_TAC[SUBSET_REFL];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `endpoint (f (i,i))` EXISTS_TAC;
  IMATCH_MP_TAC  endpoint_cls;
  USE 2(REWRITE_RULE[segment_end;psegment;segment]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  SUBCONJ_TAC;
  ASM_REWRITE_TAC[psegment_triple];
  TYPE_THEN `cls (A T) INTER cls (A F) = endpoint (f (i,i))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM ;
  COPY 13;
  TSPEC `T` 21;
  TSPEC `F` 13;
  REWRITE_TAC[SUBSET_INTER];
  TYPE_THEN `FINITE (f(i,i))` SUBAGOAL_TAC;
  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
  CONJ_TAC;
  USE 21 SYM;
  IMATCH_MP_TAC  endpoint_cls;
  USE 16(REWRITE_RULE[psegment;segment]);
  USE 13 SYM;
  IMATCH_MP_TAC  endpoint_cls;
  USE 16(REWRITE_RULE[psegment;segment]);
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[segment_end];
  (* ---C *)
  TYPE_THEN `endpoint (f (i,i)) = {(uA (i)), (uB(i))}` SUBAGOAL_TAC;
  USE 2 (REWRITE_RULE[segment_end]);
  CONJ_TAC;
  TYPE_THEN `R` UNABBREV_TAC;
  USE 5 SYM;
  IMATCH_MP_TAC  segment_end_union_rectagon;
  TYPE_THEN `uA i` EXISTS_TAC;
  TYPE_THEN `uB i` EXISTS_TAC;
  ASM_REWRITE_TAC[segment_end];
  (* --- *)
  CONJ_TAC THEN IMATCH_MP_TAC  segment_end_union_rectagon THEN   TYPE_THEN `uA i` EXISTS_TAC THEN TYPE_THEN `uB i` EXISTS_TAC THEN ASM_REWRITE_TAC[segment_end];
  (* -- *)
  FULL_REWRITE_TAC[psegment_triple];
  KILL 5;
  TYPE_THEN `R` UNABBREV_TAC;
  (* -D *)
  THM_INTRO_TAC[`i`] bool_three_delete_bij;
  TYPE_THEN `!e. ~(b e = i)` SUBAGOAL_TAC;
  USE 12(REWRITE_RULE[BIJ;SURJ;DELETE ]);
  ASM_MESON_TAC[];
  TYPE_THEN `!e e'. (b e = b e') <=> (e = e')` SUBAGOAL_TAC;
  USE 12 (REWRITE_RULE[BIJ;INJ]);
  IMATCH_MP_TAC  EQ_ANTISYM;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!j. ~(j = i) ==> (?e. (j = b e))` SUBAGOAL_TAC;
  USE 12(REWRITE_RULE[BIJ;SURJ]);
  USE 12 (GSYM);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[DELETE];
  TYPE_THEN `j` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `A = (\ (e: bool). f(i, b e) UNION f (b (~e),b e) UNION f (b(~e),i))` ABBREV_TAC ;
  TYPE_THEN `A` EXISTS_TAC;
  (* - now satisfy constraints *)
  TYPE_THEN `(!eps. A eps INTER f (i,i) = {})` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  REPEAT CONJ_TAC THEN PROOF_BY_CONTR_TAC THEN (UND 1 THEN DISCH_THEN (fun t -> RULE_ASSUM_TAC  (REWRITE_RULE[PAIR_SPLIT] o (TRY_RULE (MATCH_MP t)))))  THEN ASM_MESON_TAC[];
  (* -E *)
  TYPE_THEN `(!eps. cls (A eps) INTER cls (f (i,i)) = endpoint (f (i,i)))` SUBAGOAL_TAC ;
  TYPE_THEN `A` UNABBREV_TAC;
  ONCE_REWRITE_TAC[INTER_COMM];
  FULL_REWRITE_TAC[UNION_OVER_INTER;cls_union];
  COPY 0;
  UND 0 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(i, b eps)`]);
  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_MESON_TAC[];
  COPY 16;
  UND 16 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(b (~eps),i)`]);
  USE 16 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_MESON_TAC[];
  COPY 18;
  UND 18 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(b (~eps),b eps)`]);
  USE 18 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_MESON_TAC[];
  REWRITE_TAC[GSYM UNION_OVER_INTER];
  REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] SUBSET_INTER_ABSORPTION];
  USE 2 (REWRITE_RULE[segment_end]);
  REWRITE_TAC[SUBSET;UNION;INR in_pair  ];
  FIRST_ASSUM DISJ_CASES_TAC;
  (* - *)
  TYPE_THEN `(!j eps. ~(cls (f (j,j)) INTER cls (A eps) = {}))` SUBAGOAL_TAC;
  TYPE_THEN `j = i` ASM_CASES_TAC;
  TYPE_THEN `i` UNABBREV_TAC;
  USE 19 (ONCE_REWRITE_RULE[INTER_COMM]);
  TSPEC  `eps` 18;
  REWR 19;
  TSPEC `(j,j)` 2;
  FULL_REWRITE_TAC[segment_end];
  REWR 2;
  USE 2 SYM;
  USE 2(REWRITE_RULE[EQ_EMPTY;INR in_pair]);
  ASM_MESON_TAC[];
  TYPE_THEN `A` UNABBREV_TAC;
  FULL_REWRITE_TAC[cls_union];
  FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
  UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
  TYPE_THEN `j` UNABBREV_TAC;
  TYPE_THEN `j` UNABBREV_TAC;
  TYPE_THEN `(e = eps) \/ (e = ~eps)` SUBAGOAL_TAC;
  MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(b eps,b eps)`;`(i,b eps)`] );
  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
  TYPE_THEN `i` UNABBREV_TAC;
  REWR 21;
  UND 21 THEN REWRITE_TAC[EMPTY_EXISTS ];
  REWRITE_TAC[INTER];
  FULL_REWRITE_TAC[segment_end;INR in_pair];
  FULL_REWRITE_TAC[segment_end;INR in_pair];
  TYPE_THEN `uB (b eps)` EXISTS_TAC;
  (* -- *)
    TYPE_THEN `e` UNABBREV_TAC;
  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(b (~eps),b (~eps))`;`(b (~eps),i)`] );
  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
  TYPE_THEN `i` UNABBREV_TAC;
  REWR 16;
  UND 16 THEN REWRITE_TAC[EMPTY_EXISTS ];
  REWRITE_TAC[INTER];
  FULL_REWRITE_TAC[segment_end;INR in_pair];
  FULL_REWRITE_TAC[segment_end;INR in_pair];
  TYPE_THEN `uA (b (~eps))` EXISTS_TAC;
  (* -F *)
  TYPE_THEN `A T INTER A F = EMPTY ` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[UNION_OVER_INTER];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[EMPTY_UNION];
  TYPE_THEN `!i j. (f i INTER f j = EMPTY) <=> ~( i = j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `i'` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_IDEMPOT];
  TSPEC `j` 2;
  TYPE_THEN `f j` UNABBREV_TAC;
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  PROOF_BY_CONTR_TAC;
  UND 16 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  REWRITE_TAC[PAIR_SPLIT];
  (* - *)
  TYPE_THEN `A T UNION A F = R` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `R` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION;UNIONS];
  CONV_TAC (dropq_conv "u");
  UND 5 THEN REP_CASES_TAC THEN UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION;UNIONS];
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `!i'. (i' = i) \/ (i' = b T) \/ (i' = b F)` SUBAGOAL_TAC;
  TYPE_THEN`i'' = i` ASM_CASES_TAC;
  UND 15 THEN DISCH_THEN (  THM_INTRO_TAC[`i''`]);
  ASM_MESON_TAC[];
  TYPE_THEN `e = T` ASM_CASES_TAC;
  MESON_TAC[];
  MESON_TAC[];
  COPY 16;
  TSPEC `i'` 16;
  TSPEC `j` 22;
  JOIN 16 22 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  UND 16 THEN REP_CASES_TAC THEN REWR 5 ;
  TYPE_THEN `j` UNABBREV_TAC;
  TYPE_THEN `i'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `j` UNABBREV_TAC;
  TYPE_THEN `i'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `j` UNABBREV_TAC;
  TYPE_THEN `i'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* -G *)
  SUBCONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[cls_union];
  REWRITE_TAC[UNION_OVER_INTER];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[union_subset];
  USE 2(REWRITE_RULE[segment_end]);
  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_SIMP_TAC[];
  REWRITE_TAC[INTER;SUBSET;INR in_pair];
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  ONCE_REWRITE_TAC[eq_exchange];
  ASM_REWRITE_TAC[];
  (* -H *)
  KILL 21;
  KILL 20;
  KILL 17;
  KILL 19;
  KILL 18;
  TYPE_THEN `!eps. segment_end (A eps) (uA i) (uB i)` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  THM_INTRO_TAC[`f (b (~eps),i)`;`f (b (~eps),b eps)`;`uB i`;`uA(b (~eps))`;`uB(b eps)`] segment_end_union;
  CONJ_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  TSPEC `(b (~eps),i)` 2;
  REWR 2;
  CONJ_TAC;
  TSPEC `(b (~eps),b eps)` 2;
  REWR 2;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`(b (~eps),i)`;`(b (~eps),b eps)`]);
  USE 0(REWRITE_RULE[PAIR_SPLIT]);
  ASM_MESON_TAC[];
  USE 2(REWRITE_RULE[segment_end]);
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;INR in_pair;INR IN_SING;];
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  ONCE_REWRITE_TAC[eq_exchange];
  ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[`f (i,b eps)`;`f (b (~eps),i) UNION f (b (~eps),b eps)`;`uA i`;`uB (b eps)`;`uB i`] segment_end_union;
  CONJ_TAC;
  TSPEC `(i,b eps)` 2;
  REWR 2;
  CONJ_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  REWRITE_TAC[cls_union];
  COPY 0;
  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,b eps)`;`b (~eps),i`]);
  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[UNION_OVER_INTER];
  UND 17 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,b eps)`;`b (~eps),(b eps)`]);
  USE 17 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_MESON_TAC[];
  USE 2(REWRITE_RULE[segment_end]);
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;UNION;INR in_pair;INR IN_SING;];
  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  ONCE_REWRITE_TAC[eq_exchange];
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[UNION_COMM];
  (* - *)
  USE 17(REWRITE_RULE[segment_end]);
  USE 2 (REWRITE_RULE[segment_end]);
  ]);;
  (* }}} *)

(* --- *)


(* ------------------------------------------------------------------ *)
(* SECTION X *)
(* ------------------------------------------------------------------ *)


(* Continue from SECTION Q.
   1.0.2 Rational approximation.  *)

(* work out homeo on graph_support_set properties *)
(* apply h_translate (-- &1) o r_scale (&1/z) *)


(* Let's go back and do it in a symmetric way for both cases. *)

let eps_translate_def = jordan_def `eps_translate eps  =
  if eps then h_translate else v_translate`;;

let eps_translate = 
prove_by_refinement(
  `!eps r. eps_translate eps r = if eps then h_translate r else
     v_translate r`,

  (* {{{ proof *)
  [
  REWRITE_TAC[eps_translate_def];
  COND_CASES_TAC;
  ]);;
  (* }}} *)

let homeomorphism_eps_translate = 
prove_by_refinement(
  `!eps r. homeomorphism (eps_translate eps r) top2 top2`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[eps_translate];
  COND_CASES_TAC THEN REWRITE_TAC[h_translate_hom;v_translate_hom];
  ]);;
  (* }}} *)

let eps_hyper = jordan_def `eps_hyper eps z =
  if eps then hyperplane 2 e1 z else hyperplane 2 e2 z`;;

let eps_hyper_translate = 
prove_by_refinement(
  `!eps r z. IMAGE (eps_translate eps r) (eps_hyper eps z) =
         (eps_hyper eps (z + r)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[eps_translate;eps_hyper];
  COND_CASES_TAC THEN REWRITE_TAC[hyperplane1_h_translate;hyperplane2_v_translate];
  ]);;
  (* }}} *)

let eps_hyper_translate_perp = 
prove_by_refinement(
  `!eps r z. IMAGE (eps_translate eps r) (eps_hyper (~eps) z) =
         (eps_hyper (~eps) z) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[eps_translate;eps_hyper];
  COND_CASES_TAC THEN REWRITE_TAC[hyperplane2_h_translate;hyperplane1_v_translate];
  ]);;
  (* }}} *)

let eps_scale = jordan_def `eps_scale eps r =
  if eps then r_scale r else u_scale r`;;

let eps_hyper_scale_perp = 
prove_by_refinement(
  `!eps r z. (&0 < r) ==>
         (IMAGE (eps_scale eps r) (eps_hyper (~eps) z) =
            (eps_hyper (~eps) z)) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[eps_scale;eps_hyper];
  COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane1_u_scale;hyperplane2_r_scale];
  ]);;
  (* }}} *)

let eps_hyper_scale = 
prove_by_refinement(
  `!eps r z. (&0 < r) ==>
         (IMAGE (eps_scale eps r) (eps_hyper (eps) z) =
            (eps_hyper (eps) (if (&0 < z) then r*z else z))) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[eps_scale;eps_hyper];
  COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane2_u_scale;hyperplane1_r_scale];
  ]);;
  (* }}} *)

let homeomorphism_eps_scale = 
prove_by_refinement(
  `!eps r. (&0 < r) ==> homeomorphism (eps_scale eps r) top2 top2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[eps_scale];
  COND_CASES_TAC THEN ASM_SIMP_TAC [u_scale_hom;r_scale_hom];
  ]);;
  (* }}} *)

let graph_support_eps = jordan_def `graph_support_eps G E <=>
  good_plane_graph G /\  FINITE E /\
  (!e. (graph_edge G e ==> e SUBSET UNIONS E)) /\
  (!v. (graph_vertex G v ==>
         E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\
  (!e. (E e ==> (?z eps. (e = eps_hyper eps z)))) /\
  (!z eps. (z <= &0 /\ E (eps_hyper eps z) ==> (?j. z = -- &j)))`;;

let iso_support_eps_pair = jordan_def
 `iso_support_eps_pair (G:(A,B)graph_t) =
  { (H,E) | (graph_isomorphic G H) /\  graph_support_eps H E }`;;

let eps_hyper_ne = 
prove_by_refinement(
  `!z z' eps. ~(eps_hyper eps z = eps_hyper (~eps) z')`,

  (* {{{ proof *)
  [
  REWRITE_TAC[eps_hyper];
  UND 0 THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[hyperplane_ne;GSYM hyperplane_ne] ;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let eps_hyper_inj = 
prove_by_refinement(
  `!z z' eps eps'. (eps_hyper eps z = eps_hyper eps' z') <=>
     ((eps = eps') /\ (z = z'))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN`eps' = ~eps` ASM_CASES_TAC;
  TYPE_THEN `eps'` UNABBREV_TAC;
  REWRITE_TAC [eps_hyper_ne];
  ASM_MESON_TAC[];
  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps'` UNABBREV_TAC;
  REWRITE_TAC[eps_hyper];
  COND_CASES_TAC THEN IMATCH_MP_TAC  EQ_ANTISYM THEN CONJ_TAC;
  IMATCH_MP_TAC  hyperplane1_inj;
  IMATCH_MP_TAC  hyperplane2_inj;
  ]);;
  (* }}} *)

let iso_support_eps_nonempty = 
prove_by_refinement(
  `!(G:(A,B)graph_t). (planar_graph G) /\
         FINITE (graph_edge G) /\
         FINITE (graph_vertex G) /\
         ~(graph_edge G = {}) /\
         (!v. CARD (graph_edge_around G v) <=| 4) ==>
     ~(iso_support_eps_pair G = EMPTY) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[iso_support_eps_pair];
  TH_INTRO_TAC [`G`] graph_support_init;
  UND 0 THEN REWRITE_TAC[EMPTY_EXISTS];
  CONV_TAC (dropq_conv "u");
  REWRITE_TAC[graph_support_eps];
  UNIFY_EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[eps_hyper];
  (* - *)
  TYPE_THEN `(!e. E e ==> (?z eps. (&0 < z) /\ (e = eps_hyper eps z)))` SUBAGOAL_TAC;
  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
  FIRST_ASSUM DISJ_CASES_TAC  ;
  TYPE_THEN`z` EXISTS_TAC;
  TYPE_THEN `T` EXISTS_TAC;
  REWRITE_TAC[eps_hyper];
  TYPE_THEN`z` EXISTS_TAC;
  TYPE_THEN `F` EXISTS_TAC;
  REWRITE_TAC[eps_hyper];
  (* - *)
  CONJ_TAC;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
  MESON_TAC[];
  (* - *)
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`eps_hyper eps z`]);
  FULL_REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `z'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 14 THEN UND 13 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let count_iso_eps_pair = jordan_def
  `count_iso_eps_pair ((H:(A,B)graph_t),E) =
   CARD { e | (?z eps. (&0 < z) /\ E e /\  (e  = eps_hyper eps z)) }`;;

let iso_support_eps_finite = 
prove_by_refinement(
  `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) ==> FINITE
   { e | (?z eps. (&0 < z) /\ E e /\  (e  = eps_hyper eps z)) }`,

  (* {{{ proof *)
  [
  REWRITE_TAC[iso_support_eps_pair ;PAIR_SPLIT; graph_support_eps;];
  TYPE_THEN `E'` UNABBREV_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[SUBSET];
  ]);;
  (* }}} *)

let iso_eps_support0 = 
prove_by_refinement(
  `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\
   (count_iso_eps_pair (H,E) = 0) ==>
  good_plane_graph H /\  FINITE E /\
  (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
  (!v. (graph_vertex H v ==>
         E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\
  (!e. (E e ==> (?z eps. (e = eps_hyper eps z) ))) /\
  (!z eps. (E (eps_hyper eps z) ==> (?j. z = -- &j)))
    `,

  (* {{{ proof *)
  [
  REWRITE_TAC[count_iso_eps_pair;];
  TYPE_THEN `A = { e | (?z eps. (&0 < z) /\ E e /\  (e  =  eps_hyper eps z)) }` ABBREV_TAC ;
  TYPE_THEN `A HAS_SIZE 0` SUBAGOAL_TAC;
  REWRITE_TAC[HAS_SIZE];
  TYPE_THEN `A` UNABBREV_TAC;
  TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite;
  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;graph_support_eps;iso_support_eps_pair]);
  TYPE_THEN `E'` UNABBREV_TAC;
  TYPE_THEN `H'` UNABBREV_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN`eps` EXISTS_TAC;
  FULL_REWRITE_TAC[HAS_SIZE_0];
  TYPE_THEN `A` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  USE 2 (MATCH_MP (REAL_ARITH `~( z <= &0) ==> (&0 < z)`));
  UND 3 THEN REWRITE_TAC[EMPTY_EXISTS];
  CONV_TAC (dropq_conv "u");
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let iso_support_eps_min = 
prove_by_refinement(
  `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\
    (0 < count_iso_eps_pair (H,E)) ==>
    (?z eps. (&0 < z) /\ E (eps_hyper eps z) /\
      (!w. (&0 < w /\ w < z) ==> ~(E (eps_hyper eps w))))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[count_iso_eps_pair];
  TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ;
  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
  TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `~(A HAS_SIZE 0) ` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
  UND 4 THEN UND 0 THEN ARITH_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE_0;EMPTY_EXISTS]);
  TYPE_THEN `?r eps. (u = eps_hyper eps r)` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  MESON_TAC[];
  TYPE_THEN `u` UNABBREV_TAC;
  (* - *)
  TH_INTRO_TAC[`{z | &0 < z}`;`eps_hyper eps`;`{e | ?z. (&0 < z) /\ E e /\ (e = eps_hyper eps z)}`] finite_subset;
  REWRITE_TAC[SUBSET;IMAGE];
  CONJ_TAC;
  TYPE_THEN `z` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]);
  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `A` UNABBREV_TAC;
  UNIFY_EXISTS_TAC;
  FULL_REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `inf C` EXISTS_TAC;
  (* - *)
  TYPE_THEN `C (inf C)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  finite_inf;
  (* - *)
  TYPE_THEN `(!z. C z ==> inf C <= z)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  finite_inf_min;ALL_TAC ];
  TYPE_THEN `z = inf C` ABBREV_TAC ;
  KILL 11;
  KILL 8;
  (* - *)
  TYPE_THEN `eps` EXISTS_TAC;
  USE 5(REWRITE_RULE[IMAGE]);
  USE 5(ONCE_REWRITE_RULE[FUN_EQ_THM]);
  COPY 5;
  TSPEC `eps_hyper eps z` 5;
  USE 5(REWRITE_RULE[INR IN_SING]);
  USE 5(MATCH_MP (TAUT `(a <=> b) ==> (b ==> a)`));
  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `z'` UNABBREV_TAC;
  REP_BASIC_TAC;
  (* - *)
  TSPEC `eps_hyper eps w` 8;
  USE 8(MATCH_MP (TAUT `(a <=> b) ==> (a ==> b)`));
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
  TYPE_THEN `w` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `x` UNABBREV_TAC;
  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`w`]);
  UND 8 THEN UND 13 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let graph_eps_scale_image = 
prove_by_refinement(
  `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps
       (plane_graph_image (eps_scale eps r)G)
       (IMAGE2 (eps_scale eps r) E)
          `,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_support_eps];
  THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  plane_graph_image_plane;
  (* - *)
  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  FINITE_IMAGE;
  (* - *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  USE 10 (REWRITE_RULE[IMAGE]);
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  FULL_REWRITE_TAC [SUBSET;UNIONS];
  REWRITE_TAC[IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `im` UNABBREV_TAC;
  USE 3(CONV_RULE NAME_CONFLICT_CONV);
  USE 13 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x'` UNABBREV_TAC;
  TSPEC `x''` 3;
  REP_BASIC_TAC;
  TYPE_THEN `u'` EXISTS_TAC;
  REWRITE_TAC[IMAGE];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -A *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `im` UNABBREV_TAC;
  USE 11(REWRITE_RULE[IMAGE]);
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  CONJ_TAC;
  UNIFY_EXISTS_TAC;
  (* ? *)
  TYPE_THEN `eps = T` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
  REWRITE_TAC[eps_scale;r_scale];
  COND_CASES_TAC;
  TYPE_THEN `eps = F` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp;
  AP_TERM_TAC;
  REWRITE_TAC[eps_scale;u_scale];
  COND_CASES_TAC;
  (* -- *)
  TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
  TYPE_THEN `eps = F` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
  REWRITE_TAC[eps_scale;u_scale];
  COND_CASES_TAC;
  TYPE_THEN `eps = T` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp;
  AP_TERM_TAC;
  REWRITE_TAC[eps_scale;r_scale];
  COND_CASES_TAC;
  (* -B *)
  CONJ_TAC;
  USE 12(REWRITE_RULE[IMAGE2]);
  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  USE 12(REWRITE_RULE[IMAGE]);
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  TYPE_THEN `im` UNABBREV_TAC;
  LEFT_TAC  "eps''";
  TYPE_THEN `eps'` EXISTS_TAC;
  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_scale_perp];
  MESON_TAC[];
  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
  UND 13 THEN MESON_TAC[];
  ASM_SIMP_TAC[eps_hyper_scale];
  MESON_TAC[];
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `eps'` EXISTS_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  USE 12 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `im` UNABBREV_TAC;
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  REWR 12;
  TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `eps''` UNABBREV_TAC;
  TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
  UND 14 THEN MESON_TAC[];
  TYPE_THEN `eps''` UNABBREV_TAC;
  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale];
  FULL_REWRITE_TAC[eps_hyper_inj];
  UND 12 THEN COND_CASES_TAC;
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  PROOF_BY_CONTR_TAC;
  UND 12 THEN UND 13 THEN REAL_ARITH_TAC;
  TYPE_THEN `z'` UNABBREV_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  ]);;
  (* }}} *)

let graph_eps_scale_image = 
prove_by_refinement(
  `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps
       (plane_graph_image (eps_scale eps r)G)
       (IMAGE2 (eps_scale eps r) E)
          `,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_support_eps];
  THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  plane_graph_image_plane;
  (* - *)
  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  FINITE_IMAGE;
  (* - *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  USE 10 (REWRITE_RULE[IMAGE]);
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  FULL_REWRITE_TAC [SUBSET;UNIONS];
  REWRITE_TAC[IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `im` UNABBREV_TAC;
  USE 3(CONV_RULE NAME_CONFLICT_CONV);
  USE 13 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x'` UNABBREV_TAC;
  TSPEC `x''` 3;
  REP_BASIC_TAC;
  TYPE_THEN `u'` EXISTS_TAC;
  REWRITE_TAC[IMAGE];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -A *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `im` UNABBREV_TAC;
  USE 11(REWRITE_RULE[IMAGE]);
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  CONJ_TAC;
  UNIFY_EXISTS_TAC;
  (* ? *)
  TYPE_THEN `eps = T` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
  REWRITE_TAC[eps_scale;r_scale];
  COND_CASES_TAC;
  TYPE_THEN `eps = F` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp;
  AP_TERM_TAC;
  REWRITE_TAC[eps_scale;u_scale];
  COND_CASES_TAC;
  (* -- *)
  TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
  TYPE_THEN `eps = F` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
  REWRITE_TAC[eps_scale;u_scale];
  COND_CASES_TAC;
  TYPE_THEN `eps = T` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp;
  AP_TERM_TAC;
  REWRITE_TAC[eps_scale;r_scale];
  COND_CASES_TAC;
  (* -B *)
  CONJ_TAC;
  USE 12(REWRITE_RULE[IMAGE2]);
  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  USE 12(REWRITE_RULE[IMAGE]);
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  TYPE_THEN `im` UNABBREV_TAC;
  LEFT_TAC  "eps''";
  TYPE_THEN `eps'` EXISTS_TAC;
  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_scale_perp];
  MESON_TAC[];
  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
  UND 13 THEN MESON_TAC[];
  ASM_SIMP_TAC[eps_hyper_scale];
  MESON_TAC[];
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `eps'` EXISTS_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  USE 12 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `im` UNABBREV_TAC;
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  REWR 12;
  TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `eps''` UNABBREV_TAC;
  TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
  UND 14 THEN MESON_TAC[];
  TYPE_THEN `eps''` UNABBREV_TAC;
  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale];
  FULL_REWRITE_TAC[eps_hyper_inj];
  UND 12 THEN COND_CASES_TAC;
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  PROOF_BY_CONTR_TAC;
  UND 12 THEN UND 13 THEN REAL_ARITH_TAC;
  TYPE_THEN `z'` UNABBREV_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  ]);;
  (* }}} *)

let graph_eps_translate_image = 
prove_by_refinement(
  `!G E eps r.  (?j.  -- &j = r) /\
      (!w. (&0 < w /\ w < -- r) ==> ~(E (eps_hyper eps w)))  /\
       graph_support_eps G E ==>
       graph_support_eps
       (plane_graph_image (eps_translate eps r)G)
       (IMAGE2 (eps_translate eps r) E)
          `,

  (* {{{ proof *)
  [
  REWRITE_TAC[graph_support_eps];
  THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_translate;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  plane_graph_image_plane;
  (* - *)
  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2];
  IMATCH_MP_TAC  FINITE_IMAGE;
  (* - *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
  USE 11 (REWRITE_RULE[IMAGE]);
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  FULL_REWRITE_TAC [SUBSET;UNIONS];
  REWRITE_TAC[IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `im` UNABBREV_TAC;
  USE 3(CONV_RULE NAME_CONFLICT_CONV);
  USE 14 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x'` UNABBREV_TAC;
  TSPEC `x''` 3;
  REP_BASIC_TAC;
  TYPE_THEN `u'` EXISTS_TAC;
  REWRITE_TAC[IMAGE];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -A *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `im` UNABBREV_TAC;
  USE 12(REWRITE_RULE[IMAGE]);
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  CONJ_TAC;
  UNIFY_EXISTS_TAC;
  (* --- *)
  TYPE_THEN `eps = T` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj];
  REWRITE_TAC[eps_translate;h_translate];
  REWRITE_TAC[euclid_plus;e1;point_scale];
  REAL_ARITH_TAC;
  TYPE_THEN `eps = F` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_translate_perp;
  FULL_REWRITE_TAC [];
  AP_TERM_TAC;
  REWRITE_TAC[eps_translate;v_translate];
   REWRITE_TAC[euclid_plus;e2;point_scale];
  REAL_ARITH_TAC;
  (* -- *)
  TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
  TYPE_THEN `eps = F` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj];
  REWRITE_TAC[eps_translate;v_translate];
   REWRITE_TAC[euclid_plus;e2;point_scale];
  REAL_ARITH_TAC;
  TYPE_THEN `eps = T` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `eps` UNABBREV_TAC;
  THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_translate_perp;
  FULL_REWRITE_TAC[];
  AP_TERM_TAC;
  REWRITE_TAC[eps_translate;h_translate];
   REWRITE_TAC[euclid_plus;e1;point_scale];
  REAL_ARITH_TAC;
  (* -B *)
  CONJ_TAC;
  USE 13(REWRITE_RULE[IMAGE2]);
  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
  USE 13(REWRITE_RULE[IMAGE]);
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  TYPE_THEN `im` UNABBREV_TAC;
  LEFT_TAC  "eps''";
  TYPE_THEN `eps'` EXISTS_TAC;
  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
  ASM_SIMP_TAC [eps_hyper_translate_perp];
  MESON_TAC[];
  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
  UND 14 THEN MESON_TAC[];
  ASM_SIMP_TAC[eps_hyper_translate];
  MESON_TAC[];
  (* -C *)
  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
  TYPE_THEN `eps'` UNABBREV_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `~eps` EXISTS_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
  USE 13 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `im` UNABBREV_TAC;
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  REWR 13;
  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
  UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `eps'` UNABBREV_TAC;
  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
  UND 15 THEN MESON_TAC[];
  TYPE_THEN `eps'` UNABBREV_TAC;
  UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate];
  FULL_REWRITE_TAC[eps_hyper_inj];
  UND 17 THEN MESON_TAC[];
  (* -D *)
  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
  UND 15 THEN MESON_TAC[];
  TYPE_THEN`eps'` UNABBREV_TAC;
  TYPE_THEN `E(eps_hyper eps (z + &j))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
  USE 13 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `im` UNABBREV_TAC;
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  REWR 13;
  TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
  UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp];
  FULL_REWRITE_TAC[eps_hyper_inj];
  UND 18 THEN MESON_TAC[];
  TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
  UND 16 THEN MESON_TAC[];
  TYPE_THEN `eps''` UNABBREV_TAC;
  FULL_REWRITE_TAC[eps_hyper_translate;eps_hyper_inj];
  TYPE_THEN `r` UNABBREV_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `!a. (z' + (-- a)) + a = z'` SUBAGOAL_TAC;
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `z = &0` ASM_CASES_TAC;
  TYPE_THEN  `0` EXISTS_TAC;
  REAL_ARITH_TAC;
  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`z + &j`;`eps`]);
  IMATCH_MP_TAC  (REAL_ARITH `~(&0 < z + &j) ==> (z + &j <= &0)`);
  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`z + &j`]);
  TYPE_THEN `r` UNABBREV_TAC;
  UND 17 THEN UND 14 THEN REAL_ARITH_TAC;
  UND 6 THEN REWRITE_TAC[];
  TYPE_THEN `j +| j'` EXISTS_TAC;
  UND 0 THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let count_iso_scale = 
prove_by_refinement(
  `!G E eps r. (&0 < r) /\ graph_support_eps G E ==>
     (count_iso_eps_pair (G,E) = count_iso_eps_pair
       ((plane_graph_image(eps_scale eps r) G),
                (IMAGE2 (eps_scale eps r) E))) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[count_iso_eps_pair];
  THM_INTRO_TAC[`G`;`E`;`eps`;`r`] graph_eps_scale_image;
  FULL_REWRITE_TAC[graph_support_eps];
  IMATCH_MP_TAC  BIJ_CARD;
  TYPE_THEN `IMAGE (eps_scale eps r)` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET ;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[SUBSET];
  (* - *)
  FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v];
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
  (* - *)
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  TYPE_THEN `if (eps = eps') then r* z else z` EXISTS_TAC;
  TYPE_THEN `eps'` EXISTS_TAC;
  CONJ_TAC;
  COND_CASES_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `im` UNABBREV_TAC;
  COND_CASES_TAC;
  ASM_SIMP_TAC[eps_hyper_scale];
  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
  UND 13 THEN MESON_TAC[];
  ASM_SIMP_TAC[eps_hyper_scale_perp];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  TYPE_THEN `im` UNABBREV_TAC;
  TYPE_THEN `(eps' = eps) \/ (eps' = ~eps)` SUBAGOAL_TAC;
  MESON_TAC[];
  TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC;
  MESON_TAC[];
  REWRITE_TAC[eps_hyper_inj];
  JOIN 13 15 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR];
  UND 13 THEN REP_CASES_TAC THEN UND 14 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_scale_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`];
  IMATCH_MP_TAC  REAL_EQ_LCANCEL_IMP;
  TYPE_THEN `r` EXISTS_TAC;
  UND 1 THEN REAL_ARITH_TAC;
  (* - *)
  REWRITE_TAC[SURJ];
  CONJ_TAC;
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  (* - *)
  CONV_TAC (dropq_conv "y");
  TYPE_THEN `x` UNABBREV_TAC;
  LEFT_TAC "eps";
  TYPE_THEN `eps'` EXISTS_TAC;
  USE 16 (REWRITE_RULE[IMAGE]);
  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `z'` EXISTS_TAC;
  TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then r*z' else z')` SUBAGOAL_TAC;
  TYPE_THEN `im` UNABBREV_TAC;
  COND_CASES_TAC;
  TYPE_THEN `eps''` UNABBREV_TAC;
  UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
  COND_CASES_TAC;
  REWR 17;
  TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
  UND 8 THEN MESON_TAC[];
  TYPE_THEN `eps''` UNABBREV_TAC;
  UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale_perp;eps_hyper_inj];
  (* - *)
  TYPE_THEN `eps''` UNABBREV_TAC;
  REWR 17;
  UND 17 THEN COND_CASES_TAC;
  THM_INTRO_TAC[`r`;`z'`] REAL_LT_LMUL_0;
  USE 19 SYM;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let count_iso_translate = 
prove_by_refinement(
  `!G E eps .  graph_support_eps G E /\
       (!w. (&0 < w /\ w <  &1) ==> ~(E (eps_hyper eps w))) /\
      E (eps_hyper eps (&1))  ==>
     (count_iso_eps_pair (G,E) = SUC(count_iso_eps_pair
       ((plane_graph_image(eps_translate eps (-- &1)) G),
                (IMAGE2 (eps_translate eps (-- &1)) E)))) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[count_iso_eps_pair];
  TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ;
  TYPE_THEN `A (eps_hyper eps (&1))` SUBAGOAL_TAC;
  TYPE_THEN`A` UNABBREV_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  MESON_TAC[];
  (* - *)
  TYPE_THEN`FINITE A` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[graph_support_eps];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  (* - *)
  THM_INTRO_TAC[`(eps_hyper eps (&1))`;`A`]CARD_SUC_DELETE;
  TYPE_THEN `CARD A` UNABBREV_TAC;
  REWRITE_TAC[SUC_INJ];
  THM_INTRO_TAC[`G`;`E`;`eps`;`-- &1`] graph_eps_translate_image;
  CONJ_TAC;
  MESON_TAC[];
  FULL_REWRITE_TAC[REAL_ARITH `-- -- x = x`];
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[graph_support_eps];
  (* -A0 *)
  IMATCH_MP_TAC  BIJ_CARD;
  TYPE_THEN `IMAGE (eps_translate eps (-- &1))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_DELETE_IMP;
  (* - *)
  FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v];
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN `im = IMAGE (eps_translate eps (-- &1))` ABBREV_TAC ;
  (* -A *)
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  FULL_REWRITE_TAC[DELETE];
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `if (eps = eps'') then  z' - &1 else z'` EXISTS_TAC;
  TYPE_THEN `eps''` EXISTS_TAC;
  TYPE_THEN `eps'` UNABBREV_TAC;
  CONJ_TAC;
  COND_CASES_TAC;
  TYPE_THEN `eps''` UNABBREV_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~((z' = &1) \/ (z' < &1)) ==> (&0 < z' - &1)`);
  REWR 3;
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`z'`]);
  UND 1 THEN ASM_REWRITE_TAC[];
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  TYPE_THEN `im` UNABBREV_TAC;
  COND_CASES_TAC;
  ASM_SIMP_TAC[eps_hyper_translate];
  AP_TERM_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
  UND 3 THEN MESON_TAC[];
  ASM_SIMP_TAC[eps_hyper_translate_perp];
  TYPE_THEN `A` UNABBREV_TAC;
  FULL_REWRITE_TAC[DELETE];
  TYPE_THEN `x` UNABBREV_TAC;  (* -// *)
  TYPE_THEN `y` UNABBREV_TAC;
  TYPE_THEN `im` UNABBREV_TAC;
  TYPE_THEN `(eps''' = eps) \/ (eps''' = ~eps)` SUBAGOAL_TAC;
  MESON_TAC[];
  TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC;
  MESON_TAC[];
  REWRITE_TAC[eps_hyper_inj];
  JOIN 17 20 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR];
  UND 17 THEN REP_CASES_TAC THEN UND 18 THEN ASM_SIMP_TAC[eps_hyper_translate;eps_hyper_translate_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`];
  UND 17 THEN REAL_ARITH_TAC;
  (* -B *)
  REWRITE_TAC[SURJ];
  FULL_REWRITE_TAC[INJ];
  (* - *)
  REP_BASIC_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DELETE];
  CONV_TAC (dropq_conv "y");  (* -// *)
  LEFT_TAC "eps";
  TYPE_THEN `eps'` EXISTS_TAC;
  KILL 18;
  KILL 19;
  FULL_REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `z'` UNABBREV_TAC;
  TYPE_THEN `eps''` UNABBREV_TAC;
  (* - *)
  USE 21 (REWRITE_RULE[IMAGE]);
  UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `z''` EXISTS_TAC;
  TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then z'' - &1  else z'')` SUBAGOAL_TAC;
  TYPE_THEN `im` UNABBREV_TAC;
  COND_CASES_TAC;
  TYPE_THEN `eps''` UNABBREV_TAC;
  USE 3 (REWRITE_RULE  [eps_hyper_translate;eps_hyper_inj]);
  REAL_ARITH_TAC;
  TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
  UND 12 THEN MESON_TAC[];
  TYPE_THEN `eps''` UNABBREV_TAC;
  USE 3 (REWRITE_RULE[   eps_hyper_translate_perp;eps_hyper_inj]);
  (* - *)
  TYPE_THEN `eps''` UNABBREV_TAC;
  TYPE_THEN `z` UNABBREV_TAC;
  CONJ_TAC;
  UND 22 THEN COND_CASES_TAC;
  UND 12 THEN REAL_ARITH_TAC;
  TYPE_THEN `z''` UNABBREV_TAC;
  TYPE_THEN `eps'` UNABBREV_TAC;
  UND 22 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let iso_support_min_int = 
prove_by_refinement(
  `!G:(A,B)graph_t H E. iso_support_eps_pair G (H,E) /\
    (0 <| count_iso_eps_pair (H,E)) ==>
    (?H' E'. iso_support_eps_pair G (H',E') /\
       (count_iso_eps_pair(H',E') = count_iso_eps_pair(H,E)) /\
       (?eps. E' (eps_hyper eps (&1)) /\
         (!w. (&0 < w /\ w < &1) ==> ~(E'(eps_hyper eps w)))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_min;
  TYPE_THEN `z' = &1/z` ABBREV_TAC ;
  TYPE_THEN `H' = plane_graph_image (eps_scale eps z') H` ABBREV_TAC ;
  TYPE_THEN `E' = IMAGE2 (eps_scale eps z') E` ABBREV_TAC ;
  TYPE_THEN `H'` EXISTS_TAC;
  TYPE_THEN `E'` EXISTS_TAC;
  (* - *)
  TYPE_THEN `&0 < z'` SUBAGOAL_TAC;
  TYPE_THEN `z'` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `z' * z = &1` SUBAGOAL_TAC;
  TYPE_THEN `z'` UNABBREV_TAC;
  IMATCH_MP_TAC  REAL_DIV_RMUL;
  UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
  (* - *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[iso_support_eps_pair];
  FULL_REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `E''` UNABBREV_TAC;
  TYPE_THEN `H''` UNABBREV_TAC;
  TYPE_THEN `H'` EXISTS_TAC;
  TYPE_THEN `E'` EXISTS_TAC;
  TYPE_THEN `H'` UNABBREV_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  CONJ_TAC;
  THM_INTRO_TAC[`eps_scale eps z'`;`H`] plane_graph_image_iso;
  ASM_SIMP_TAC [homeomorphism_eps_scale];
  FULL_REWRITE_TAC[graph_support_eps;good_plane_graph];
  THM_INTRO_TAC[`G`;`H`;`(plane_graph_image (eps_scale eps z') H)`] graph_isomorphic_trans;
  IMATCH_MP_TAC  graph_eps_scale_image;
  (* - *)
  SUBCONJ_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  TYPE_THEN `E'` UNABBREV_TAC;
  TYPE_THEN `H'` UNABBREV_TAC;
  IMATCH_MP_TAC  count_iso_scale;
  FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
  ASM_MESON_TAC[];
  TYPE_THEN `eps` EXISTS_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  (* - *)
  SUBCONJ_TAC;
  REWRITE_TAC[IMAGE2];
  TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `eps_hyper eps z` EXISTS_TAC;
  TYPE_THEN `im` UNABBREV_TAC;
  ASM_SIMP_TAC [eps_hyper_scale];
  (* - *)
  FULL_REWRITE_TAC[IMAGE2];
  TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ;
  USE 7(REWRITE_RULE[IMAGE]);
  TYPE_THEN `im` UNABBREV_TAC;
  UND 2 THEN  DISCH_THEN (THM_INTRO_TAC[ `z*w`  ]);
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  IMATCH_MP_TAC  (REAL_ARITH `z * w < z* &1 ==> z*w < z`);
  IMATCH_MP_TAC  REAL_LT_LMUL;
  TYPE_THEN `x = eps_hyper eps (z * w)` SUBAGOAL_TAC;
  USE 1 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
  TYPE_THEN `E''` UNABBREV_TAC;
  USE 17 (REWRITE_RULE[graph_support_eps]);
  UND 17 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  TYPE_THEN `x` UNABBREV_TAC;
  REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `eps' = eps` ASM_CASES_TAC;
  TYPE_THEN `eps'` UNABBREV_TAC;
  UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_inj];
  COND_CASES_TAC;
  UND 9 THEN REWRITE_TAC[REAL_MUL_AC];
  ASM_REWRITE_TAC [REAL_MUL_ASSOC];
  REAL_ARITH_TAC;
  REWR 13;
  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
  UND 17 THEN MESON_TAC[];
  TYPE_THEN `eps'` UNABBREV_TAC;
  UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale_perp;eps_hyper_inj];
  TYPE_THEN `x` UNABBREV_TAC;
  UND 2 THEN ASM_REWRITE_TAC[];


  ]);;
  (* }}} *)

let iso_int_model_lemma = 
prove_by_refinement(
  `!(G:(A,B)graph_t) . (planar_graph G) /\
         FINITE (graph_edge G) /\
         FINITE (graph_vertex G) /\
         ~(graph_edge G = {}) /\
         (!v. CARD (graph_edge_around G v) <=| 4) ==>
  (?H E. iso_support_eps_pair G (H,E) /\
     (count_iso_eps_pair (H,E) = 0))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `c  = count_iso_eps_pair:((num->real,(num->real)->bool)graph_t#(((num->real)->bool)->bool))->num` ABBREV_TAC ;
  THM_INTRO_TAC[`G`] iso_support_eps_nonempty;
  THM_INTRO_TAC[`iso_support_eps_pair G`;`c`] select_image_num_min;
  UND 6 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `?H E. z = H,E` SUBAGOAL_TAC ;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `H` EXISTS_TAC;
  TYPE_THEN `E` EXISTS_TAC;
  TYPE_THEN `c` UNABBREV_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `~(0 < x) ==> (x = 0)`);
  THM_INTRO_TAC[`G`;`H`;`E`] iso_support_min_int;
  THM_INTRO_TAC[`H'`;`E'`;`eps`] count_iso_translate;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
  ASM_MESON_TAC[];
  TYPE_THEN `H'' = plane_graph_image (eps_translate eps (-- &1)) H'` ABBREV_TAC ;
  TYPE_THEN `E'' = IMAGE2 (eps_translate eps ( -- &1)) E'`ABBREV_TAC ;
  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[ `(H'',E'')`]);
  TYPE_THEN `H''` UNABBREV_TAC;
  TYPE_THEN `E''` UNABBREV_TAC;
  REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
  CONV_TAC (dropq_conv "H");
  CONV_TAC (dropq_conv "E");
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `graph_isomorphic H' (plane_graph_image (eps_translate eps (-- &1)) H')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  plane_graph_image_iso;
  REWRITE_TAC[homeomorphism_eps_translate;];
  USE 12 (REWRITE_RULE[iso_support_eps_pair;graph_support_eps;good_plane_graph;PAIR_SPLIT]);
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`G`;`H'`;`(plane_graph_image (eps_translate eps (-- &1)) H')`] graph_isomorphic_trans;
  USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
  ASM_MESON_TAC[];
  (* -- *)
  IMATCH_MP_TAC  graph_eps_translate_image;
  CONJ_TAC;
  MESON_TAC[];
  ASM_REWRITE_TAC[ARITH_RULE `-- (-- x) = x`];
  USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
  ASM_MESON_TAC[];
  UND 7 THEN UND 13 THEN UND 11 THEN ARITH_TAC;

  ]);;
  (* }}} *)

let graph_int_model = 
prove_by_refinement(
  `!(G:(A,B)graph_t) . (planar_graph G) /\
         FINITE (graph_edge G) /\
         FINITE (graph_vertex G) /\
         ~(graph_edge G = {}) /\
         (!v. CARD (graph_edge_around G v) <=| 4) ==>
  (?H E.
     graph_isomorphic G H /\
     good_plane_graph H /\
     FINITE E /\
     (!e. graph_edge H e ==> e SUBSET UNIONS E) /\
     (!v. graph_vertex H v
                  ==> E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1))) /\
     (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
     (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j))
    )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`]iso_int_model_lemma;
  TYPE_THEN `H` EXISTS_TAC;
  TYPE_THEN `E` EXISTS_TAC;
  THM_INTRO_TAC[`G`;`H`;`E`] iso_eps_support0;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION Y *)
(* ------------------------------------------------------------------ *)

(* if a graph has an int model then it is a rectagonal graph *)
(* k33_nonplanar proved! *)


let h_edge_ball = 
prove_by_refinement(
  `!m. h_edge m SUBSET open_ball
       (euclid 2,d_euclid)
       (pointI m + (&1/ &2)*# e1) (&1 / &2)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[h_edge;open_ball;SUBSET;euclid_point;e1;point_scale;pointI;point_add];
  REWRITE_TAC[euclid_point;];
  TYPE_THEN `v` UNABBREV_TAC;
  REDUCE_TAC;
  REWRITE_TAC[d_euclid_point];
  REDUCE_TAC;
  TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC;
  REWRITE_TAC[EXP_EQ_0];
  UND 0 THEN ARITH_TAC;
  REDUCE_TAC;
  REWRITE_TAC[POW_2_SQRT_ABS];
  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
  REWRITE_TAC[GSYM REAL_ABS_BETWEEN];
  CONJ_TAC;
  REWRITE_TAC[REAL_LT_HALF1];
  CONJ_TAC;
  REWRITE_TAC[REAL_LT_SUB_RADD];
  REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE];
  UND 2 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let v_edge_ball = 
prove_by_refinement(
  `!m. v_edge m SUBSET open_ball
       (euclid 2,d_euclid)
       (pointI m + (&1/ &2)*# e2) (&1 / &2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[v_edge;open_ball;SUBSET;euclid_point;e2;point_scale;pointI;point_add];
  REWRITE_TAC[euclid_point;];
  TYPE_THEN `u` UNABBREV_TAC;
  REDUCE_TAC;
  REWRITE_TAC[d_euclid_point];
  REDUCE_TAC;
  TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC;
  REWRITE_TAC[EXP_EQ_0];
  UND 0 THEN ARITH_TAC;
  REDUCE_TAC;
  REWRITE_TAC[POW_2_SQRT_ABS];
  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
  REWRITE_TAC[GSYM REAL_ABS_BETWEEN];
  CONJ_TAC;
  REWRITE_TAC[REAL_LT_HALF1];
  CONJ_TAC;
  REWRITE_TAC[REAL_LT_SUB_RADD];
  REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE];
  UND 2 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let sqrt_frac = 
prove_by_refinement(
  `!n m. sqrt ((&n/ &m) pow 2) = &n/ (&m) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  POW_2_SQRT;
  IMATCH_MP_TAC  REAL_LE_DIV;
  REWRITE_TAC[REAL_POS];
  ]);;
  (* }}} *)

let abs_dest_int_half = 
prove_by_refinement(
  `!m. &1 / &2 <= abs  (real_of_int m - &1 / &2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
  TYPE_THEN `&2` EXISTS_TAC;
  CONJ_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `&2 * (&1/ &2) = &1` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 0 THEN REAL_ARITH_TAC;
  TYPE_THEN `&2 = abs  (&2)` SUBAGOAL_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN`!x. &2 * abs  x = abs  (&2 * x)` SUBAGOAL_TAC;
  UND 1 THEN REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_SUB_LDISTRIB];
  REWRITE_TAC[GSYM int_of_num_th;GSYM int_mul_th;GSYM int_sub_th;GSYM int_abs_th;GSYM int_le];
  TYPE_THEN `!x. ~(&:0 = ||: x) ==> (&:1 <= ||: x)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`x`] INT_ABS_POS;
  UND 3 THEN UND 4 THEN INT_ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 4 SYM;
  FULL_REWRITE_TAC[INT_ABS_ZERO];
  THM_INTRO_TAC[`m`] INT_REP;
  TYPE_THEN`m` UNABBREV_TAC;
  FULL_REWRITE_TAC[INT_OF_NUM_MUL;INT_SUB_LDISTRIB;INT_EQ_SUB_RADD;INT_OF_NUM_ADD;INT_OF_NUM_EQ;];
  UND 4 THEN REDUCE_TAC ;
  TYPE_THEN `ODD (2 *| n)` SUBAGOAL_TAC;
  REWRITE_TAC[ODD_EXISTS];
  TYPE_THEN `m'` EXISTS_TAC;
  ARITH_TAC;
  KILL 4;
  TYPE_THEN `EVEN (2 *| n)` SUBAGOAL_TAC;
  REWRITE_TAC[EVEN_EXISTS];
  MESON_TAC[];
  ASM_MESON_TAC[EVEN_AND_ODD];
  ]);;
  (* }}} *)

let REAL_LT_SQUARE_ABS = 
prove_by_refinement(
  `!x y. abs  x < abs  y <=> x pow 2 < y pow 2`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y /\ ~(y <= x))`];
  MESON_TAC[REAL_LE_SQUARE_ABS];
  ]);;
  (* }}} *)

let h_edge_closed_ball = 
prove_by_refinement(
  `!e m. edge e /\ ~(e INTER closed_ball
       (euclid 2,d_euclid)
       (pointI m + (&1/ &2)*# e1) (&1 / &2) = EMPTY) ==>
       (e = h_edge m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
  (*  - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  USE 1 (MATCH_MP point_onto);
  TYPE_THEN `u` UNABBREV_TAC;
  KILL 5;
  FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;v_edge;point_inj];
  TYPE_THEN `p` UNABBREV_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
  UND 0 THEN REWRITE_TAC[];
  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
  REWRITE_TAC[sqrt_frac];
  IMATCH_MP_TAC  SQRT_MONO_LT;
  IMATCH_MP_TAC (REAL_ARITH  `(x <= u /\ &0 < v) ==> x < u + v` );
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS];
  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
  ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG];
  TYPE_THEN `--((real_of_int (FST m) + &1 / &2) - real_of_int (FST m')) = (real_of_int (FST m' - FST m)) - &1 / &2 ` SUBAGOAL_TAC;
  REWRITE_TAC[int_sub_th];
  REAL_ARITH_TAC;
  REWRITE_TAC[abs_dest_int_half];
  (* -- *)
  IMATCH_MP_TAC  (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`);
  REWRITE_TAC[];
  USE 1 (MATCH_MP POW_ZERO);
  TYPE_THEN `v = real_of_int (SND m)` SUBAGOAL_TAC;
  UND 1 THEN REAL_ARITH_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  FULL_REWRITE_TAC[GSYM int_lt];
  UND 3 THEN UND 5 THEN INT_ARITH_TAC;
  (* - *)
  REWRITE_TAC[cell_clauses];
  TYPE_THEN `e` UNABBREV_TAC;
  FULL_REWRITE_TAC[h_edge];
  TYPE_THEN `v` UNABBREV_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  (* - *)
  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
  UND 0 THEN REWRITE_TAC[];
  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
  REWRITE_TAC[sqrt_frac];
  IMATCH_MP_TAC  SQRT_MONO_LT;
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  IMATCH_MP_TAC (REAL_ARITH  `(x < u /\ &0 <= v) ==> x < u + v` );
  (* --B *)
  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
  KILL 0;
  TYPE_THEN `!x y. x < abs  y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `&1 / &2 < (real_of_int (FST m) + &1 / &2) - u'` ASM_CASES_TAC;
  DISJ1_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `&1 / &2` EXISTS_TAC;
  CONJ_TAC ;
  IMATCH_MP_TAC  REAL_LE_DIV;
  REAL_ARITH_TAC;
  UND 9 THEN REAL_ARITH_TAC;
  (* -- *)
  TYPE_THEN `real_of_int (FST m) + &1 < u'` BACK_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_TRANS;
  TYPE_THEN `real_of_int (FST m) + &1 - u'` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_LT_HALF2];
  UND 11 THEN REAL_ARITH_TAC;
  UND 10 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE;
  UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t]));
  UND 10 THEN REAL_ARITH_TAC;
  (* -- *)
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `u' <= real_of_int (FST m) + &1` SUBAGOAL_TAC;
  UND 10 THEN REAL_ARITH_TAC;
  TYPE_THEN `real_of_int (FST m) <= u'` SUBAGOAL_TAC;
  UND 9 THEN REAL_ARITH_TAC;
  TYPE_THEN `~(u' = real_of_int (FST m) + &1)` SUBAGOAL_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;];
  UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC;
  TYPE_THEN `u' < real_of_int (FST m) + &1` SUBAGOAL_TAC;
  UND 13 THEN UND 11 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `floor u' = (FST m')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
  ASM_REWRITE_TAC[floor_range];
  UND 6 THEN REAL_ARITH_TAC;
  USE 15 SYM;
  TYPE_THEN `floor u' = FST m` SUBAGOAL_TAC;
  REWRITE_TAC[floor_range];
  ASM_MESON_TAC[];
  (* -C different second coord *)
  IMATCH_MP_TAC  (REAL_ARITH `x < z /\ &0 <= y  ==> x < y + z`);
  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
  REDUCE_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `&1` EXISTS_TAC;
  CONJ_TAC;
  KILL 0;
  REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
  REWRITE_TAC[REAL_LT_HALF2];
  REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;];
  UND 7 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let v_edge_closed_ball = 
prove_by_refinement(
  `!e m. edge e /\ ~(e INTER closed_ball
       (euclid 2,d_euclid)
       (pointI m + (&1/ &2)*# e2) (&1 / &2) = EMPTY) ==>
       (e = v_edge m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
  (*  - *)
  USE 4 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  USE 1 (MATCH_MP point_onto);
  TYPE_THEN `u` UNABBREV_TAC;
  KILL 5;
  FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;h_edge;point_inj];
  TYPE_THEN `p` UNABBREV_TAC;
  TYPE_THEN `v ` UNABBREV_TAC;
  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
  UND 0 THEN REWRITE_TAC[];
  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
  REWRITE_TAC[sqrt_frac];
  IMATCH_MP_TAC  SQRT_MONO_LT;
  IMATCH_MP_TAC (REAL_ARITH  `(x <= v /\ &0 < u) ==> x < u + v` );
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS];
  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
  ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG];
  TYPE_THEN `--((real_of_int (SND m) + &1 / &2) - real_of_int (SND  m')) = (real_of_int (SND  m' - SND  m)) - &1 / &2 ` SUBAGOAL_TAC;
  REWRITE_TAC[int_sub_th];
  REAL_ARITH_TAC;
  REWRITE_TAC[abs_dest_int_half];
  (* --// *)
  IMATCH_MP_TAC  (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`);
  REWRITE_TAC[];
  USE 1 (MATCH_MP POW_ZERO);
  TYPE_THEN `u' = real_of_int (FST  m)` SUBAGOAL_TAC;
  UND 1 THEN REAL_ARITH_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  FULL_REWRITE_TAC[GSYM int_lt];
  UND 3 THEN UND 5 THEN INT_ARITH_TAC;
  (* - *)
  REWRITE_TAC[cell_clauses];
  TYPE_THEN `e` UNABBREV_TAC;
  FULL_REWRITE_TAC[v_edge];
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  (* - *)
  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
  UND 0 THEN REWRITE_TAC[];
  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
  REWRITE_TAC[sqrt_frac];
  IMATCH_MP_TAC  SQRT_MONO_LT;
  (* - *)
  USE 3 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
  FIRST_ASSUM DISJ_CASES_TAC;
  IMATCH_MP_TAC (REAL_ARITH  `(x < v /\ &0 <= u) ==> x < u + v` );
  (* --B *)
  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
  KILL 0;
  TYPE_THEN `!x y. x < abs  y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `&1 / &2 < (real_of_int (SND  m) + &1 / &2) - v` ASM_CASES_TAC;
  DISJ1_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `&1 / &2` EXISTS_TAC;
  CONJ_TAC ;
  IMATCH_MP_TAC  REAL_LE_DIV;
  REAL_ARITH_TAC;
  UND 9 THEN REAL_ARITH_TAC;
  (* -- *)
  TYPE_THEN `real_of_int (SND  m) + &1 < v` BACK_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_TRANS;
  TYPE_THEN `real_of_int (SND  m) + &1 - v` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_LT_HALF2];
  UND 11 THEN REAL_ARITH_TAC;
  UND 10 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE;
  UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t]));
  UND 10 THEN REAL_ARITH_TAC;
  (* -- *)
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `v <= real_of_int (SND  m) + &1` SUBAGOAL_TAC;
  UND 10 THEN REAL_ARITH_TAC;
  TYPE_THEN `real_of_int (SND  m) <= v` SUBAGOAL_TAC;
  UND 9 THEN REAL_ARITH_TAC;
  TYPE_THEN `~(v = real_of_int (SND  m) + &1)` SUBAGOAL_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;];
  UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC;
  TYPE_THEN `v < real_of_int (SND  m) + &1` SUBAGOAL_TAC;
  UND 13 THEN UND 11 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `floor v = (SND  m')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
  ASM_REWRITE_TAC[floor_range];
  UND 6 THEN REAL_ARITH_TAC;
  USE 15 SYM;
  TYPE_THEN `floor v = SND  m` SUBAGOAL_TAC;
  REWRITE_TAC[floor_range];
  ASM_MESON_TAC[];
  (* -C different second coord *)
  IMATCH_MP_TAC  (REAL_ARITH `x < y /\ &0 <= z  ==> x < y + z`);
  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
  REDUCE_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `&1` EXISTS_TAC;
  CONJ_TAC;
  KILL 0;
  REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
  REWRITE_TAC[REAL_LT_HALF2];
  REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;];
  UND 7 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let connected_in_edge = 
prove_by_refinement(
  `!C. connected top2 C /\ C SUBSET (UNIONS edge) ==>
    (?e. edge e /\ C SUBSET e)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `C = EMPTY` ASM_CASES_TAC ;
  REWRITE_TAC[connected_empty];
  TYPE_THEN `C` UNABBREV_TAC;
  TYPE_THEN `h_edge (&:0,&:0)` EXISTS_TAC;
  REWRITE_TAC[edge_h];
  (* - *)
  TYPE_THEN `?e. edge e /\ ~(C INTER e = EMPTY)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET;UNIONS;EMPTY_EXISTS];
  TSPEC `u` 0;
  REWRITE_TAC[INTER ];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `e` EXISTS_TAC;
  FULL_REWRITE_TAC[connected;edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `A = open_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ;
  TYPE_THEN `B = closed_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ;
  TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
  UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`]));
  CONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  open_ball_open;
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[top2];
  THM_INTRO_TAC[`top2`;`B`] closed_open ;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  closed_ball_closed;
  FULL_REWRITE_TAC[open_DEF;top2_unions;];
  FULL_REWRITE_TAC[top2];
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[EQ_EMPTY;INTER;DIFF];
  UND 1 THEN REWRITE_TAC[];
  ASM_MESON_TAC[open_ball_sub_closed;subset_imp;];
  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
  REWRITE_TAC[SUBSET;UNION];
  TSPEC `x` 0;
  REWRITE_TAC[];
  TYPE_THEN `u = v_edge m` ASM_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  DISJ1_TAC;
  ASM_MESON_TAC[v_edge_ball;subset_imp ];
  DISJ2_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[DIFF];
  CONJ_TAC;
  FULL_REWRITE_TAC[top2_unions];
  ASM_MESON_TAC[subset_imp];
  UND 10 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  v_edge_closed_ball;
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  ASM_MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
  REWRITE_TAC[SUBSET];
  TSPEC `x` 0;
  REWRITE_TAC[];
  TYPE_THEN `u = v_edge m` BACK_TAC ;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  v_edge_closed_ball;
  REWRITE_TAC[INTER;EMPTY_EXISTS ];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_MESON_TAC[open_ball_sub_closed;subset_imp];
  USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  PROOF_BY_CONTR_TAC;
  UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET];
  TSPEC `u` 8;
  UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
  DISJ2_TAC;
  ASM_MESON_TAC[v_edge_ball;subset_imp;open_ball_sub_closed];
  (* -A *)
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `A = open_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ;
  TYPE_THEN `B = closed_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ;
  TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
  UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`]));
  CONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  open_ball_open;
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[top2];
  THM_INTRO_TAC[`top2`;`B`] closed_open ;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  closed_ball_closed;
  FULL_REWRITE_TAC[open_DEF;top2_unions;];
  FULL_REWRITE_TAC[top2];
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[EQ_EMPTY;INTER;DIFF];
  UND 1 THEN REWRITE_TAC[];
  ASM_MESON_TAC[open_ball_sub_closed;subset_imp;];
  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
  REWRITE_TAC[SUBSET;UNION];
  TSPEC `x` 0;
  REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `u = h_edge m` ASM_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  DISJ1_TAC;
  ASM_MESON_TAC[h_edge_ball;subset_imp ];
  DISJ2_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[DIFF];
  CONJ_TAC;
  FULL_REWRITE_TAC[top2_unions];
  ASM_MESON_TAC[subset_imp];
  UND 10 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  h_edge_closed_ball;
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  ASM_MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
  REWRITE_TAC[SUBSET];
  TSPEC `x` 0;
  REWRITE_TAC[];
  TYPE_THEN `u = h_edge m` BACK_TAC ;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  h_edge_closed_ball;
  REWRITE_TAC[INTER;EMPTY_EXISTS ];
  TYPE_THEN `x` EXISTS_TAC;
  ASM_MESON_TAC[open_ball_sub_closed;subset_imp];
  USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  PROOF_BY_CONTR_TAC;
  (* - *)
  UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET];
  TSPEC `u` 8;
  UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
  DISJ2_TAC;
  ASM_MESON_TAC[h_edge_ball;subset_imp;open_ball_sub_closed];
  (* - *)
  (* Mon Dec 20 15:16:18 EST 2004 *)

  ]);;
  (* }}} *)

let int_pow2_gt1 = 
prove_by_refinement(
  `!x. ~(x = &:0) ==> &1 <= (real_of_int x) pow 2`,

  (* {{{ proof *)
  [
  TYPE_THEN  `&1 = &1 pow 2` SUBAGOAL_TAC ;
  REDUCE_TAC;
  UND 1 THEN DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
  REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS;GSYM int_le;GSYM int_abs_th ;GSYM int_of_num_th;];
  UND 0 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let d_euclid_pointI_pos = 
prove_by_refinement(
  `!m n. d_euclid (pointI m) (pointI n) < &1 ==> (m = n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[pointI;d_euclid_point;PAIR_SPLIT];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  USE 0 (MATCH_MP (REAL_ARITH  `x < y ==> ~(y <= x)`));
  UND 0 THEN REWRITE_TAC[];
  TYPE_THEN `&1 = sqrt(&1)` SUBAGOAL_TAC;
  ONCE_REWRITE_TAC [EQ_SYM_EQ];
  IMATCH_MP_TAC  SQRT_POS_UNIQ;
  REDUCE_TAC;
  UND 0 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
  IMATCH_MP_TAC  SQRT_MONO_LE;
  REDUCE_TAC;
  FULL_REWRITE_TAC[GSYM int_sub_th];
  USE 1 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] INT_SUB_0]);
  FIRST_ASSUM DISJ_CASES_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= x + y`);
  IMATCH_MP_TAC  int_pow2_gt1;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= y + x`);
  IMATCH_MP_TAC  int_pow2_gt1;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

extend_simp_rewrites[prove_by_refinement(
  `&0 < &1 / &2`,
  (* {{{ proof *)
  [
  REWRITE_TAC[REAL_LT_HALF1];
  ])];;
  (* }}} *)

extend_simp_rewrites[prove_by_refinement(
  `&2 * &1/ &2 = &1`,
  (* {{{ proof *)
  [
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 0 THEN REAL_ARITH_TAC;
  ])];;
  (* }}} *)

let totally_bounded_pointI = 
prove_by_refinement(
  `?eps. !x m n. (&0 <eps ) /\
       (open_ball(euclid 2,d_euclid) x eps (pointI m) /\
       open_ball(euclid 2,d_euclid) x eps (pointI n) ==>
        (m = n))  `,

  (* {{{ proof *)
  [
  TYPE_THEN `&1/ &2` EXISTS_TAC;
  REWRITE_TAC[];
  IMATCH_MP_TAC  d_euclid_pointI_pos;
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`x`;`&1 / &2`] BALL_DIST;
  TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let simple_arc_finite_pointI = 
prove_by_refinement(
  `! e .
       simple_arc top2 e  ==>
       (?X. FINITE X /\ (!m. e (pointI m) ==> X m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`e`] simple_arc_compact;
  THM_INTRO_TAC[`e`] simple_arc_euclid;
  THM_INTRO_TAC[`e`;`d_euclid`] compact_totally_bounded;
  CONJ_TAC;
  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace;
  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] compact_subset;
  FULL_REWRITE_TAC[top2];
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[totally_bounded];
  THM_INTRO_TAC[] totally_bounded_pointI;
  TSPEC `eps` 3;
  RIGHT 4 "n";
  RIGHT 4 "m";
  RIGHT 4 "x";
  REWRITE_TAC[];
  TYPE_THEN `X = { m | ?b. B b /\ b (pointI m) }` ABBREV_TAC ;
  TYPE_THEN `X` EXISTS_TAC;
  (* - *)
  TYPE_THEN `!m. ?b. (X m) ==> (B b /\ b (pointI m))` SUBAGOAL_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  MESON_TAC[];
  LEFT 9 "b";
  CONJ_TAC;
  THM_INTRO_TAC[`X`;`B`;`b`] FINITE_INJ;
  REWRITE_TAC[INJ];
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  COPY 9;
  TSPEC `x` 13;
  TSPEC `y` 9;
  COPY 6;
  TSPEC `b x` 16;
  TSPEC `b y` 6;
  TYPE_THEN `x'` EXISTS_TAC;
  (* // *)
  TYPE_THEN `b y` UNABBREV_TAC;
  TYPE_THEN `b x` UNABBREV_TAC;
  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace;
  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`;`x'`;`eps`] open_ball_subspace;
  CONJ_TAC THEN ASM_MESON_TAC[subset_imp];
  (* - *)
  TYPE_THEN `X` UNABBREV_TAC;
  FULL_REWRITE_TAC[UNIONS];
  ASM_MESON_TAC[];
  (* Mon Dec 20 18:39:42 EST 2004 *)


  ]);;
  (* }}} *)

let simple_arc_finite_lemma1 = 
prove_by_refinement(
  `!e v v'. simple_arc_end  e v v' ==>
    (?X f. (X SUBSET {x | &0 <= x /\ x <= &1}) /\ FINITE X /\
      (f (&0) = v) /\ (f (&1) = v') /\
      (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
              continuous f (top_of_metric (UNIV,d_real)) top2 /\
              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
        (!x.   &0 <= x /\ x <= &1 ==> ( (?m. f x = pointI m) <=> (X x))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_simple;
  THM_INTRO_TAC[`e`] simple_arc_finite_pointI;
  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end;
  REWR 4;
  TYPE_THEN `Y = {x | &0 <= x /\ x <= &1 /\ (?m. (f x = pointI m))}` ABBREV_TAC ;
  TYPE_THEN `Y` EXISTS_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN`Y` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  (* - *)
  FULL_REWRITE_TAC[top2_unions];
  CONJ_TAC;
  THM_INTRO_TAC[`Y`;`IMAGE (pointI) X`;`f`] FINITE_INJ;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  FULL_REWRITE_TAC[INJ];
  CONJ_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `Y` UNABBREV_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 9 SYM;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `Y` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `Y` UNABBREV_TAC;
  ]);;
  (* }}} *)

let simple_arc_finite_lemma2 = 
prove_by_refinement(
  `!e v v'. simple_arc_end e v v'==>
    (?(N:num) t f.
      (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\
      (f (&0) = v) /\ (f (&1) = v') /\
      (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
      (!i j. (i < j) /\  (i < N) /\  (j < N) ==> (t i < t j)) /\
              continuous f (top_of_metric (UNIV,d_real)) top2 /\
              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
        (!x.   &0 <= x /\ x <= &1 ==>
        ( (?m. f x = pointI m) <=> (?k.  (k < N) /\ (x = t k)))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma1;
  THM_INTRO_TAC[`X`] real_finite_increase;
  TYPE_THEN `CARD X` EXISTS_TAC;
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  (* - *)
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[BIJ;IMAGE;SURJ];
  FULL_REWRITE_TAC[SUBSET];
  TSPEC `x'` 11;
  (* - *)
  SUBCONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  TSPEC `x` 1;
  REWR 1;
  FULL_REWRITE_TAC[BIJ;SURJ];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)

let connected_unions_common = 
prove_by_refinement(
  `!U (ZZ:(A->bool)->bool). (!Z. ZZ Z ==> connected U Z) /\
     (!Z Z'. ZZ Z /\ ZZ Z' ==> ~(Z INTER Z' = EMPTY)) ==>
     (connected U (UNIONS ZZ))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[connected];
  SUBCONJ_TAC;
  TYPE_THEN `UU = UNIONS U` ABBREV_TAC ;
  REWRITE_TAC[UNIONS;SUBSET];
  TSPEC `u` 1;
  REWRITE_TAC[];
  ASM_MESON_TAC[subset_imp];
  (* - *)
  TYPE_THEN `!Z. ZZ Z ==> Z SUBSET A \/ Z SUBSET B` SUBAGOAL_TAC;
  TSPEC `Z` 1;
  REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 2 (REWRITE_RULE[UNIONS;SUBSET]);
  REWRITE_TAC[SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `AA = {Z | ZZ Z /\ Z SUBSET A}` ABBREV_TAC ;
  TYPE_THEN `BB = {Z | ZZ Z /\ Z SUBSET B}` ABBREV_TAC ;
  TYPE_THEN `ZZ = AA UNION BB` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  TYPE_THEN `AA` UNABBREV_TAC;
  TYPE_THEN `BB` UNABBREV_TAC;
  ASM_MESON_TAC[];
  PROOF_BY_CONTR_TAC;
  USE 11 (REWRITE_RULE[DE_MORGAN_THM;UNIONS;SUBSET;UNION]);
  LEFT 11 "x";
  LEFT 12 "x";
  TYPE_THEN `AA` UNABBREV_TAC;
  TYPE_THEN `BB` UNABBREV_TAC;
  LEFT 11 "u";
  LEFT 8 "u";
  LEFT 12 "u";
  LEFT 9 "u";
  (* - *)
  TYPE_THEN `ZZ u` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `ZZ u'` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `u SUBSET A` SUBAGOAL_TAC;
  TSPEC `u` 7;
  FIRST_ASSUM DISJ_CASES_TAC ;
  USE 13(REWRITE_RULE[SUBSET]);
  TSPEC `x` 13;
  ASM_MESON_TAC[];
  TYPE_THEN `u' SUBSET B` SUBAGOAL_TAC;
  TSPEC `u'` 7;
  FIRST_ASSUM DISJ_CASES_TAC ;
  USE 14(REWRITE_RULE[SUBSET]);
  TSPEC `x'` 14;
  ASM_MESON_TAC[];
  (* - *)
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`u`;`u'`]);
  USE 0 (REWRITE_RULE[EMPTY_EXISTS;INTER ]);
  USE 3(REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `u''` 3;
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let connect_real_open = 
prove_by_refinement(
  `!a b. connected
       (top_of_metric (UNIV,d_real)) {x | a < x /\ x < b}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `{x | a < x /\ x < b} = EMPTY` ASM_CASES_TAC;
  REWRITE_TAC[connected_empty];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `ZZ = {Z | ?a' b'. a < a' /\ a' < u /\ u < b' /\ b' < b /\ (Z = {x | a' <= x /\ x <= b'})}` ABBREV_TAC ;
  TYPE_THEN `{x | a < x /\ x < b} = UNIONS ZZ` SUBAGOAL_TAC;
  TYPE_THEN `ZZ` UNABBREV_TAC;
  REWRITE_TAC[UNIONS];
  IMATCH_MP_TAC  EQ_EXT;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  CONV_TAC (dropq_conv "u");
  CONV_TAC (dropq_conv "x'");
  TYPE_THEN `u < x` ASM_CASES_TAC;
  TYPE_THEN `(a + u)/ &2` EXISTS_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  real_middle1_lt;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  real_middle2_lt;
  UND 6 THEN UND 4 THEN REAL_ARITH_TAC;
  TYPE_THEN `(a + x)/ &2` EXISTS_TAC;
  TYPE_THEN `(u + b)/ &2` EXISTS_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  real_middle1_lt;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `x` EXISTS_TAC;
  USE 4 (MATCH_MP (REAL_ARITH `~(u < x) ==> (x <= u)`));
  IMATCH_MP_TAC  real_middle2_lt;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  real_middle1_lt;
  CONJ_TAC;
  IMATCH_MP_TAC  real_middle2_lt;
  CONJ_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
  IMATCH_MP_TAC  real_middle2_lt;
  UND 4 THEN UND 7 THEN REAL_ARITH_TAC;
  (* -- *)
  TYPE_THEN `u'` UNABBREV_TAC;
  UND 7 THEN UND 3 THEN UND 2 THEN UND 4 THEN REAL_ARITH_TAC;
  (* - *)
  IMATCH_MP_TAC  connected_unions_common;
  CONJ_TAC;
  TYPE_THEN `ZZ` UNABBREV_TAC;
  REWRITE_TAC[connect_real];
  TYPE_THEN `ZZ` UNABBREV_TAC;
  TYPE_THEN `Z` UNABBREV_TAC;
  TYPE_THEN `Z'` UNABBREV_TAC;
  USE 4(REWRITE_RULE[EQ_EMPTY;INTER]);
  TSPEC `u` 2;
  KILL 3;
  REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let int_neg_num_th = 
prove_by_refinement(
  `!j. real_of_int (--: (&: j)) = -- (&j)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[int_neg_th;int_of_num_th;];
  ]);;
  (* }}} *)

let closed_ball_subset_larger_open = 
prove_by_refinement(
  `!n a r r'.
     (r < r') ==> closed_ball (euclid n,d_euclid) a r SUBSET
          open_ball (euclid n,d_euclid) a r'`,

  (* {{{ proof *)
  [
  REWRITE_TAC[closed_ball;open_ball;SUBSET];
  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let simple_arc_end_edge_closure = 
prove_by_refinement(
  `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\
     (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==>
     (closure top2 e (pointI m))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`e`] edge_euclid2;
  FULL_REWRITE_TAC[edge];
  TYPE_THEN `connected top2 C` SUBAGOAL_TAC;
  USE 1 (MATCH_MP simple_arc_end_simple);
  USE 1(MATCH_MP simple_arc_connected);
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`e`] closure_open_ball;
  USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC  `(pointI m)` 6;
  USE 5 (REWRITE_RULE[top2]);
  UND 6 THEN ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  (* - *)
  TYPE_THEN `?r. &0 < r /\ (r < &1/ &2) /\ (e INTER closed_ball (euclid 2, d_euclid) (pointI m) r = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `?s. &0 < s /\ s <= r /\ s <= &1/ &2` SUBAGOAL_TAC;
  TYPE_THEN `min_real r (&1 / &2)` EXISTS_TAC;
  REWRITE_TAC[min_real_le];
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  TYPE_THEN `s/ &2` EXISTS_TAC;
  ASM_REWRITE_TAC[REAL_LT_HALF1];
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `s` EXISTS_TAC;
  REWRITE_TAC[REAL_LT_HALF2];
  REWRITE_TAC[EQ_EMPTY;INTER];
  LEFT 7 "z";
  TSPEC `x` 7;
  UND 7 THEN ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `s/ &2 < r` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN  `s` EXISTS_TAC;
  REWRITE_TAC[REAL_LT_HALF2];
  THM_INTRO_TAC[`2`;`pointI m`;`s / &2`;`r`] closed_ball_subset_larger_open;
  ASM_MESON_TAC[subset_imp];
  (*  - *)
  THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct;
  FULL_REWRITE_TAC[connected];
  TYPE_THEN `A = open_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ;
  TYPE_THEN `B = closed_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ;
  TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
  (* -A *)
  TYPE_THEN `top2 A /\ top2 E /\ (A INTER E = {}) /\ C SUBSET A UNION E /\ A (pointI m) /\ E (pointI n)` SUBAGOAL_TAC;
  CONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  open_ball_open;
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[top2];
  THM_INTRO_TAC[`top2`;`B`] closed_open;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  closed_ball_closed;
  FULL_REWRITE_TAC[open_DEF;top2_unions ];
  FULL_REWRITE_TAC[top2];
  (* --// *)
  CONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[INTER;EQ_EMPTY;DIFF];
  ASM_MESON_TAC[subset_imp;open_ball_sub_closed];
  (* -- *)
  TYPE_THEN `A (pointI m)` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  (INR open_ball_nonempty);
  REWRITE_TAC[pointI];
  (* -- *)
  TYPE_THEN `E (pointI n)` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[DIFF];
  TYPE_THEN `B` UNABBREV_TAC;
  CONJ_TAC;
  REWRITE_TAC[pointI];
  FULL_REWRITE_TAC[pointI_inj];
  TYPE_THEN `open_ball (euclid 2,d_euclid) (pointI m) (&1 / &2) (pointI n)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`2`;`pointI m`;`r'`;`&1 / &2`] closed_ball_subset_larger_open;
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`pointI m`;`&1 / &2`] BALL_DIST;
  IMATCH_MP_TAC  (INR open_ball_nonempty);
  REWRITE_TAC[pointI];
  TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC;
  REWR 17;
  USE 17 (MATCH_MP d_euclid_pointI_pos);
  TYPE_THEN `m` UNABBREV_TAC;
  (* --// *)
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC;
  TSPEC `x` 0;
  ASM_MESON_TAC[];
  UND 19 THEN REP_CASES_TAC;
  DISJ2_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[DIFF];
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  ASM_MESON_TAC[subset_imp];
  DISJ1_TAC;
  DISJ2_TAC;
  (* - *)
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`E`]);
  (* -B *)
  TYPE_THEN `C (pointI m)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `C (pointI n)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_end2;
  UNIFY_EXISTS_TAC;
  USE 19 (REWRITE_RULE[INTER;EQ_EMPTY ]);
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 24 (REWRITE_RULE[SUBSET]); (* -- *)
  ASM_MESON_TAC[];
  USE 24 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let vc_edge_pointI = 
prove_by_refinement(
  `!m n. vc_edge m (pointI n) <=> (n = m) \/ (n = up m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[vc_edge;cell_clauses;INR IN_SING;UNION];
  TYPE_THEN `pointI m + e2 = pointI (up m)` SUBAGOAL_TAC;
  REWRITE_TAC[up;e2;point_add ;pointI];
  REDUCE_TAC;
  REWRITE_TAC[int_of_num_th;int_add_th];
  REWRITE_TAC[pointI_inj];
  ]);;
  (* }}} *)

let hc_edge_pointI = 
prove_by_refinement(
  `!m n. hc_edge m (pointI n) <=> (n = m) \/ (n = right m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[hc_edge;cell_clauses;INR IN_SING;UNION];
  TYPE_THEN `pointI m + e1 = pointI (right m)` SUBAGOAL_TAC;
  REWRITE_TAC[right;e1;point_add ;pointI];
  REDUCE_TAC;
  REWRITE_TAC[int_of_num_th;int_add_th];
  REWRITE_TAC[pointI_inj];
  ]);;
  (* }}} *)

let mk_segment_v = 
prove_by_refinement(
  `!r s b x. (r <= s) ==> (mk_segment (point(b,r)) (point(b,s)) x <=>
      (?t. (r <= t /\ t <= s /\ (x = point(b,t)))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[mk_segment];
  REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC;
  CONJ_TAC;
  ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`;
  ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`;
  TYPE_THEN `s = r` ASM_CASES_TAC;
  REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`];
  TYPE_THEN `&0` EXISTS_TAC;
  UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC;
  (* - *)
  REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ;
  TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  REWRITE_TAC[GSYM real_div_assoc];
  REDUCE_TAC;
  IMATCH_MP_TAC  REAL_DIV_REFL;
  UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
  TYPE_THEN `v*(s - t)` EXISTS_TAC;
  TYPE_THEN `&0 < v` SUBAGOAL_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_MUL;
  UND 7 THEN UND 2 THEN REAL_ARITH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
  TYPE_THEN `(s - r)` EXISTS_TAC;
  CONJ_TAC;
  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
  REWRITE_TAC[REAL_MUL_ASSOC];
  REDUCE_TAC;
  UND 3 THEN REAL_ARITH_TAC;
  TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC];
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;

  ]);;
  (* }}} *)

let mk_segment_vc = 
prove_by_refinement(
  `!m. mk_segment (pointI m) (pointI (up m)) = vc_edge m`,

  (* {{{ proof *)
  [
  REWRITE_TAC[up;vc_edge;v_edge;pointI;UNION ;e2;];
  IMATCH_MP_TAC  EQ_EXT;
  THM_INTRO_TAC[`real_of_int (SND m)`;`real_of_int(SND m + &:1)`;`real_of_int (FST m)`;`x`] mk_segment_v;
  REWRITE_TAC[GSYM int_le];
  INT_ARITH_TAC;
  REWRITE_TAC[point_add;];
  REDUCE_TAC;
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  TYPE_THEN `t = real_of_int (SND m)` ASM_CASES_TAC;
 REWRITE_TAC[INR IN_SING];
  TYPE_THEN `t = real_of_int (SND m) + &1` ASM_CASES_TAC;
  REWRITE_TAC[INR IN_SING];
  DISJ1_TAC;
  CONV_TAC (dropq_conv "u");
CONV_TAC (dropq_conv "v");
  FULL_REWRITE_TAC[int_add_th;int_of_num_th;];
  UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
  (* - *)
  UND 1 THEN REP_CASES_TAC ;
  TYPE_THEN `v` EXISTS_TAC;
  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
  FULL_REWRITE_TAC [INR IN_SING];
  TYPE_THEN `real_of_int (SND m)` EXISTS_TAC;
  REWRITE_TAC[int_add_th;int_of_num_th];
  REAL_ARITH_TAC;
  FULL_REWRITE_TAC [INR IN_SING];
  TYPE_THEN `real_of_int (SND m) + &1` EXISTS_TAC;
  REWRITE_TAC[int_add_th;int_of_num_th];
  REAL_ARITH_TAC;
  (* Tue Dec 21 18:22:18 EST 2004 *)

  ]);;
  (* }}} *)

let mk_segment_hc = 
prove_by_refinement(
  `!m. mk_segment (pointI m) (pointI (right m)) = hc_edge m`,

  (* {{{ proof *)
  [
  REWRITE_TAC[right;hc_edge;h_edge;pointI;UNION ;e1;];
  IMATCH_MP_TAC  EQ_EXT;
  THM_INTRO_TAC[`real_of_int (FST m)`;`real_of_int(FST m + &:1)`;`real_of_int (SND  m)`;`x`] mk_segment_h;
  REWRITE_TAC[int_add_th;int_of_num_th;];
  REAL_ARITH_TAC;
  REWRITE_TAC[point_add;];
  REDUCE_TAC;
  FULL_REWRITE_TAC[int_add_th;int_of_num_th;];
  (* - *)
  REWRITE_TAC[INR IN_SING];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[point_inj;PAIR_SPLIT ];
  TYPE_THEN `t = real_of_int (FST  m)` ASM_CASES_TAC;
  TYPE_THEN `t = real_of_int (FST  m) + &1` ASM_CASES_TAC;
  CONV_TAC (dropq_conv "u");
CONV_TAC (dropq_conv "v");
  UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
  (* - *)
  UND 1 THEN REP_CASES_TAC ;
  TYPE_THEN `u` EXISTS_TAC;
  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
  TYPE_THEN `real_of_int (FST  m)` EXISTS_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `real_of_int (FST  m) + &1` EXISTS_TAC;
  REAL_ARITH_TAC;

  ]);;
  (* }}} *)

let simple_arc_end_edge_full_closure = 
prove_by_refinement(
  `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\
    (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==>
    (C = closure top2 e ) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`;`e`;`m`;`n`] simple_arc_end_edge_closure;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`e`;`n`;`m`] simple_arc_end_edge_closure;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  TYPE_THEN `C SUBSET closure top2 e` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET];
  TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  UND 6 THEN REP_CASES_TAC;
  THM_INTRO_TAC[`top2`;`e`] subset_closure;
  REWRITE_TAC[top2_top];
  ASM_MESON_TAC[subset_imp];
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `B = closure top2 e` ABBREV_TAC ;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `pointI m` EXISTS_TAC;
  TYPE_THEN `pointI n` EXISTS_TAC;
  REWRITE_TAC[SUBSET_REFL];
  TYPE_THEN `simple_arc_end B (pointI m) (pointI n)` BACK_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  (* -A *)
  THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct;
  FULL_REWRITE_TAC[pointI_inj];
  (* - *)
  TYPE_THEN `mk_segment (pointI m) (pointI n) = B` SUBAGOAL_TAC ;
  FULL_REWRITE_TAC[edge];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;];
  TYPE_THEN `B` UNABBREV_TAC;
  TYPE_THEN `(m = m') /\ (n = up m') \/ (m = up m') /\ (n = m')` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[vc_edge_pointI;]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `n` UNABBREV_TAC;
  REWR 3;
  TYPE_THEN `n` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* --- *)
  REWRITE_TAC[GSYM mk_segment_vc];
  FIRST_ASSUM DISJ_CASES_TAC;
  MESON_TAC[mk_segment_sym];
  (* -- *)
  TYPE_THEN `e` UNABBREV_TAC;
  FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;];
  TYPE_THEN `B` UNABBREV_TAC;
  TYPE_THEN `(m = m') /\ (n = right m') \/ (m = right m') /\ (n = m')` SUBAGOAL_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[hc_edge_pointI;]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `n` UNABBREV_TAC;
  REWR 3;
  TYPE_THEN `n` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  REWRITE_TAC[GSYM mk_segment_hc];
  FIRST_ASSUM DISJ_CASES_TAC;
  MESON_TAC[mk_segment_sym];
  KILL 6;
  TYPE_THEN `B` UNABBREV_TAC;
  IMATCH_MP_TAC  mk_segment_simple_arc_end;
  REWRITE_TAC[pointI_inj];
  REWRITE_TAC[pointI];
  ]);;
  (* }}} *)

let simple_arc_finite_lemma3 = 
prove_by_refinement(
  `!E e v v'. simple_arc_end e v v' /\
      FINITE E /\
      e SUBSET UNIONS E /\
      E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\
      E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\
      (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
      (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==>
      (?(N:num) t f.
      (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\
      (f (&0) = v) /\ (f (&1) = v') /\
      (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
      (!i j. (i < j) /\  (i < N) /\  (j < N) ==> (t i < t j)) /\
              continuous f (top_of_metric (UNIV,d_real)) top2 /\
              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
        (!x.   &0 <= x /\ x <= &1 ==>
        ( (?m. f x = pointI m) = (?k.  (k < N) /\ (x = t k)))) /\
       (&0 = t 0) /\ (&1 = t (N - 1)) /\
      (!i. (SUC i < N) ==> (?ed. (edge ed) /\
           (IMAGE f { x | t i <= x /\ x <= t (SUC i) } =
             closure top2 ed))))
   `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma2;
  TYPE_THEN `N` EXISTS_TAC;
  TYPE_THEN `t` EXISTS_TAC;
  TYPE_THEN `f` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC;
  COPY 0;
  COPY 1;
  TSPEC `eps_hyper F (w 1)` 21;
  TSPEC `eps_hyper T (w 0)` 1;
  TSPEC `z` 20;
  TSPEC `eps` 20;
  TSPEC `z'` 0;
  TSPEC `eps'` 0;
  FULL_REWRITE_TAC[eps_hyper_inj];
  TYPE_THEN `z` UNABBREV_TAC;
  TYPE_THEN `z'` UNABBREV_TAC;
  TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  REWRITE_TAC[pointI];
  TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC;
  REWRITE_TAC[int_neg;int_abstr;int_of_num_th;];
  TYPE_THEN `!j. (integer (-- &j))` SUBAGOAL_TAC;
  REWRITE_TAC[is_int];
  MESON_TAC[];
  USE 24 (REWRITE_RULE[int_rep]);
  USE 19 (MATCH_MP point_onto);
  REWRITE_TAC[point_inj];
  TYPE_THEN `w` UNABBREV_TAC;
  FULL_REWRITE_TAC[coord01;PAIR_SPLIT];
  (* -A *)
  SUBCONJ_TAC;
  TYPE_THEN `?m. v = pointI m` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end;
  USE 8 (MATCH_MP simple_arc_end_simple);
  USE 8 (MATCH_MP simple_arc_euclid);
  ASM_MESON_TAC[subset_imp];
  UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&0`]));
  REDUCE_TAC;
  TYPE_THEN `(?k. k <| N /\ (&0 = t k))` SUBAGOAL_TAC;
  USE 9 SYM;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  AP_TERM_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `~(0 < k) ==> (k = 0)`);
  USE 16 (REWRITE_RULE[IMAGE;SUBSET ]);
  USE 16 (CONV_RULE NAME_CONFLICT_CONV);
  TSPEC `t 0` 16;
  LEFT 16 "x'" ;
  TSPEC `0` 16;
  TYPE_THEN `0 < N` SUBAGOAL_TAC;
  UND 21 THEN UND 20 THEN ARITH_TAC;
  REWR 16;
  USE 23 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`));
  UND 23 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* -B *)
  SUBCONJ_TAC;
  TYPE_THEN `?m. v' = pointI m` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end2;
  USE 8 (MATCH_MP simple_arc_end_simple);
  USE 8 (MATCH_MP simple_arc_euclid);
  ASM_MESON_TAC[subset_imp];
  UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&1`]));
  REDUCE_TAC;
  REWRITE_TAC[ARITH_RULE `1 <= 1`];
  USE 18 SYM;
  REDUCE_TAC;
  (* -- *)
  TYPE_THEN `(?k. k <| N /\ (&1 = t k))` SUBAGOAL_TAC;
  USE 9 SYM;
  TYPE_THEN `m` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  AP_TERM_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `(k < N) /\ ~(k < N - 1) ==> (k = N - 1)`);
  USE 16 (REWRITE_RULE[IMAGE;SUBSET ]);
  USE 22 (CONV_RULE NAME_CONFLICT_CONV);
  TSPEC `t (N-1)` 22;
  LEFT 22 "x'" ;
  TSPEC `N-1` 22;
  UND 22 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UND 21 THEN ARITH_TAC;
  REWR 22;
  USE 22 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`));
  UND 22 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 16 THEN ARITH_TAC;
  (* -C *)
  USE 20 SYM;
  USE 18 SYM;
  TYPE_THEN `&0 <= t i /\ t i <= &1` SUBAGOAL_TAC;
  USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  UND 19 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `&0 <= t (SUC i) /\ t (SUC i) <= &1` SUBAGOAL_TAC;
  USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `SUC i` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `connected top2 (IMAGE f {x | t i < x /\ x < t (SUC i)})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  connect_image;
  TYPE_THEN `top_of_metric (UNIV,d_real)` EXISTS_TAC;
  REWRITE_TAC[top2_unions];
  CONJ_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  USE 10 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 26 THEN UND 27 THEN UND 23 THEN UND 22 THEN REAL_ARITH_TAC;
  (* --D *)
  REWRITE_TAC[connect_real_open];
  (* - *)
  TYPE_THEN `!x. &0 <= x /\ x <= &1 /\ ~(IMAGE t {j | j<| N} x) ==> (?e. edge e /\ (e (f x)))` SUBAGOAL_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  USE 6 (REWRITE_RULE[SUBSET;UNIONS;IMAGE  ]);
  USE 6 (CONV_RULE NAME_CONFLICT_CONV);
  TSPEC `f x` 6;
  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TSPEC `u'` 1;
  REWRITE_TAC[];
  TYPE_THEN `u'` UNABBREV_TAC;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`z`;`eps`]);
  TYPE_THEN `z` UNABBREV_TAC;
  (* --E *)
  TYPE_THEN `euclid 2 (f x)` SUBAGOAL_TAC;
  USE 8 (MATCH_MP simple_arc_end_simple);
  USE 0 (MATCH_MP simple_arc_euclid);
  USE 0 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  TYPE_THEN `?C. cell C /\ C (f x)` SUBAGOAL_TAC;
  USE 0 (MATCH_MP point_onto);
  THM_INTRO_TAC[`p`] cell_unions;
  USE 1 (REWRITE_RULE[UNIONS]);
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  FULL_REWRITE_TAC[cell];
  UND 29 THEN REP_CASES_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR IN_SING];
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  TYPE_THEN `(?k. k <| N /\ (x = t k))` SUBAGOAL_TAC;
  USE 9 SYM;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 26 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[edge_h];
  REWRITE_TAC[edge_v];
  TYPE_THEN `C` UNABBREV_TAC;
  USE 1 (REWRITE_RULE[squ]);
  TYPE_THEN `f x` UNABBREV_TAC;
  USE 6 (REWRITE_RULE[eps_hyper]);
  UND 6 THEN COND_CASES_TAC;
   FULL_REWRITE_TAC[e1];
  FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_F];
  FULL_REWRITE_TAC[point_inj];
  TYPE_THEN `p'` UNABBREV_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  (* ---F *)
  FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;];
  UND 30 THEN UND 31 THEN INT_ARITH_TAC;
  (* -- *)
   FULL_REWRITE_TAC[e2];
  FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_S];
  FULL_REWRITE_TAC[point_inj];
  TYPE_THEN `p'` UNABBREV_TAC;
  TYPE_THEN `v''` UNABBREV_TAC;
  FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;];
  UND 1 THEN UND 29 THEN INT_ARITH_TAC;
  (* -G *)
  THM_INTRO_TAC[`(IMAGE f {x | t i < x /\ x < t (SUC i)})`] connected_in_edge;
  REWRITE_TAC[IMAGE;SUBSET;UNIONS];
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  UND 29 THEN UND 22 THEN REAL_ARITH_TAC;
  CONJ_TAC;
  UND 23 THEN UND 28 THEN REAL_ARITH_TAC;
  USE 30 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x'` UNABBREV_TAC;
  USE 28 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`));
  UND 30 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC   (ARITH_RULE  `~(x = y) /\ ~(x <| y) ==> (y < x)`);
  CONJ_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  USE 29 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`));
  UND 32 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i <| N` SUBAGOAL_TAC;
  UND 19 THEN ARITH_TAC;
  IMATCH_MP_TAC   (ARITH_RULE  `~(x = y) /\ ~(x <| y) ==> (y < x)`);
  CONJ_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  UND 33 THEN UND 30 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `e'` EXISTS_TAC;
  (* -H *)
  TYPE_THEN `C = IMAGE f {x | t i <= x /\ x <= t (SUC i)}` ABBREV_TAC ;
  IMATCH_MP_TAC  simple_arc_end_edge_full_closure;
  KILL 5;
  KILL 4;
  KILL 2;
  KILL 3;
  KILL 0;
  KILL 17;
  TYPE_THEN `v` UNABBREV_TAC;
  TYPE_THEN `v'` UNABBREV_TAC;
  TYPE_THEN `!k. k <| N ==> (?m. f (t k) = pointI m)` SUBAGOAL_TAC;
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`t k`]);
  USE 16 (REWRITE_RULE[IMAGE;SUBSET]);
  ASM_MESON_TAC[];
  TYPE_THEN `k` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  COPY 0;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  UND 19 THEN ARITH_TAC;
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
  TYPE_THEN `m` EXISTS_TAC;
  TYPE_THEN `m'` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
  CONJ_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  USE 5 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `pointI m` UNABBREV_TAC;
  TYPE_THEN `pointI m'` UNABBREV_TAC;
  USE 27 (REWRITE_RULE[IMAGE;SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x'` EXISTS_TAC;
  TYPE_THEN `~(x' = t i)` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `~(x' = t (SUC i))` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  UND 5 THEN UND 2 THEN UND 15 THEN UND 14 THEN REAL_ARITH_TAC;
  (* - *)
  REWRITE_TAC[simple_arc_end];
  THM_INTRO_TAC[`&0`;`&1`;`t i`;`t (SUC i)`;`C`;`f`;`t i`;`t (SUC i)`] arc_restrict;
  REWRITE_TAC[REAL_ARITH `x <= x`];
  USE 11 (REWRITE_RULE[top2]);
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 19 THEN ARITH_TAC;
  IMATCH_MP_TAC  inj_subset_domain;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET];
  UND 4 THEN UND 5 THEN UND 22 THEN UND 23 THEN REAL_ARITH_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[top2];
  (* Tue Dec 21 19:05:25 EST 2004 *)

  ]);;
  (* }}} *)

let order_lt_imp_psegment = 
prove_by_refinement(
  `!f n.
     INJ f {p | p <| n} edge /\
          0 <| n /\
          (!i j.
               i <| n /\ j <| n /\ (i < j)
               ==> (adj (f i) (f j) = (SUC i = j) ))
          ==> psegment (IMAGE f {p | p <| n})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  order_imp_psegment;
  REP_BASIC_TAC;
  TYPE_THEN `i <| j` ASM_CASES_TAC;
  TYPE_THEN `~(SUC j = i)` SUBAGOAL_TAC;
  UND 6 THEN UND 5 THEN ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i = j` ASM_CASES_TAC;
  REWRITE_TAC[adj];
  UND 7 THEN ARITH_TAC;
  TYPE_THEN `j <| i` SUBAGOAL_TAC;
  UND 6 THEN UND 5 THEN ARITH_TAC;
  TYPE_THEN `~(SUC i = j)` SUBAGOAL_TAC;
  UND 8 THEN UND 7 THEN ARITH_TAC;
  ONCE_REWRITE_TAC[adj_symm];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)


let simple_arc_finite_lemma4 = 
prove_by_refinement(
  `!E e v v'. simple_arc_end e v v' /\
      FINITE E /\
      e SUBSET UNIONS E /\
      E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\
      E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\
      (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
      (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==>
   (?S a b. segment_end S a b /\ (v = pointI a) /\ (v' = pointI b) /\
      (e = closure top2 (UNIONS S)))
   `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`;`e`;`v`;`v'`]simple_arc_finite_lemma3;
  ASM_REWRITE_TAC[];
  (* - *)
  REWRITE_TAC[segment_end];
  LEFT 9 "ed";
  LEFT 9 "ed";
  TYPE_THEN `S = IMAGE ed {p | p <| N - 1}` ABBREV_TAC ;
  TYPE_THEN `S` EXISTS_TAC;
  TYPE_THEN `!i. i <| N ==> (?m. f (t i) = pointI m)` SUBAGOAL_TAC;
  USE 10 SYM;
  USE 11 SYM;
  UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`t i`]);
  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `0 <| N` SUBAGOAL_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `~(N = 0) ==> (0 <| N)`);
  TYPE_THEN `N` UNABBREV_TAC;
  FULL_REWRITE_TAC[ARITH_RULE `0 -| 1 = 0`];
  UND 10 THEN UND 11 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `?a. f (t 0) = pointI a` SUBAGOAL_TAC;
  TYPE_THEN `?b. f (t (N - 1)) = pointI b` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 22 THEN ARITH_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  (* - *)
  TYPE_THEN `v = pointI a` SUBAGOAL_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `v' = pointI b` SUBAGOAL_TAC;
  TYPE_THEN `v'` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* -A *)
  TYPE_THEN `(INJ ed {p | p <| N-1 } edge) /\ ( 0 <| N-1) /\ (!i j. i <| N-1 /\ j <| N-1 /\ i <| j ==> (adj (ed i) (ed j) <=> (SUC i = j)))` SUBAGOAL_TAC;
  TYPE_THEN `S` UNABBREV_TAC;
  SUBCONJ_TAC; (* // *)
  REWRITE_TAC[INJ];
  CONJ_TAC;
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  UND 20 THEN ARITH_TAC;
  TYPE_THEN `!x y. x < y /\ y <| N - 1 ==> ~(ed x = ed y)` SUBAGOAL_TAC;
  TYPE_THEN `t x' < t y'` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 31 THEN UND 30 THEN ARITH_TAC;
  COPY 9;
  UND 33 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  UND 31 THEN UND 30 THEN ARITH_TAC;
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`y'`]);
  UND 30 THEN ARITH_TAC;
  TYPE_THEN `ed x'` UNABBREV_TAC;
  TYPE_THEN `IMAGE f {x | t x' <= x /\ x <= t (SUC x')} (f (t x'))` SUBAGOAL_TAC;
  USE 33 SYM;
  IMATCH_MP_TAC  image_imp;
  CONJ_TAC;
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 31 THEN UND 30 THEN ARITH_TAC;
  TYPE_THEN `IMAGE f {x | t y' <= x /\ x <= t (SUC y')} (f (t x'))` SUBAGOAL_TAC;
  USE 33 SYM;
  ASM_REWRITE_TAC[];
  USE 36 (REWRITE_RULE[IMAGE]);
  USE 13 (REWRITE_RULE[INJ]);
  TYPE_THEN `t x' = x''` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 11 SYM;
  USE 10 SYM;
  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x'` EXISTS_TAC;
  UND 31 THEN UND 30 THEN ARITH_TAC;
  TYPE_THEN `&0 <= t y' /\ t y' <= &1` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `y'` EXISTS_TAC;
  UND 30 THEN ARITH_TAC;
  CONJ_TAC;
  UND 41 THEN UND 38 THEN ARITH_TAC;
  TYPE_THEN `&0 <= t (SUC y') /\ t (SUC y') <= &1` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `SUC y'` EXISTS_TAC;
  UND 30 THEN ARITH_TAC;
  UND 42 THEN UND 37 THEN ARITH_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  UND 38 THEN UND 32 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  (ARITH_RULE  `(~(x <| y) /\ ~(y < x)) ==> (x = y)`);
  CONJ_TAC;
  UND 30 THEN UND 29 THEN UND 27 THEN UND 20 THEN MESON_TAC[];
  UND 30 THEN UND 29 THEN UND 28 THEN UND 20 THEN MESON_TAC[];
  (* -- *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `~(0 = N-1) ==> (0 <| N- 1)`);
  TYPE_THEN `N -| 1` UNABBREV_TAC;
  UND 10 THEN UND 11 THEN REAL_ARITH_TAC;
  (* --B *)
  TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC;
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
  UND 31 THEN ARITH_TAC;
  USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `u` 9;
  USE 9 SYM;
  REWRITE_TAC[IMAGE];
  REWRITE_TAC[CONJ_ACI];
  (* -- *)
  REWRITE_TAC[adj;EMPTY_EXISTS;INTER ];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `x = x'` SUBAGOAL_TAC;
  USE 13 (REWRITE_RULE[INJ]);
  USE 10 SYM;
  USE 11 SYM;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
  TYPE_THEN `&0 <= t j' /\ t j' <= &1` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j'` EXISTS_TAC;
  UND 41 THEN ARITH_TAC;
  TYPE_THEN `&0 <= t (SUC j') /\ t (SUC j') <= &1` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `SUC j'` EXISTS_TAC;
  UND 41 THEN ARITH_TAC;
  UND 44 THEN UND 39 THEN UND 43 THEN UND 40 THEN REAL_ARITH_TAC;
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN  `i` EXISTS_TAC;
  TYPE_THEN `j` EXISTS_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `t i < t j` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN UND 29 THEN ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `t j <= t (SUC i)` SUBAGOAL_TAC;
  UND 35 THEN UND 33 THEN REAL_ARITH_TAC;
  USE 40 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`));
  UND 40 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 39 THEN UND 27 THEN UND 28 THEN UND 29 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `j` UNABBREV_TAC;
  CONJ_TAC;
  TYPE_THEN `i = SUC i` SUBAGOAL_TAC;
  USE 20 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 33 THEN ARITH_TAC;
  TYPE_THEN `f (t (SUC i))` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `t (SUC i)` EXISTS_TAC;
  REWRITE_TAC[REAL_ARITH `x <= x`];
  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN ARITH_TAC;
  TYPE_THEN `t (SUC i)` EXISTS_TAC;
  REWRITE_TAC[REAL_ARITH `x <= x`];
  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC;
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  UND 30 THEN ARITH_TAC;
  USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `u` 9;
  USE 9 SYM;
  REWRITE_TAC[IMAGE];
  REWRITE_TAC[CONJ_ACI];
  (* - *)
  USE 11 SYM;
  USE 10 SYM;
  TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
  TYPE_THEN `&0 <= t j /\ t j <= &1` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` EXISTS_TAC;
  UND 33 THEN ARITH_TAC;
  TYPE_THEN `&0 <= t (SUC j) /\ t (SUC j) <= &1` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `SUC j` EXISTS_TAC;
  UND 33 THEN ARITH_TAC;
  UND 36 THEN UND 31 THEN UND 35 THEN UND 32 THEN REAL_ARITH_TAC;
  (* -C *)
  ONCE_REWRITE_TAC[CONJ_ACI];
  SUBCONJ_TAC;
  THM_INTRO_TAC[`ed`;`N-| 1`] order_lt_imp_psegment;
  ASM_REWRITE_TAC[];
  TYPE_THEN `S` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `{a, b} SUBSET endpoint S` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET;INR in_pair];
  REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`S`;`pointI x`] num_closure1;
  USE 32 (REWRITE_RULE[psegment;segment]);
  FIRST_ASSUM DISJ_CASES_TAC; (* // *)
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `ed (N -2)` EXISTS_TAC;
  TYPE_THEN `S` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `x' < N -| 2` SUBAGOAL_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `x' < N -| 1 /\ ~(x' = N-2) ==> x' < N -2`);
  PROOF_BY_CONTR_TAC;
  REWR 37;
  TYPE_THEN `x'` UNABBREV_TAC;
  (* ---- *)
  TYPE_THEN `pointI b` UNABBREV_TAC;
  UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[];
  USE 10 SYM;
  TYPE_THEN `t (N -1) = x''` SUBAGOAL_TAC;
  USE 13 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 10 SYM;
  REDUCE_TAC;
  REWRITE_TAC[ARITH_RULE `1 <= 1`];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN  `x'` EXISTS_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  USE 20 (MATCH_MP (REAL_ARITH  `x <= y ==> ~( y < x)`));
  UND 20 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 37 THEN ARITH_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  CONJ_TAC;
  TYPE_THEN `N-| 2` EXISTS_TAC;
  UND 28 THEN ARITH_TAC;
  TYPE_THEN `N -| 2 < N -| 1` SUBAGOAL_TAC;
  UND 28 THEN ARITH_TAC;
  TYPE_THEN `t (N - 1)` EXISTS_TAC;
  TYPE_THEN `SUC (N - 2) = N - 1` SUBAGOAL_TAC;
  UND 28 THEN  ARITH_TAC;
  USE 10 SYM;
  REWRITE_TAC[REAL_ARITH `x <= x`];
  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN ARITH_TAC;
  (* --D *)
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `ed (0)` EXISTS_TAC;
  TYPE_THEN `S` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `0 < x'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `~(x' = 0) ==> 0 < x'`);
  TYPE_THEN `x'` UNABBREV_TAC;
  (* --- *)
  TYPE_THEN `pointI a` UNABBREV_TAC;
  UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[];
  USE 11 SYM;
  TYPE_THEN `t (0) = x''` SUBAGOAL_TAC;
  USE 13 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 11 SYM;
  REDUCE_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN  `x'` EXISTS_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  USE 25 (MATCH_MP (REAL_ARITH  `x <= y ==> ~( y < x)`));
  UND 25 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 38 THEN ARITH_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  CONJ_TAC;
  TYPE_THEN `0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `t (0)` EXISTS_TAC;
  REDUCE_TAC;
  USE 11 SYM;
  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN ARITH_TAC;
  (* -E *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  has_size2_pair;
  CONJ_TAC;
  IMATCH_MP_TAC  endpoint_size2;
  USE 33 (REWRITE_RULE[SUBSET;INR in_pair]);
  CONJ_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `a` UNABBREV_TAC;
  TYPE_THEN `v = v'` SUBAGOAL_TAC;
  USE 8(MATCH_MP simple_arc_end_distinct);
  UND 8 THEN ASM_REWRITE_TAC[];
  (* -F *)
  IMATCH_MP_TAC  EQ_EXT ;
  THM_INTRO_TAC[`S`;`top2`] closure_unions;
  REWRITE_TAC[top2_top];
  FULL_REWRITE_TAC[psegment;segment];
  TYPE_THEN `S` UNABBREV_TAC;
  REWRITE_TAC[UNIONS];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  USE 20 (REWRITE_RULE[IMAGE]);
  (* -- *)
  TYPE_THEN `A = {i | (i <=| N -| 1) /\ (t i <= x')}` ABBREV_TAC ;
  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `{i | i <=| (N -| 1)}` EXISTS_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  REWRITE_TAC[FINITE_NUMSEG_LE];
  TYPE_THEN `A 0` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  UND 28 THEN ARITH_TAC;
  THM_INTRO_TAC[`A`] select_num_max;
  REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `0` EXISTS_TAC;
  TYPE_THEN `x' = &1` ASM_CASES_TAC;
  TYPE_THEN `closure top2 (ed (N -| 2))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  IMATCH_MP_TAC  image_imp;
  UND 28 THEN ARITH_TAC;
  USE 24 SYM;
  TYPE_THEN `N - 2 <| N - 1` SUBAGOAL_TAC;
  UND 28 THEN ARITH_TAC;
  TYPE_THEN `t (N -| 1)` EXISTS_TAC;
  TYPE_THEN `N - 1 = SUC (N - 2)` SUBAGOAL_TAC;
  UND 28 THEN ARITH_TAC;
  USE 10 SYM;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[REAL_ARITH `x <= x`];
  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 28 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `closure top2 (ed z)` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  IMATCH_MP_TAC  image_imp;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`);
  DISCH_TAC;
  TYPE_THEN `z` UNABBREV_TAC;
  UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC;
  TYPE_THEN `z <| N-1` SUBAGOAL_TAC;
  IMATCH_MP_TAC  (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`);
  TYPE_THEN `A` UNABBREV_TAC;
  DISCH_TAC;
  TYPE_THEN `z` UNABBREV_TAC;
  UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  (REAL_ARITH `~(x <= y) ==> (y <= x)`);
  UND 41 THEN DISCH_THEN (THM_INTRO_TAC[`SUC z`]);
  UND 44 THEN ARITH_TAC;
  UND 41 THEN ARITH_TAC;
  (* -G *)
  USE 36 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  UND 30 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x`]);
  REWR 30;
  IMATCH_MP_TAC  image_imp;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x''` EXISTS_TAC;
  (* Wed Dec 22 07:47:58 EST 2004 *)
  ]);;
  (* }}} *)

let psegment_cls = 
prove_by_refinement(
  `!S. psegment S ==> IMAGE pointI (cls S) SUBSET closure top2 (UNIONS S)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[cls;IMAGE;SUBSET];
  THM_INTRO_TAC[`S`;`top2`] closure_unions;
  FULL_REWRITE_TAC[top2_top;psegment;segment];
  REWRITE_TAC[UNIONS;IMAGE];
  CONV_TAC (dropq_conv "u");
  UNIFY_EXISTS_TAC;
  ]);;
  (* }}} *)

let planar_graph_rectagonal = 
prove_by_refinement(
  `!(G:(A,B)graph_t). planar_graph G /\ FINITE (graph_edge G) /\
         FINITE (graph_vertex G) /\
         ~(graph_edge G = {}) /\
         (!v. CARD (graph_edge_around G v) <=| 4) ==>
      (rectagonal_graph G)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`G`] graph_int_model;
  REWRITE_TAC[rectagonal_graph;rectagon_graph];
  TYPE_THEN `graph H` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[good_plane_graph;plane_graph];
  TYPE_THEN `!e. graph_edge H e ==> (?S a b. segment_end S a b /\ (graph_inc H e = { (pointI a), (pointI b) }) /\ (e = closure top2 (UNIONS S)))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[good_plane_graph];
  TSPEC `e` 10;
  REWR 10;
  THM_INTRO_TAC[`H`;`e`] graph_edge_end_select;
  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`v`;`v'`]);
  THM_INTRO_TAC[`E`;`e`;`v`;`v'`] simple_arc_finite_lemma4;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`H`;`e`] graph_inc_subset;
  TYPE_THEN `graph_vertex H v` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `graph_vertex H v'` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `S` EXISTS_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  USE 18 SYM;
  IMATCH_MP_TAC  has_size2_subset_ne;
  CONJ_TAC;
  IMATCH_MP_TAC  graph_edge2;
  REWRITE_TAC[SUBSET;INR in_pair];
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  USE 19 SYM;
  ASM_REWRITE_TAC[];
  USE 20 SYM;
  ASM_REWRITE_TAC[];
  UND 15 THEN ASM_REWRITE_TAC[];
  (* -A *)
  LEFT 13 "S";
  LEFT 13 "S";
  (* - *)
  TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC;
  TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  REWRITE_TAC[pointI];
  TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC;
  REWRITE_TAC[int_neg_num_th];
  USE 16 (MATCH_MP point_onto);
  REWRITE_TAC[point_inj];
  TYPE_THEN `w` UNABBREV_TAC;
  FULL_REWRITE_TAC[coord01;PAIR_SPLIT];
  (* -- *)
  TYPE_THEN `!v. graph_vertex H v ==> ?a. (v = pointI a)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[good_plane_graph;plane_graph];
  ASM_MESON_TAC[subset_imp];
  LEFT 15 "a";
  LEFT 15 "a";
  TYPE_THEN `J = mk_graph_t (IMAGE a (graph_vertex H), IMAGE S (graph_edge H),endpoint)` ABBREV_TAC ;
  TYPE_THEN `J` EXISTS_TAC;
  (* - *)
  TYPE_THEN `graph_isomorphic H J` SUBAGOAL_TAC;
  REWRITE_TAC[graph_isomorphic;graph_iso];
  LEFT_TAC "u";
  TYPE_THEN `a` EXISTS_TAC;
  LEFT_TAC "v";
  TYPE_THEN `S` EXISTS_TAC;
  TYPE_THEN `a,S` EXISTS_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
  CONJ_TAC;
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  TYPE_THEN `x = pointI (a x)` SUBAGOAL_TAC;
  TYPE_THEN `y = pointI (a y)` SUBAGOAL_TAC;
  TYPE_THEN `a x` UNABBREV_TAC;
  TYPE_THEN `pointI (a y)` UNABBREV_TAC;
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  TYPE_THEN `x = closure top2 (UNIONS (S x))` SUBAGOAL_TAC;
  USE 16 SYM;
  ASM_MESON_TAC[];
  TYPE_THEN `y = closure top2 (UNIONS (S y))` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `S x` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
  THM_INTRO_TAC[`H`;`e`] graph_inc_subset;
  REWR 19;
  USE 19 (REWRITE_RULE[SUBSET;INR in_pair]);
  TYPE_THEN `IMAGE a {(pointI a'), (pointI b)} = {a', b}` SUBAGOAL_TAC;
  REWRITE_TAC[IMAGE ;INR in_pair];
  IMATCH_MP_TAC  EQ_EXT ;
  REWRITE_TAC[INR in_pair];
  NAME_CONFLICT_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  DISJ1_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  TSPEC `pointI b` 15;
  USE 15 (REWRITE_RULE[pointI_inj]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  DISJ2_TAC;
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  TSPEC `pointI a'` 15;
  USE 15 (REWRITE_RULE[pointI_inj]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* --- *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `pointI b` EXISTS_TAC;
  TSPEC `pointI b` 15;
  USE 15 (REWRITE_RULE[pointI_inj]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `pointI a'` EXISTS_TAC;
  TSPEC `pointI a'` 15;
  USE 15 (REWRITE_RULE[pointI_inj]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[segment_end];
  (* -B *)
  REWRITE_TAC[GSYM CONJ_ASSOC];
  SUBCONJ_TAC;
  THM_INTRO_TAC[`H`;`J`] graph_isomorphic_graph;
  SUBCONJ_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;graph_edge_mk_graph];
  USE 16 (REWRITE_RULE[IMAGE]);
  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  FULL_REWRITE_TAC[segment_end];
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[graph_inc_mk_graph];
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
  USE 22 (REWRITE_RULE[IMAGE]);
  USE 23 (REWRITE_RULE[IMAGE]);
  COPY 13;
  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  UND 25 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  PROOF_BY_CONTR_TAC;  (* repeat from - to here // *)
  USE 30 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  TYPE_THEN `edge u` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `(UNIONS (S x) SUBSET closure top2 (UNIONS (S x)))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_closure;
  REWRITE_TAC[top2_top];
  TYPE_THEN `(UNIONS (S x') SUBSET closure top2 (UNIONS (S x')))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_closure;
  REWRITE_TAC[top2_top];
  TYPE_THEN `UNIONS (S x) SUBSET x` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `UNIONS (S x') SUBSET x'` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  USE 36 (REWRITE_RULE[UNIONS;SUBSET]);
  USE 35 (REWRITE_RULE[UNIONS;SUBSET]);
  LEFT 35 "u" ;
  LEFT 35 "u" ;
  LEFT 36 "u" ;
  LEFT 36 "u" ;
  TSPEC `u` 36;
  TSPEC `u` 35;
  TYPE_THEN `u SUBSET x` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `u SUBSET x'` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[good_plane_graph;plane_graph];
  UND 39 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`x'`]);
  DISCH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  UND 21 THEN ASM_REWRITE_TAC[];
  USE 39 (REWRITE_RULE[INTER;SUBSET]);
  TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  USE 32 (MATCH_MP edge_cell);
  USE 32 (MATCH_MP cell_nonempty);
  UND 32 THEN (REWRITE_TAC[]);
  USE 44 (REWRITE_RULE[EMPTY_EXISTS]);
  TSPEC  `u'` 39;
  TYPE_THEN `graph_vertex H u'` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[subset_imp];
  UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`u'`]);
  UND 15 THEN UND 44 THEN UND 32 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
  FULL_REWRITE_TAC[edge];
  TYPE_THEN `c = a u'` ABBREV_TAC ;
  FIRST_ASSUM DISJ_CASES_TAC ;
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses];
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses];
  (* -C *)
  TYPE_THEN `graph_isomorphic J G` SUBAGOAL_TAC;
  THM_INTRO_TAC[`G`;`H`;`J`] graph_isomorphic_trans;
  IMATCH_MP_TAC  graph_isomorphic_symm;
  IMATCH_MP_TAC  planar_is_graph;
  (* - *)
  TYPE_THEN `J` UNABBREV_TAC;
  FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
  USE 23 (REWRITE_RULE[IMAGE]);
  USE 24 (REWRITE_RULE[IMAGE]);
  COPY 13;
  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  CONJ_TAC THEN (IMATCH_MP_TAC endpoint_cls);
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  (* -D *)
  TYPE_THEN `IMAGE pointI (cls(S x') INTER cls(S x)) SUBSET (IMAGE pointI (endpoint (S x') INTER endpoint (S x)))` BACK_TAC;
  THM_INTRO_TAC[`pointI`] image_inj;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `UNIV:int#int ->bool` EXISTS_TAC;
  REWRITE_TAC[INJ];
  FULL_REWRITE_TAC[pointI_inj];
  (* - *)
  TYPE_THEN `!A B. (IMAGE pointI (A INTER B) = IMAGE pointI A INTER IMAGE pointI B)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  inj_inter;
  TYPE_THEN `UNIV:int#int->bool` EXISTS_TAC;
  TYPE_THEN `UNIV:(num->real)->bool` EXISTS_TAC;
  REWRITE_TAC[INJ];
  FULL_REWRITE_TAC[pointI_inj];
  (* - *)
  TYPE_THEN `IMAGE pointI (endpoint (S x')) = graph_inc H x'` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end];
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR in_pair];
  MESON_TAC[];
  TYPE_THEN `IMAGE pointI (endpoint (S x)) = graph_inc H x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end];
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR in_pair];
  MESON_TAC[];
  USE 28 SYM;
  USE 30 SYM;
  (* -E *)
  TYPE_THEN `!e. graph_edge H e ==> (graph_inc H e = e INTER graph_vertex H)` SUBAGOAL_TAC;
  USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]);
  TYPE_THEN `x' INTER x SUBSET graph_vertex H` SUBAGOAL_TAC;
  USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 24 THEN UND 23 THEN UND 16 THEN MESON_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `x' INTER x` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  UND 36 THEN REWRITE_TAC[INTER;SUBSET;] THEN MESON_TAC[];
  (* - *)
  IMATCH_MP_TAC  subset_inter_pair;
  (* -F *)
  UND 31 THEN UND 13 THEN UND 29 THEN UND 27 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
  FULL_REWRITE_TAC[segment_end];
  ASM_MESON_TAC[psegment_cls];
  (* Wed Dec 22 11:18:27 EST 2004 *)

  ]);;
  (* }}} *)

let cartesian_finite = 
prove_by_refinement(
  `!(A:A->bool) (B:B->bool). FINITE A /\ FINITE B ==>
          FINITE (cartesian A B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `cartesian A B = {(x,y) | (x IN A) /\ (y IN B)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[cartesian];
  IMATCH_MP_TAC  FINITE_PRODUCT;
  ]);;
  (* }}} *)

let three_t_finite = 
prove_by_refinement(
  `FINITE (UNIV:three_t ->bool)`,

  (* {{{ proof *)
  [
  THM_INTRO_TAC[`ABS3 0`] three_delete_size;
  FULL_REWRITE_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[FINITE_DELETE];
  ]);;
  (* }}} *)

let three_t_size3 = 
prove_by_refinement(
  `(UNIV:three_t ->bool) HAS_SIZE 3`,

  (* {{{ proof *)
  [
  THM_INTRO_TAC[`ABS3 0`] three_delete_size;
  FULL_REWRITE_TAC[HAS_SIZE];
  FULL_REWRITE_TAC[FINITE_DELETE];
  THM_INTRO_TAC[`ABS3 0`;`UNIV:three_t->bool`;] CARD_SUC_DELETE;
  ASM_REWRITE_TAC[];
  USE 2 SYM;
  ASM_REWRITE_TAC[];
  ARITH_TAC;
  ]);;
  (* }}} *)

let k33_nonplanar = 
prove_by_refinement(
  `~(planar_graph k33_graph)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`k33_graph`] planar_graph_rectagonal;
  REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex];
  ASSUME_TAC three_t_finite;
  ASSUME_TAC bool_size;
  FULL_REWRITE_TAC[HAS_SIZE];
  CONJ_TAC;
  IMATCH_MP_TAC  cartesian_finite;
  CONJ_TAC;
  IMATCH_MP_TAC  cartesian_finite;
  (* -- *)
  REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  TYPE_THEN `(ABS3 0,ABS3 0)` EXISTS_TAC;
  REWRITE_TAC[cartesian;PAIR_SPLIT];
  MESON_TAC[];
  REWRITE_TAC[graph_edge_around];
  REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex;cartesian_univ];
  TYPE_THEN `E = {e | (v = FST e,T) \/ (v = SND e,F)}` ABBREV_TAC ;
  TYPE_THEN `SND v ==> (E = IMAGE (\ f. (FST v, f)) UNIV)` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE];
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `~(SND v) ==> (E = IMAGE (\ f. (f,FST v)) UNIV)` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE];
  REWRITE_TAC[PAIR_SPLIT];
  NAME_CONFLICT_TAC;
  MESON_TAC[];
  TYPE_THEN `CARD E <=| CARD (UNIV:three_t ->bool)` SUBAGOAL_TAC;
  TYPE_THEN `SND v` ASM_CASES_TAC;
  IMATCH_MP_TAC  CARD_IMAGE_LE;
  IMATCH_MP_TAC  CARD_IMAGE_LE;
  ASSUME_TAC three_t_size3;
  FULL_REWRITE_TAC[HAS_SIZE];
  UND 8 THEN UND 7 THEN ARITH_TAC;
  (* - *)
  ASSUME_TAC rectagon_graph_k33_false;
  UND 2 THEN ASM_REWRITE_TAC[];
  (* Wed Dec 22 11:57:49 EST 2004 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION Z *)
(* ------------------------------------------------------------------ *)

(* show the complement of a simple arc is connected *)


let grid33 = jordan_def `grid33 m =
         rectangle_grid (FST m -: &:1, SND m -: &:1)
                    (FST m +: &:2, SND m +: &:2)`;;

let grid = jordan_def `grid f N =
   UNIONS (IMAGE
    ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1)))
    {j | j <= N})`;;

let grid33_conn2 = 
prove_by_refinement(
  `!m. conn2 (grid33 m)`,

  (* {{{ proof *)

  [
  REWRITE_TAC[grid33];
  TYPE_THEN `SUC 2 = 3` SUBAGOAL_TAC;
  ARITH_TAC;
  TYPE_THEN `a = FST m -: &:1` ABBREV_TAC  ;
  TYPE_THEN `FST m +: &:2 = a +: &:(SUC 2)` SUBAGOAL_TAC;
  TYPE_THEN `a` UNABBREV_TAC;
  INT_ARITH_TAC;
  TYPE_THEN `b = SND m -: &:1` ABBREV_TAC ;
  TYPE_THEN `SND m +: &:2 = b +: &:(SUC 2)` SUBAGOAL_TAC;
  TYPE_THEN `b` UNABBREV_TAC;
  ARITH_TAC;
  USE 0 SYM;
  THM_INTRO_TAC[`2`;`2`;`(a,b)`] rectangle_grid_conn2;
  FULL_REWRITE_TAC[];
  ]);;
  (* }}} *)

let grid_finite = 
prove_by_refinement(
  `!f N. FINITE (grid f N)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[ grid];
  TYPE_THEN `FINITE (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N}) ` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  REWRITE_TAC[FINITE_NUMSEG_LE];
  ASM_SIMP_TAC[FINITE_FINITE_UNIONS];
  USE 1 (REWRITE_RULE[IMAGE]);
  THM_INTRO_TAC[`floor (f (&x / &N) 0),floor (f (&x / &N) 1)`] grid33_conn2;
  FULL_REWRITE_TAC[conn2];
  ]);;
  (* }}} *)

let grid33_edge = 
prove_by_refinement(
  `!m. grid33 m SUBSET edge `,

  (* {{{ proof *)
  [
  REWRITE_TAC[grid33;rectangle_grid_edge];
  ]);;
  (* }}} *)

let grid_edge = 
prove_by_refinement(
  `!f N . grid f N SUBSET edge `,

  (* {{{ proof *)

  [
  REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ];
  TYPE_THEN `u` UNABBREV_TAC;
  ASM_MESON_TAC[grid33_edge;subset_imp];
  ]);;
  (* }}} *)

let floor_add_num = 
prove_by_refinement(
  `!x m. floor (x + &m) = floor x +: &:m`,

  (* {{{ proof *)
  [
  REWRITE_TAC [floor_range;int_add_th;int_of_num_th;];
  THM_INTRO_TAC[`x`;`floor x`] floor_range;
  REWR 0;
  UND 0 THEN UND 1 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_abs = 
prove_by_refinement(
  `!x y m. (abs  (x -. y) <= &m) ==> (||: (floor x -: floor y) <=: &:m)`,

  (* {{{ proof *)
  [
  TYPE_THEN `!x y m. (y <. x) /\ (x - y <= &m) ==> (floor x -: floor y <=: &:m)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`x`;`y + &m`] floor_mono;
  UND 0 THEN REAL_ARITH_TAC;
  FULL_REWRITE_TAC[floor_add_num];
  UND 2 THEN INT_ARITH_TAC ;
  TYPE_THEN `y = x` ASM_CASES_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  FULL_REWRITE_TAC[REAL_ARITH `x -. x = &0`;ABS_0;INT_SUB_REFL;INT_ABS_0;int_le ; int_of_num_th];
  ASM_REWRITE_TAC[];
  TYPE_THEN `y <= x` ASM_CASES_TAC;
  TYPE_THEN `abs  (x - y) = (x - y)` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_REFL];
  UND 3 THEN REAL_ARITH_TAC;
  REWR 0;
  TYPE_THEN `floor y  <=: floor x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  floor_mono;
  TYPE_THEN `||: (floor x -: floor y) = (floor x -: floor y)` SUBAGOAL_TAC;
  REWRITE_TAC[INT_ABS_REFL];
  UND 5 THEN INT_ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
  TYPE_THEN `x < y` SUBAGOAL_TAC;
  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
  (* -A *)
  TYPE_THEN `abs  (x - y) = (y - x)` SUBAGOAL_TAC;
  UND 4 THEN REAL_ARITH_TAC;
  REWR 0;
  TYPE_THEN `floor x  <=: floor y` SUBAGOAL_TAC;
  IMATCH_MP_TAC  floor_mono;
  UND 4 THEN REAL_ARITH_TAC;
  TYPE_THEN `||: (floor x -: floor y) = (floor y -: floor x)` SUBAGOAL_TAC;
  UND 6 THEN INT_ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)

let d_euclid_floor = 
prove_by_refinement(
  `!x y i n. (euclid n x) /\ (euclid n y) /\ (d_euclid x y < &1) ==>
     (||: (floor (x i) -: floor (y i)) <=: &:1)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  floor_abs;
  THM_INTRO_TAC[`n`;`x`;`y`;`i`] proj_contraction;
  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

extend_simp_rewrites[prove_by_refinement(
  `!x . x/ &0 = &0 `,
  (* {{{ proof *)
  [
  REWRITE_TAC[REAL_INV_0;real_div;REAL_MUL_RZERO];
  ])];;
  (* }}} *)

extend_simp_rewrites[INR in_pair ; INR IN_SING];;

extend_simp_rewrites[REAL_POS];;

let real_eq_div = 
prove_by_refinement(
  `!x y z. ~(z = &0) ==> ((x / z = y) <=> (x = y * z))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `&0 < z` ASM_CASES_TAC;
  ASM_SIMP_TAC[REAL_EQ_LDIV_EQ];
  TYPE_THEN `&0 < -- z` SUBAGOAL_TAC;
  UND 0 THEN UND 1 THEN REAL_ARITH_TAC;
  TYPE_THEN `x / z = (--x)/(--z)` SUBAGOAL_TAC;
  REWRITE_TAC[real_div;REAL_INV_NEG;REAL_NEG_MUL2];
  ASM_SIMP_TAC[REAL_EQ_LDIV_EQ];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let grid_conn2_induct_lemma = 
prove_by_refinement(
  `!k f N.
   (k <= N) /\ (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\
   (!i. (i < N) ==> d_euclid  (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==>
   conn2 (UNIONS (IMAGE
    ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1)))
    {j | j <= k}))`,

  (* {{{ proof *)

  [
  INDUCT_TAC;
  TYPE_THEN `{j | j <=| 0} = {0}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_SING];
  ARITH_TAC;
  REWRITE_TAC[IMAGE;INR IN_SING ];
  TYPE_THEN `{y | ?x. (x = 0) /\ (y = grid33 (floor (f (&x / &N) 0),floor (f (&x / &N) 1)))} =  {(grid33 (floor (f (&0 / &N) 0), floor (f (&0 / &N) 1)))}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  NAME_CONFLICT_TAC;
  REWRITE_TAC[INR IN_SING];
  CONV_TAC (dropq_conv "x'");
  REWRITE_TAC[grid33_conn2];
  (* - *)
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`f`;`N`]);
  UND 2 THEN ARITH_TAC;
  TYPE_THEN `{j | j <=| SUC k} = {j | j <=| k} UNION {(SUC k)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;];
  ARITH_TAC;
  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1];
  IMATCH_MP_TAC  conn2_union_edge;
  ASM_REWRITE_TAC[grid33_conn2];
  (* - *)
  CONJ_TAC;
    REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ];
  TYPE_THEN `u` UNABBREV_TAC;
  ASM_MESON_TAC[grid33_edge;subset_imp];
  REWRITE_TAC[EMPTY_EXISTS];
  REWRITE_TAC[grid33_edge];
  TYPE_THEN `{j | j <=| k} = {j | j <| k} UNION {k}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING];
  ARITH_TAC;
  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1];
  ONCE_REWRITE_TAC[INTER_COMM];
  REWRITE_TAC[UNION_OVER_INTER];
  REWRITE_TAC[UNION];
  RIGHT_TAC "u";
  DISJ2_TAC;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
  UND 2 THEN ARITH_TAC;
  (* -A *)
  TYPE_THEN `a = floor (f (&k / &N) 0)` ABBREV_TAC ;
  TYPE_THEN `b = floor (f (&k / &N) 1)` ABBREV_TAC ;
  TYPE_THEN `a' = floor (f (&(SUC k) / &N) 0)` ABBREV_TAC ;
  TYPE_THEN `b' = floor (f (&(SUC k) / &N) 1)` ABBREV_TAC ;
  TYPE_THEN `h_edge (a,b)` EXISTS_TAC;
  REWRITE_TAC[INTER];
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  REWRITE_TAC[grid33];
  REWRITE_TAC[rectangle_grid_h];
  INT_ARITH_TAC;
  (* - *)
  TYPE_THEN `!k. (k <=| N) ==> euclid 2 (f (&k / &N))` SUBAGOAL_TAC;
  USE 1(REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  image_imp;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_DIV;
  TYPE_THEN `&N = &0` ASM_CASES_TAC;
  REWRITE_TAC[];
  REAL_ARITH_TAC;
  TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
  UND 11 THEN REWRITE_TAC[REAL_OF_NUM_EQ;REAL_LT] THEN ARITH_TAC;
  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
  UND 10 THEN REWRITE_TAC[REAL_LE;REAL_OF_NUM_MUL] THEN ARITH_TAC ;
  (* - *)
  TYPE_THEN `euclid 2 (f (&k/ &N))` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 2 THEN ARITH_TAC;
  TYPE_THEN `euclid 2 (f (&(SUC k)/ &N))` SUBAGOAL_TAC;
  (* - *)
  THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`0`;`2`] d_euclid_floor;
  THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`1`;`2`] d_euclid_floor;
  TYPE_THEN `||: (a - a') <=: &:1` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `||: (b - b') <=: &:1` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILL 14 THEN KILL 13;
  KILL 5 THEN KILL  4;
  KILL 3 THEN KILL 1;
  REWRITE_TAC[grid33];
  REWRITE_TAC[rectangle_grid_h];
  UND 16 THEN UND 15 THEN INT_ARITH_TAC;
  (* Thu Dec 23 10:46:15 EST 2004 *)

  ]);;

  (* }}} *)

let grid_conn2 = 
prove_by_refinement(
  `!f N. (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\
   (!i. (i < N) ==> d_euclid  (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==>
   conn2 (grid f N)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`N`;`f`;`N`] grid_conn2_induct_lemma;
  ARITH_TAC;
  REWRITE_TAC[grid];
  ]);;
  (* }}} *)

let simple_arc_uniformly_continuous = 
prove_by_refinement(
  `!f . continuous f (top_of_metric(UNIV,d_real)) top2 /\
      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
   uniformly_continuous f
        ({x | &0 <= x /\ x <= &1},d_real)
        (euclid 2,d_euclid)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASSUME_TAC metric_real;
  IMATCH_MP_TAC  compact_uniformly_continuous;
  THM_INTRO_TAC[`&0`;`&1`] interval_compact;
  THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] compact_subset;
  REWRITE_TAC[metric_real];
  REWR 4;
  KILL 4;
  KILL 3;
  (* - *)
  TYPE_THEN  `IMAGE f {x | &0 <= x /\ x <= &1} SUBSET euclid 2` SUBAGOAL_TAC;
  IMATCH_MP_TAC  inj_image_subset;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  (* -A *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC metric_subspace;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  (* -// *)
  THM_INTRO_TAC[`f`;`top_of_metric(UNIV,d_real)`;`top2`;`{x | &0 <= x /\ x <= &1}`] continuous_induced_domain;
  ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions];
  (* - *)
  THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_induced;
  REWRITE_TAC[metric_real];
  REWR 5;
  THM_INTRO_TAC[`f`;`{x | &0 <= x /\ x <= &1}`;`euclid 2`;`d_real`;`d_euclid`] metric_continuous_continuous;
  USE 7 SYM;
  FULL_REWRITE_TAC[top2];
  (* Thu Dec 23 11:29:49 EST 2004 *)
  ]);;
  (* }}} *)

let num_abs_of_int_mono = 
prove_by_refinement(
  `!a b. &:0 <= a /\ a <= b ==> num_abs_of_int a <= num_abs_of_int b`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM REAL_LE;num_abs_of_int_th;GSYM int_abs_th;GSYM int_le ];
  UND 0 THEN UND 1 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_num = 
prove_by_refinement(
  `!n. floor (&n) = &:n`,

  (* {{{ proof *)
  [
  REWRITE_TAC[floor_range];
  REWRITE_TAC[int_of_num_th;];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let floor_neg_num = 
prove_by_refinement(
  `!n. floor (-- &n) = -- (&:n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[floor_range];
  REWRITE_TAC[int_neg_th;int_of_num_th;];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let delta_partition_lemma = 
prove_by_refinement(
  `!delta. (&0 < delta) ==> (?N. !x. ?i.  (0 < N) /\
      ((&0 <= x /\ x <= &1) ==> (i <= N) /\ abs  (&i/ &N - x) < delta))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE;
  TYPE_THEN `n` EXISTS_TAC;
  TYPE_THEN `num_abs_of_int (floor (&n*x))` EXISTS_TAC;
  TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC;
  TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
  UND 1 THEN UND 2 THEN REAL_ARITH_TAC;
  TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC;
  ASM_MESON_TAC[REAL_LE_LDIV_EQ];
  CONJ_TAC;
  FULL_REWRITE_TAC[REAL_LT];
  TYPE_THEN `&:0 <= floor (&n * x)` SUBAGOAL_TAC;
  TYPE_THEN `floor (&0) <=: floor (&n * x)` BACK_TAC;
  FULL_REWRITE_TAC[floor_num];
  IMATCH_MP_TAC  floor_mono;
  IMATCH_MP_TAC  REAL_LE_MUL;
  (* - *)
  CONJ_TAC;
  TYPE_THEN `num_abs_of_int (floor (&n * x)) <= num_abs_of_int (floor (&n))` BACK_TAC;
  FULL_REWRITE_TAC[floor_num;num_abs_of_int_num];
  IMATCH_MP_TAC  num_abs_of_int_mono;
  IMATCH_MP_TAC  floor_mono;
  TYPE_THEN `&n * x <= &n * &1` BACK_TAC;
  UND 8 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
  (* -A *)
  IMATCH_MP_TAC  REAL_LT_LCANCEL_IMP;
  TYPE_THEN `&n` EXISTS_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN`&1` EXISTS_TAC;
  (* - *)
  REWRITE_TAC[num_abs_of_int_th;];
  TYPE_THEN `abs  (real_of_int (floor (&n * x))) = (real_of_int (floor (&n *x)))` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_REFL];
  FULL_REWRITE_TAC [int_le; int_of_num_th;];
  TYPE_THEN `!u. &n * abs  (u / &n - x) = abs  (u - &n*x)` SUBAGOAL_TAC;
  TYPE_THEN `!t. &n * abs  t = abs  (&n *t)` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM];
  AP_TERM_TAC;
  REWRITE_TAC[REAL_SUB_LDISTRIB];
  TYPE_THEN `&n * u/ &n = u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 10 THEN UND 3 THEN REAL_ARITH_TAC;
  TYPE_THEN `t = &n * x ` ABBREV_TAC ;
  TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC;
  REWRITE_TAC[floor_ineq];
  TYPE_THEN `abs  (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC;
  UND 11 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`t`] floor_ineq;
  UND 13 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let simple_arc_ball_cover  = 
prove_by_refinement(
  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
    (?N. !x. ?i. (0 < N) /\ (&0 <= x /\ x <= &1 ==>
        (i <= N) /\
           open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
  FULL_REWRITE_TAC[uniformly_continuous];
  TSPEC `&1` 2;
  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWRITE_TAC[open_ball];
  THM_INTRO_TAC[`delta`] delta_partition_lemma;
  TYPE_THEN `N` EXISTS_TAC;
  TSPEC `x` 4;
  TYPE_THEN `i` EXISTS_TAC;
  REP_BASIC_TAC;
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]);
  (* - *)
  TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_DIV;
  THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ;
  REWRITE_TAC[REAL_LT];
  REWRITE_TAC[REAL_MUL;REAL_LE];
  UND 8 THEN ARITH_TAC;
  (* - *)
  FULL_REWRITE_TAC[INJ];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[d_real];
  ]);;
  (* }}} *)

let unbounded_diff = 
prove_by_refinement(
  `!G. unbounded_set G = UNIONS(ctop G) DIFF (bounded_set G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM bounded_unbounded_union];
  IMATCH_MP_TAC  EQ_EXT;
  THM_INTRO_TAC[`G`] bounded_unbounded_disj;
  UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[];
  ]);;
  (* }}} *)

let bounded_diff = 
prove_by_refinement(
  `!G. bounded_set G = UNIONS(ctop G) DIFF (unbounded_set G)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[GSYM bounded_unbounded_union];
  IMATCH_MP_TAC  EQ_EXT;
  THM_INTRO_TAC[`G`] bounded_unbounded_disj;
  UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[];
  ]);;
  (* }}} *)

let rectangle_grid_subset = 
prove_by_refinement(
  `!p q r s. (FST p <=: FST r) /\ (SND p <= SND r) /\
       (FST s <= FST q) /\ (SND s <= SND q) ==>
    rectangle_grid r s SUBSET rectangle_grid p q`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET;rectangle_grid];
  FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[cell_clauses] THEN  CONV_TAC (dropq_conv "m'");
  UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
  UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let grid_image_bounded = 
prove_by_refinement(
  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
   (?N. (0 < N) /\ ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER
         (unbounded_set (grid f N)) =  EMPTY))  `,

  (* {{{ proof *)
  [
  REWRITE_TAC[EQ_EMPTY;INTER;];
  THM_INTRO_TAC[`f`] simple_arc_ball_cover;
  TYPE_THEN `N` EXISTS_TAC;
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  RIGHT 2 "i";
  RIGHT 2 "x";
  TYPE_THEN `x''` UNABBREV_TAC;
  FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ];
  UND 2 THEN REWRITE_TAC[];
  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  REWR 2;
  FULL_REWRITE_TAC[open_ball];
  (* _ *)
  IMATCH_MP_TAC  bounded_avoidance_subset;
  TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ;
  TYPE_THEN `E` EXISTS_TAC;
  (* _ *)
  TYPE_THEN `conn2 E` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[grid33_conn2];
  REWRITE_TAC[grid_edge;grid_finite];
  TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC;
  REWRITE_TAC[grid];
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UND 6 THEN ARITH_TAC;
  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION];
  REWRITE_TAC[SUBSET;UNION];
  DISJ1_TAC;
  REWRITE_TAC[image_sing];
  (* _ *)
  TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC;
  UND 3 THEN REWRITE_TAC[];
  THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset;
  USE 3 (MATCH_MP UNIONS_UNIONS);
  ASM_MESON_TAC[subset_imp];
  KILL 13;
  KILL 3;
  (* _A *)
  TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ;
  THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq;
  FULL_REWRITE_TAC [];
  REWR 13;
  TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[grid33];
  IMATCH_MP_TAC  rectangle_grid_subset;
  (* __ *)
  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor;
  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor;
  UND 3 THEN UND 11 THEN INT_ARITH_TAC;
  (* _ *)
  IMATCH_MP_TAC  bounded_avoidance_subset;
  TYPE_THEN `E'` EXISTS_TAC;
  TYPE_THEN `conn2 E'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  conn2_rectagon;
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  (* _ *)
  TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[grid33_edge];
  (* _ *)
  ASM_SIMP_TAC[GSYM odd_bounded];
  REWRITE_TAC[UNIONS];
  TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT ` a/\ b ==> b /\ a`);
  (* -B *)
  TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC;
  UND 14 THEN REWRITE_TAC[];
  THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset;
  USE 14 (MATCH_MP UNIONS_UNIONS);
  ASM_MESON_TAC[subset_imp];
  (* - *)
  TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ;
  TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC;
  UND 19 THEN REWRITE_TAC[];
  REWRITE_TAC[UNIONS];
  TYPE_THEN `h_edge m` EXISTS_TAC;
  REWRITE_TAC[curve_cell_h_ver2];
  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
  REWR 3;
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[INSERT];
  (* - *)
  TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC;
  UND 19 THEN REWRITE_TAC[];
  REWRITE_TAC[UNIONS];
  TYPE_THEN `v_edge m` EXISTS_TAC;
  REWRITE_TAC[curve_cell_v_ver2];
  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
  REWR 3;
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[INSERT];
  (* - *)
  TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC;
  UND 19 THEN REWRITE_TAC[];
  REWRITE_TAC[UNIONS];
  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
  ASM_SIMP_TAC[rectagon_segment;curve_cell_cls];
  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
  REWR 3;
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;INSERT];
  USE 24 (MATCH_MP cls_subset);
  USE 24 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[cls_h];
  (* -C *)
  USE 9 (MATCH_MP point_onto);
  THM_INTRO_TAC[`p`] square_domain;
  UND 24 THEN LET_TAC;
  TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  REWR 24;
  TYPE_THEN `point p` UNABBREV_TAC;
  USE 24 (REWRITE_RULE[UNION;INR IN_SING;]);
  REWR 9;
  (* -D *)
  ASM_SIMP_TAC[rectagon_segment;par_cell_squ];
  FULL_REWRITE_TAC[num_lower];
  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
  REWR 3;
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[INSERT;cell_clauses];
  REWR 24;
  (* - *)
  TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[up;PAIR_SPLIT];
  INT_ARITH_TAC;
  REWR 24;
  FULL_REWRITE_TAC[card_sing;EVEN2];
  (* Thu Dec 23 20:25:33 EST 2004 *)

  ]);;
  (* }}} *)

let conn2_sequence_lemma1 = 
prove_by_refinement(
  `!k G N . (k <= N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
    (!i. (i <= N) ==> (G i SUBSET edge )) /\
    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) ==>
   conn2 (UNIONS (IMAGE G ({i | i <=| k})))`,

  (* {{{ proof *)
  [
  INDUCT_TAC;
  TYPE_THEN `{i | i <=| 0} = {0}` SUBAGOAL_TAC;
  IMATCH_MP_TAC   EQ_EXT ;
  ARITH_TAC;
  REWRITE_TAC[image_sing];
  (* - *)
  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`G`;`N`]);
  UND 3 THEN ARITH_TAC;
  TYPE_THEN `{i | i <=| SUC k} = {i | i <= k} UNION {(SUC k)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  ARITH_TAC;
  REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION];
  IMATCH_MP_TAC  conn2_union_edge;
  REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  REWRITE_TAC[UNIONS;IMAGE;SUBSET];
  FULL_REWRITE_TAC[SUBSET];
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  UND 8 THEN UND 3 THEN ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `u` UNABBREV_TAC;
  REWRITE_TAC[INTER];
  TYPE_THEN`{i | i <=| k} = {i | i <| k} UNION {k}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  ARITH_TAC;
  (* - *)
  REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION];
  REWRITE_TAC[UNION];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
  FULL_REWRITE_TAC[INTER];
  TYPE_THEN `u` EXISTS_TAC;
  ]);;
  (* }}} *)

let thread_finite_union = 
prove_by_refinement(
  `!(A:(A->bool)->(B->bool)) S.
    (FINITE S) /\ (!a b. A (a UNION b) = A a UNION A b) /\
      (A EMPTY = EMPTY) ==>
       (A (UNIONS S) = UNIONS (IMAGE A S))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!k S. S HAS_SIZE k ==> (A (UNIONS S) = UNIONS (IMAGE A S))` SUBAGOAL_TAC THENL [INDUCT_TAC;ALL_TAC];
  FULL_REWRITE_TAC[HAS_SIZE_0];
  ASM_REWRITE_TAC[IMAGE_CLAUSES;UNIONS_0;];
  THM_INTRO_TAC[`S'`;`k`] HAS_SIZE_SUC;
  REWR 5;
  USE 6 (REWRITE_RULE[EMPTY_EXISTS]);
  TSPEC `u` 5;
  TSPEC `S' DELETE u` 4;
  TYPE_THEN `S' = (S' DELETE u) UNION {u}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  UND 6 THEN REWRITE_TAC[DELETE;UNION;INR IN_SING ] THEN MESON_TAC[];
  UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  ASM_REWRITE_TAC[UNIONS_UNION;IMAGE_UNION;image_sing;];
  (* - *)
  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`CARD S`;`S`]);
  ASM_REWRITE_TAC[HAS_SIZE];
  ]);;
  (* }}} *)

let conn2_sequence_lemma2 = 
prove_by_refinement(
  `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
    (!i. (i <= N) ==> (G i SUBSET edge )) /\
    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
   (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\
   ~(unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==>
   (bounded_set (UNIONS (IMAGE G {i | i <=| N})) p)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC  [unbounded_diff;DIFF;DE_MORGAN_THM;];
  UND 6 THEN ASM_REWRITE_TAC[];
  USE 0 (ONCE_REWRITE_RULE[DISJ_SYM]);
  FIRST_ASSUM DISJ_CASES_TAC;
  KILL 0;
  FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM;];
  (* - *)
  COPY 1;
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`]);
  UND 5 THEN ARITH_TAC;
  REWR 6;
  (* - *)
  TYPE_THEN `?j. (j <=| N) /\ UNIONS (curve_cell (G j)) p` SUBAGOAL_TAC;
  TYPE_THEN `!r. UNIONS (curve_cell r) = (UNIONS o curve_cell) r` SUBAGOAL_TAC;
  REWRITE_TAC[o_DEF];
  REWR 6;
  TYPE_THEN `A = UNIONS o curve_cell` ABBREV_TAC ;
  THM_INTRO_TAC[`A`;`IMAGE G {i | i <=| N}`] thread_finite_union;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  REWRITE_TAC[FINITE_NUMSEG_LE];
  TYPE_THEN `A` UNABBREV_TAC;
  USE 9 GSYM;
  CONJ_TAC;
  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
  REWRITE_TAC[curve_cell_empty;];
  USE 11 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `p` 11;
  TYPE_THEN `A` UNABBREV_TAC;
  KILL 9;
  FULL_REWRITE_TAC[IMAGE_o];
  FULL_REWRITE_TAC[o_DEF];
  REWR 11;
  FULL_REWRITE_TAC[GSYM UNIONS_IMAGE_UNIONS];
  USE 9 (REWRITE_RULE[UNIONS]);
  USE 11 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `u'` UNABBREV_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  REWRITE_TAC[UNIONS];
  TYPE_THEN `u` EXISTS_TAC;
  (* - *)
  FULL_REWRITE_TAC[curve_cell_union;UNIONS_UNION];
  FULL_REWRITE_TAC[UNION;DE_MORGAN_THM];
  TYPE_THEN `j = 0` ASM_CASES_TAC;
  REWR 9;
  (* - *)
  TYPE_THEN `?i. j = SUC i` SUBAGOAL_TAC ;
  TYPE_THEN `j - 1` EXISTS_TAC;
  UND 12 THEN ARITH_TAC;
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  REWR 10;
  TYPE_THEN `j` UNABBREV_TAC;
  UND 14 THEN ASM_REWRITE_TAC[];
  (* Fri Dec 24 07:02:02 EST 2004 *)

  ]);;
  (* }}} *)

let conn2_sequence_lemma3 = 
prove_by_refinement(
  `!G N. (!i. (i <= N) ==> (G i SUBSET edge )) ==>
    (UNIONS (IMAGE G {i | i <=| N}) SUBSET edge)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[UNIONS;IMAGE;SUBSET ];
  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  ASM_MESON_TAC[subset_imp];
  ]);;
  (* }}} *)

let unbounded_avoidance_subset_ver2 = 
prove_by_refinement(
  `!E E' x.
          unbounded_set E' x /\
          E SUBSET E' /\
          E' SUBSET edge /\
          FINITE E' /\
          conn2 E
             ==> unbounded_set E x`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`;`E'`;`x`] unbounded_avoidance_subset;
  THM_INTRO_TAC[`E'`;`x`] unbounded_subset_unions;
  FULL_REWRITE_TAC[ctop_unions;DIFF];
  UND 6 THEN ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let conn2_sequence_lemma4 = 
prove_by_refinement(
  `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
    (!i. (i <= N) ==> (G i SUBSET edge )) /\
    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
   (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\
   (bounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==>
    (?C i j . rectagon C /\ bounded_set C p /\
       (SUC i < j) /\ (j <=| N) /\
       (C SUBSET (UNIONS (IMAGE G ({x | (i <=| x) /\ (x <=| j)})))) /\
    (!C' i' j'. rectagon C' /\ bounded_set  C' p /\
       (i' < j') /\ (j' <=| N) /\
       (C' SUBSET (UNIONS (IMAGE G ({x | (i' <=| x /\ x <=| j')})))) ==>
       (j - i <= j' - i') /\
   ((j - i = j' - i') ==>
      (CARD (C DIFF (G (SUC i))) <= CARD (C' DIFF (G (SUC i')))))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1;
  ARITH_TAC;
  TYPE_THEN `X = {(C,i,j) | rectagon C /\ bounded_set C p /\ (i <| j) /\ (j <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i <=| x /\ x <=| j})) }` ABBREV_TAC ;
  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
  UND 8 THEN REWRITE_TAC[EMPTY_EXISTS];
  THM_INTRO_TAC[`UNIONS (IMAGE G {i | i <=| N})`] rectagon_surround_conn2;
  IMATCH_MP_TAC  conn2_sequence_lemma3;
  TYPE_THEN `(C,0,N)` EXISTS_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `0` EXISTS_TAC;
  TYPE_THEN `N` EXISTS_TAC;
  REWRITE_TAC[ARITH_RULE `!x. 0 <=| x`];
  ARITH_TAC;
  (* -A *)
  THM_INTRO_TAC[`X`;`(\ (C,i,j). j -| i):(((((num->real)->bool)->bool)#(num#num)) -> num)`] select_image_num_min;
  UND 8 THEN ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `?D i j. z = (D,i,j)` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `z` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `Y = {(C,i',j') | rectagon C /\ bounded_set C p /\ (i' <| j') /\ (j' <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i' <=| x /\ x <=| j'})) /\ (j' - i' = j - i) }` ABBREV_TAC ;
  TYPE_THEN `~(Y = EMPTY)` SUBAGOAL_TAC;
  UND 12 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `(D,i,j)` EXISTS_TAC;
  TYPE_THEN `Y` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `D` EXISTS_TAC;
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `j` EXISTS_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  USE 7 (REWRITE_RULE[PAIR_SPLIT]);
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`Y`;`\ (C,i',(j':num)). (CARD (C DIFF (G (SUC i'))))`] select_image_num_min;
  UND 12 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `?C i' j'. z' = (C,i',j')` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `z'` UNABBREV_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `i'` EXISTS_TAC;
  TYPE_THEN `j'` EXISTS_TAC;
  USE 11 SYM;
  REWR 14;
  USE 11 SYM;
  USE 14 (REWRITE_RULE[PAIR_SPLIT]);
  TYPE_THEN `C'` UNABBREV_TAC;
  TYPE_THEN `i''` UNABBREV_TAC;
  TYPE_THEN `j''` UNABBREV_TAC;
  (* -B *)
  CONJ_TAC;
  TYPE_THEN `(SUC i' <| j') \/ (SUC i' = j')` SUBAGOAL_TAC;
  UND 18 THEN ARITH_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `j'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
  TYPE_THEN `{x | i' <=| x /\ x <=| SUC i'} = {i'} UNION {(SUC i')}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  ARITH_TAC;
  REWR 16;
  USE 16 (REWRITE_RULE[UNIONS_UNION;image_sing;IMAGE_UNION]);
  (* -- *)
  THM_INTRO_TAC[`C`;`(G i' UNION G (SUC i'))`;`p`]unbounded_avoidance_subset_ver2;
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UND 17 THEN ARITH_TAC;
  CONJ_TAC;
  REWRITE_TAC[FINITE_UNION];
  TYPE_THEN `i' <=| N` SUBAGOAL_TAC;
  UND 17 THEN ARITH_TAC;
  FULL_REWRITE_TAC[conn2];
  IMATCH_MP_TAC  conn2_rectagon;
  (* -- *)
  THM_INTRO_TAC[`C`] bounded_unbounded_disj;
  USE 24 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPEC `p` 24;
  UND 24 THEN ASM_REWRITE_TAC[];
  (* -C *)
  TYPE_THEN `X (C'',i''',j''')` SUBAGOAL_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `C''` EXISTS_TAC;
  TYPE_THEN `i'''` EXISTS_TAC;
  TYPE_THEN `j'''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  TSPEC `(C'',i''',j''')` 9;
  USE 9 (GBETA_RULE);
  (* - *)
  TYPE_THEN `Y (C'',i''',j''')` SUBAGOAL_TAC;
  TYPE_THEN `Y` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `C''` EXISTS_TAC;
  TYPE_THEN `i'''` EXISTS_TAC;
  TYPE_THEN `j'''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`(C'',i''',j''')`]);
(*** Removed by JRH; no longer needed with paired beta in default rewrites
  USE 13 (GBETA_RULE);
 ***)
  (* Fri Dec 24 12:26:34 EST 2004 *)
  ]);;
  (* }}} *)

let endpoint_sub_rectagon = 
prove_by_refinement(
  `!C G m. rectagon G /\ C SUBSET G /\ endpoint C m ==>
    (?!e. G e /\ ~(C e) /\ cls {e} m)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  FULL_REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`C`;`pointI m`] num_closure1;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `G` EXISTS_TAC;
  FULL_REWRITE_TAC[rectagon];
  REWR 3;
  FULL_REWRITE_TAC[rectagon];
  KILL 2;
  TSPEC `m` 4;
  USE 2 (REWRITE_RULE[INSERT]);
  USE 2 (ONCE_REWRITE_RULE[TAUT `a \/ b <=> b \/ a`]);
  FIRST_ASSUM DISJ_CASES_TAC;
  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
  REWR 8;
  TSPEC `e` 8;
  USE 1 (REWRITE_RULE[SUBSET]);
  TSPEC `e` 3;
  ASM_MESON_TAC[];
  (* -A *)
  COPY 3;
  TSPEC `e` 8;
  USE 8 (REWRITE_RULE[]);
  THM_INTRO_TAC[`G`;`pointI m`] num_closure2;
  REWR 10;
  COPY 10;
  TSPEC `e` 10;
  TYPE_THEN `G e` SUBAGOAL_TAC;
  USE 1 (REWRITE_RULE[SUBSET]);
  TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  REWRITE_TAC[cls];
  REWRITE_TAC[EXISTS_UNIQUE_ALT];
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  TSPEC `y` 12;
  REWR 12;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  UND 18 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `y` UNABBREV_TAC;
  TSPEC  `b` 3;
  TSPEC `b` 12;
  REWR 12;
  REWR 3;
  TYPE_THEN `b` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  TSPEC `y` 12;
  REWR 12;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  UND 18 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `y` UNABBREV_TAC;
  TSPEC  `a` 3;
  TSPEC `a` 12;
  REWR 12;
  REWR 3;
  TYPE_THEN `a` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Mon Dec 27 15:17:28 EST 2004 *)
  ]);;
  (* }}} *)

let cut_rectagon_unique = 
prove_by_refinement(
  `!E A B C m n. rectagon E /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\
    segment_end A m n /\ segment_end B m n /\ segment_end C m n /\
    (E = A UNION B) /\ (A INTER B = EMPTY) ==>
    (C = A) \/ (C = B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!A. A SUBSET E /\ segment_end A m n /\ ~(A INTER C = EMPTY) ==> (A SUBSET C)` SUBAGOAL_TAC;
  TYPE_THEN `inductive_set A' (A' INTER C)` SUBAGOAL_TAC;
  REWRITE_TAC[inductive_set];
  CONJ_TAC;
  REWRITE_TAC[INTER;SUBSET];
  FULL_REWRITE_TAC[INTER];
  TYPE_THEN `edge C' /\ edge C''` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end;psegment;segment];
  UND 16 THEN UND 15 THEN UND 13 THEN MESON_TAC[subset_imp];
  THM_INTRO_TAC[`C'`;`C''`] adjv_adj;
  THM_INTRO_TAC[`C'`;`C''`] adjv_adj2;
  TYPE_THEN `q =adjv C' C''` ABBREV_TAC ;
  TYPE_THEN `~(C' = C'')` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[adj];
  UND 22 THEN ASM_REWRITE_TAC[];
  (* --- *)
  TYPE_THEN `~(endpoint A' q)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end];
  USE 2 SYM;
  USE 22 (REWRITE_RULE[endpoint]);
  THM_INTRO_TAC[`A'`;`pointI q`] num_closure1;
  USE 3 (REWRITE_RULE[psegment;segment]);
  REWR 27;
  COPY 27;
  TSPEC `C'` 27;
  TSPEC `C''` 28;
  ASM_MESON_TAC[];
  (* ---A *)
  TYPE_THEN `~(endpoint C q)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end];
  TYPE_THEN `endpoint A'` UNABBREV_TAC;
  TYPE_THEN `endpoint C` UNABBREV_TAC;
  UND 22 THEN ASM_REWRITE_TAC[];
  (* --- *)
  PROOF_BY_CONTR_TAC;
  UND 23 THEN ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  rectagon_subset_endpoint;
  USE 1 SYM;
  TYPE_THEN `E` EXISTS_TAC;
  CONJ_TAC THEN IMATCH_MP_TAC  num_closure_pos;
  CONJ_TAC;
  USE 2 (REWRITE_RULE[segment_end;segment;psegment]);
  TYPE_THEN `C'` EXISTS_TAC;
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  FULL_REWRITE_TAC[rectagon];
  TYPE_THEN `C''` EXISTS_TAC;
  REWRITE_TAC[DIFF];
  USE 11 (REWRITE_RULE[SUBSET]);
  (* -- *)
  USE 10 (REWRITE_RULE[segment_end;psegment;segment]);
  FULL_REWRITE_TAC[inductive_set];
  UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`A' INTER C`]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET_INTER_ABSORPTION];
  (* -B *)
  TYPE_THEN `!A B. (A INTER B = EMPTY ) /\ (E = A UNION B) /\ (segment_end B m n) /\ (segment_end A m n) /\ (B SUBSET E) /\ (A SUBSET E) /\ ~(C INTER A = EMPTY) ==> (C = A)` SUBAGOAL_TAC;
  TYPE_THEN `A' SUBSET C` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[INTER_COMM];
  UND 10 THEN ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `B' INTER C = EMPTY` ASM_CASES_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  UND 5 THEN UND 18 THEN UND 17 THEN POP_ASSUM_LIST (fun t-> ALL_TAC);
  FULL_REWRITE_TAC[SUBSET;INTER;EQ_EMPTY;UNION];
  IMATCH_MP_TAC  EQ_EXT ;
  TSPEC `x` 0;
  TSPEC `x` 1;
  TSPEC `x` 2;
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `B' SUBSET C` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USE 1 SYM;
  TYPE_THEN `E = C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[subset_imp];
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  USE 5 (REWRITE_RULE[SUBSET;UNION]);
  TYPE_THEN `C` UNABBREV_TAC;
  USE 2 (REWRITE_RULE[segment_end;psegment]);
  UND 20 THEN ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~(C INTER A = EMPTY) \/ ~( C INTER B = EMPTY)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 11 (REWRITE_RULE[DE_MORGAN_THM]);
  TYPE_THEN `E` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
  USE 5 (REWRITE_RULE[SUBSET;UNION]);
  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  TSPEC `u` 1;
  TSPEC `u` 11;
  TSPEC `u` 12;
  ASM_MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  DISJ1_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `B` EXISTS_TAC;
  ASM_REWRITE_TAC[SUBSET;UNION];
  DISJ2_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `A` EXISTS_TAC;
  FULL_REWRITE_TAC[INTER_COMM;UNION_COMM];
  ASM_REWRITE_TAC[SUBSET;UNION];
  (* Mon Dec 27 20:34:44 EST 2004 *)

  ]);;
  (* }}} *)

let conn2_sequence_lemma5 = 
prove_by_refinement(
  `!C E . ~(E SUBSET C) /\ psegment E /\ rectagon C /\
    endpoint E SUBSET cls C  ==>
   (?E'. E' SUBSET E /\ psegment E' /\ (E' INTER C = EMPTY ) /\
     (cls E' INTER cls C = endpoint E'))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?e. E e /\ ~C e` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `J = segment_of (E DIFF C) e` ABBREV_TAC ;
  TYPE_THEN `X = { A | psegment A /\ A SUBSET E /\ (A INTER C = EMPTY) /\ (endpoint A SUBSET cls C)}` ABBREV_TAC ;
  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
  TYPE_THEN `X` UNABBREV_TAC;
  TYPE_THEN `J` EXISTS_TAC;
  TYPE_THEN `J SUBSET (E DIFF C)` SUBAGOAL_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  THM_INTRO_TAC[`(E DIFF C)`;`e`] segment_of_G;
  REWRITE_TAC[DIFF];
  CONJ_TAC;
  THM_INTRO_TAC[`E`;`E DIFF C`;`e`] segment_of_segment;
  FULL_REWRITE_TAC[psegment];
  REWRITE_TAC[DIFF;SUBSET];
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[psegment];
  DISCH_TAC;
  THM_INTRO_TAC[`segment_of (E DIFF C) e`;`E`] rectagon_subset;
  USE 2 (REWRITE_RULE[psegment]);
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `E DIFF C` EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  USE 2 (REWRITE_RULE[psegment]);
  ASM_MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  UND 7 THEN REWRITE_TAC[SUBSET;DIFF];
  CONJ_TAC;
  UND 7 THEN REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY] THEN MESON_TAC[];
  REWRITE_TAC[SUBSET];
  PROOF_BY_CONTR_TAC;
  (* --A *)
  THM_INTRO_TAC[`E DIFF C`;`e`] inductive_segment;
  REWRITE_TAC[DIFF];
  FULL_REWRITE_TAC[inductive_set];
  USE 8 (REWRITE_RULE[endpoint]);
  THM_INTRO_TAC[`J`;`pointI x`] num_closure1;
  TYPE_THEN `J` UNABBREV_TAC;
  IMATCH_MP_TAC  segment_of_finite;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  USE 2 (REWRITE_RULE[psegment;segment]);
  REWRITE_TAC[DIFF];
  REWR 13;
 USE 2 (REWRITE_RULE[psegment;segment]);
  TSPEC `x` 15;
  USE 15 (REWRITE_RULE[INSERT]);
  UND 15 THEN REP_CASES_TAC;
  THM_INTRO_TAC[`E`;`pointI x`] num_closure2;
  REWR 15;
  (* ---- *)
  TYPE_THEN `?a b. ~(a = b) /\ (!e. E e /\ closure top2 e (pointI x) <=> (e = a) \/ (e = b)) /\ (!e. J e /\ closure top2 e (pointI x) <=> (e = a))` SUBAGOAL_TAC;
  TYPE_THEN `(e' = a) \/ (e' = b)` SUBAGOAL_TAC;
  TSPEC `e'` 15;
  USE 15 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
  TSPEC `e'` 13;
  TYPE_THEN `J` UNABBREV_TAC;
  THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G;
  REWRITE_TAC[DIFF];
  USE 21 (REWRITE_RULE[SUBSET]);
  TSPEC `e'` 21;
  USE 13 (REWRITE_RULE[DIFF]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  TYPE_THEN `a` EXISTS_TAC ;
  TYPE_THEN `b` EXISTS_TAC;
  MESON_TAC[];
  TYPE_THEN `e'` UNABBREV_TAC;
  TYPE_THEN `b` EXISTS_TAC;
  TYPE_THEN `a` EXISTS_TAC;
  REWRITE_TAC [EQ_SYM_EQ ];
  MESON_TAC[];
  (* ---- *)
  USE 6 SYM;
  TYPE_THEN `segment_of (E DIFF C) e b'` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `a'` EXISTS_TAC;
  CONJ_TAC;
  TSPEC `a'` 21;
  TYPE_THEN `J` UNABBREV_TAC;
  CONJ_TAC;
  REWRITE_TAC[DIFF];
  CONJ_TAC;
  TSPEC `b'` 22;
  KILL 15;
  REWR 22;
  (* ------ *)
  USE 9 (REWRITE_RULE[cls]);
  LEFT 9 "e";
  TSPEC  `b'` 9;
  TSPEC `b'` 22;
  KILL 15;
  UND 22 THEN ASM_REWRITE_TAC[];
  UND 9 THEN ASM_REWRITE_TAC[];
  (* ----- *)
  REWRITE_TAC[adj];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `pointI x` EXISTS_TAC;
  KILL 15;
  COPY 22;
  TSPEC  `a'` 15;
  TSPEC `b'` 22;
  REWR 22;
  REWR 15;
  (* ---- *)
  TSPEC `b'` 21;
  TYPE_THEN `J` UNABBREV_TAC;
  TSPEC `b'` 22;
  KILL 15;
  REWR 6;
  KILL 13;
  UND 21 THEN ASM_REWRITE_TAC[];
  (* --- *)
  USE 0 (REWRITE_RULE[SUBSET]);
  TSPEC `x` 0;
  USE 0 (REWRITE_RULE[endpoint]);
  UND 9 THEN ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[`J`;`E`;`pointI x`] num_closure_mono;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G;
  REWRITE_TAC[DIFF];
  USE 19 (REWRITE_RULE[SUBSET]);
  TSPEC `x'` 19;
  USE 6 (REWRITE_RULE[DIFF]);
  UND 8 THEN UND 15 THEN UND 19 THEN ARITH_TAC;
  (* -B *)
  THM_INTRO_TAC[`X`] select_card_min;
  UND 8 THEN ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `z` EXISTS_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  IMATCH_MP_TAC  (TAUT `a /\ b==> b /\ a`);
  CONJ_TAC;
  REWRITE_TAC[SUBSET_INTER];
  IMATCH_MP_TAC  endpoint_cls;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  USE 2 (REWRITE_RULE[psegment;segment]);
  REWRITE_TAC[INTER;SUBSET];
  PROOF_BY_CONTR_TAC;
  (* - cut along x *)
  THM_INTRO_TAC[`z`] endpoint_size2;
  FULL_REWRITE_TAC[has_size2];
  TYPE_THEN `segment_end z a b` SUBAGOAL_TAC;
  REWRITE_TAC[segment_end];
  (* - *)
  THM_INTRO_TAC[`z`;`a`;`b`;`x`] cut_psegment;
  TYPE_THEN `endpoint z` UNABBREV_TAC;
  USE 15 (REWRITE_RULE[INR in_pair;DE_MORGAN_THM ]);
  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`A`]);
  CONJ_TAC;
  USE 20 (REWRITE_RULE[segment_end]);
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `z` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  REWRITE_TAC[EQ_EMPTY;INTER];
  USE 10 (REWRITE_RULE[INTER;EQ_EMPTY ]);
  TSPEC `x'` 10;
  UND 10 THEN ASM_REWRITE_TAC[];
  REWRITE_TAC[UNION];
  USE 20 (REWRITE_RULE[segment_end]);
  REWRITE_TAC[SUBSET;INR in_pair];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  USE 7 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[];
  USE 9 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
  UND 9 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  card_subset_lt;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION];
  CONJ_TAC;
  TYPE_THEN `B = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USE 24 (REWRITE_RULE[EMPTY_EXISTS]);
  USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPEC `u` 9;
  USE 9 (REWRITE_RULE[UNION]);
  UND 22 THEN ASM_REWRITE_TAC[INTER;EMPTY_EXISTS];
  ASM_MESON_TAC[];
  TYPE_THEN `B` UNABBREV_TAC;
  USE 19 (REWRITE_RULE[segment_end;psegment;segment]);
  (* - *)
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  USE 12 (REWRITE_RULE[psegment;segment;]);
  (* Mon Dec 27 23:01:48 EST 2004 *)


  ]);;
  (* }}} *)

let conn_splice = 
prove_by_refinement(
  `!E AE B a b a' b'. segment_end E a b /\ segment_end AE a' b' /\
      segment_end B a' b' /\ AE SUBSET E ==>
      (?B'. segment_end B' a b /\ B' SUBSET (E DIFF AE) UNION B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `J= (E DIFF AE) UNION B` ABBREV_TAC ;
  TYPE_THEN `B SUBSET J` SUBAGOAL_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  TYPE_THEN `cls B SUBSET cls J` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  TYPE_THEN `endpoint B SUBSET cls B` SUBAGOAL_TAC;
  IMATCH_MP_TAC  endpoint_cls;
  USE 1 (REWRITE_RULE[segment_end;segment;psegment]);
  (* - *)
  TYPE_THEN `cls B a' /\ cls B b'` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  USE 1 (REWRITE_RULE[segment_end]);
  CONJ_TAC  THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[INR in_pair ];
  TYPE_THEN `cls J a' /\ cls J b'` SUBAGOAL_TAC;
  USE 6 (REWRITE_RULE[SUBSET]);
  (* -// *)
  TYPE_THEN `conn J` SUBAGOAL_TAC ;
  TYPE_THEN `!x. cls J x ==> (x = a') \/ (?P. segment_end P x a' /\ P SUBSET J)` BACK_TAC;
  REWRITE_TAC[conn];
  TYPE_THEN `a'' = a'` ASM_CASES_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  TYPE_THEN `a''` UNABBREV_TAC;
  TSPEC `b''` 12;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `b''` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `P` EXISTS_TAC;
  (* --- *)
  TYPE_THEN `b'' = a'` ASM_CASES_TAC;
  TYPE_THEN `b''` UNABBREV_TAC;
  TSPEC `a''` 12;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `a''` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `P` EXISTS_TAC;
  (* --- *)
  COPY 12;
  TSPEC `a''` 18;
  REWR 15;
  TSPEC `b''` 12;
  REWR 12;
  THM_INTRO_TAC[`P`;`P'`;`a''`;`a'`;`b''`] segment_end_trans;
  ONCE_REWRITE_TAC[segment_end_symm];
  TYPE_THEN `U` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `P UNION P'` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  (* --A// *)
  TYPE_THEN `x = a'` ASM_CASES_TAC;
  TYPE_THEN `x = b'` ASM_CASES_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  ONCE_REWRITE_TAC [segment_end_symm];
  (* -- *)
  TYPE_THEN `?P. segment_end P x b' /\ P SUBSET J` ASM_CASES_TAC;
  THM_INTRO_TAC[`P`;`B`;`x`;`b'`;`a'`] segment_end_trans;
  ONCE_REWRITE_TAC[segment_end_symm];
  TYPE_THEN `U` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `P UNION B` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  (* -- *)
  TYPE_THEN `cls B x` ASM_CASES_TAC;
  THM_INTRO_TAC[`B`;`a'`;`b'`;`x`] cut_psegment;
  TYPE_THEN `A` EXISTS_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* --// *)
  TYPE_THEN `cls E x` SUBAGOAL_TAC;
  TYPE_THEN `(E DIFF AE) SUBSET E` SUBAGOAL_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  USE 17 (MATCH_MP cls_subset);
  USE 17 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `J` UNABBREV_TAC;
  FULL_REWRITE_TAC[cls_union];
  USE 12 (REWRITE_RULE[UNION]);
  REWR 4;
  (* -- *)
  TYPE_THEN `cls (E DIFF AE) x` SUBAGOAL_TAC ;
  TYPE_THEN `J` UNABBREV_TAC;
  USE 12 (REWRITE_RULE[cls_union]);
  USE 4 (REWRITE_RULE[UNION]);
  REWR 4;
  (* -- *)
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `S = {e | E e /\ ~AE e /\ (?x. closure top2 e (pointI x) /\ ~(?P. segment_end P x a' /\ P SUBSET J) /\ ~(?P. segment_end P x b' /\ P SUBSET J) ) }` ABBREV_TAC ;
  TYPE_THEN `inductive_set E S` SUBAGOAL_TAC;
  REWRITE_TAC[inductive_set];
  SUBCONJ_TAC;
  TYPE_THEN `S` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  SUBCONJ_TAC;
  USE 18 (REWRITE_RULE[cls]);
  UND 22 THEN REWRITE_TAC[EMPTY_EXISTS];
  TYPE_THEN `e` EXISTS_TAC;
  TYPE_THEN `S` UNABBREV_TAC;
  USE 23 (REWRITE_RULE[DIFF]);
  TYPE_THEN `x` EXISTS_TAC;
  (* --- *)
  TYPE_THEN `S` UNABBREV_TAC;
  CONJ_TAC;
  THM_INTRO_TAC[`E`;`AE`;`adjv C C'`] psegment_subset_endpoint;
  SUBCONJ_TAC;
  USE 3 (REWRITE_RULE[segment_end]);
  CONJ_TAC;
  IMATCH_MP_TAC  num_closure_pos;
  CONJ_TAC;
  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
  TYPE_THEN `C'` EXISTS_TAC;
  IMATCH_MP_TAC  adjv_adj2;
  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  USE 34 (REWRITE_RULE[SUBSET]);
  IMATCH_MP_TAC  num_closure_pos;
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  USE 3 (REWRITE_RULE[segment_end;psegment;segment]);
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC [DIFF];
  IMATCH_MP_TAC  adjv_adj;
  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  USE 34 (REWRITE_RULE[SUBSET]);
  USE 2 (REWRITE_RULE[segment_end]);
  TYPE_THEN `endpoint AE` UNABBREV_TAC;
  USE 30 (REWRITE_RULE[INR in_pair]);
  (* ----B *)
  TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC;
  TYPE_THEN `adjv C C'` UNABBREV_TAC;
  FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN (TYPE_THEN`x'` UNABBREV_TAC);
  UND 24 THEN REWRITE_TAC[];
  TYPE_THEN `B` EXISTS_TAC;
  ONCE_REWRITE_TAC [segment_end_symm];
  UND 20 THEN REWRITE_TAC[];
  TYPE_THEN `B` EXISTS_TAC;
  (* ----//B1 *)
  THM_INTRO_TAC[`C`;`C'`] adjv_adj;
  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  USE 35 (REWRITE_RULE[SUBSET]);
  (* ---- *)
  TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;INR IN_SING;DIFF;UNION];
  (* ---- *)
  TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  segment_end_sing;
  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  USE 37 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `b'` UNABBREV_TAC;
  UND 20 THEN REWRITE_TAC[];
  TYPE_THEN `{C}` EXISTS_TAC;
  TYPE_THEN `a'` UNABBREV_TAC;
  UND 24 THEN REWRITE_TAC[];
  TYPE_THEN `{C}` EXISTS_TAC;
  (* --- *)
  TYPE_THEN `adjv C C'` EXISTS_TAC;
  TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC;
   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  USE 32 (REWRITE_RULE[SUBSET]);
  CONJ_TAC;
  IMATCH_MP_TAC  adjv_adj2;
  (* --- *)
  TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC;
  TYPE_THEN `adjv C C'` UNABBREV_TAC;
  (* ---C//  *)
  TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  segment_end_sing;
  IMATCH_MP_TAC  adjv_adj;
  TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;DIFF;UNION;INR IN_SING ];
  (* --- *)
  TYPE_THEN `adjv C C' = a'` ASM_CASES_TAC;
  TYPE_THEN `adjv C C'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 24 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `{C}` EXISTS_TAC;
  TYPE_THEN `adjv C C' = b'` ASM_CASES_TAC;
  TYPE_THEN `adjv C C'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 20 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `{C}` EXISTS_TAC;
  (* --- repeat from here *)
  TYPE_THEN `x' = a'` ASM_CASES_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 20 THEN REWRITE_TAC[];
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `x' = b'` ASM_CASES_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UND 24 THEN REWRITE_TAC[];
  TYPE_THEN `B` EXISTS_TAC;
  ONCE_REWRITE_TAC[segment_end_symm];
  (* --- *)
  CONJ_TAC;
  UND 24 THEN REWRITE_TAC[];
  THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`a'`] segment_end_trans;
  TYPE_THEN `U` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `{C} UNION P` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  (* ---// *)
  UND 20 THEN REWRITE_TAC[];
  THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`b'`] segment_end_trans;
  TYPE_THEN `U` EXISTS_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `{C} UNION P` EXISTS_TAC;
  REWRITE_TAC[union_subset];
  (* -- *)
  TYPE_THEN `S = E` SUBAGOAL_TAC;
  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[inductive_set];
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `S` UNABBREV_TAC;
  USE 22 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TYPE_THEN `~(AE = EMPTY)` SUBAGOAL_TAC;
  USE 2 (REWRITE_RULE[segment_end;segment;psegment]);
  UND 27 THEN ASM_REWRITE_TAC[];
  USE 22 (REWRITE_RULE[EMPTY_EXISTS]);
  TSPEC `u` 20;
  UND 20 THEN ASM_REWRITE_TAC[];
  USE 0 (REWRITE_RULE[SUBSET]);
  (* -D//  *)
  FULL_REWRITE_TAC[conn];
  TYPE_THEN `~(a = b)` SUBAGOAL_TAC;
  USE 3 (MATCH_MP segment_end_disj);
 UND 3 THEN ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[TAUT `a /\ b <=> b /\ a`];
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  TYPE_THEN `!c. endpoint E c /\ cls AE c ==> endpoint AE c` SUBAGOAL_TAC;
  REWRITE_TAC[endpoint];
  THM_INTRO_TAC[`AE`;`E`;`pointI c`] num_closure_mono;
  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  USE 15 (REWRITE_RULE[endpoint]);
  REWR 16;
  USE 16 (MATCH_MP (ARITH_RULE `x <=| 1 ==> (x = 1) \/ (x = 0)`));
  FIRST_ASSUM DISJ_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  USE 14 (REWRITE_RULE[cls]);
  THM_INTRO_TAC[`AE`;`pointI c`] num_closure0;
  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
  REWR 20;
  TSPEC `e` 20;
  UND 19 THEN ASM_REWRITE_TAC[];
  (* -E *)
  TYPE_THEN `!c. endpoint E c ==> cls J c` SUBAGOAL_TAC;
  TYPE_THEN `J` UNABBREV_TAC;
  REWRITE_TAC[cls_union];
  REWRITE_TAC[UNION];
  TYPE_THEN `cls AE c` ASM_CASES_TAC;
  TSPEC `c` 14;
  TYPE_THEN `endpoint AE c` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `endpoint B c` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[segment_end];
  TYPE_THEN `{a',b'}` UNABBREV_TAC;
  THM_INTRO_TAC[`B`] endpoint_cls;
  USE 1 (REWRITE_RULE[segment_end;psegment;segment]);
  DISJ2_TAC;
  ASM_MESON_TAC[subset_imp];
  DISJ1_TAC;
  TYPE_THEN `E = (E DIFF AE) UNION AE` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  UND 0 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
  TYPE_THEN `cls E c` SUBAGOAL_TAC;
  THM_INTRO_TAC[`E`] endpoint_cls;
  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
  ASM_MESON_TAC[subset_imp];
  UND 16 THEN DISCH_THEN (fun t -> USE 17 (ONCE_REWRITE_RULE[t]));
  FULL_REWRITE_TAC[cls_union];
  USE 16 (REWRITE_RULE[UNION ]);
  REWR 16;
  (* - *)
  USE 3 (REWRITE_RULE[segment_end]);
  TYPE_THEN `endpoint E` UNABBREV_TAC;
  USE 15 (REWRITE_RULE[INR in_pair]);
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
  (* Tue Dec 28 12:02:34 EST 2004 *)

  ]);;
  (* }}} *)

let conn2_sequence = 
prove_by_refinement(
  `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
    (!i. (i <= N) ==> (G i SUBSET edge )) /\
    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
    (!i j. (i < j) /\ (j <=| N) /\ ~(SUC i = j) ==>
         (curve_cell (G i) INTER (curve_cell (G j)) = EMPTY)) /\
    (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) ==>
    (unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p)
   `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1;
  ARITH_TAC;
  THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma2;
  THM_INTRO_TAC[`G`;`N`] conn2_sequence_lemma3;
  THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma4;
  (* - *)
  TYPE_THEN `?ei. C ei /\ G i ei /\ (!k. i < k /\ k <=|j ==> ~G k ei)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`SUC i`;`j`]);
  TYPE_THEN `{x | i <=| x /\ x <=| j} = {i} UNION {x | SUC i <= x /\ x <= j}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UNDH 3810 THEN ARITH_TAC;
  REWRH 1849;
  USEH 4802 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]);
  USEH 5681 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]);
  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
  CONV_TAC (dropq_conv "u");
  NAME_CONFLICT_TAC;
  TSPECH `x` 7945;
  LEFTH 1695 "ei";
  TSPECH `x` 5608;
  LEFTH 1699 "u";
  USEH 7623 (CONV_RULE NAME_CONFLICT_CONV);
  REWRH 2787;
  TYPE_THEN `G i x` ASM_CASES_TAC;
  REWRH 2360;
  LEFTH 4513 "k" ;
  TYPE_THEN `k` EXISTS_TAC;
  UNDH 2414 THEN MESON_TAC[ARITH_RULE `a <| b ==> SUC a <=| b`];
  REWRH 7623;
  ASM_MESON_TAC[];
  UNDH 5817 THEN UNDH 3810 THEN ARITH_TAC;
  (* -A *)
  TYPE_THEN `?ej. C ej /\ G j ej /\ (!k. i <= k /\ k <| j ==> ~G k ej)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`i`;`j -1`]);
  TYPE_THEN `{x | i <=| x /\ x <=| j} = {j} UNION {x | i <= x /\ x <= j- 1}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UNDH 3810 THEN ARITH_TAC;
  REWRH 1849;
  USEH 6712 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]);
  USEH 7737 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]);
  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
  CONJ_TAC ;
  UNDH 3810 THEN ARITH_TAC;
  CONJ_TAC;
  UNDH 5153 THEN ARITH_TAC;
  CONV_TAC (dropq_conv "u");
  NAME_CONFLICT_TAC;
  TSPECH `x` 5663;
  LEFTH 6587 "ej";
  TSPECH `x` 613;
  LEFTH 8601 "u";
  USEH 2468 (CONV_RULE NAME_CONFLICT_CONV);
  REWRH 3770;
  TYPE_THEN `G j x` ASM_CASES_TAC;
  REWRH 7772;
  LEFTH 3203 "k" ;
  TYPE_THEN `k` EXISTS_TAC;
  UNDH 9304 THEN MESON_TAC[ARITH_RULE `a <| b ==> a <=| b - 1`];
  REWRH 2468;
  ASM_MESON_TAC[];
  UNDH 7805 THEN UNDH 3810 THEN ARITH_TAC;
  (* -B< *)
  TYPE_THEN `Ci = {e | C e /\ G i e /\ (!k. i <| k /\ k <=| j ==> ~G k e)}` ABBREV_TAC ;
  TYPE_THEN `Ci ei` SUBAGOAL_TAC;
  TYPE_THEN `Ci` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `CiS = segment_of Ci ei` ABBREV_TAC ;
  TYPE_THEN `segment CiS` SUBAGOAL_TAC;
  TYPE_THEN `CiS` UNABBREV_TAC;
  IMATCH_MP_TAC  segment_of_segment;
  TYPE_THEN `C` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  TYPE_THEN `Ci` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  (* - *)
  TYPE_THEN `~Ci ej` SUBAGOAL_TAC THENL [TYPE_THEN `Ci` UNABBREV_TAC;ALL_TAC];
  TSPECH `j` 9673;
  UNDH 375 THEN ASM_REWRITE_TAC[];
  UNDH 3810  THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `CiS SUBSET Ci` SUBAGOAL_TAC;
  TYPE_THEN `CiS` UNABBREV_TAC;
  IMATCH_MP_TAC  segment_of_G;
  (* - *)
  TYPE_THEN `psegment CiS` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`CiS`;`C`] rectagon_subset;
  USEH 5119 (REWRITE_RULE[psegment]);
  REWRH 2394;
  CONJ_TAC;
  IMATCH_MP_TAC  rectagon_segment;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Ci` EXISTS_TAC;
  TYPE_THEN `Ci` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 2712 (REWRITE_RULE[SUBSET]);
  UNDH 7665 THEN REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`CiS`] endpoint_size2;
  FULL_REWRITE_TAC[has_size2];
  USEH 1801 SYM;
  (* -C< *)
  TYPE_THEN `Ci SUBSET C` SUBAGOAL_TAC;
  TYPE_THEN `Ci` UNABBREV_TAC;
  REWRITE_TAC[SUBSET];
  TYPE_THEN `CiS SUBSET C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `Ci` EXISTS_TAC;
  (* - *)
  TYPE_THEN `!m. endpoint CiS m ==> cls (G (SUC i)) m` SUBAGOAL_TAC;
  THM_INTRO_TAC[`CiS`;`C`;`m`] endpoint_sub_rectagon;
  USEH 5941 (REWRITE_RULE[EXISTS_UNIQUE_ALT]);
  REWRITE_TAC[cls];
  TYPE_THEN `e` EXISTS_TAC;
  TSPECH `e` 8431;
  USEH 3634 (REWRITE_RULE[cls_edge]);
  (* -- *)
  KILLH 3313 THEN KILLH 5237 THEN KILLH 2072  THEN KILLH 4795 THEN KILLH 3667 THEN KILLH 8912;
  REWRH 142;
  TYPE_THEN `~Ci e` SUBAGOAL_TAC;
  KILLH 5989 THEN KILLH 9803 THEN KILLH 1909 THEN KILLH 8416 THEN KILLH 320 THEN KILLH 846;
  THM_INTRO_TAC[`Ci`;`ei`] inductive_segment;
  FULL_REWRITE_TAC[inductive_set];
  USEH 7070 (REWRITE_RULE[endpoint]);
  THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1;
  FULL_REWRITE_TAC[segment];
  REWRH 4780;
  UNDH 8549 THEN DISCH_THEN (THM_INTRO_TAC[`e'`;`e`]);
  REWRITE_TAC[adj;INTER;EMPTY_EXISTS];
  TSPECH `e'` 5120;
  REWRH 6063;
  CONJ_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  UNDH 9580 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `pointI m` EXISTS_TAC;
  TYPE_THEN `CiS` UNABBREV_TAC;
  UNDH 1420 THEN ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `UNIONS (IMAGE G {x | i <=| x /\ x <=| j}) e` SUBAGOAL_TAC;
  USEH 1849 (REWRITE_RULE[SUBSET]);
  USEH 9077 (REWRITE_RULE[UNIONS;IMAGE]);
  TYPE_THEN `u` UNABBREV_TAC;
  (* --// *)
  TYPE_THEN `!y. (SUC i < y) /\ (y <=| N) ==> ~(G y e)` SUBAGOAL_TAC;
  UNDH 4928 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`y`]);
  UNDH 8692 THEN ARITH_TAC;
  USEH 6879 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPECH `{(pointI m)}` 6278;
  TYPE_THEN `!r. (r <=| N) ==> (G r SUBSET UNIONS (IMAGE G {i | i <=| N}))` SUBAGOAL_TAC;
  REWRITE_TAC[UNIONS;IMAGE;SUBSET];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `r` EXISTS_TAC;
  (* --- *)
  TYPE_THEN `!r. (r <=| N) ==> (curve_cell (G r) {(pointI m)} <=> (?e. G r e /\ closure top2 e (pointI m)))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  curve_cell_point;
  USEH 2858 (REWRITE_RULE[conn2;]);
  IMATCH_MP_TAC  FINITE_SUBSET;
  UNIFY_EXISTS_TAC;
  (* --- *)
  TYPE_THEN `i <=| N` SUBAGOAL_TAC;
  UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
  UNDH 4794 THEN ASM_REWRITE_TAC[];
  CONJ_TAC;
  USEH 7070 (REWRITE_RULE[endpoint]);
  THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `C` EXISTS_TAC;
  FULL_REWRITE_TAC[rectagon];
  REWRH 4780;
  TYPE_THEN `e'` EXISTS_TAC;
  TSPECH `e'` 5120;
  REWRH 6063;
  TYPE_THEN `Ci` UNABBREV_TAC;
  USEH 2281 (REWRITE_RULE[SUBSET]);
  (* --- *)
  TYPE_THEN `e` EXISTS_TAC;
  (* --D< *)
  PROOF_BY_CONTR_TAC;
  USEH 1849 (REWRITE_RULE[UNIONS;IMAGE;SUBSET]);
  TSPECH `e` 5988;
  FULL_REWRITE_TAC[];
  TYPE_THEN `u'` UNABBREV_TAC;
  TYPE_THEN `x' = i` ASM_CASES_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `Ci` UNABBREV_TAC;
  UNDH 8814 THEN ASM_REWRITE_TAC[];
  TSPECH  `k` 8651;
  TYPE_THEN `k = SUC i` ASM_CASES_TAC;
  UNDH 9079 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `k` UNABBREV_TAC;
  UNDH 5461 THEN ASM_REWRITE_TAC[];
  UNDH 9872 THEN UNDH 5198 THEN  UNDH 2528 THEN UNDH 5153 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `x' = SUC i` ASM_CASES_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  UNDH 9079 THEN ASM_REWRITE_TAC[];
  TSPECH `x'` 8651;
  UNDH 7878 THEN ASM_REWRITE_TAC[];
  UNDH 9481 THEN UNDH 5258 THEN UNDH 5565 THEN UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC;
  (* - *)
  COPYH 9674;
  UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`b`]);
  USEH 8662 SYM;
  REWRITE_TAC[];
  UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`a`]);
  USEH 8662 SYM;
  REWRITE_TAC[];
  (* -E *)
  TYPE_THEN `X = { E | E SUBSET (C UNION (G (SUC i))) /\ ~(E ei) /\ ~(E ej) /\ segment_end E a b }` ABBREV_TAC ;
  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
  TYPE_THEN `X` UNABBREV_TAC;
  UNDH 8912 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
  UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
  THM_INTRO_TAC[`G (SUC i)`] conn2_imp_conn;
  FIRST_ASSUM IMATCH_MP_TAC ;
   UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
  FULL_REWRITE_TAC[conn];
  UNDH 6247 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
  TYPE_THEN  `S` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `G (SUC i)` EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION ];
  TSPECH `SUC i` 320;
  TSPECH `SUC i` 9803;
  UNDH 8789 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UNDH 3810 THEN ARITH_TAC;
  UNDH 5005 THEN DISCH_THEN (THM_INTRO_TAC[]);
  ARITH_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  USEH 1620 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM DISJ_CASES_TAC;
  UNDH 4837 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 683 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `f = (\ E . CARD (E DIFF C))` ABBREV_TAC ;
  THM_INTRO_TAC[`X`;`f`] select_image_num_min;
  UNDH 6007 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `E = z` ABBREV_TAC ;
  TYPE_THEN `z` UNABBREV_TAC;
  (* -F< *)
  TYPE_THEN `cls C a /\ cls C b` SUBAGOAL_TAC;
  TYPE_THEN `cls CiS SUBSET cls C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cls_subset;
  USEH 2127 (REWRITE_RULE[SUBSET]);
  THM_INTRO_TAC[`CiS`] endpoint_cls;
  USEH 214 (REWRITE_RULE[psegment;segment]);
  USEH 477 (REWRITE_RULE[SUBSET]);
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (TYPE_THEN `endpoint CiS` UNABBREV_TAC) THEN REWRITE_TAC[INR in_pair];
  (* -// *)
  THM_INTRO_TAC[`C`;`a`;`b`] cut_rectagon_cls;
  TYPE_THEN `segment_end CiS a b` SUBAGOAL_TAC;
  REWRITE_TAC[segment_end];
  TYPE_THEN `?CjS. (cls (CjS) INTER cls CiS = {a,b}) /\ (CiS INTER CjS = EMPTY) /\ (C = CiS UNION CjS) /\ segment_end CjS a b ` SUBAGOAL_TAC;
  THM_INTRO_TAC[`C`;`A`;`B`;`CiS`;`a`;`b`] cut_rectagon_unique;
  REWRITE_TAC[SUBSET;UNION];
  FIRST_ASSUM DISJ_CASES_TAC ;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[INTER_COMM];
  ASM_REWRITE_TAC[];
  TYPE_THEN `B` UNABBREV_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[INTER_COMM;UNION_COMM;];
  KILLH 7539 THEN KILLH 8335 THEN KILLH 2130 THEN KILLH 6524 THEN KILLH 3863;
  (* -G< *)
  TYPE_THEN `CjS ej` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 2238 (REWRITE_RULE[UNION ]);
  UNDH 3048 THEN UNDH 2712 THEN UNDH 7665 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC ));
  USEH 2712 (REWRITE_RULE[SUBSET]);
  ASM_MESON_TAC[];
  (* -// *)
  TYPE_THEN `CiS ei` SUBAGOAL_TAC;
  TYPE_THEN `CiS` UNABBREV_TAC;
  REWRITE_TAC[segment_of_in];
  TYPE_THEN `~CjS ei` SUBAGOAL_TAC;
  UNDH 947 THEN UNDH 1398  THEN UNDH 3558 THEN REWRITE_TAC[INTER;EQ_EMPTY] THEN MESON_TAC[];
  (* -// *)
  TYPE_THEN `~(E SUBSET C)` SUBAGOAL_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  THM_INTRO_TAC[`C`;`CiS`;`CjS`;`E`;`a`;`b`] cut_rectagon_unique;
  REWRITE_TAC[SUBSET;UNION];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  UNDH 5338 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `E` UNABBREV_TAC;
  UNDH 442 THEN ASM_REWRITE_TAC[];
  (* -H< *)
  THM_INTRO_TAC[`C`;`E`] conn2_sequence_lemma5;
  USEH 4704 SYM;
  CONJ_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  USEH 7614 (REWRITE_RULE[segment_end]);
  TYPE_THEN `X` UNABBREV_TAC;
  USEH 7614 (REWRITE_RULE[segment_end]);
  REWRITE_TAC[SUBSET;INR in_pair];
  FIRST_ASSUM (DISJ_CASES_TAC ) THEN (TYPE_THEN `x` UNABBREV_TAC);
  (* -// *)
  THM_INTRO_TAC[`E'`] endpoint_size2;
  FULL_REWRITE_TAC[has_size2];
  (* -// *)
  TYPE_THEN `?E''. E'' SUBSET C /\ ~E'' ei /\ ~E'' ej /\ segment_end E'' a' b'` ASM_CASES_TAC;
  UNDH 3844 THEN UNDH 6993 THEN UNDH 1260 THEN UNDH 6943 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5435 THEN UNDH 7079 THEN UNDH 2483 THEN UNDH 1489 THEN UNDH 9777 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
  (* -- *)
  TYPE_THEN `X` UNABBREV_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  (* --I< *)
  THM_INTRO_TAC[`E`;`E'`;`E''`;`a`;`b`;`a'`;`b'`] conn_splice;
  REWRITE_TAC[segment_end];
  TSPECH `B'` 8320;
  UNDH 8902 THEN  DISCH_THEN (THM_INTRO_TAC[]);
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `E UNION E''` EXISTS_TAC ;
  CONJ_TAC;
  UNDH 280 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
  REWRITE_TAC[union_subset];
  UNDH 6943 THEN REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `B' SUBSET E UNION E''` SUBAGOAL_TAC;
  UNDH 280 THEN REWRITE_TAC[DIFF;SUBSET;UNION] THEN MESON_TAC[];
  USEH 9489 (REWRITE_RULE[SUBSET;UNION]);
  CONJ_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `B' DIFF C SUBSET (E DIFF E') DIFF C` SUBAGOAL_TAC;
  UNDH 280 THEN UND 3 THEN REWRITE_TAC[SUBSET;DIFF;UNION;] THEN MESON_TAC[];
  USEH 8272 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
  UNDH 200 THEN ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  card_subset_lt;
  CONJ_TAC;
  UNDH 8308 THEN (REWRITE_TAC[DIFF;SUBSET]) THEN MESON_TAC[];
  CONJ_TAC;
  USEH 7143 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TYPE_THEN `~(E' = EMPTY)` SUBAGOAL_TAC ;
  USEH 4430 (REWRITE_RULE[psegment;segment]);
  UNDH 5706 THEN ASM_REWRITE_TAC[];
  USEH 5706 (REWRITE_RULE[EMPTY_EXISTS]);
  TSPECH `u` 5085;
  USEH 9707 (REWRITE_RULE[DIFF]);
  USEH 7802 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPECH `u` 6967;
  UNDH 366 THEN ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  REWRH 2690;
  USEH 8308 (REWRITE_RULE[SUBSET;DIFF;]);
  TSPECH `u` 5436;
  USEH 5435 (REWRITE_RULE[SUBSET]);
  TSPECH `u` 5036;
  ASM_MESON_TAC[];
  (* -- *)
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `E` EXISTS_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  USEH 7614 (REWRITE_RULE[segment_end;segment;psegment]);
  (* -J< // (57 HYP here ) *)
  (* KILLH 846  THEN KILLH 1909  THEN KILLH 5989; ?? *)
  KILLH 9203 THEN KILLH 4704 THEN KILLH 3558 THEN KILLH 3114 THEN KILLH 5443 THEN KILLH 7079 THEN KILLH 1489 THEN KILLH 6007 THEN KILLH 9461 THEN KILLH 4797 THEN KILLH 8662 THEN KILLH 214;
  KILLH 4596 THEN KILLH 947 THEN KILLH 5282;
  (* - *)
  TYPE_THEN `E' SUBSET C UNION (G (SUC i))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `E` EXISTS_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `E' SUBSET (G (SUC i))` SUBAGOAL_TAC;
  UNDH 7718 THEN UNDH 7802 THEN REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;UNION] THEN MESON_TAC[];
  KILLH 7718;
  KILLH 7292 THEN KILLH 4330 THEN KILLH 4248 THEN KILLH 2712 THEN KILLH 7665 THEN KILLH 5425 THEN KILLH 5357 THEN KILLH 1285;
  KILLH 145 THEN KILLH 7070 THEN KILLH 2483 THEN KILLH 9777;
  KILLH 7420;
  KILLH 5435;
  (* -K< *)
  TYPE_THEN `cls C a' /\ cls C b'` SUBAGOAL_TAC;
  TYPE_THEN ` endpoint E' SUBSET cls C` SUBAGOAL_TAC;
  USEH 2907 SYM;
 KILLH  8660;
  TYPE_THEN `endpoint E'` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;INTER];
  REWRH 5756;
  USEH 6207 (REWRITE_RULE[SUBSET;INR in_pair]);
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
  (* -// *)
  TYPE_THEN `?A B. segment_end A a' b' /\ segment_end B a' b' /\ (C = A UNION B) /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {a',b'}) /\ (A ei) /\ (B ej)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`C`;`a'`;`b'`] cut_rectagon_cls;
  TYPE_THEN `A ei` ASM_CASES_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  FULL_REWRITE_TAC[INTER_COMM];
  LEFTH 4284 "E''";
  TSPECH `B` 567;
  UNDH 469 THEN ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  UNDH 7424 THEN REP_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  UNDH 3642 THEN REWRITE_TAC[SUBSET;UNION];
  USEH 8335 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPECH `ei` 554;
  UNDH 8511 THEN ASM_REWRITE_TAC[];
  (* --// *)
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  FULL_REWRITE_TAC[INTER_COMM;UNION_COMM];
  CONJ_TAC;
  UNDH 4532 THEN (TYPE_THEN `C` UNABBREV_TAC) THEN ASM_REWRITE_TAC[UNION];
  LEFTH 4284 "E''";
  TSPECH `A` 567;
  PROOF_BY_CONTR_TAC;
  UNDH 937 THEN ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;UNION];
  (* -L< *)

  TYPE_THEN `~(G (SUC i) ei)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
  UNDH 3810 THEN ARITH_TAC;
  TYPE_THEN `~(G (SUC i) ej)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
  ARITH_TAC;
  (* -// *)
  TYPE_THEN `psegment_triple A B E'` SUBAGOAL_TAC;
  UNDH 830 THEN UNDH 8335 THEN UNDH 2130 THEN UNDH 4401 THEN UNDH 3688 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5107 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
  FULL_REWRITE_TAC[psegment_triple;segment_end];
  CONJ_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  TYPE_THEN `(A INTER E' = EMPTY) /\ (B INTER E' = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  UNDH 7714 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION] THEN MESON_TAC[];
  (* --// *)
  TYPE_THEN `(cls A INTER cls E' = {a',b'}) /\ (cls B INTER cls E' = {a',b'})` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 9349 (REWRITE_RULE[cls_union]);
  CONJ_TAC THEN (IMATCH_MP_TAC  SUBSET_ANTISYM);
  CONJ_TAC;
  TYPE_THEN `endpoint E'` UNABBREV_TAC;
  TYPE_THEN `{a',b'}` UNABBREV_TAC;
  REWRITE_TAC[INTER;SUBSET;UNION];
  REWRITE_TAC[SUBSET_INTER];
  CONJ_TAC;
  KILLH 2907;
  TYPE_THEN `{a',b'}` UNABBREV_TAC;
  REWRITE_TAC[INTER;SUBSET];
  TYPE_THEN `{a',b'}` UNABBREV_TAC;
  IMATCH_MP_TAC  endpoint_cls;
  FULL_REWRITE_TAC[psegment;segment];
  CONJ_TAC;
  TYPE_THEN `{a',b'}` UNABBREV_TAC;
  TYPE_THEN `endpoint E'` UNABBREV_TAC;
  REWRITE_TAC[INTER;SUBSET;UNION];
  REWRITE_TAC[SUBSET_INTER];
  CONJ_TAC;
  USEH 5640 SYM;
  IMATCH_MP_TAC  endpoint_cls;
  USEH 4134 (REWRITE_RULE[psegment;segment]);
  USEH 2907 SYM;
  IMATCH_MP_TAC  endpoint_cls;
  USEH 4430 (REWRITE_RULE[psegment;segment]);
  CONJ_TAC THEN IMATCH_MP_TAC  segment_end_union_rectagon;
  FULL_REWRITE_TAC[segment_end];
  MESON_TAC[];
  FULL_REWRITE_TAC[segment_end];
  MESON_TAC[];
  (* -M< // *)
  USEH 2518 (MATCH_MP psegment_triple3);
  COPYH 7680;
  USEH 7680 (MATCH_MP bounded_triple_inner_union);
  USEH 3265 (REWRITE_RULE [SUBSET]);
  (* TSPEC p deferred ///// *)
  (* -// *)
  TYPE_THEN `~(bounded_set (B UNION E') p)` SUBAGOAL_TAC;
  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`B UNION E'`;`i`;`j`]);
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC;
  UNDH 3810 THEN ARITH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `C UNION E'` EXISTS_TAC ;
  CONJ_TAC;
  REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  REWRITE_TAC[union_subset];
  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `SUC i` EXISTS_TAC;
  USEH 343 (REWRITE_RULE[SUBSET]);
  UNDH 3810 THEN ARITH_TAC;
  REWRH 9345;
  USEH 1598 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
  UNDH 5101 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  card_subset_lt;
  CONJ_TAC;
  UNDH 343 THEN  REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
  CONJ_TAC;
  USEH 7390 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPECH `ei` 9338;
  USEH 4016 (REWRITE_RULE[UNION;DIFF]);
  UNDH 1090 THEN ASM_REWRITE_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `ei` EXISTS_TAC;
  UNDH 4837 THEN ASM_REWRITE_TAC[];
  ASM_MESON_TAC[subset_imp];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `A UNION B` EXISTS_TAC;
  CONJ_TAC;
  USEH 2130 SYM;
  USEH 5107 (REWRITE_RULE[rectagon]);
  REWRITE_TAC[SUBSET;DIFF];
  (* -// *)
  TYPE_THEN `~(bounded_set (E' UNION A) p)` SUBAGOAL_TAC;
  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`E' UNION A`;`i`;`j`]);
  CONJ_TAC;
  FULL_REWRITE_TAC[psegment_triple];
  CONJ_TAC;
  UNDH 3810 THEN ARITH_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `E' UNION C` EXISTS_TAC ;
  CONJ_TAC;
  REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  REWRITE_TAC[union_subset];
  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `SUC i` EXISTS_TAC;
  USEH 343 (REWRITE_RULE[SUBSET]);
  UNDH 3810 THEN ARITH_TAC;
  REWRH 9505;
  USEH 4752 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
  UNDH 2448 THEN REWRITE_TAC[];
  IMATCH_MP_TAC  card_subset_lt;
  CONJ_TAC;
  UNDH 343 THEN  REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
  CONJ_TAC;
  USEH 758 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPECH `ej` 1425;
  USEH 5076 (REWRITE_RULE[UNION;DIFF]);
  UNDH 5580 THEN ASM_REWRITE_TAC[];
  USEH 3977 (MATCH_MP (TAUT `a \/ b ==> b\/ a`));
  FIRST_ASSUM DISJ_CASES_TAC;
  UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `ej` EXISTS_TAC;
  UNDH 683 THEN ASM_REWRITE_TAC[];
  ASM_MESON_TAC[subset_imp];
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `A UNION B` EXISTS_TAC;
  CONJ_TAC;
  USEH 2130 SYM;
  USEH 5107 (REWRITE_RULE[rectagon]);
  REWRITE_TAC[SUBSET;DIFF];
  (* -N< // *)
  KILLH 3313 THEN KILLH 4532 THEN KILLH 846 THEN KILLH 320 THEN KILLH 8416 THEN KILLH 1909 THEN KILLH 9803 THEN KILLH 5989 THEN KILLH 4430 THEN KILLH 7802 THEN KILLH 6174 THEN KILLH 2907;
  KILLH 683 THEN KILLH 4837 THEN KILLH 3627 THEN KILLH 2590 THEN KILLH 830 THEN KILLH 8335 THEN KILLH 4401 THEN KILLH 3688;
  POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t));
  (* - *)
  TYPE_THEN `bounded_set (B UNION E' UNION A) p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  bounded_avoidance_subset;
  TYPE_THEN `C` EXISTS_TAC;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]);
  CONJ_TAC;
  REWRITE_TAC[FINITE_UNION];
  USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]);
  CONJ_TAC;
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  IMATCH_MP_TAC  conn2_rectagon;
  (* --// *)
  UNDH 8721 THEN REWRITE_TAC[] THEN (IMATCH_MP_TAC  bounded_set_curve_cell_empty);
  TYPE_THEN `UNIONS (IMAGE G {i | i <=| N})` EXISTS_TAC;
  TYPE_THEN `B UNION E' UNION A = E' UNION C` SUBAGOAL_TAC;
  REWRITE_TAC[UNION_ACI ];
  REWRITE_TAC[union_subset];
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `(SUC i)` EXISTS_TAC;
  USEH 343 (REWRITE_RULE[SUBSET]);
  UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
  TYPE_THEN `A UNION B` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  IMATCH_MP_TAC  UNIONS_UNIONS;
  REWRITE_TAC[IMAGE;SUBSET];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC;
  TSPECH `p` 2110;
  USEH 1588 (ONCE_REWRITE_RULE[UNION]);
  USEH 6893 (REWRITE_RULE[]);
  ASM_MESON_TAC[];
  (* Tue Dec 28 15:56:13 EST 2004 *)
  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION AA *)
(* ------------------------------------------------------------------ *)


(* finish proof of the connectedness of the complement of an arc *)

let real_div_denom = 
prove_by_refinement(
  `!z x y . (&0 < z) ==> ((x/ z <= y/ z) <=> (x <= y))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
  ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
  REWRITE_TAC[GSYM real_div_assoc];
  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
  FULL_REWRITE_TAC[REAL_MUL_AC];
  IMATCH_MP_TAC  REAL_LE_RMUL_EQ;
  ]);;
  (* }}} *)

let real_div_denom_lt = 
prove_by_refinement(
  `!z x y . (&0 < z) ==> ((x/ z < y/ z) <=> (x < y))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
  ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
  REWRITE_TAC[GSYM real_div_assoc];
  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
  FULL_REWRITE_TAC[REAL_MUL_AC];
  IMATCH_MP_TAC  REAL_LT_RMUL_EQ;
  ]);;
  (* }}} *)

let simple_arc_constants = 
prove_by_refinement(
  `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\
                           euclid 2 p /\ euclid 2 q ==>
  (?d N B a d'. (&0 <. d) /\ (&0 <. d') /\ (0 < N) /\
    (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\
    (C = UNIONS (IMAGE B {i | i <| N})) /\
    (!x. C x ==>
        (&8 * d <= d_euclid x p) /\ (&8 * d <= d_euclid x q)) /\
    (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==>
        (&16 * d' < d_euclid x y)) /\
    (!i. (i <| N) ==>
        (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d))))
    `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`]simple_arc_compact;
  THM_INTRO_TAC[`2`] metric_euclid;
  THM_INTRO_TAC[`C`] simple_arc_nonempty;
  THM_INTRO_TAC[`top2`] compact_point;
  FULL_REWRITE_TAC[top2_unions];
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{p}`] compact_distance;
  FULL_REWRITE_TAC[top2];
  REWRITE_TAC[EMPTY_EXISTS];
  MESON_TAC[];
  FULL_REWRITE_TAC[INR IN_SING];
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{q}`] compact_distance;
  FULL_REWRITE_TAC[top2];
  REWRITE_TAC[EMPTY_EXISTS];
  MESON_TAC[];
  FULL_REWRITE_TAC[INR IN_SING];
  (* - *)
  TYPE_THEN `p''''` UNABBREV_TAC;
  TYPE_THEN `p''` UNABBREV_TAC;
  TYPE_THEN `d = (min_real (d_euclid p''' q) (d_euclid p' p))/(&8)` ABBREV_TAC ;
  TYPE_THEN `d` EXISTS_TAC;
  TYPE_THEN `&0 < d` SUBAGOAL_TAC;
  TYPE_THEN `d` UNABBREV_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  ASSUME_TAC (REAL_ARITH `&0 < &8`);
  REWRITE_TAC[min_real] ;
  THM_INTRO_TAC[`C`] simple_arc_euclid;
  COND_CASES_TAC;
  IMATCH_MP_TAC  d_euclid_pos2;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_MESON_TAC[subset_imp];
  IMATCH_MP_TAC  d_euclid_pos2;
  TYPE_THEN `2` EXISTS_TAC;
  ASM_MESON_TAC[subset_imp];
  (* -A// *)
  TYPE_THEN `(!x. C x ==> &8 * d <= d_euclid x p /\ &8 * d <= d_euclid x q)` SUBAGOAL_TAC;
  TYPE_THEN `&8 * d = min_real (d_euclid p''' q) (d_euclid p' p)` SUBAGOAL_TAC;
  TYPE_THEN `d` UNABBREV_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 10 THEN REAL_ARITH_TAC ;
  UNDH 6289 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`q`]);
  ASM_REWRITE_TAC[];
  UNDH 4386 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`p`]);
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`(d_euclid p''' q)`;`d_euclid p' p  `] min_real_le;
  UNDH 4228 THEN UNDH 5042 THEN UNDH 8570 THEN UNDH 8336 THEN REAL_ARITH_TAC;
  KILLH 8745 THEN KILLH 6021 THEN KILLH 6289 THEN KILLH 371;
  KILLH 4386 THEN KILLH 6186;
  (* -B// *)
  COPYH 3550;
  USEH 3550 (REWRITE_RULE[simple_arc]);
  FULL_REWRITE_TAC[top2_unions];
  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
  FULL_REWRITE_TAC[uniformly_continuous];
  TSPECH `d` 814;
  FULL_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `?N. &1/delta <= &N` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ARCH_SIMPLE];
  TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `&1/ &N <= delta` SUBAGOAL_TAC;
  UNDH 338 THEN   ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
  FULL_REWRITE_TAC[REAL_MUL_AC];
  TYPE_THEN `N' = 2*N` ABBREV_TAC ;
  TYPE_THEN `&0 < &N'` SUBAGOAL_TAC;
  TYPE_THEN `N'` UNABBREV_TAC;
  FULL_REWRITE_TAC[REAL_OF_NUM_LT];
  UNDH 7562 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `!r. (r <= &1/ (&N')) ==> (r < delta)` SUBAGOAL_TAC;
  TYPE_THEN `&1/ &N' < &1/ &N` SUBAGOAL_TAC;
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
  ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
  REWRITE_TAC[GSYM real_div_assoc];
  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
  TYPE_THEN `N'` UNABBREV_TAC;
  REDUCE_TAC;
  UNDH 5547 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC;
  UNDH 5945 THEN UNDH 3160 THEN UNDH 532 THEN REAL_ARITH_TAC;
  (* -C// *)
  KILLH 1557 THEN KILLH 5945 THEN KILLH 5547 THEN KILLH 338;
  TYPE_THEN `N'` EXISTS_TAC;
  TYPE_THEN `B = (\ i. IMAGE f {x | (&i / &N') <= x /\ (x <= &(SUC i)/(&N'))} )` ABBREV_TAC ;
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `a = (\ i. f(&i / &N'))` ABBREV_TAC  ;
  TYPE_THEN `a` EXISTS_TAC;
  (* - *)
  THM_INTRO_TAC[`&N'`] real_div_denom;
  REWRH 9377;
  (* - *)
  TYPE_THEN `!x. (&0 <= x/ &N') <=> (&0 <= x)` SUBAGOAL_TAC;
  UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`x`]);
  FULL_REWRITE_TAC[REAL_DIV_LZERO];
  (* - *)
  TYPE_THEN `!x. (x/ &N' <= &1) <=> (x <= &N')` SUBAGOAL_TAC;
  UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`&N'`]);
  THM_INTRO_TAC[`&N'`] REAL_DIV_REFL;
  TYPE_THEN `&N'` UNABBREV_TAC;
  UNDH 869 THEN REAL_ARITH_TAC;
  REWRH 4881;
  (* - *)
  TYPE_THEN `!i x. (i <| N') /\ (&i / &N' <= x) /\ (x <= &(SUC i) / &N') ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
  TYPE_THEN `&0 <= &i / &N' /\ &(SUC i) / (&N') <= &1` BACK_TAC;
  UNDH 601 THEN UNDH 1707 THEN UNDH 167 THEN UNDH 1199 THEN REAL_ARITH_TAC;
  REWRITE_TAC[REAL_OF_NUM_LE];
  UNDH 9580 THEN ARITH_TAC;
  (* -D// *)
  TYPE_THEN `(!i. i <| N' ==> (?x. B i x /\ B i SUBSET open_ball (euclid 2,d_euclid) x d))` SUBAGOAL_TAC;
  TYPE_THEN `a i` EXISTS_TAC;
  TYPE_THEN `a` UNABBREV_TAC;
  SUBCONJ_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[REAL_OF_NUM_LE ];
  ARITH_TAC;
  (* -- *)
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[open_ball;IMAGE;SUBSET;];
  TYPE_THEN `x` UNABBREV_TAC;
  USEH 3550 (MATCH_MP simple_arc_euclid);
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 3429 (REWRITE_RULE[SUBSET]);
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[REAL_OF_NUM_LE ];
  UNDH 9580 THEN ARITH_TAC;
  (* -- *)
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  image_imp;
  FIRST_ASSUM  IMATCH_MP_TAC ;
  TYPE_THEN  `i` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[REAL_OF_NUM_LE];
  CONJ_TAC;
  UNDH 9580 THEN ARITH_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  REWRITE_TAC[d_real];
  TYPE_THEN `x' <= &i/ &N' + &1/ &N'` SUBAGOAL_TAC;
  UNDH 3570 THEN REWRITE_TAC[REAL];
  REWRITE_TAC[real_div;GSYM REAL_ADD_RDISTRIB];
  REWRITE_TAC[GSYM real_div];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 4551 THEN UNDH 1464 THEN  REAL_ARITH_TAC;
  KILLH 8623 THEN KILLH 2193;
  KILLH 626 THEN KILLH 4538;
  (* -E// *)
  TYPE_THEN `!i. &i / &N' < &(SUC i)/ &N'` SUBAGOAL_TAC;
  ASM_SIMP_TAC[real_div_denom_lt];
  REWRITE_TAC[REAL_OF_NUM_LT];
  ARITH_TAC;
  (* - *)
  TYPE_THEN `(!i. i <| N' ==> simple_arc_end (B i) (a i) (a (SUC i)))` SUBAGOAL_TAC;
  TYPE_THEN `a` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[simple_arc_end];
  THM_INTRO_TAC[`f`;`&0`;`&1`;`&i/ &N'`;`&(SUC i)/ &N'`] arc_reparameter_gen;
  IMATCH_MP_TAC  inj_subset_domain;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `g` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -F// *)
  TYPE_THEN `(IMAGE f {x | &0 <= x /\ x <= &1} = UNIONS (IMAGE B {i | i <| N'}))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNIONS;IMAGE];
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  CONV_TAC (dropq_conv "u");
  NAME_CONFLICT_TAC;
  LEFT_TAC "x''";
  LEFT_TAC "x''";
  TYPE_THEN `x'` EXISTS_TAC;
  (* --- *)
  TYPE_THEN `x' = &1` ASM_CASES_TAC;
  TYPE_THEN `N' -| 1` EXISTS_TAC;
  FULL_REWRITE_TAC[REAL_LT;REAL_LE];
  TYPE_THEN `N' -| 1 <| N'` SUBAGOAL_TAC;
  UNDH 8859 THEN ARITH_TAC;
  CONJ_TAC;
  UNDH 9064 THEN ARITH_TAC;
  FULL_REWRITE_TAC[GSYM REAL_LT];
  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
  REDUCE_TAC;
  FULL_REWRITE_TAC[REAL_LT];
  UND 25 THEN ARITH_TAC;
  (* --- *)
  TYPE_THEN `num_abs_of_int (floor (&N' * x'))` EXISTS_TAC;
  TYPE_THEN `t = &N' * x'` ABBREV_TAC ;
  TYPE_THEN `x' = t/(&N')` SUBAGOAL_TAC;
  TYPE_THEN `t` UNABBREV_TAC;
  REWRITE_TAC[real_div_assoc];
  ONCE_REWRITE_TAC[EQ_SYM_EQ ];
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UNDH 3200 THEN UNDH 7688 THEN REAL_ARITH_TAC;
  TYPE_THEN `&0 <= t` SUBAGOAL_TAC;
  TYPE_THEN `t` UNABBREV_TAC;
  IMATCH_MP_TAC  REAL_LE_MUL;
  TYPE_THEN `&:0 <=: (floor t)` SUBAGOAL_TAC;
  REWRITE_TAC[int_of_num_th;GSYM floor_le];
  REWRITE_TAC[GSYM REAL_OF_NUM_LT];
  ASM_REWRITE_TAC[REAL;num_abs_of_int_th;GSYM int_abs_th;];
  TYPE_THEN `(||: (floor t) = (floor t))` SUBAGOAL_TAC;
  REWRITE_TAC[INT_ABS_REFL;];
  THM_INTRO_TAC[`t`] floor_ineq;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  TYPE_THEN `t < &N' * &1` SUBAGOAL_TAC;
  TYPE_THEN `t` UNABBREV_TAC;
  ASM_SIMP_TAC[REAL_LT_LMUL_EQ];
  UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
  CONJ_TAC;
  UNDH 5082 THEN REAL_ARITH_TAC;
  TYPE_THEN `real_of_int (floor (&N' )) = &N'` SUBAGOAL_TAC;
  REWRITE_TAC[floor_num;int_of_num_th;];
  UNDH 6307 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
  REWRITE_TAC[GSYM   int_lt ];
  IMATCH_MP_TAC  (INT_ARITH  `~(x = y) /\ (x <= y) ==> (x <: y)`);
  CONJ_TAC;
  FULL_REWRITE_TAC[floor_range];
  FULL_REWRITE_TAC[int_of_num_th;floor_num];
  UNDH 1048 THEN UNDH 6689 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  floor_mono;
  UNDH 1048 THEN REAL_ARITH_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `x''` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x'` EXISTS_TAC;
  (* -G// *)
  TYPE_THEN `!i. (i <| N') ==> compact top2 (B i)` SUBAGOAL_TAC;
  UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  USEH 9744 (MATCH_MP simple_arc_end_simple);
  USEH 3463 (MATCH_MP simple_arc_compact);
  (* - *)
  TYPE_THEN `!i. (i <| N') ==> ~(B i = EMPTY)` SUBAGOAL_TAC;
  UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  USEH 9744 (MATCH_MP simple_arc_end_simple);
  USEH 3463 (MATCH_MP simple_arc_nonempty);
  UNDH 8481 THEN ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!k. ?dij. !i j. (k = (i,j)) /\ SUC i < j /\ j < N' ==> (&0 < dij /\ (!x y. B i x /\ B j y ==> dij <= d_euclid x y))` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  CONV_TAC (dropq_conv "i");
  CONV_TAC (dropq_conv "j");
  TYPE_THEN `i = FST k` ABBREV_TAC ;
  TYPE_THEN `j = SND k` ABBREV_TAC ;
  RIGHT_TAC "y";
  RIGHT_TAC "x";
  RIGHT_TAC "dij";
  THM_INTRO_TAC[`(euclid 2)`;`d_euclid`;`(B i)`;`(B j)`] compact_distance;
  CONJ_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
  FULL_REWRITE_TAC[top2];
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
  TYPE_THEN `d_euclid p' p''` EXISTS_TAC;
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  d_euclid_pos2;
  TYPE_THEN `2` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `p''` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  USEH 7066 (REWRITE_RULE[IMAGE]);
  USEH 6258 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `p'` UNABBREV_TAC;
  TYPE_THEN `x = x'` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  UNIFY_EXISTS_TAC;
  UNIFY_EXISTS_TAC;
  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `&j/ &N' <= &(SUC i) / (&N')` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  REAL_LE_TRANS;ALL_TAC];
  UNIFY_EXISTS_TAC;
  UNDH 5902 THEN ASM_REWRITE_TAC[];
  UNDH 4223 THEN UNDH 3810 THEN REWRITE_TAC[REAL_LE] THEN ARITH_TAC;
  (* --- *)
  TYPE_THEN `(i <| N')` SUBAGOAL_TAC;
  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
  TYPE_THEN `!i x. (i <| N') /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC;
  TSPECH `i'` 8913;
  USEH 9316 (MATCH_MP simple_arc_end_simple);
  USEH 5604 (MATCH_MP simple_arc_euclid);
  ASM_MESON_TAC[subset_imp];
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  UNIFY_EXISTS_TAC;
  UNIFY_EXISTS_TAC;
  (* -- *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* -H// *)
  LEFTH 8852 "dij";
  TYPE_THEN `?d''. (&0 < d'') /\  (!i j. (SUC i < j /\ j <| N') ==> (d'' <= dij (i,j)))` SUBAGOAL_TAC;
  TYPE_THEN `X = { r  | (?i j. SUC i < j /\ j <| N' /\ (r = dij (i,j))) }` ABBREV_TAC ;
  TYPE_THEN `d'' = inf X` ABBREV_TAC ;
  TYPE_THEN `X = IMAGE dij {(i,j) | (SUC i < j /\ j < N')}` SUBAGOAL_TAC;
  TYPE_THEN `X` UNABBREV_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE;];
  NAME_CONFLICT_TAC;
  POP_ASSUM_LIST (fun t->ALL_TAC);
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  CONV_TAC (dropq_conv "x'");
  ASM_MESON_TAC[];
  TYPE_THEN `x'` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `FINITE X` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `A = {i | (i <| N')}` ABBREV_TAC ;
  TYPE_THEN `{(i,j) | A i /\ A j}` EXISTS_TAC;
  CONJ_TAC;
  THM_INTRO_TAC[`A`;`A`] FINITE_PRODUCT;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[FINITE_NUMSEG_LT];
  REWRITE_TAC[SUBSET;];
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN`i` EXISTS_TAC;
  TYPE_THEN `j` EXISTS_TAC;
  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
  (* --// *)
  TYPE_THEN `X = EMPTY` ASM_CASES_TAC;
  TYPE_THEN `&1` EXISTS_TAC;
  REWRH 9106;
  USEH 3802 SYM;
  USEH 7502 (REWRITE_RULE[image_empty]);
  USEH 1549 (REWRITE_RULE[EQ_EMPTY]);
  TSPECH  `(i,j)` 7313 ;
  LEFTH 4977 "i'";
  TSPECH `i` 9356;
  LEFTH 6976 "j'";
  TSPECH `j` 1468;
  UNDH 5891 THEN ASM_REWRITE_TAC[];
  (* --H2// *)
  THM_INTRO_TAC[`X`] finite_inf_min;
  THM_INTRO_TAC[`X`] finite_inf;
  TYPE_THEN `d''` EXISTS_TAC;
  USEH 9106 SYM;
  (* TYPE_THEN `d''` UNABBREV_TAC; *)
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `?i j. SUC i <| j /\ j <| N' /\ (d'' = dij (i,j))` SUBAGOAL_TAC;
  UNDH 7611 THEN ASM_REWRITE_TAC[] THEN UNDH 3235 THEN DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
  UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]);
  ASM_REWRITE_TAC[];
  REP_BASIC_TAC;
  UNDH 6732 THEN DISCH_THEN (THM_INTRO_TAC[`dij (i,j)`]);
  UNDH 3235 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
  ASM_MESON_TAC[];
  USEH 7679 SYM;
  ASM_REWRITE_TAC[];
  (* -I *)
  TYPE_THEN `d' = d''/ &32` ABBREV_TAC  ;
  TYPE_THEN `&0 < &32` SUBAGOAL_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `d'` EXISTS_TAC;
  SUBCONJ_TAC;
  TYPE_THEN `d'` UNABBREV_TAC;
  ASM_SIMP_TAC[REAL_LT_RDIV_0];
  SUBCONJ_TAC;
  FULL_REWRITE_TAC[REAL_LT];
  (* - *)
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `d''` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `d'` UNABBREV_TAC;
  REWRITE_TAC[GSYM real_div_assoc];
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
  REWRITE_TAC[REAL_MUL_AC];
  IMATCH_MP_TAC  REAL_LT_LMUL;
  REAL_ARITH_TAC;
  (* -/// *)
  UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `dij (i,j)` EXISTS_TAC;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  (* Wed Dec 29 17:40:18 EST 2004 *)

  ]);;
  (* }}} *)

let euclid_scale_rinv = 
prove_by_refinement(
  `!x r. (&0 < r) ==> ((r * &1/ r) *# x = x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
  ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
  ]);;
  (* }}} *)

let euclid_scale_bij = 
prove_by_refinement(
  `!r . (&0 < r) ==> BIJ (euclid_scale r) (euclid 2) (euclid 2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[BIJ;INJ;];
  TYPE_THEN `!x. (r * &1 / r) *# x = x` SUBAGOAL_TAC;
  USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
  ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
  SUBCONJ_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  euclid_scale_closure;
  TYPE_THEN `euclid_scale (&1/ r)` (fun t -> USEH 9290 (AP_TERM t));
  FULL_REWRITE_TAC[euclid_scale_act];
  USEH 7114 (ONCE_REWRITE_RULE[REAL_ARITH `x * y = y *x`]);
  REWRH 5498;
  REWRITE_TAC[SURJ];
  REP_BASIC_TAC;
  TYPE_THEN`(&1/ r) *# x` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  euclid_scale_closure;
  REWRITE_TAC[euclid_scale_act];
  ]);;
  (* }}} *)

let euclid_scale_cont = 
prove_by_refinement(
  `!r. (&0 < r) ==> (continuous (euclid_scale r) top2 top2)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`( *# ) r`] metric_continuous_continuous_top2;
  REWRITE_TAC[IMAGE;SUBSET];
  IMATCH_MP_TAC euclid_scale_closure;
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  TYPE_THEN `epsilon/r` EXISTS_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  THM_INTRO_TAC[`2`;`r`;`x`;`y`] norm_scale_vec;
  TYPE_THEN `abs  r = r` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_REFL];
  UNDH 6412 THEN REAL_ARITH_TAC;
  UNDH 3108 THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
  FULL_REWRITE_TAC[REAL_MUL_AC];
  ]);;
  (* }}} *)

let euclid_scale_inv = 
prove_by_refinement(
  `!r x. (&0 < r) /\ (euclid 2 x) ==>
     (INV (( *# ) r) (euclid 2) (euclid 2) x = (( *# ) (&1 / r)) x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`( *# ) r`;`(euclid 2)`;`(euclid 2)`;`&1 / r *# x`;`x`] INVERSE_XY;
  ASM_SIMP_TAC[euclid_scale_bij];
  IMATCH_MP_TAC  euclid_scale_closure;
  USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
  REWRITE_TAC[euclid_scale_act];
  ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
  ]);;
  (* }}} *)

let euclid_scale_homeo = 
prove_by_refinement(
  `!r. (&0 < r) ==> homeomorphism (euclid_scale r) top2 top2`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  bicont_homeomorphism;
  REWRITE_TAC[top2_unions];
  ASM_SIMP_TAC [euclid_scale_bij];
  ASM_SIMP_TAC[euclid_scale_cont];
  IMATCH_MP_TAC  cont_domain;
  TYPE_THEN `( *# ) (&1 / r)` EXISTS_TAC;
  TYPE_THEN `&0 < &1 /r` SUBAGOAL_TAC;
  ASM_SIMP_TAC[euclid_scale_cont];
  FULL_REWRITE_TAC[top2_unions];
  ASM_SIMP_TAC[euclid_scale_inv];
  (* Wed Dec 29 18:45:44 EST 2004 *)
  ]);;
  (* }}} *)

let simple_arc_end_homeo = 
prove_by_refinement(
  `!f C a b. simple_arc_end C a b /\ homeomorphism f top2 top2 ==>
  simple_arc_end (IMAGE f C) (f a) (f b)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc_end_cont];
  TYPE_THEN `f o f'` EXISTS_TAC;
  REWRITE_TAC[IMAGE_o];
  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  metric_subspace;
  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
  REWRITE_TAC[metric_real];
  (* - *)
  TYPE_THEN `UNIONS (top_of_metric (({x | &0 <= x /\ x <= &1},d_real))) = {x | &0 <= x /\ x <= &1}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  (GSYM top_of_metric_unions);
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  continuous_comp;
  TYPE_THEN `top2` EXISTS_TAC;
  REWRITE_TAC[top2_unions];
  FULL_REWRITE_TAC[homeomorphism];
  (* -- *)
  IMATCH_MP_TAC  inj_image_subset;
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[comp_comp];
  IMATCH_MP_TAC  COMP_INJ;
  TYPE_THEN `(euclid 2)` EXISTS_TAC;
  FULL_REWRITE_TAC[homeomorphism];
  FULL_REWRITE_TAC[top2_unions;BIJ];
  REWRITE_TAC[o_DEF];
  ]);;
  (* }}} *)

let simple_arc_homeo = 
prove_by_refinement(
  `!f C. simple_arc top2 C /\ homeomorphism f top2 top2 ==>
   simple_arc top2 (IMAGE f C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]);
  TYPE_THEN `simple_arc_end C (f' (&0)) (f' (&1))` SUBAGOAL_TAC;
  REWRITE_TAC[simple_arc_end];
  TYPE_THEN `f'` EXISTS_TAC;
  FULL_REWRITE_TAC[top2_unions];
  THM_INTRO_TAC[`f`;`C`;`f' (&0)`;`f' (&1)`] simple_arc_end_homeo;
  USEH 6603 (MATCH_MP simple_arc_end_simple);
  TYPE_THEN `C` UNABBREV_TAC;
  ]);;
  (* }}} *)

let euclid_scale_simple_arc_ver2 = 
prove_by_refinement(
  `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ (euclid 2 p) /\
    (euclid 2 q) /\ ~(p = q) /\
    (!A. simple_arc_end A p q ==> ~(C INTER A = EMPTY)) ==>
    (?C' p' q' d N B a d'.
           simple_arc top2 C' /\ ~C' p' /\ ~C' q' /\ (euclid 2 p') /\
        (euclid 2 q') /\ ~(p' = q') /\
      (!A. simple_arc_end A p' q' ==> ~(C' INTER A = EMPTY)) /\
      (&1 <=. d) /\ (&1 <=. d') /\ (0 < N) /\
    (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\
    (C' = UNIONS (IMAGE B {i | i <| N})) /\
    (!x. C' x ==>
        (&8 * d <= d_euclid x p') /\ (&8 * d <= d_euclid x q')) /\
    (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==>
        (&16 * d' < d_euclid x y)) /\
    (!i. (i <| N) ==>
        (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d))))
    `,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`;`p`;`q`] simple_arc_constants;
  TYPE_THEN `r = min_real d d'` ABBREV_TAC ;
  TYPE_THEN `f = ( *# ) (&1 /r)` ABBREV_TAC ;
  TYPE_THEN `C' = IMAGE f C` ABBREV_TAC ;
  TYPE_THEN `B' = (IMAGE f) o B` ABBREV_TAC ;
  TYPE_THEN `p' = f p` ABBREV_TAC ;
  TYPE_THEN `q' = f q` ABBREV_TAC ;
  TYPE_THEN `dr = d/r` ABBREV_TAC ;
  TYPE_THEN `dr' = d'/r` ABBREV_TAC ;
  TYPE_THEN `a' = f o a` ABBREV_TAC ;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `p'` EXISTS_TAC;
  TYPE_THEN `q'` EXISTS_TAC;
  TYPE_THEN `dr` EXISTS_TAC;
  TYPE_THEN `N` EXISTS_TAC;
  TYPE_THEN `B'` EXISTS_TAC;
  TYPE_THEN `a'` EXISTS_TAC;
  TYPE_THEN `dr'` EXISTS_TAC;
  (* -A *)
  TYPE_THEN `&0 < r` SUBAGOAL_TAC;
  TYPE_THEN `r` UNABBREV_TAC;
  REWRITE_TAC[min_real];
  COND_CASES_TAC;
  TYPE_THEN `&0 < &1/ r` SUBAGOAL_TAC;
  (* - *)
  TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  IMATCH_MP_TAC  euclid_scale_homeo;
  USEH 5104 SYM;
  SUBCONJ_TAC;
  TYPE_THEN `C'` UNABBREV_TAC;
  IMATCH_MP_TAC  simple_arc_homeo;
  (* - *)
  TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC;
  USEH 3550 (MATCH_MP simple_arc_euclid);
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `C'` UNABBREV_TAC;
  TYPE_THEN `p'` UNABBREV_TAC;
  UNDH 9726 THEN ASM_REWRITE_TAC[];
  USEH 7428 (REWRITE_RULE[IMAGE]);
  FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
  TYPE_THEN `(x = p)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[top2_unions];
  TYPE_THEN `p` UNABBREV_TAC;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `C'` UNABBREV_TAC;
  TYPE_THEN `q'` UNABBREV_TAC;
  UNDH 6497 THEN ASM_REWRITE_TAC[];
  USEH 4199 (REWRITE_RULE[IMAGE]);
  FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
  TYPE_THEN `(q = x)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[top2_unions];
  TYPE_THEN `q` UNABBREV_TAC;
  (* -B *)
  TYPE_THEN `euclid 2 p' /\ euclid 2 q'` SUBAGOAL_TAC;
  TYPE_THEN `p'` UNABBREV_TAC;
  TYPE_THEN `q'` UNABBREV_TAC;
  FULL_REWRITE_TAC[homeomorphism;BIJ;SURJ;top2_unions];
  (* -// *)
  CONJ_TAC;
  TYPE_THEN `p'` UNABBREV_TAC;
  TYPE_THEN `q'` UNABBREV_TAC;
  FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
  UNDH 11 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[top2_unions];
  (* - *)
  CONJ_TAC;
  TYPE_THEN `g = ( *# ) r` ABBREV_TAC ;
  TYPE_THEN `A' = IMAGE g A` ABBREV_TAC ;
  TYPE_THEN`homeomorphism g top2 top2` SUBAGOAL_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  ASM_SIMP_TAC[euclid_scale_homeo];
  TSPECH `A'` 8219;
  TYPE_THEN `!x.  (g (f x) = x)` SUBAGOAL_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  REWRITE_TAC[euclid_scale_act];
  ASM_SIMP_TAC [euclid_scale_rinv];
  (* -- *)
  UNDH 5082 THEN DISCH_THEN (THM_INTRO_TAC[]);
  TYPE_THEN `A'` UNABBREV_TAC;
  TYPE_THEN `(p = g p') /\ (q = g q')` SUBAGOAL_TAC;
  TYPE_THEN `p'` UNABBREV_TAC;
  TYPE_THEN `q'` UNABBREV_TAC;
  IMATCH_MP_TAC  simple_arc_end_homeo;
  USEH 7123  (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  USEH 8329  (REWRITE_RULE[EQ_EMPTY;INTER]);
  TSPECH `f u` 5681;
  UNDH 1812 THEN REWRITE_TAC[];
  TYPE_THEN `C'` UNABBREV_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  TYPE_THEN `A'` UNABBREV_TAC;
  USEH 1648 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `f` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  REWRITE_TAC[euclid_scale_act];
  ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`];
  ASM_SIMP_TAC[euclid_scale_rinv];
  (* -C *)
  CONJ_TAC;
  TYPE_THEN `dr` UNABBREV_TAC;
  TYPE_THEN `r` UNABBREV_TAC;
  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
  REDUCE_TAC;
  REWRITE_TAC[min_real_le];
  CONJ_TAC;
  TYPE_THEN `dr'` UNABBREV_TAC;
  TYPE_THEN `r` UNABBREV_TAC;
  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
  REDUCE_TAC;
  REWRITE_TAC[min_real_le];
  (* - *)
  CONJ_TAC;
  TYPE_THEN `B'` UNABBREV_TAC;
  TYPE_THEN `a'` UNABBREV_TAC;
  REWRITE_TAC[o_DEF];
  IMATCH_MP_TAC  simple_arc_end_homeo;
  (* - *)
  CONJ_TAC;
  TYPE_THEN `C'` UNABBREV_TAC;
  TYPE_THEN `B'` UNABBREV_TAC;
  REWRITE_TAC[IMAGE_o];
  REWRITE_TAC[GSYM image_unions];
  (* - *)
  TYPE_THEN `!x y. (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid (f x) (f y) = (d_euclid x y)/r)` SUBAGOAL_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  THM_INTRO_TAC[`2`;`&1 / r`;`x`;`y`] norm_scale_vec;
  TYPE_THEN `abs  (&1/r) = &1/r` SUBAGOAL_TAC;
  REWRITE_TAC[ABS_REFL];
  UNDH 4597 THEN REAL_ARITH_TAC;
  ONCE_REWRITE_TAC[REAL_ARITH `x * y = y* x`];
  REWRITE_TAC[GSYM real_div_assoc];
  REDUCE_TAC;
  (* -D *)
  CONJ_TAC;
  TYPE_THEN `C'` UNABBREV_TAC;
  USEH 3184 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `p'` UNABBREV_TAC;
  TYPE_THEN `q'` UNABBREV_TAC;
  ASM_SIMP_TAC[];
  TYPE_THEN `dr` UNABBREV_TAC;
  REWRITE_TAC[GSYM real_div_assoc];
  ASM_SIMP_TAC[real_div_denom];
  (* - *)
  TYPE_THEN `!i x. (i <| N) /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC;
  UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  USEH 9744 (MATCH_MP simple_arc_end_simple);
  USEH 3463 (MATCH_MP simple_arc_euclid);
  USEH 4246 (REWRITE_RULE[SUBSET]);
  (* - *)
  CONJ_TAC;
  TYPE_THEN `B'` UNABBREV_TAC;
  FULL_REWRITE_TAC[o_DEF];
  USEH 407 (REWRITE_RULE[IMAGE]);
  USEH 3121 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `i <| N` SUBAGOAL_TAC;
  UNDH 3810 THEN UNDH 1688 THEN ARITH_TAC;
  UNDH 2436 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x'`]);
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_MESON_TAC[];
  TYPE_THEN `dr'` UNABBREV_TAC;
  REWRITE_TAC[GSYM real_div_assoc];
  ASM_SIMP_TAC[real_div_denom_lt];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  (* -E *)
  TSPECH `i` 4673;
  REWRITE_TAC[];
  TYPE_THEN `f x` EXISTS_TAC;
  TYPE_THEN `B'` UNABBREV_TAC;
  REWRITE_TAC[o_DEF];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  FULL_REWRITE_TAC[SUBSET;open_ball];
  USEH 4418 (REWRITE_RULE[IMAGE]);
  TSPECH `x''` 7148;
  (* - *)
  CONJ_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  IMATCH_MP_TAC  euclid_scale_closure;
  CONJ_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  IMATCH_MP_TAC  euclid_scale_closure;
  ASM_SIMP_TAC[];
  TYPE_THEN `dr` UNABBREV_TAC;
  ASM_SIMP_TAC[real_div_denom_lt];
  (* Thu Dec 30 10:14:03 EST 2004 *)

  ]);;
  (* }}} *)

let delta_pos_arch = 
prove_by_refinement(
  `!d. (&0 < d) ==> (?n. (0 <| n) /\ (&1/(&n) < d))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`&1/d`] REAL_ARCH_SIMPLE;
  TYPE_THEN `2 * n` EXISTS_TAC;
  SUBCONJ_TAC;
  REWRITE_TAC[LT_MULT];
  CONJ_TAC;
  ARITH_TAC;
  REWRITE_TAC[GSYM REAL_LT];
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `&1 / d` EXISTS_TAC;
  (* - *)
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN `&1/ &n` EXISTS_TAC;
  (* - *)
  TYPE_THEN `&0 < &(2 *| n)` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_LT];
  TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[REAL_LT];
  FULL_REWRITE_TAC[LT_MULT];
  CONJ_TAC;
  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
  ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`];
  REWRITE_TAC[GSYM real_div_assoc];
  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
  REDUCE_TAC;
  FULL_REWRITE_TAC[REAL_LT];
  UNDH 3476 THEN ARITH_TAC;
  UNDH 27 THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
  FULL_REWRITE_TAC[REAL_MUL_AC];
  ]);;
  (* }}} *)

let suc_div = 
prove_by_refinement(
  `!i a. &(SUC i) / a = &i/ a + &1/a`,

  (* {{{ proof *)
  [
  REWRITE_TAC[REAL];
  REWRITE_TAC[real_div];
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let delta_partition_lemma_ver2 = 
prove_by_refinement(
  `!delta. (&0 < delta) ==> (?M. !N. !x. ?i.  (0 < M) /\
      ((M <= N) /\ (&0 <= x /\ x <= &1) ==>
      (i <= N) /\ abs  (&i/ &N - x) < delta))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE;
  TYPE_THEN `n` EXISTS_TAC;
  TYPE_THEN `num_abs_of_int (floor (&N*x))` EXISTS_TAC;
  TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC;
  TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
  UND 1 THEN UND 2 THEN REAL_ARITH_TAC;
  TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC;
  ASM_MESON_TAC[REAL_LE_LDIV_EQ];
  CONJ_TAC;
  FULL_REWRITE_TAC[REAL_LT];
  TYPE_THEN `&:0 <= floor (&N * x)` SUBAGOAL_TAC;
  TYPE_THEN `floor (&0) <=: floor (&N * x)` BACK_TAC;
  FULL_REWRITE_TAC[floor_num];
  IMATCH_MP_TAC  floor_mono;
  IMATCH_MP_TAC  REAL_LE_MUL;
  (* - *)
  CONJ_TAC;
  TYPE_THEN `num_abs_of_int (floor (&N * x)) <= num_abs_of_int (floor (&N))` BACK_TAC;
  FULL_REWRITE_TAC[floor_num;num_abs_of_int_num];
  IMATCH_MP_TAC  num_abs_of_int_mono;
  IMATCH_MP_TAC  floor_mono;
  TYPE_THEN `&N * x <= &N * &1` BACK_TAC;
  UND 9 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
  (* -A *)
  IMATCH_MP_TAC  REAL_LT_LCANCEL_IMP;
  TYPE_THEN `&N` EXISTS_TAC;
  (* - *)
  TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[REAL_LT];
  UNDH 3476 THEN UNDH 9390 THEN ARITH_TAC;
  IMATCH_MP_TAC  REAL_LTE_TRANS;
  TYPE_THEN`&1` EXISTS_TAC;
  (* - *)
  REWRITE_TAC[num_abs_of_int_th;];
  TYPE_THEN `abs  (real_of_int (floor (&N * x))) = (real_of_int (floor (&N *x)))` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_REFL];
  FULL_REWRITE_TAC [int_le; int_of_num_th;];
  TYPE_THEN `!u. &N * abs  (u / &N - x) = abs  (u - &N*x)` SUBAGOAL_TAC;
  TYPE_THEN `!t. &N * abs  t = abs  (&N *t)` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM];
  AP_TERM_TAC;
  REWRITE_TAC[REAL_SUB_LDISTRIB];
  TYPE_THEN `&N * u/ &N = u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_DIV_LMUL;
  UND 12 THEN UND 9 THEN REAL_ARITH_TAC;
  TYPE_THEN `t = &N * x ` ABBREV_TAC ;
  TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC;
  REWRITE_TAC[floor_ineq];
  TYPE_THEN `abs  (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC;
  UND 13 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`t`] floor_ineq;
  CONJ_TAC;
  UND 15 THEN REAL_ARITH_TAC;
  (* - *)
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `&n * delta` EXISTS_TAC;
  ASM_SIMP_TAC[REAL_LE_RMUL_EQ];
  FULL_REWRITE_TAC[REAL_LE];
  ]);;
  (* }}} *)

let simple_arc_ball_cover_ver2  = 
prove_by_refinement(
  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
    (?M. !N. !x. ?i. (0 < M) /\ (( M <= N) /\ (&0 <= x /\ x <= &1) ==>
        (i <= N) /\
           open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
  FULL_REWRITE_TAC[uniformly_continuous];
  TSPECH `&1` 814;
  UNDH 4636 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWRITE_TAC[open_ball];
  THM_INTRO_TAC[`delta`] delta_partition_lemma_ver2;
  TYPE_THEN `M` EXISTS_TAC;
  TSPECH `N` 6807;
  TSPECH `x` 8373;
  TYPE_THEN `i` EXISTS_TAC;
  REP_BASIC_TAC;
  UNDH 5594 THEN DISCH_THEN (THM_INTRO_TAC[]);
  (* - *)
  TYPE_THEN `0 <| N` SUBAGOAL_TAC;
  UNDH 6734 THEN UNDH 4600 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_DIV;
  THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ;
  REWRITE_TAC[REAL_LT];
  REWRITE_TAC[REAL_MUL;REAL_LE];
  UNDH 8395 THEN ARITH_TAC;
  (* - *)
  FULL_REWRITE_TAC[INJ];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[d_real];
  ]);;
  (* }}} *)

let grid_image_bounded_ver2 = 
prove_by_refinement(
  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
   (?M. !N. (0 < M) /\ ((M <= N) ==>
    ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER
         (unbounded_set (grid f N)) =  EMPTY))  )`,

  (* {{{ proof *)

  [
  REWRITE_TAC[EQ_EMPTY;INTER;];
  THM_INTRO_TAC[`f`] simple_arc_ball_cover_ver2;
  TYPE_THEN `M` EXISTS_TAC;
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  TSPECH `N` 8189;
  RIGHTH 2874 "i";
  RIGHTH 3911 "x";
  TYPE_THEN `x''` UNABBREV_TAC;
  TYPE_THEN `0 <| N` SUBAGOAL_TAC;
  UNDH 4600 THEN UNDH 6734 THEN ARITH_TAC;
  FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ];
  UNDH 5619 THEN REWRITE_TAC[]; (* ~bounded *)
  UNDH 1431 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  REWRH 3036;
  FULL_REWRITE_TAC[open_ball];
  (* _ *)
  IMATCH_MP_TAC  bounded_avoidance_subset;
  TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ;
  TYPE_THEN `E` EXISTS_TAC;
  (* _ *)
  TYPE_THEN `conn2 E` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[grid33_conn2];
  REWRITE_TAC[grid_edge;grid_finite];
  TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC;
  REWRITE_TAC[grid];
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  UNDH 8395 THEN ARITH_TAC; (* i <=| N *)
  (* -- *)
  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION];
  REWRITE_TAC[SUBSET;UNION];
  DISJ1_TAC;
  REWRITE_TAC[image_sing];
  (* - *)
  TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC;
  UNDH 4893 THEN REWRITE_TAC[];
  THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset;
  USEH 2367 (MATCH_MP UNIONS_UNIONS); (* CURVE_CELL SUBSET curve-cell *)
  ASM_MESON_TAC[subset_imp];
  KILLH 3474; (* E SUBSET grid f N *)
  KILLH 4893; (* ~UNIONS (. grid f N) *)
  (* -A// *)
  TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ;
  THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq;
  FULL_REWRITE_TAC [];
  REWRH 2390;
  TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[grid33];
  IMATCH_MP_TAC  rectangle_grid_subset;
  (* __ *)
  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor;
  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor;
  UNDH 7979 THEN UNDH 4359 THEN INT_ARITH_TAC;
  (* -// *)
  IMATCH_MP_TAC  bounded_avoidance_subset;
  TYPE_THEN `E'` EXISTS_TAC;
  TYPE_THEN `conn2 E'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  conn2_rectagon;
  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[conn2];
  (* -// *)
  TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[grid33_edge];
  (* -// *)
  ASM_SIMP_TAC[GSYM odd_bounded];
  REWRITE_TAC[UNIONS];
  TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC;
  IMATCH_MP_TAC  (TAUT ` a/\ b ==> b /\ a`);
  (* -B// *)
  TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC;
  UNDH 1109 THEN REWRITE_TAC[]; (* ~  E *)
  THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset;
  USEH 2664 (MATCH_MP UNIONS_UNIONS);  (* curve-cell SUBSET *)
  ASM_MESON_TAC[subset_imp];
  (* -// *)
  TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ;
  TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC;
  UNDH 8466 THEN REWRITE_TAC[]; (* ~ *)
  REWRITE_TAC[UNIONS];
  TYPE_THEN `h_edge m` EXISTS_TAC;
  REWRITE_TAC[curve_cell_h_ver2];
  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); (* floor,floor = m *)
  REWRH 1242; (* rg flor,flor *)
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[INSERT];
  (* -// *)
  TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC;
  UNDH 8466 THEN REWRITE_TAC[]; (* ~UNIONS .. E' *)
  REWRITE_TAC[UNIONS];
  TYPE_THEN `v_edge m` EXISTS_TAC;
  REWRITE_TAC[curve_cell_v_ver2];
  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
  REWRH 1242;
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[INSERT];
  (* -// *)
  TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC;
  UNDH 8466 THEN REWRITE_TAC[];
  REWRITE_TAC[UNIONS];
  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
  ASM_SIMP_TAC[rectagon_segment;curve_cell_cls];
  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
  REWRH 1242;
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;INSERT];
  USEH 9677 (MATCH_MP cls_subset); (* { hedge } SUBSET E' *)
  USEH 1949 (REWRITE_RULE[SUBSET]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[cls_h];
  (* -C// *)
  USEH 2851 (MATCH_MP point_onto); (* euclid 2 (f x') *)
  THM_INTRO_TAC[`p`] square_domain;
  UNDH 4082 THEN LET_TAC;
  TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  REWRH 2288; (* big ONE *)
  TYPE_THEN `point p` UNABBREV_TAC;
  USEH 459 (REWRITE_RULE[UNION;INR IN_SING;]); (* long *)
  REWRH 4739; (* \/ *)
  (* -D// *)
  ASM_SIMP_TAC[rectagon_segment;par_cell_squ];
  FULL_REWRITE_TAC[num_lower];
  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
  REWRH 1242;  (* rect-grid *)
  FULL_REWRITE_TAC[rectangle_grid_sq];
  TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[INSERT;cell_clauses];
  REWRH 5179; (* EVEN *)
  (* - *)
  TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[up;PAIR_SPLIT];
  INT_ARITH_TAC;
  REWRH 3452; (* EVEN *)
  FULL_REWRITE_TAC[card_sing;EVEN2];
  ]);;

  (* }}} *)

let grid33_h = 
prove_by_refinement(
  `!m. grid33 m (h_edge m)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[grid33];
  REWRITE_TAC[rectangle_grid];
  DISJ1_TAC;
  TYPE_THEN `m` EXISTS_TAC;
  INT_ARITH_TAC;
  ]);;
  (* }}} *)

let curve_cell_grid_unions = 
prove_by_refinement(
  `!f N. curve_cell (grid f N) =
       UNIONS (IMAGE curve_cell
       ((IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1)))
         {j | j <=| N})))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  REWRITE_TAC[grid];
  TYPE_THEN `S = (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1)))  {j | j <=| N})` ABBREV_TAC ;
  IMATCH_MP_TAC  thread_finite_union;
  REWRITE_TAC[curve_cell_union;curve_cell_empty];
  TYPE_THEN `S` UNABBREV_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  REWRITE_TAC[FINITE_NUMSEG_LE];
  ]);;
  (* }}} *)

let curve_cell_finite_union = 
prove_by_refinement(
  `!E. FINITE E ==>
     ( curve_cell (UNIONS E) = UNIONS (IMAGE curve_cell E))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  thread_finite_union;
  REWRITE_TAC[curve_cell_empty;curve_cell_union];
  ]);;
  (* }}} *)

let grid33_unions = 
prove_by_refinement(
  `!p.  grid33 p =
    (IMAGE h_edge
       { m | (FST p -: &:1 <=: FST m) /\ FST m <=: FST p +: &:1 /\
              SND p -: &:1 <=: SND m /\ (SND m <=: SND p +: &:2) })
   UNION
    (IMAGE v_edge
       { m | FST p -: &:1 <=: FST m /\ FST m <= FST p +: &:2 /\
             SND p -: &:1 <=: SND m /\ SND m <= SND p +: &:1}) `,

  (* {{{ proof *)

  [
  REWRITE_TAC[grid33;IMAGE;rectangle_grid];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION];
  IMATCH_MP_TAC  EQ_ANTISYM ;
  CONJ_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses];
  CONV_TAC (dropq_conv "x");
  TYPE_THEN `m'` UNABBREV_TAC;
  UNDH 3867 THEN INT_ARITH_TAC;
  (* -- *)
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses];
  CONV_TAC (dropq_conv "x");
  TYPE_THEN `m'` UNABBREV_TAC;
  UNDH 2244 THEN INT_ARITH_TAC;
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses];
  CONV_TAC (dropq_conv "m");
  TYPE_THEN `x'` UNABBREV_TAC;
  UNDH 6786 THEN INT_ARITH_TAC;
  (* - *)
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[cell_clauses];
  CONV_TAC (dropq_conv "m");
  TYPE_THEN `x'` UNABBREV_TAC;
  UNDH 2096 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let int_range_finite = 
prove_by_refinement(
  `!a b. FINITE {t | a <=: t /\ t <=: b}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `b <: a` ASM_CASES_TAC;
  TYPE_THEN `{ t | a <=: t /\ t <=: b} = EMPTY ` BACK_TAC;
  REWRITE_TAC[FINITE_RULES];
  IMATCH_MP_TAC  EQ_EXT;
  UNDH 5826 THEN INT_ARITH_TAC;
  (* - *)
  THM_INTRO_TAC[`a`] INT_REP;
  THM_INTRO_TAC[`b`] INT_REP;
  TYPE_THEN `a` UNABBREV_TAC;
  TYPE_THEN `b` UNABBREV_TAC;
  (* - *)
  THM_INTRO_TAC[`{ i | i <=| (n' + m) - (n + m') }`;`{t | (&:n -: &:m)  <=: t /\ t <=: &:n' -: &:m'}`;`(\ i. (&:i) + &:n -: &:m)`] SURJ_FINITE;
  REWRITE_TAC[FINITE_NUMSEG_LE];
  REWRITE_TAC[SURJ];
  CONJ_TAC;
  TYPE_THEN `(n +| m') <= (n' + m)` SUBAGOAL_TAC;
  REWRITE_TAC[GSYM INT_OF_NUM_LE];
  REWRITE_TAC[GSYM INT_OF_NUM_ADD];
  UNDH 6818 THEN INT_ARITH_TAC;
  USEH 2499 (MATCH_MP INT_OF_NUM_SUB);
  USEH 6968 SYM;
  FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE];
  REWRH 3919;
  FULL_REWRITE_TAC[INT_OF_NUM_ADD];
  CONJ_TAC;
  TYPE_THEN `&:0 <=: &:x` SUBAGOAL_TAC;
  REWRITE_TAC[INT_OF_NUM_LE];
  ARITH_TAC;
  UNDH 163 THEN ARITH_TAC;
  UNDH 1710 THEN ARITH_TAC;
  (* -A *)
  THM_INTRO_TAC[`x`] INT_REP;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `(n'' + m) -| (m'' + n)` EXISTS_TAC;
  TYPE_THEN `&:n'' + &:m' <=: &:n' + &:m''` SUBAGOAL_TAC;
  UNDH 4837 THEN INT_ARITH_TAC;
  KILLH 4837;
  TYPE_THEN `&:m'' + &:n <=: &:n'' + &:m` SUBAGOAL_TAC;
  UNDH 9532 THEN INT_ARITH_TAC;
  KILLH 9532;
  KILLH 6818;
  (* - *)
  CONJ_TAC;
  FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE];
  UNDH 8565 THEN UNDH 9575 THEN ARITH_TAC;
  (* - *)
  FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE];
  ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB];
  FULL_REWRITE_TAC[GSYM INT_OF_NUM_ADD];
  FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE;GSYM INT_OF_NUM_ADD ];
  UNDH 4630 THEN UNDH 1357 THEN INT_ARITH_TAC;
  ]);;
  (* }}} *)

let subs_lemma = 
prove_by_refinement(
  `!y (f:A->bool). (f y) ==> (!x. (x = y) ==> f x)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  ]);;
  (* }}} *)

(*** JRH changed the labels here because somehow
     some beta-redexes get contracted that did not before,
     (new IN_ELIM_THM?) and this changes the set comprehensions

let int2_range_finite = prove_by_refinement(
  `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\
                          c <=: SND m /\ SND m <=: d}`,
  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT;
  REWRITE_TAC[int_range_finite];
  USEH 3506 (MATCH_MP subs_lemma);
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  EQ_EXT;
  KILLH 8899;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "t'");
  CONV_TAC (dropq_conv "u'");
  REWRITE_TAC[PAIR_SPLIT];
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

 ****)

let int2_range_finite = 
prove_by_refinement(
  `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\
                          c <=: SND m /\ SND m <=: d}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT;
  REWRITE_TAC[int_range_finite];
  USEH 4853 (MATCH_MP subs_lemma);
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  EQ_EXT;
  KILLH 4636;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  NAME_CONFLICT_TAC;
  CONV_TAC (dropq_conv "t'");
  CONV_TAC (dropq_conv "u'");
  REWRITE_TAC[PAIR_SPLIT];
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)


let grid33_finite = 
prove_by_refinement(
  `!p. FINITE (grid33 p)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[grid33_unions];
  REWRITE_TAC[FINITE_UNION];
  CONJ_TAC THEN (IMATCH_MP_TAC  FINITE_IMAGE) THEN (REWRITE_TAC[int2_range_finite]);
  ]);;
  (* }}} *)

let d_euclid_bound2 = 
prove_by_refinement(
  `!x y eps. euclid 2 x /\ euclid 2 y /\ (abs  (x 0 - y 0) <= eps) /\
    (abs  (x 1 - y 1) <= eps) ==> (d_euclid x y <= sqrt(&2) * eps)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  D_EUCLID_BOUND;
  REP_BASIC_TAC;
  TYPE_THEN `(i=0) \/ (i = 1) \/ (2 <= i)` SUBAGOAL_TAC;
  ARITH_TAC;
  UNDH 2744 THEN REP_CASES_TAC;
  TYPE_THEN `i` UNABBREV_TAC;
  TYPE_THEN `i` UNABBREV_TAC;
  FULL_REWRITE_TAC[euclid];
  UND 0 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let grid33_radius = 
prove_by_refinement(
  `!x y. (euclid 2 x) /\
  (UNIONS (curve_cell (grid33 (floor (x 0),floor (x 1)))) y) ==>
        (d_euclid x y < &4 )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `m = (floor (x 0),floor (x 1))` ABBREV_TAC  ;
  THM_INTRO_TAC[`grid33 m`] (GSYM curve_closure_ver2);
  REWRITE_TAC[grid33_edge;grid33_finite];
  REWRH 2056;
  KILLH 7690;
  TYPE_THEN `(UNIONS (grid33 m)) SUBSET  closed_ball (euclid 2,d_euclid) x (&3) ` BACK_TAC;
  THM_INTRO_TAC[`top2`;`UNIONS(grid33 m)`;`closed_ball (euclid 2,d_euclid) x (&3)`;] closure_subset;
  REWRITE_TAC [top2_top;];
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`&3 `]closed_ball_closed;
  FULL_REWRITE_TAC[GSYM top2];
  KILLH 1468;
  FULL_REWRITE_TAC[SUBSET;closed_ball];
  TSPECH `y` 8043;
  FULL_REWRITE_TAC[];
  UNDH 9621 THEN REAL_ARITH_TAC;
  (* -A *)
  KILLH 920;
  FULL_REWRITE_TAC [grid33_unions];
  REWRITE_TAC[UNIONS_UNION;union_subset];
  (* - *)
  TYPE_THEN `sqrt (&2) * (&2) <= (&3)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_POW_2_LE;
  REWRITE_TAC[REAL_POW_MUL];
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_MUL;
  IMATCH_MP_TAC  SQRT_POS_LE;
  TYPE_THEN `sqrt(&2) pow 2 = &2` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SQRT_POW_2;
  REWRITE_TAC[REAL_POW_2];
  REAL_ARITH_TAC;
  (* - *)
  CONJ_TAC;
  FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball];
  TYPE_THEN `u` UNABBREV_TAC;
  SUBCONJ_TAC;
  ASM_MESON_TAC[h_edge_euclid;subset_imp];
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC;
  IMATCH_MP_TAC d_euclid_bound2;
  FULL_REWRITE_TAC[h_edge];
  REWRITE_TAC[coord01];
  TYPE_THEN `v` UNABBREV_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  THM_INTRO_TAC[`x 0`] floor_ineq;
  THM_INTRO_TAC[`x 1`] floor_ineq;
  FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le];
  POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC;
  (* - *)
  FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball];
  TYPE_THEN `u` UNABBREV_TAC;
  SUBCONJ_TAC;
  ASM_MESON_TAC[v_edge_euclid;subset_imp];
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC;
  IMATCH_MP_TAC d_euclid_bound2;
  FULL_REWRITE_TAC[v_edge];
  REWRITE_TAC[coord01];
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `m` UNABBREV_TAC;
  THM_INTRO_TAC[`x 0`] floor_ineq;
  THM_INTRO_TAC[`x 1`] floor_ineq;
  FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le];
  POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC;
  (* Thu Dec 30 21:22:53 EST 2004 *)

  ]);;
  (* }}} *)

let simple_arc_grid_properties = 
prove_by_refinement(
  `!C a b. simple_arc_end C a b ==> (?E.
      E SUBSET edge /\
      (C INTER (unbounded_set E) = EMPTY) /\
      conn2 E /\
      E (h_edge (floor (a 0),floor (a 1))) /\
      E (h_edge (floor (b 0),floor (b 1))) /\
     (!y. UNIONS (curve_cell E) y ==> (?x. C x /\ d_euclid x y < &4)))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  COPYH 2895;
  USEH 2895 (REWRITE_RULE [simple_arc_end]);
  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
  FULL_REWRITE_TAC[uniformly_continuous];
  (* - *)
  TYPE_THEN `!N' x. (&0 < &N') ==> ((&0 <= x/ &N') <=> (&0 <= x))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`&N'`;`&0`;`x`] real_div_denom;
  FULL_REWRITE_TAC[REAL_DIV_LZERO];
  (* - *)
  TYPE_THEN `!N' x. (&0 < &N') ==> ((x/ &N' <= &1) <=> (x <= &N'))` SUBAGOAL_TAC;
  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
  REDUCE_TAC;
  (* - *)
  TYPE_THEN `?N. (!i N'. (N <= N') /\ (i <| N') ==> d_euclid (f (&i / &N')) (f (&(SUC i) / &N')) < &1)` SUBAGOAL_TAC;
  TSPECH `&1` 814;
  FULL_REWRITE_TAC[REAL_ARITH `&0 < &1`];
  THM_INTRO_TAC[`delta`] delta_pos_arch;
  TYPE_THEN `n` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FULL_REWRITE_TAC[GSYM REAL_LT];
  FULL_REWRITE_TAC[REAL_LE;REAL_LT;d_real];
  (* -- *)
  TYPE_THEN `0 <| N'` SUBAGOAL_TAC;
  UNDH 800 THEN UNDH 3476 THEN ARITH_TAC;
  (* -- *)
  FULL_REWRITE_TAC[REAL_LE;REAL_LT;];
  CONJ_TAC;
  UNDH 9580 THEN ARITH_TAC;
  CONJ_TAC;
  UNDH 9580 THEN ARITH_TAC;
  REWRITE_TAC[suc_div];
  REWRITE_TAC[REAL_ARITH `abs  (x - (x + y)) = abs  y`];
  REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
  IMATCH_MP_TAC  REAL_LET_TRANS;
  TYPE_THEN `&1/ &n`EXISTS_TAC;
  FULL_REWRITE_TAC[GSYM REAL_LT];
  ASM_SIMP_TAC[RAT_LEMMA4];
  REDUCE_TAC;
  (* -A *)
  THM_INTRO_TAC[`f`] grid_image_bounded_ver2;
  TYPE_THEN `n = N +| M` ABBREV_TAC  ;
  TYPE_THEN`E = grid f n` ABBREV_TAC ;
  TYPE_THEN `E` EXISTS_TAC;
  TYPE_THEN `0 <| n /\ M <= n /\ N <= n` SUBAGOAL_TAC;
  RIGHTH 8917 "N";
  UNDH 8208 THEN UNDH 4600 THEN ARITH_TAC;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC [  grid_edge];
  (* - *)
  SUBCONJ_TAC;
  TSPECH `n` 8917;
  TYPE_THEN `E` UNABBREV_TAC;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  IMATCH_MP_TAC  grid_conn2;
  CONJ_TAC;
  IMATCH_MP_TAC  inj_image_subset;
  (* -- *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* -B *)
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[grid];
  TYPE_THEN `a` UNABBREV_TAC;
  REWRITE_TAC[IMAGE;UNIONS];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `0` EXISTS_TAC;
  CONJ_TAC;
  UNDH 3476 THEN ARITH_TAC;
  REWRITE_TAC[REAL_DIV_LZERO;grid33_h];
  (* - *)
  CONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[grid];
  TYPE_THEN `b` UNABBREV_TAC;
  REWRITE_TAC[IMAGE;UNIONS];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `n` EXISTS_TAC;
  CONJ_TAC;
  ARITH_TAC;
  USEH 3476 (REWRITE_RULE [GSYM REAL_LT]);
  USEH 1089 (MATCH_MP (REAL_ARITH `&0 < y ==> ~(y = &0)`));
  ASM_SIMP_TAC[REAL_DIV_REFL];
  REWRITE_TAC[grid33_h];
  (* -C *)
  TYPE_THEN `E` UNABBREV_TAC;
  USEH 2127 (REWRITE_RULE[curve_cell_grid_unions]);
  USEH 957 (REWRITE_RULE[IMAGE;UNIONS]);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  TYPE_THEN `f ( &x' / &n )` EXISTS_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC image_imp ;
  FULL_REWRITE_TAC[GSYM REAL_LT];
  FULL_REWRITE_TAC[REAL_LE;REAL_LT ];
  ARITH_TAC;
  (* - *)
  IMATCH_MP_TAC  grid33_radius;
  CONJ_TAC;
  USEH 2083 (REWRITE_RULE[IMAGE]);
  USEH 7215 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  (* - *)
  REWRITE_TAC[UNIONS];
  UNIFY_EXISTS_TAC;
  (* Thu Dec 30 21:27:32 EST 2004 *)
  ]);;

  (* }}} *)

let unbounded_set_lemma = 
prove_by_refinement(
  `!E p. (FINITE E /\ E SUBSET edge) ==>
     (unbounded_set E p <=> (?r. !s. (r <= s) ==>
          (?C. simple_arc_end C p (point(s,&0)) /\
              (C INTER UNIONS (curve_cell E) = EMPTY))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  THM_INTRO_TAC[`E`;`p`] unbounded_euclid;
  USEH 7802 (MATCH_MP point_onto);
  TYPE_THEN `p` UNABBREV_TAC;
  (* -- *)
  FULL_REWRITE_TAC[unbounded_set;unbounded];
  TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ;
  TYPE_THEN `r'` EXISTS_TAC;
  THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc;
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
  TYPE_THEN `s` UNABBREV_TAC;
  TYPE_THEN `r'` UNABBREV_TAC;
  UNDH 5363 THEN UNDH 4629 THEN REAL_ARITH_TAC;
  USEH 3140 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
    THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
  UNDH 1263 THEN UNDH 5669 THEN UNDH 6232 THEN REAL_ARITH_TAC;
  (* - *)
  REWRITE_TAC[unbounded_set;unbounded];
  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
  TSPECH `r` 3171;
  FULL_REWRITE_TAC[REAL_ARITH `r <= r`];
  COPYH 3604;
  USEH 3604 (MATCH_MP simple_arc_end_end);
  USEH 3604 (MATCH_MP simple_arc_end_simple);
  USEH 3550 (MATCH_MP simple_arc_euclid);
  ASM_MESON_TAC[subset_imp];
  USEH 7802 (MATCH_MP point_onto);
  TYPE_THEN `p` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ;
  TYPE_THEN `r'` EXISTS_TAC;
  THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc;
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
  UNDH 5363 THEN UNDH 6232 THEN UNDH 5669 THEN UNDH 9420 THEN REAL_ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `r'` UNABBREV_TAC;
  THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
  UNDH 1263 THEN UNDH 540 THEN REAL_ARITH_TAC;
  (* Fri Dec 31 07:35:03 EST 2004 *)

  ]);;
  (* }}} *)

let simple_arc_end_subset_trans_lemma = 
prove_by_refinement(
  `!C a b c. simple_arc_end C a b /\ C c /\ ~(c = a) ==>
    (?C'. C' SUBSET C /\ simple_arc_end C' a c)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `b = c` ASM_CASES_TAC;
  TYPE_THEN `b` UNABBREV_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  REWRITE_TAC[SUBSET_REFL];
  THM_INTRO_TAC[`C`;`a`;`b`;`c`] simple_arc_end_cut;
  TYPE_THEN `C'` EXISTS_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION];
  ]);;
  (* }}} *)

let simple_arc_end_subset_trans = 
prove_by_refinement(
  `!C C' a b c. simple_arc_end C a b /\ simple_arc_end C' b c /\
    ~(a = c) ==>
    (?U. simple_arc_end U a c /\ U SUBSET (C UNION C'))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `C' a` ASM_CASES_TAC;
  THM_INTRO_TAC[`C'`;`c`;`b`;`a`] simple_arc_end_subset_trans_lemma;
  IMATCH_MP_TAC  simple_arc_end_symm;
  TYPE_THEN `C''` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  IMATCH_MP_TAC  SUBSET_TRANS;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* - *)
  THM_INTRO_TAC[`C`;`{a}`;`C'`] simple_arc_end_restriction;
  CONJ_TAC;
  USEH 2895 (MATCH_MP simple_arc_end_simple);
  CONJ_TAC;
  USEH 2895 (MATCH_MP simple_arc_end_end_closed);
  CONJ_TAC;
  USEH 3594 (MATCH_MP simple_arc_end_closed);
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ];
  TYPE_THEN `u` UNABBREV_TAC;
  ASM_MESON_TAC[];
  CONJ_TAC THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `a` EXISTS_TAC;
  USEH 2895 (MATCH_MP simple_arc_end_end);
  TYPE_THEN `b` EXISTS_TAC;
  USEH 2895 (MATCH_MP simple_arc_end_end2);
  USEH 3594 (MATCH_MP simple_arc_end_end);
  (* - *)
  TYPE_THEN `v = a` SUBAGOAL_TAC;
  USEH 6975 (REWRITE_RULE[eq_sing]);
  USEH 8361 (REWRITE_RULE[INTER;INR IN_SING]);
  TYPE_THEN `v` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `v' = c` ASM_CASES_TAC;
  TYPE_THEN `v'` UNABBREV_TAC;
  TYPE_THEN `C''` EXISTS_TAC;
  FULL_REWRITE_TAC[SUBSET;UNION];
  (* - *)
  THM_INTRO_TAC[`C'`;`c`;`b`;`v'`] simple_arc_end_subset_trans_lemma;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  USEH 9287 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  USEH 6723 (MATCH_MP simple_arc_end_symm);
  THM_INTRO_TAC[`C''`;`C'''`;`a`;`v'`;`c`] simple_arc_end_trans;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER];
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  FULL_REWRITE_TAC[INTER;eq_sing;INR IN_SING;SUBSET];
  ASM_MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  USEH 3266 (MATCH_MP simple_arc_end_end2);
  USEH 2088 (MATCH_MP simple_arc_end_end);
  TYPE_THEN `C'' UNION C'''` EXISTS_TAC;
  FULL_REWRITE_TAC[SUBSET;UNION];
  FIRST_ASSUM DISJ_CASES_TAC;
  (* Fri Dec 31 08:49:20 EST 2004 *)

  ]);;
  (* }}} *)

let unbounded_set_trans_lemma = 
prove_by_refinement(
  `!E p q x r. FINITE E /\ E SUBSET edge /\
     (unbounded_set E p) /\
     (UNIONS E SUBSET (closed_ball(euclid 2,d_euclid) x r)) /\
     (?C. simple_arc_end C p q /\
         (C INTER closed_ball(euclid 2,d_euclid) x r = EMPTY)) ==>
   (unbounded_set E q)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `closure top2 (UNIONS E) SUBSET (closed_ball (euclid 2,d_euclid) x r)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  closure_subset;
  REWRITE_TAC[top2_top];
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  closed_ball_closed;
  (* - *)
  THM_INTRO_TAC[`E`] curve_closure_ver2;
  REWRH 5238;
  KILLH 3085;
  KILLH 5161;
  (* - *)
  TYPE_THEN `C INTER UNIONS (curve_cell E) = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  FULL_REWRITE_TAC[EQ_EMPTY ];
  TSPECH `u` 5342;
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* - *)
  UNDH 2166 THEN ASM_SIMP_TAC [unbounded_set_lemma];
  TYPE_THEN `euclid 2 q` SUBAGOAL_TAC;
  COPYH 5276;
  USEH 5276 (MATCH_MP simple_arc_end_simple);
  USEH 5276 (MATCH_MP simple_arc_end_end2);
  USEH 3550 (MATCH_MP simple_arc_euclid);
  ASM_MESON_TAC[subset_imp];
  USEH 877 (MATCH_MP point_onto);
  TYPE_THEN `q` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `r'' = max_real r' (FST p' + &1)` ABBREV_TAC ;
  TYPE_THEN `r''` EXISTS_TAC;
  TSPECH `s` 5976;
  (* - *)
  TYPE_THEN `r' <= s` SUBAGOAL_TAC;
  TYPE_THEN `r''` UNABBREV_TAC;
  THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le;
  UNDH 6140 THEN UNDH 3019 THEN REAL_ARITH_TAC;
  REP_BASIC_TAC;
  USEH 9110 (MATCH_MP simple_arc_end_symm);
  (* - *)
  TYPE_THEN `~(point p' = point (s,&0))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `s` UNABBREV_TAC;
  TYPE_THEN `r''` UNABBREV_TAC;
  THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le;
  UNDH 9809 THEN UNDH 7108 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`C`;`C'`;`point p'`;`p`;`(point(s,&0))`] simple_arc_end_subset_trans;
  TYPE_THEN `U` EXISTS_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
  FULL_REWRITE_TAC[SUBSET;UNION;EQ_EMPTY];
  ASM_MESON_TAC[];
  (* Fri Dec 31 09:05:35 EST 2004 *)

  ]);;
  (* }}} *)

let unbounded_set_empty = 
prove_by_refinement(
  `(unbounded_set EMPTY = euclid 2)`,

  (* {{{ proof *)
  [
  THM_INTRO_TAC[`EMPTY:((num->real)->bool)->bool`] unbound_set_x_axis;
  REWRITE_TAC[FINITE_RULES];
  TSPECH `r` 9109;
  FULL_REWRITE_TAC[REAL_ARITH `r <= r`];
  IMATCH_MP_TAC  EQ_EXT;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  unbounded_euclid;
  UNIFY_EXISTS_TAC;
  (* - *)
  TYPE_THEN `x = (point(r,&0))` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  IMATCH_MP_TAC  unbounded_set_trans_lemma;
  REWRITE_TAC[FINITE_RULES];
  TYPE_THEN `point(r,&0)` EXISTS_TAC;
  TYPE_THEN `point(&0,&0)` EXISTS_TAC;
  TYPE_THEN `-- &1` EXISTS_TAC;
  (* - *)
  THM_INTRO_TAC[`2`;`point(&0,&0)`;`-- &1`] closed_ball_empty;
  REAL_ARITH_TAC;
  TYPE_THEN `mk_segment (point (r,&0)) x` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  mk_segment_simple_arc_end;
  REWRITE_TAC[INTER_EMPTY];
  (* Fri Dec 31 09:37:30 EST 2004 *)

  ]);;
  (* }}} *)

let continuous_real_const = 
prove_by_refinement(
  `!r. continuous (\t. r) (top_of_metric (UNIV,d_real))
 (top_of_metric (UNIV,d_real))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[continuous;preimage];
  TYPE_THEN `v r` ASM_CASES_TAC;
  TYPE_THEN `{x | UNIONS (top_of_metric (UNIV,d_real)) x} = UNIONS (top_of_metric(UNIV,d_real))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  IMATCH_MP_TAC  top_univ;
  IMATCH_MP_TAC  top_of_metric_top;
  REWRITE_TAC[metric_real];
(**** Modified by JRH to avoid GSPEC
  REWRITE_TAC[GSYM EMPTY;GSPEC;top_of_metric_empty ];
 ****)
  (
let lemma = prove(`{x | F} = {}`,
                     REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]) in
   REWRITE_TAC[lemma; top_of_metric_empty])
  (* Fri Dec 31 10:30:48 EST 2004 *)

  ]);;
  (* }}} *)

let continuous_real_mul = 
prove_by_refinement(
  `!r. (&0 < r) ==> continuous (( *. ) r)
  (top_of_metric (UNIV,d_real))
 (top_of_metric (UNIV,d_real)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`( *. ) r`;`UNIV:real->bool`;`UNIV:real->bool`;`d_real`;`d_real`;] metric_continuous_continuous;
  REWRITE_TAC[metric_real];
  REWRITE_TAC[metric_continuous;metric_continuous_pt];
  FULL_REWRITE_TAC[d_real];
  TYPE_THEN `epsilon/r` EXISTS_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  UNDH 5576 THEN (ASM_SIMP_TAC[REAL_LT_RDIV_EQ]);
  ASM_SIMP_TAC[REAL_ARITH `r * x - r *y = r*. (x - y)`;ABS_MUL ];
  UNDH 7175 THEN UNDH 6412 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let polar_curve_lemma = 
prove_by_refinement(
  `!x theta r. euclid 2 x /\ &0 < theta /\ theta < &2 * pi /\ &0 < r ==>
   (?C.
    simple_arc_end C (x + point(r,&0)) (x + r *# (cis theta)) /\
    !y. C y ==> (d_euclid x y = r))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `f = (\ (t:real) . r) ` ABBREV_TAC  ;
  TYPE_THEN `g = ( *. ) theta` ABBREV_TAC ;
  THM_INTRO_TAC[`x`;`f`;`g`] polar_cont;
  TYPE_THEN `f` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  ASM_SIMP_TAC [continuous_real_const;continuous_real_mul];
  TYPE_THEN `G = (\t. euclid_plus x (f t *# cis (g t))) ` ABBREV_TAC ;
  TYPE_THEN `C = IMAGE G {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
  TYPE_THEN `C` EXISTS_TAC;
  REWRITE_TAC[simple_arc_end];
  SUBCONJ_TAC;
  TYPE_THEN `G` EXISTS_TAC;
  (* -- *)
  TYPE_THEN `G (&0) = euclid_plus x (point (r,&0)) ` SUBAGOAL_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  AP_TERM_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  REDUCE_TAC;
  REWRITE_TAC[cis];
  REWRITE_TAC[point_scale;COS_0;SIN_0];
  REDUCE_TAC;
  (* -- *)
  TYPE_THEN `G (&1) = euclid_plus x (r *# cis theta)` SUBAGOAL_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  AP_TERM_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  REDUCE_TAC;
  (* -- *)
  TYPE_THEN `G` UNABBREV_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  IMATCH_MP_TAC  euclid_add_closure;
  REWRITE_TAC[polar_euclid];
  (* -- *)
  FULL_REWRITE_TAC[euclid_add_cancel];
  TYPE_THEN `f` UNABBREV_TAC;
  THM_INTRO_TAC[`g x'`;`g y`;`r`;`r`] polar_inj;
  TYPE_THEN `g` UNABBREV_TAC;
  ASSUME_TAC (REAL_ARITH `&0 < r ==> &0 <= r`);
  TYPE_THEN `!x. &0 <= x ==> &0 <= theta* x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_MUL;
  UNDH 2540 THEN REAL_ARITH_TAC;
  TYPE_THEN `!x. (x <= &1) ==> (theta* x < &2 * pi)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LET_TRANS;
  TYPE_THEN `theta* &1` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_LMUL;
  UNDH 2540 THEN REAL_ARITH_TAC;
  REDUCE_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `r` UNABBREV_TAC;
  UNDH 869 THEN REAL_ARITH_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  FULL_REWRITE_TAC[REAL_EQ_MUL_LCANCEL];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `theta` UNABBREV_TAC;
  UNDH 869 THEN REAL_ARITH_TAC;
  (* -A *)
  TYPE_THEN `C` UNABBREV_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  USEH 1547 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `f` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `d_euclid x (euclid_plus x (r *# cis (theta * x'))) = d_euclid (x + (&0 *# (cis (theta * x')))) (euclid_plus x (r *# cis (theta * x')))` SUBAGOAL_TAC;
  AP_THM_TAC;
  AP_TERM_TAC;
  REWRITE_TAC[euclid_scale0;euclid_rzero];
  THM_INTRO_TAC[`2`;`(&0 *# cis (theta * x'))`;`(r *# cis (theta * x'))`;`x`]  metric_translate_LEFT;
  REWRITE_TAC[polar_euclid];
  REWRITE_TAC[d_euclid_eq_arg];
  UNDH 6412 THEN REAL_ARITH_TAC;
  (* Fri Dec 31 11:25:13 EST 2004 *)

  ]);;
  (* }}} *)

let unbounded_set_ball = 
prove_by_refinement(
  `!E x r p.  (&0 < r) /\
        FINITE E /\ E SUBSET edge /\ (euclid 2 p) /\
        UNIONS E SUBSET (closed_ball (euclid 2,d_euclid) x r) /\
        ~(closed_ball (euclid 2,d_euclid) x r p) ==>
      unbounded_set E p`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`E`] unbound_set_x_axis;
  (* - *)
  TYPE_THEN `E = EMPTY` ASM_CASES_TAC;
  FULL_REWRITE_TAC[unbounded_set_empty];
  TYPE_THEN `UNIONS E = EMPTY` ASM_CASES_TAC;
  FULL_REWRITE_TAC[UNIONS_EQ_EMPTY];
  REWRH 7639;
  TYPE_THEN `E` UNABBREV_TAC;
  USEH 8908(REWRITE_RULE[SUBSET;INR IN_SING ]);
  TYPE_THEN `edge EMPTY` SUBAGOAL_TAC;
  USEH 1936 (MATCH_MP edge_cell);
  USEH 5731 (MATCH_MP cell_nonempty);
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[EMPTY_EXISTS];
  (* - *)
  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET;closed_ball];
  TSPECH `u` 9087;
  USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  (* -A *)
  TYPE_THEN `!x. (FST p' + r <  x) ==> unbounded_set E (point(x,&0))` SUBAGOAL_TAC;
  TYPE_THEN `r' <= x'` ASM_CASES_TAC;
  IMATCH_MP_TAC  unbounded_set_trans_lemma;
  TYPE_THEN `point(r',&0)` EXISTS_TAC;
  TYPE_THEN `point p'` EXISTS_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REAL_ARITH_TAC;
  TYPE_THEN `mk_segment (point (r',&0)) (point(x',&0))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  mk_segment_simple_arc_end;
  REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `x'` UNABBREV_TAC;
  UNDH 7236 THEN REAL_ARITH_TAC;
  ONCE_REWRITE_TAC[mk_segment_sym];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  THM_INTRO_TAC[`x'`;`r'`;`&0`;`u''`]mk_segment_h;
  UNDH 7636 THEN REAL_ARITH_TAC;
  REWRH 9446;
  TYPE_THEN `u''` UNABBREV_TAC;
  USEH 7067 (REWRITE_RULE[closed_ball]);
  THM_INTRO_TAC[`2`;`point p'`;`point(t,&0)`;`0`]proj_contraction;
  FULL_REWRITE_TAC[coord01];
  UNDH 9207 THEN UNDH 6790 THEN UNDH 9670 THEN UNDH 2823 THEN REAL_ARITH_TAC;
  (* -B *)
  KILLH 3473;
  KILLH 5938;
  KILLH 7857;
  (* - *)
  TYPE_THEN `?R theta. r < R /\ &0 <= theta /\ theta < &2 * pi /\ (p = (point p') + (R *# cis theta))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[closed_ball];
  TYPE_THEN `?q. (euclid 2 q) /\ (p = point p' + q) ` SUBAGOAL_TAC;
  TYPE_THEN `euclid_minus p (point p')` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  euclid_sub_closure;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[euclid_plus;euclid_minus];
  REAL_ARITH_TAC;
  TYPE_THEN `p` UNABBREV_TAC;
  (* -- *)
  USEH 877 (MATCH_MP polar_exist);
  TYPE_THEN `q` UNABBREV_TAC;
  TYPE_THEN `r'` EXISTS_TAC ;
  TYPE_THEN `t` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  UNDH 1925 THEN ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[`2`;`&0 *# cis t`;`r' *# cis t`;`point p'`] metric_translate_LEFT;
  REWRITE_TAC[polar_euclid];
  TYPE_THEN `point p' + &0 *# cis t = point p'` SUBAGOAL_TAC;
  REWRITE_TAC[euclid_scale0;euclid_rzero];
  REWRH 5125;
  REWRITE_TAC[d_euclid_eq_arg];
  UNDH 3665 THEN UNDH 1444 THEN REAL_ARITH_TAC;
  (* -C *)
  TYPE_THEN `unbounded_set E (point (FST p' + R,SND p'))` SUBAGOAL_TAC;
  TYPE_THEN `SND p' = &0` ASM_CASES_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 8204 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  unbounded_set_trans_lemma;
  TYPE_THEN `point (FST p' +R, &0)` EXISTS_TAC;
  TYPE_THEN `point p'` EXISTS_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 8204 THEN REAL_ARITH_TAC;
  TYPE_THEN `mk_segment (point (FST p' + R,&0)) (point(FST p' + R,SND p'))` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  mk_segment_simple_arc_end;
  REWRITE_TAC[point_inj;PAIR_SPLIT];
  UNDH 5038 THEN ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `&0 <= SND p'` ASM_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  THM_INTRO_TAC[`&0`;`SND p'`;`FST p' + R`;`u`]mk_segment_v;
  REWRH 1093;
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[closed_ball];
  THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction;
  FULL_REWRITE_TAC[coord01];
  UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC;
  (* -- *)
  ONCE_REWRITE_TAC[mk_segment_sym];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  THM_INTRO_TAC[`SND p'`;`&0`;`FST p' + R`;`u`]mk_segment_v;
  UNDH 2479 THEN REAL_ARITH_TAC;
  REWRH 2966;
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[closed_ball];
  THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction;
  FULL_REWRITE_TAC[coord01];
  UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC;
  (* -D *)
  TYPE_THEN `theta= &0` ASM_CASES_TAC ;
  REWRITE_TAC[cis;COS_0;SIN_0;point_scale];
  TYPE_THEN `point p' + point (R * &1, R* &0) = point (FST p' + R , SND p')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_SYM;
  ONCE_REWRITE_TAC[euclid_add_comm];
  REWRITE_TAC[euclid_cancel1];
  REWRITE_TAC[euclid_minus_scale;point_scale;point_add;point_inj;PAIR_SPLIT];
  REAL_ARITH_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  IMATCH_MP_TAC  unbounded_set_trans_lemma;
  TYPE_THEN `point (FST p' + R,SND p')` EXISTS_TAC;
  TYPE_THEN `point p'` EXISTS_TAC;
  TYPE_THEN `r` EXISTS_TAC;
  THM_INTRO_TAC[`point p'`;`theta`;`R`] polar_curve_lemma;
  UNDH 6412 THEN UNDH 8204 THEN UNDH 6162 THEN UNDH 4026 THEN REAL_ARITH_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  TYPE_THEN `?u v. (p' = (u,v))` SUBAGOAL_TAC ;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `p'` UNABBREV_TAC;
  FULL_REWRITE_TAC[point_add;REAL_ARITH `x + &0 = x`];
  (* - *)
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
  USEH 3064 (REWRITE_RULE[closed_ball]);
  TSPECH `u` 5780;
  TYPE_THEN `R` UNABBREV_TAC;
  UNDH 8265 THEN UNDH 4705 THEN REAL_ARITH_TAC;
  (* Fri Dec 31 12:28:22 EST 2004 *)

  ]);;
  (* }}} *)

let unbounded_connect = 
prove_by_refinement(
  `!E p q. FINITE E /\ E SUBSET edge /\ ~(p = q) /\
    unbounded_set E p /\ unbounded_set E q ==>
    (?C. C SUBSET unbounded_set E /\ simple_arc_end C p q)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `(?r. !s. r <= s  ==> (?C. simple_arc_end C p (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC;
  ASM_MESON_TAC[unbounded_set_lemma];
  TYPE_THEN `(?r. !s. r <= s  ==> (?C. simple_arc_end C q (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC;
  ASM_MESON_TAC[unbounded_set_lemma];
  TYPE_THEN `r'' = max_real r r'` ABBREV_TAC ;
  TSPECH `r''` 4812;
  TSPECH `r''` 3171;
  THM_INTRO_TAC[`r`;`r'`] max_real_le;
  UNDH 4459 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UNDH 6887 THEN UNDH 2 THEN REAL_ARITH_TAC;
  UNDH 5611 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UNDH 7318 THEN UNDH 2 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`C`;`C'`;`p`;`point(r'',&0)`;`q`] simple_arc_end_subset_trans;
  IMATCH_MP_TAC  simple_arc_end_symm;
  TYPE_THEN `U` EXISTS_TAC;
  (* - *)
  THM_INTRO_TAC[`E`] unbounded_set_comp;
  THM_INTRO_TAC[`E`;`x`] unbounded_set_comp_elt;
  THM_INTRO_TAC[`E`;`x`;`p`] unbounded_comp_unique;
  REWRITE_TAC[GSYM unbounded_set];
  IMATCH_MP_TAC  rectagon_curve;
  TYPE_THEN `q` EXISTS_TAC;
  (* - *)
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  FULL_REWRITE_TAC[SUBSET;UNION];
  FULL_REWRITE_TAC[EQ_EMPTY];
  ASM_MESON_TAC[];
  (* Fri Dec 31 16:38:36 EST 2004 *)

  ]);;
  (* }}} *)

let simple_arc_conn_complement = 
prove_by_refinement(
  `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\
       (euclid 2 p) /\ ~(p = q) /\
   (euclid 2 q) ==> (?A. simple_arc_end A p q /\ (C INTER A = EMPTY))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`C`;`p`;`q`] euclid_scale_simple_arc_ver2;
  REP_BASIC_TAC;
  ASM_MESON_TAC[];
  (* - *)
  KILLH 907 THEN KILLH 877 THEN KILLH 7802 THEN KILLH 6497 THEN KILLH 9726 THEN KILLH 3550 THEN KILLH 11;
  (* - simple-arc-grid-properties *)
  TYPE_THEN `!i. (?E. (i <| N) ==> (  E SUBSET edge /\  (B i INTER (unbounded_set E) = EMPTY) /\  conn2 E /\ E (h_edge (floor (a i 0),floor (a i 1))) /\ E (h_edge (floor (a (SUC i) 0),floor (a (SUC i) 1))) /\  (!y. UNIONS (curve_cell E) y ==> (?x. B i x /\ d_euclid x y < &4))))` SUBAGOAL_TAC;
  RIGHT_TAC "E";
  TSPECH `i` 4963;
  USEH 9744 (MATCH_MP simple_arc_grid_properties);
  TYPE_THEN `E` EXISTS_TAC;
  LEFTH 3651 "E";
  (* - conn2-sequence *)
  THM_INTRO_TAC[`E`;`N-1`] conn2_sequence;
  (* -A *)
  TYPE_THEN `!i. (i <=| N- 1) ==> (i <| N)` SUBAGOAL_TAC;
  UNDH 7562 THEN UNDH 6077 THEN ARITH_TAC;
  TYPE_THEN `(!i. i <=| N- 1 ==> conn2 (E i))` SUBAGOAL_TAC;
  TSPECH `i` 2188;
  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWRH 1437;
  (* - *)
  TYPE_THEN `!i. (i <= N-| 1) ==> (E i SUBSET edge)` SUBAGOAL_TAC;
  TSPECH `i` 2188;
  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWRH 456;
  (* - *)
  TYPE_THEN `(!i. (SUC i <= N -| 1) ==> ~(E i INTER E (SUC i) = {}))` SUBAGOAL_TAC;
  UNDH 6943 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `h_edge (floor (a (SUC i) 0), floor (a (SUC i) 1))` EXISTS_TAC;
  CONJ_TAC;
  TSPECH `i` 2188;
  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UNDH 1989 THEN UNDH 7562 THEN ARITH_TAC;
  TSPECH `SUC i` 2188;
  UNDH 395 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWRH  7915 ;
  (* -B *)
  TYPE_THEN `(!i j.  i <| j /\ j <=| N -| 1 /\ ~(SUC i = j) ==> (curve_cell (E i) INTER curve_cell (E j) = {}))` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USEH 2591 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  cell_nonempty ; ALL_TAC];
  THM_INTRO_TAC[`E i`] curve_cell_cell;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
  ASM_MESON_TAC[subset_imp];
  USEH 1008 (REWRITE_RULE[EMPTY_EXISTS]);
  (* -- *)
  TYPE_THEN `euclid 2 u'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `u` EXISTS_TAC;
  IMATCH_MP_TAC  cell_euclid;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `curve_cell (E j)` EXISTS_TAC;
  IMATCH_MP_TAC  curve_cell_cell;
  (* -- *)
  TYPE_THEN `(?x. B i x /\ d_euclid x u' < &4)` SUBAGOAL_TAC;
  TSPECH `i` 2188;
  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
  UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[UNIONS];
  UNIFY_EXISTS_TAC;
  (* -- *)
  TYPE_THEN `(?y. B j y /\ d_euclid y u' < &4)` SUBAGOAL_TAC;
  TSPECH `j` 2188;
  UNDH 7711 THEN DISCH_THEN (THM_INTRO_TAC[]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[UNIONS];
  UNIFY_EXISTS_TAC;
  (* -- *)
  UNDH 1512 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`x`;`y`]);
  UNDH 5462 THEN UNDH 2236 THEN ARITH_TAC;
  (* -- *)
  TYPE_THEN `!k x. B k x /\ (k <| N) ==> euclid 2 x` SUBAGOAL_TAC;
  UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
  USEH 120 (MATCH_MP   simple_arc_end_simple);
  USEH 6892 (MATCH_MP simple_arc_euclid);
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBAGOAL_TAC;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  TYPE_THEN `i` EXISTS_TAC;
  UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
  TYPE_THEN `j` EXISTS_TAC;
  (* -- *)
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`u'`;`y`] metric_space_triangle;
  TYPE_THEN `d_euclid x y <= &8` SUBAGOAL_TAC;
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`y`;`u'`] metric_space_symm;
  UNDH 8326 THEN UNDH 204 THEN UNDH 2611 THEN UNDH 2778 THEN REAL_ARITH_TAC;
  UNDH 6749 THEN UNDH 4559 THEN UNDH 6444 THEN REAL_ARITH_TAC;
  REWRH 6286;
  (* -C *)
  TYPE_THEN `E' = UNIONS (IMAGE E {i | i <=| N -| 1})` ABBREV_TAC ;
  TYPE_THEN `E' SUBSET edge` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[IMAGE;UNIONS;SUBSET];
  TYPE_THEN `u` UNABBREV_TAC;
  TSPECH `x'` 2188;
  UNDH 1746 THEN DISCH_THEN (THM_INTRO_TAC[]);
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  (* - *)
  TYPE_THEN `FINITE E'` SUBAGOAL_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  THM_INTRO_TAC[`IMAGE E {i | i <=| N -| 1}`] FINITE_FINITE_UNIONS;
  IMATCH_MP_TAC  FINITE_IMAGE;
  REWRITE_TAC[FINITE_NUMSEG_LE];
  USEH 3282 (REWRITE_RULE[IMAGE]);
  UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  FULL_REWRITE_TAC[conn2];
  (* - *)
  TYPE_THEN `C' INTER unbounded_set E' = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USEH 8327 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  USEH 3168 (REWRITE_RULE [UNIONS;IMAGE]);
  TYPE_THEN `u'` UNABBREV_TAC;
  TSPECH `x` 2188;
  REP_BASIC_TAC;
  USEH 2251 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPECH `u` 5859;
  UNDH 5490 THEN ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  unbounded_avoidance_subset_ver2;
  TYPE_THEN `E'` EXISTS_TAC;
  TYPE_THEN `E'` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `x` EXISTS_TAC;
  UNDH 5971 THEN ARITH_TAC;
  (* -D *)
  TYPE_THEN `unbounded_set E' p' /\ unbounded_set E' q'` ASM_CASES_TAC;
  THM_INTRO_TAC[`E'`;`p'`;`q'`] unbounded_connect;
  TSPECH `C` 7694;
  USEH 8696 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  USEH 5828 (REWRITE_RULE[SUBSET]);
  USEH 6174 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPECH `u` 5341;
  TSPECH `u` 7291;
  UNDH 362 THEN ASM_REWRITE_TAC[];
  (* -E *)
  TYPE_THEN `N = 1` ASM_CASES_TAC;
  TYPE_THEN `N` UNABBREV_TAC;
  FULL_REWRITE_TAC[ARITH_RULE `i <| 1 <=> (i = 0)`];
  FULL_REWRITE_TAC[ARITH_RULE `i <= 1 -| 1 <=> (i = 0)`];
  TSPECH `0` 6703;
  TYPE_THEN `0 = 0` SUBAGOAL_TAC;
  TYPE_THEN `{i | i = 0} = {0}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRH 327;
  REWRH 627;
  FULL_REWRITE_TAC[image_sing];
  TYPE_THEN `E'` UNABBREV_TAC;
  TYPE_THEN `C'` UNABBREV_TAC;
  TSPECH `0` 4218;
  UNDH 9174 THEN DISCH_THEN (THM_INTRO_TAC[]);
  (* -- *)
  UNDH 5439 THEN REWRITE_TAC[];
  TYPE_THEN `!p. (!x. B 0 x ==> &8 *d <= d_euclid x p) /\ (euclid 2 p) ==> unbounded_set (E 0) p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  unbounded_set_ball;
  TYPE_THEN `x` EXISTS_TAC;
  TYPE_THEN `&7* d` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  UNDH 5147 THEN REAL_ARITH_TAC;
  (* --- *)
  CONJ_TAC;
  REWRITE_TAC[SUBSET;closed_ball];
  SUBCONJ_TAC;
  TSPECH `0` 6993;
  UNDH 9405 THEN DISCH_THEN (THM_INTRO_TAC[]);
  USEH 4758 (MATCH_MP simple_arc_end_simple);
  USEH 6872 (MATCH_MP simple_arc_euclid);
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B 0` EXISTS_TAC;
  SUBCONJ_TAC;
  USEH 6028 (REWRITE_RULE[UNIONS]);
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `u` EXISTS_TAC;
  IMATCH_MP_TAC  cell_euclid;
  IMATCH_MP_TAC  edge_cell;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `E 0` EXISTS_TAC;
  (* ---- *)
  UNDH 7489 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `UNIONS (E 0)` EXISTS_TAC;
  IMATCH_MP_TAC UNIONS_UNIONS;
  REWRITE_TAC[SUBSET];
  USEH 361 (REWRITE_RULE[SUBSET]);
  ASM_SIMP_TAC[curve_cell_edge];
  USEH 5290 (REWRITE_RULE[SUBSET;open_ball]);
  TSPECH `x''` 19;
  REP_BASIC_TAC;
  (* ---- *)
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`x''`;`x'`] metric_space_triangle;
  TYPE_THEN `d_euclid x x' <= d + &4` SUBAGOAL_TAC;
  UNDH 8092 THEN UNDH 8809 THEN UNDH 9378 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `d + &4` EXISTS_TAC;
  UNDH 5147 THEN REAL_ARITH_TAC;
  (* --- *)
  USEH 129 (REWRITE_RULE[closed_ball]);
  TSPECH `x` 7711;
  UNDH 6465 THEN UNDH 5617 THEN UNDH 5147 THEN REAL_ARITH_TAC;
  (* -- *)
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  (* -F *)
  TYPE_THEN `0 <| N -| 1` SUBAGOAL_TAC;
  UNDH 426 THEN UNDH 7562 THEN ARITH_TAC;
  REWRH 532;
  UNDH 7535 THEN REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!p. (euclid 2 p) /\ (!i. (SUC i <= (N-1)) ==> (&8 * d <= d_euclid (a (SUC i)) p)) ==> (unbounded_set E' p)` BACK_TAC;
  TYPE_THEN `!i. (SUC i <= (N-1)) ==> C' (a (SUC i))` SUBAGOAL_TAC;
  REWRITE_TAC[UNIONS;IMAGE];
  CONV_TAC (dropq_conv ("u"));
  TYPE_THEN `i` EXISTS_TAC;
  CONJ_TAC;
  UNDH 1989 THEN ARITH_TAC;
  TSPECH `i` 4963;
  TYPE_THEN `i <| N` SUBAGOAL_TAC;
  UNDH 1989 THEN ARITH_TAC;
  USEH 9744 (MATCH_MP simple_arc_end_end2);
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN REP_BASIC_TAC THEN ASM_MESON_TAC[];
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 8137 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  KILLH 6656 THEN KILLH 1512 THEN KILLH 7562 THEN KILLH 6444 THEN KILLH 7694 THEN KILLH 9229 THEN KILLH 2174 THEN KILLH 9099 THEN KILLH 3258 THEN KILLH 6487;
  COPYH 2188;
  UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
  UNDH 1989 THEN ARITH_TAC;
  UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
  KILLH 5053 THEN KILLH 8136 THEN KILLH 5388 THEN KILLH 6737;
  (* -G *)
  IMATCH_MP_TAC  unbounded_set_ball;
  TYPE_THEN `a(SUC i)` EXISTS_TAC;
  TYPE_THEN `&7 *d` EXISTS_TAC;
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_MUL;
  UNDH 5147 THEN REAL_ARITH_TAC;
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[  FINITE_UNION];
  FULL_REWRITE_TAC[conn2];
  REWRITE_TAC[union_subset];
  REWRITE_TAC[UNIONS_UNION;union_subset];
  (* - *)
  IMATCH_MP_TAC  (TAUT `a/\ b ==> b/\ a`);
  CONJ_TAC;
  USEH 9183 (REWRITE_RULE[closed_ball]);
  UNDH 6641 THEN UNDH 3603 THEN UNDH 5147 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `!i x. (i <| N) /\  (B i x) ==> euclid 2 x` SUBAGOAL_TAC;
  UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
  USEH 9316 (MATCH_MP simple_arc_end_simple);
  USEH 5604 (MATCH_MP simple_arc_euclid);
  USEH 2996 (REWRITE_RULE[SUBSET]);
  COPYH 3219;
  TSPECH `i` 3219;
  TSPECH `SUC i` 3219;
  (* - *)
  TYPE_THEN `(i <| N) /\ (SUC i <| N)` SUBAGOAL_TAC;
  UNDH 1989 THEN ARITH_TAC;
  REWRH 6689;
  REWRH 5459;
  (* - *)
  TYPE_THEN `B i (a(SUC i))` SUBAGOAL_TAC;
  TSPECH `i` 4963;
  USEH 9744 (MATCH_MP simple_arc_end_end2);
  (* - *)
  TYPE_THEN `B (SUC i) (a (SUC i))` SUBAGOAL_TAC;
  TSPECH `SUC i` 4963;
  USEH 9147 (MATCH_MP simple_arc_end_end);
  (* - *)
  REWRITE_TAC[SUBSET;closed_ball];
  TYPE_THEN `euclid 2 (a(SUC i))` SUBAGOAL_TAC;
  (* - *)
  TYPE_THEN `!i x y. (i <| N) /\ B i x /\ B i y /\ (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid x y < &2 *d)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  BALL_DIST;
  TYPE_THEN `euclid 2` EXISTS_TAC;
  UNDH 4673 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
  TYPE_THEN `x'` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B i'` EXISTS_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B i'` EXISTS_TAC;
  (* - *)
  KILLH 3302 THEN KILLH 6317 THEN KILLH 4963 THEN KILLH 4847;
  KILLH 4673 THEN KILLH 3226 THEN KILLH 9755 THEN KILLH 8762 THEN KILLH 6174;
  KILLH 7802 THEN KILLH 3603 THEN KILLH 5957;
  (* - *)
  TYPE_THEN `(!x. (euclid 2 x) /\ (?y. (euclid 2 y) /\ (d_euclid y x < &4) /\ (d_euclid (a (SUC i)) y < &2 * d)) ==> (d_euclid (a (SUC i)) x <= &7 *d))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`a(SUC i)`;`y`;`x`] metric_space_triangle;
  UNDH 8917 THEN UNDH 3588 THEN UNDH 1391 THEN UNDH 5147 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `!G x. G SUBSET edge /\ UNIONS G x ==> (euclid 2 x /\ UNIONS (curve_cell G) x)` SUBAGOAL_TAC;
  USEH 6599 (REWRITE_RULE[UNIONS]);
  TYPE_THEN `edge u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `G` EXISTS_TAC;
  CONJ_TAC;
  USEH 9350 (MATCH_MP edge_euclid2);
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `u` EXISTS_TAC;
  REWRITE_TAC[UNIONS];
  TYPE_THEN `u` EXISTS_TAC;
  ASM_SIMP_TAC[curve_cell_edge];
  (* -H *)
  CONJ_TAC;
  UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E i`;`x`]);
  UNDH 404 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x'` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  (* - *)
  UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E (SUC i)`;`x`]);
  UNDH 9352 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `x'` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `SUC i` EXISTS_TAC;
  (* Sat Jan  1 19:23:34 EST 2005 *)

  ]);;
  (* }}} *)

let cut_arc =
  jordan_def `cut_arc C v w = @B. simple_arc_end B v w /\ B SUBSET C`;;

let cut_arc_symm = 
prove_by_refinement(
  `!C v w. cut_arc C v w = cut_arc C w v`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cut_arc];
  TYPE_THEN `!B. simple_arc_end B v w = simple_arc_end B w v` SUBAGOAL_TAC;
  MESON_TAC[simple_arc_end_symm];
  ]);;
  (* }}} *)

let cut_arc_simple = 
prove_by_refinement(
  `!C v w. simple_arc top2 C /\  C v /\ C w /\ ~(v = w) ==>
        simple_arc_end (cut_arc C v w) v w`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cut_arc];
  SELECT_TAC;
  ASM_MESON_TAC[simple_arc_end_select];
  ]);;
  (* }}} *)

let cut_arc_subset = 
prove_by_refinement(
  `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==>
        cut_arc C v w SUBSET C`,

  (* {{{ proof *)
  [
  REWRITE_TAC[cut_arc];
  SELECT_TAC;
  ASM_MESON_TAC[simple_arc_end_select];
  ]);;
  (* }}} *)

let cut_arc_unique = 
prove_by_refinement(
  `!C v w B. simple_arc top2 C /\ (B SUBSET C) /\ simple_arc_end B v w
        ==> (cut_arc C v w = B)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `w` EXISTS_TAC;
  TYPE_THEN `~(v = w)` SUBAGOAL_TAC THENL[ (IMATCH_MP_TAC  simple_arc_end_distinct);ALL_TAC];
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `C v` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  TYPE_THEN `w` EXISTS_TAC;
  TYPE_THEN `C w` SUBAGOAL_TAC ;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_end2;
  UNIFY_EXISTS_TAC;
  ASM_MESON_TAC [cut_arc_subset;cut_arc_simple];
  ]);;
  (* }}} *)

let cut_arc_inter = 
prove_by_refinement(
  `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==>
     (cut_arc C v u INTER cut_arc C u w = {u}) /\
     (cut_arc C v u UNION cut_arc C u w = C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`;`v`;`w`;`u`] simple_arc_end_cut;
  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
  USEH 8829 (MATCH_MP simple_arc_end_simple);
  TYPE_THEN `cut_arc C v u = C'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_unique;
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `cut_arc C u w = C''` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_unique;
  TYPE_THEN `C` UNABBREV_TAC;
   REWRITE_TAC[SUBSET;UNION];
  ASM_REWRITE_TAC[];
  (* Sat Jan  1 19:57:51 EST 2005 *)

  ]);;
  (* }}} *)

let simple_closed_curve_euclid = 
prove_by_refinement(
  `!C . simple_closed_curve top2 C ==> (C SUBSET euclid 2) `,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_closed_curve];
  REWRITE_TAC[IMAGE;SUBSET];
  TYPE_THEN `!u. &0 <= u /\ u < &1 ==> euclid 2 (f u)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INJ;top2_unions];
  FIRST_ASSUM  IMATCH_MP_TAC ;
  USEH 5825 SYM ;
  TYPE_THEN `x' = &1` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
 UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
  ]);;
  (* }}} *)

let open_real_interval = 
prove_by_refinement(
  `!a b. top_of_metric (UNIV,d_real) {x | a < x /\ x < b}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`b`] half_open;
  THM_INTRO_TAC[`a`] half_open_above;
  TYPE_THEN `{x | a < x /\ x < b} = {x | a < x} INTER {x | x < b}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER];
  IMATCH_MP_TAC  top_inter;
  IMATCH_MP_TAC  top_of_metric_top;
  REWRITE_TAC[metric_real];
  ]);;
  (* }}} *)

let simple_closed_curve_cut_unique = 
prove_by_refinement(
  `!A A' A'' C v w. simple_closed_curve top2 C /\
      simple_arc_end A v w /\
      simple_arc_end A' v w /\
      simple_arc_end A'' v w /\
      ~(A' = A'') /\
    (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==>
      (A = A') \/ (A = A'')`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `A'` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  TYPE_THEN`w` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `A'` EXISTS_TAC;
  REWRITE_TAC[SUBSET_UNION];
  IMATCH_MP_TAC  simple_arc_end_end2;
  TYPE_THEN `v` EXISTS_TAC;
  USEH 4051  (MATCH_MP simple_arc_end_distinct);
  UNDH 1472 THEN ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`C`;`v`] simple_closed_curve_pt;
  TYPE_THEN `?t. (&0 < t /\ t < &1 /\ (f t = w))` SUBAGOAL_TAC ;
  (*   KILLH 9405; *)
  TYPE_THEN `C` UNABBREV_TAC ;
  FULL_REWRITE_TAC[IMAGE];
  TYPE_THEN `x` EXISTS_TAC;
  TYPE_THEN `x = &0` ASM_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `x = &1` ASM_CASES_TAC;
  ASM_MESON_TAC[];
  UNDH 3483 THEN UNDH 9557 THEN UNDH 953 THEN UNDH 8032 THEN REAL_ARITH_TAC;
  TYPE_THEN `w` UNABBREV_TAC;
  TYPE_THEN `v` UNABBREV_TAC;
  (* -A *)
  (*   USEH 9405 SYM; // *)
  FULL_REWRITE_TAC[top2_unions];
  TYPE_THEN `simple_arc_end (IMAGE f {x | &0 <= x /\ x <= t}) (f (&0)) (f t)` SUBAGOAL_TAC;
  USEH 5825 SYM;
  IMATCH_MP_TAC  simple_arc_segment;
  UNDH 6523 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `simple_arc_end (IMAGE f {x | t <= x /\ x <= &1}) (f t) (f (&1))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_segment;
  UNDH 2449 THEN REAL_ARITH_TAC;
  USEH 5825 SYM;
  REWRH 3167;
  (* - *)
  TYPE_THEN `!q. {x | q <= x /\ x <= q} = {q}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `!x. &0 <= x /\ x <= &1 ==> euclid 2 (f x)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  USEH 5674 SYM;
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  (* - *)
  TYPE_THEN `! r s. &0 <= r /\ s <= &1 /\ r < s  ==>  (?U. top2 U /\ (IMAGE f {x | r < x /\ x < s} = U INTER C))` SUBAGOAL_TAC;
  TYPE_THEN `closed_ top2 (IMAGE f {x | &0 <= x /\ x <= r})` SUBAGOAL_TAC;
  TYPE_THEN `r = &0` ASM_CASES_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[image_sing];
  IMATCH_MP_TAC  closed_point;
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  simple_arc_end_closed;
  TYPE_THEN  `f( &0)` EXISTS_TAC;
  TYPE_THEN `f (r)` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_segment;
  UNDH 5145 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC;
  TYPE_THEN `closed_ top2 (IMAGE f {x | s <= x /\ x <= &1})` SUBAGOAL_TAC;
  TYPE_THEN `s = &1` ASM_CASES_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[image_sing];
  IMATCH_MP_TAC  closed_point;
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  simple_arc_end_closed;
  TYPE_THEN  `f(s)` EXISTS_TAC;
  USEH 1826 SYM;
  TYPE_THEN `f (&1)` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_segment;
  UNDH 2144 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC;
  TYPE_THEN `closed_ top2 ((IMAGE f {x | &0 <= x /\ x <= r}) UNION (IMAGE f {x | s <= x /\ x <= &1}))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  closed_union;
  REWRITE_TAC[top2_top];
  USEH 9076 (MATCH_MP closed_open);
  FULL_REWRITE_TAC[open_DEF;top2_unions ];
  TYPE_THEN `(euclid 2 DIFF   (IMAGE f {x | &0 <= x /\ x <= r} UNION  IMAGE f {x | s <= x /\ x <= &1}))` EXISTS_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[IMAGE;DIFF;UNION;INTER];
  NAME_CONFLICT_TAC;
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  REWRITE_TAC[DE_MORGAN_THM;CONJ_ACI];
  TYPE_THEN `&0 <= x' /\ x' <= &1` SUBAGOAL_TAC;
  UNDH 507 THEN UNDH 3413 THEN UNDH 1908 THEN UNDH 147 THEN REAL_ARITH_TAC;
  CONJ_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  CONJ_TAC;
  USEH 2422 (REWRITE_RULE[INJ]);
  TYPE_THEN `x'' = &1` ASM_CASES_TAC;
  TYPE_THEN `x' = &0` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  UNDH 507 THEN UNDH 1908 THEN REAL_ARITH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  UNDH 8462 THEN UNDH 147 THEN REAL_ARITH_TAC;
  TYPE_THEN `x' = x''` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 5595 THEN UNDH 8732 THEN UNDH 9674 THEN UNDH 507 THEN UNDH 9329 THEN UNDH 1908 THEN REAL_ARITH_TAC ;
  TYPE_THEN `x''` UNABBREV_TAC;
  UNDH 507 THEN UNDH 1162 THEN REAL_ARITH_TAC;
  (* --- *)
  TYPE_THEN `x' = x''` SUBAGOAL_TAC;
  USEH 2422 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 8691 THEN UNDH 7080 THEN UNDH 1908 THEN UNDH 507 THEN REAL_ARITH_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  UNDH 3283 THEN UNDH 3413 THEN REAL_ARITH_TAC;
  (* -- *)
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  TYPE_THEN `x'` EXISTS_TAC;
  LEFTH  7656 "x'";
  TSPECH `x'` 4068;
  TYPE_THEN `x` UNABBREV_TAC;
  LEFTH 5373 "x''";
  TSPECH `x'` 1785;
  UNDH 1589 THEN UNDH 4223 THEN REWRITE_TAC[] THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC;
  (* -B *)
  COPYH 7922;
  UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`t`]);
  UNDH 6523 THEN REAL_ARITH_TAC;
  UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`t`;`&1`]);
  UNDH 2449 THEN REAL_ARITH_TAC;
  (* - *)
  USEH 5674 SYM;
  TYPE_THEN `U INTER U' INTER C = EMPTY` SUBAGOAL_TAC;
  TYPE_THEN `U INTER U' INTER C = (U INTER C) INTER (U' INTER C)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER] THEN MESON_TAC[];
  TYPE_THEN `U INTER C` UNABBREV_TAC;
  TYPE_THEN `U' INTER C` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  USEH 6182 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]);
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `x = x'` SUBAGOAL_TAC;
  USEH 2422 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 4410 THEN UNDH 8119 THEN UNDH 6523 THEN UNDH 5777 THEN UNDH 2449 THEN REAL_ARITH_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  UNDH 4480 THEN UNDH 8119 THEN REAL_ARITH_TAC;
  (* -C *)
  TYPE_THEN `UNIONS (top_of_metric (UNIV,d_real)) = UNIV` SUBAGOAL_TAC;
  IMATCH_MP_TAC  (GSYM top_of_metric_unions);
  REWRITE_TAC[metric_real];
  THM_INTRO_TAC[`&0`;`&1`] connect_real_open;
  THM_INTRO_TAC[`&0`;`&1`] open_real_interval;
  TYPE_THEN `!B.  simple_arc_end B (f (&0)) (f t) /\ B SUBSET C ==> (B = IMAGE f {x | &0 <= x /\ x <= t}) \/ (B = IMAGE f {x | t <= x /\ x <= &1})` SUBAGOAL_TAC;
  COPYH 3089;
    USEH 3089 (REWRITE_RULE[simple_arc_end]);
  USEH 3272 (REWRITE_RULE[continuous;preimage]);
  REWRH 1293;
  TYPE_THEN `!v. top2 v ==> top_of_metric(UNIV,d_real) {x | &0 < x /\ x < &1 /\ v (f' x)}` SUBAGOAL_TAC;
  TYPE_THEN `{x | &0 < x /\ x < &1 /\ v' (f' x)} = {x | &0 < x /\ x < &1 } INTER {x | v' (f' x)}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER];
  MESON_TAC[];
  IMATCH_MP_TAC top_inter;
  IMATCH_MP_TAC  top_of_metric_top;
  REWRITE_TAC[metric_real];
  COPYH 7847;
  TSPECH `U` 7847;
  TSPECH `U'`7847;
  FULL_REWRITE_TAC[connected];
  UNDH 868 THEN DISCH_THEN (THM_INTRO_TAC[`{x | &0 < x /\ x < &1 /\ U (f' x)}`;`{x | &0 < x /\ x < &1 /\ U' (f' x)}`]);
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  USEH 228 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  TYPE_THEN `C (f' u)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  image_imp;
  UNDH 5411 THEN UNDH 7814 THEN REAL_ARITH_TAC;
  USEH 161 (REWRITE_RULE[INTER;EQ_EMPTY]);
  TSPECH `f' u` 3418;
  UNDH 1284 THEN ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;UNION];
  TYPE_THEN `C (f' x)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  image_imp;
  UNDH 4410 THEN UNDH 2236 THEN REAL_ARITH_TAC ;
  USEH 3773 SYM;
  REWRH 5090;
  USEH 8548 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `~(x' = &0)` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `f(&0)` UNABBREV_TAC;
  TYPE_THEN `f(&1)` UNABBREV_TAC;
  TYPE_THEN `x = &0` SUBAGOAL_TAC;
  USEH 5798 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  UNDH 869 THEN REAL_ARITH_TAC;
  TYPE_THEN `~(x' = &1)` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `f(&0)` UNABBREV_TAC;
  TYPE_THEN `f(&1)` UNABBREV_TAC;
  TYPE_THEN `x = &0` SUBAGOAL_TAC;
  USEH 5798 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  UNDH 869 THEN REAL_ARITH_TAC;
  TYPE_THEN `~(x' = t)` SUBAGOAL_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `f(&0)` UNABBREV_TAC;
  TYPE_THEN `f(&1)` UNABBREV_TAC;
  TYPE_THEN `f t` UNABBREV_TAC;
  TYPE_THEN `x = &1` SUBAGOAL_TAC;
  USEH 5798 (REWRITE_RULE[INJ]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  UNDH 6586 THEN REAL_ARITH_TAC;
  (* --- *)
  TYPE_THEN `x' < t` ASM_CASES_TAC;
  DISJ1_TAC;
  USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPECH `f x'` 4001;
  USEH 4175 (REWRITE_RULE[INTER]);
  USEH 4860 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`));
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  UNDH 2455 THEN UNDH 9329 THEN REAL_ARITH_TAC;
  DISJ2_TAC;
  USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPECH `f x'` 7907;
  USEH 1343 (REWRITE_RULE[INTER]);
  USEH 5291 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`));
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  UNDH 9585 THEN UNDH 7068 THEN UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
  (* --D *)
  FIRST_ASSUM DISJ_CASES_TAC;
  DISJ1_TAC;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC;
  TYPE_THEN `f (&0)` EXISTS_TAC;
  TYPE_THEN `f (t)` EXISTS_TAC;
  CONJ_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  CONJ_TAC;
  USEH 4679 (MATCH_MP simple_arc_end_simple);
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET;IMAGE];
  (* --- *)
  TYPE_THEN `x' = &0` ASM_CASES_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  UNDH 2449 THEN REAL_ARITH_TAC;
  TYPE_THEN `x' = &1` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `t` EXISTS_TAC;
  UNDH 2449 THEN REAL_ARITH_TAC;
  USEH 8833 (REWRITE_RULE[SUBSET]);
  UNDH 5386 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  UNDH 6268 THEN UNDH 2455 THEN UNDH 9329 THEN UNDH 3324 THEN REAL_ARITH_TAC;
  TYPE_THEN `C (f' x')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  image_imp;
(*** Removed by JRH --- not quite sure why this changed
  UNDH 7473 THEN UNDH 5707 THEN UNDH 6268 THEN  UNDH 2455 THEN REAL_ARITH_TAC;
 ***)
  USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPECH `(f' x')` 4001;
  USEH 3320 (REWRITE_RULE[INTER;IMAGE]);
  REWRH 7476;
  TYPE_THEN `x''` EXISTS_TAC;
  UNDH 4332 THEN UNDH 4962 THEN REAL_ARITH_TAC;
  (* --E *)
  DISJ2_TAC;
  IMATCH_MP_TAC  simple_arc_end_inj;
  TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC;
  TYPE_THEN `f t` EXISTS_TAC;
  TYPE_THEN `f (&1)` EXISTS_TAC;
  USEH 1826 SYM;
  CONJ_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_MESON_TAC[];
  CONJ_TAC;
  USEH 9241 (MATCH_MP simple_arc_end_simple);
  REWRITE_TAC[SUBSET_REFL];
  REWRITE_TAC[SUBSET;IMAGE];
  (* --- *)
  TYPE_THEN `x' = &0` ASM_CASES_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `&1` EXISTS_TAC;
  UNDH 6523 THEN REAL_ARITH_TAC;
  TYPE_THEN `x' = &1` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `t` EXISTS_TAC;
  UNDH 6523 THEN REAL_ARITH_TAC;
  TYPE_THEN `&0 < x' /\ x' < &1` SUBAGOAL_TAC;
  UNDH 9329 THEN UNDH 2455 THEN UNDH 3324 THEN UNDH 6268 THEN REAL_ARITH_TAC;
  USEH 1419 (REWRITE_RULE[SUBSET]);
  UNDH 7111 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
  TYPE_THEN `C (f' x')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `B` EXISTS_TAC;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPECH `(f' x')` 7907;
  USEH 1445 (REWRITE_RULE[INTER;IMAGE]);
  REWRH 6223;
  TYPE_THEN `x''` EXISTS_TAC;
  UNDH 4402 THEN UNDH 8966 THEN REAL_ARITH_TAC;
  (* -F *)
  TYPE_THEN `X = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ;
  TYPE_THEN `Y = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ;
  TYPE_THEN `a = f(&0)` ABBREV_TAC ;
  TYPE_THEN `b = f t` ABBREV_TAC ;
  TYPE_THEN `f t` UNABBREV_TAC;
  TYPE_THEN `f (&0)` UNABBREV_TAC;
  TYPE_THEN `f (&1)` UNABBREV_TAC;
  UNDH 7556 THEN UNDH 7601 THEN UNDH 9279 THEN UNDH 3395 THEN UNDH 1702 THEN UNDH 2817 THEN UNDH 7605 THEN UNDH 1063 THEN POP_ASSUM_LIST (fun t-> ALL_TAC);
  TYPE_THEN `(A = X) \/ (A = Y)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `(A' = X) \/ (A' = Y)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `(A'' = X) \/ (A'' = Y)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  FIRST_ASSUM DISJ_CASES_TAC THEN FIRST_ASSUM DISJ_CASES_TAC THEN ASM_MESON_TAC[];
  (* Sun Jan  2 11:55:31 EST 2005 *)

  ]);;
  (* }}} *)

let infinite_closed_interval = 
prove_by_refinement(
  `!a b. a < b ==> INFINITE {x | a <= x /\ x <= b}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?r s. a < r /\ r < s /\ s < b` SUBAGOAL_TAC;
  TYPE_THEN `(&2*a + b)/ &3` EXISTS_TAC;
  TYPE_THEN `(a + &2*b)/ &3` EXISTS_TAC;
  ASSUME_TAC (REAL_ARITH `&0 < &3 /\ ~(&3 = &0)`);
  ASM_SIMP_TAC[REAL_LT_RDIV_EQ;REAL_LT_LDIV_EQ;REAL_DIV_RMUL];
  UNDH 4394 THEN REAL_ARITH_TAC;
  IMATCH_MP_TAC  infinite_subset;
  TYPE_THEN `{x | r < x /\ x < s}` EXISTS_TAC ;
  CONJ_TAC;
  ASM_SIMP_TAC[infinite_interval];
  REWRITE_TAC[SUBSET];
  UNDH 2351 THEN UNDH 2116 THEN UNDH 5157 THEN UNDH 4011 THEN REAL_ARITH_TAC;
  (* Sun Jan  2 12:21:29 EST 2005 *)

  ]);;
  (* }}} *)

let infinite_image = 
prove_by_refinement(
  `!(f:A->B) X. INFINITE X /\ INJ f X UNIV ==> INFINITE (IMAGE f X)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INJ;INFINITE];
  THM_INTRO_TAC[`f`;`IMAGE f X`;`X`] FINITE_IMAGE_INJ_GENERAL;
  ASM_REWRITE_TAC[];
  UNDH 3229 THEN REWRITE_TAC[];
  TYPE_THEN `{x | x IN X /\ f x IN IMAGE f X} = X` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  ASM_MESON_TAC[image_imp];
  REWRH 2588;
  ]);;
  (* }}} *)

let simple_arc_infinite = 
prove_by_refinement(
  `!C. simple_arc top2 C ==> INFINITE C`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc];
  IMATCH_MP_TAC  infinite_image;
  CONJ_TAC;
  IMATCH_MP_TAC  infinite_closed_interval;
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ]);;
  (* }}} *)

let simple_closed_curve_cut_unique_inter = 
prove_by_refinement(
  `!A A' A'' C v w. simple_closed_curve top2 C /\
      simple_arc_end A v w /\
      simple_arc_end A' v w /\
      simple_arc_end A'' v w /\
      (A' INTER A'' = {v,w})  /\
    (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==>
      (A = A') \/ (A = A'')`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  simple_closed_curve_cut_unique;
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  TYPE_THEN `w` EXISTS_TAC;
  DISCH_TAC;
  TYPE_THEN `A''` UNABBREV_TAC;
  FULL_REWRITE_TAC [INTER_ACI];
  TYPE_THEN `A'` UNABBREV_TAC;
  USEH 2648 (MATCH_MP simple_arc_end_simple);
  USEH 9214 (MATCH_MP simple_arc_infinite);
  FULL_REWRITE_TAC[INFINITE];
  UNDH 8436 THEN ASM_REWRITE_TAC[];
  REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
  (* Sun Jan  2 12:47:35 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_access = 
prove_by_refinement(
  `!A C v w x p. simple_closed_curve top2 C /\
      simple_arc_end A v w /\
      A SUBSET C /\
      A x /\ ~(x = v) /\ ~(x = w) /\
      (euclid 2 p) /\
      ~C p /\
      (?q. ~( p = q) /\ ~(C q) /\ (euclid 2 q) /\
         (!B. simple_arc_end B p q ==> ~(B INTER C = EMPTY)))   ==>
    (?E.
        simple_arc_end E p x /\
        E INTER C SUBSET A /\
      (!e. E e /\ ~C e /\ ~(p = e) ==> (cut_arc E p e INTER C = EMPTY)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `A` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  TYPE_THEN`w` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `A` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_end2;
  TYPE_THEN `v` EXISTS_TAC;
  USEH 9236  (MATCH_MP simple_arc_end_distinct);
  UNDH 1472 THEN ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`C`;`v`;`w`] simple_closed_cut;
  (* - *)
  TYPE_THEN `?B. (A UNION B = C) /\ (A INTER B = {v,w}) /\ (simple_arc_end B v w)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`A`;`C'`;`C''`;`C`;`v`;`w`] simple_closed_curve_cut_unique_inter;
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION];
  (* -- *)
  FIRST_ASSUM DISJ_CASES_TAC ;
  TYPE_THEN `C'` UNABBREV_TAC;
  TYPE_THEN `C''` EXISTS_TAC;
  TYPE_THEN `C''` UNABBREV_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  FULL_REWRITE_TAC[INTER_ACI;UNION_ACI];
  KILLH 6724 THEN KILLH 906 THEN KILLH 4244 THEN KILLH 3747;
  (* -A *)
  THM_INTRO_TAC[`B`;`p`;`q`] simple_arc_conn_complement;
  USEH 2164 (MATCH_MP simple_arc_end_simple);
  TYPE_THEN `B SUBSET C` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION];
  ASM_MESON_TAC[subset_imp];
  (* - *)
  THM_INTRO_TAC[`A'`;`{p}`;`A`] simple_arc_end_restriction;
  CONJ_TAC;
  USEH 384 (MATCH_MP   simple_arc_end_simple);
  CONJ_TAC;
  USEH 384 (MATCH_MP simple_arc_end_end_closed);
  CONJ_TAC;
  USEH 9236 (MATCH_MP simple_arc_end_closed);
  CONJ_TAC;
  REWRITE_TAC[EQ_EMPTY];
  FULL_REWRITE_TAC[INTER;INR IN_SING];
  TYPE_THEN `x'` UNABBREV_TAC;
  ASM_MESON_TAC[subset_imp];
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  CONJ_TAC;
  CONV_TAC (dropq_conv "u");
  USEH 384 (MATCH_MP simple_arc_end_end);
  TSPECH `A'` 1640;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `u` EXISTS_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  FULL_REWRITE_TAC[UNION];
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[EQ_EMPTY];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `v' = p` SUBAGOAL_TAC;
  USEH 6335 (REWRITE_RULE[INR eq_sing;INTER;INR IN_SING ]);
  TYPE_THEN `v'` UNABBREV_TAC;
  (* -B *)
  TYPE_THEN `x = v''` ASM_CASES_TAC ;
  TYPE_THEN `v''` UNABBREV_TAC;
  TYPE_THEN `C'` EXISTS_TAC;
  SUBCONJ_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[INTER;UNION;SUBSET];
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[INTER;EQ_EMPTY;SUBSET ];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `~(e = x)` SUBAGOAL_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  UNDH 3668 THEN REWRITE_TAC[] ;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `A` EXISTS_TAC;
  THM_INTRO_TAC[`C'`;`e`;`p`;`x`] cut_arc_inter;
  (* -- *)
  PROOF_BY_CONTR_TAC;
  THM_INTRO_TAC[`C'`;`p`;`e`] cut_arc_subset;
  CONJ_TAC;
  USEH 8530 (MATCH_MP simple_arc_end_simple);
  USEH 8530 (MATCH_MP simple_arc_end_end);
  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
  FULL_REWRITE_TAC[SUBSET;INR eq_sing ;INR IN_SING;];
  THM_INTRO_TAC[`C'`;`e`;`x`] cut_arc_simple;
  USEH 8530 (MATCH_MP simple_arc_end_simple);
  USEH 5502 (MATCH_MP simple_arc_end_end2);
  ASM_MESON_TAC[];
  (* -C *)
  TYPE_THEN `cutvx = cut_arc A v'' x` ABBREV_TAC ;
  TYPE_THEN `E = C' UNION cutvx` ABBREV_TAC ;
  TYPE_THEN `E` EXISTS_TAC;
  (* - *)
  TYPE_THEN `simple_arc top2 A` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `A v'' ` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INTER;INR eq_sing; INR IN_SING];
  THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_simple;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC ;
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `v''` EXISTS_TAC;
  TYPE_THEN `cutvx` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  USEH 6508 SYM;
  REWRITE_TAC[INTER;SUBSET];
  THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset;
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  REWRITE_TAC[SUBSET;INTER;INR IN_SING];
  FULL_REWRITE_TAC[INTER;INR IN_SING;INR eq_sing];
  USEH 4778 (MATCH_MP simple_arc_end_end);
  (* -D *)
  SUBCONJ_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `cutvx` UNABBREV_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;INTER;UNION];
  FIRST_ASSUM DISJ_CASES_TAC;
  KILLH 4866;
  FIRST_ASSUM DISJ_CASES_TAC;
  FULL_REWRITE_TAC[SUBSET;EQ_EMPTY;INTER;];
  ASM_MESON_TAC[];
  THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset;
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  (* -E *)
  TYPE_THEN `simple_arc top2 E` SUBAGOAL_TAC;
  USEH 9538 (MATCH_MP simple_arc_end_simple);
  TYPE_THEN `C' p /\ C' e`  SUBAGOAL_TAC;
  CONJ_TAC;
  FULL_REWRITE_TAC[INTER;INR eq_sing;INR IN_SING];
  TYPE_THEN `E` UNABBREV_TAC;
  USEH 3684 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `cutvx SUBSET C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `cutvx` UNABBREV_TAC;
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_MESON_TAC[subset_imp];
  (* - *)
  TYPE_THEN `cut_arc E p e = cut_arc C' p e` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_unique;
  TYPE_THEN `E` UNABBREV_TAC;
  CONJ_TAC;
  TYPE_THEN `cut_arc C' p e SUBSET C'` BACK_TAC;
  UNDH 7958 THEN REWRITE_TAC[SUBSET;UNION];
  IMATCH_MP_TAC  cut_arc_subset;
  USEH 2528 (MATCH_MP simple_arc_end_simple);
  IMATCH_MP_TAC  cut_arc_simple;
  USEH 2528 (MATCH_MP simple_arc_end_simple);
  (* - *)
  TYPE_THEN `~(e = v'')` SUBAGOAL_TAC;
  UNDH 5697 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[UNION];
  THM_INTRO_TAC[`C'`;`e`;`p`;`v''`] cut_arc_inter;
  (* - *)
  TYPE_THEN `C' INTER C = {v''}` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  REWRITE_TAC[eq_sing;INR IN_SING ;INTER;UNION;];
  USEH 2528 (MATCH_MP simple_arc_end_end2);
  REP_BASIC_TAC;
  FIRST_ASSUM DISJ_CASES_TAC ;
  USEH 6508 (REWRITE_RULE[INTER;INR eq_sing;INR IN_SING]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  USEH 7813 (REWRITE_RULE[SUBSET]);
  USEH 4523 (REWRITE_RULE[EQ_EMPTY;INTER;]);
  ASM_MESON_TAC[];
  (* -F *)
  TYPE_THEN `C' v''` SUBAGOAL_TAC;
  USEH 2528 (MATCH_MP simple_arc_end_end2);
  TYPE_THEN `~cut_arc C' p e v''` SUBAGOAL_TAC;
  USEH 8060 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  UNDH 2267 THEN DISCH_THEN (THM_INTRO_TAC[`v''`]);
  THM_INTRO_TAC[`C'`;`e`;`v''`] cut_arc_simple;
  USEH 2528 (MATCH_MP   simple_arc_end_simple);
  USEH 1175 (MATCH_MP simple_arc_end_end2);
  UNDH 1069 THEN ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  USEH 7182 (REWRITE_RULE [EMPTY_EXISTS;INTER]);
  USEH 3774 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  TYPE_THEN `u = v''` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `cut_arc C' p e SUBSET C'` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_subset;
  USEH 2528 (MATCH_MP simple_arc_end_simple);
  IMATCH_MP_TAC  subset_imp;
  UNIFY_EXISTS_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  UNDH 9484 THEN ASM_REWRITE_TAC[];
  (* Sun Jan  2 14:55:11 EST 2005 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION BB *)
(* ------------------------------------------------------------------ *)


(* show that a Jordan curve has no more than 2 components *)

let jordan_curve_seg3 = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==>
     (?s.  (!(i:three_t). (s i SUBSET C) /\ (simple_arc top2 (s i))) /\
          (!i j. ~(s i INTER s j = EMPTY) ==> (i = j)))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_closed_curve];
  TYPE_THEN `s = (\ i. IMAGE f {x | ((&2 * &(REP3 i) + &1)/ &8) <= x /\ x <= ((&2 * &(REP3 i) + &2)/ &8) } )` ABBREV_TAC ;
  TYPE_THEN `s` EXISTS_TAC;
  (* - *)
  TYPE_THEN `&0 < &8 /\ ~(&8 = &0)` SUBAGOAL_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `!i. &0 <= (&2 * &(REP3 i) + &1) / &8` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_DIV;
  REDUCE_TAC;
  TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / &8 <= &1` SUBAGOAL_TAC;
  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
  REDUCE_TAC;
  THM_INTRO_TAC[`i`] rep3_lt;
  UNDH 1618 THEN ARITH_TAC;
  (* - *)
  CONJ_TAC;
  CONJ_TAC;
  TYPE_THEN `s` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;IMAGE];
  TYPE_THEN `x'` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  UNIFY_EXISTS_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  UNIFY_EXISTS_TAC;
  (* -- *)
  TYPE_THEN `s` UNABBREV_TAC ;
  THM_INTRO_TAC[`f`;`(&2 * &(REP3 i) + &1) / &8 `;`(&2 * &(REP3 i) + &2) / &8`] simple_arc_segment;
  FULL_REWRITE_TAC[top2_unions];
  CONJ_TAC;
 ASM_SIMP_TAC[real_div_denom_lt];
  REDUCE_TAC;
  ARITH_TAC;
  DISJ1_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  REDUCE_TAC;
  ARITH_TAC;
  USEH 6148 (MATCH_MP simple_arc_end_simple);
  (* -A *)
  TYPE_THEN `!i j. (REP3 i < REP3 j) ==> (s i INTER s j = EMPTY)` BACK_TAC ;
  TYPE_THEN `(REP3 i = REP3 j) \/ (REP3 j <| REP3 i) \/ (REP3 i < REP3 j)` SUBAGOAL_TAC;
  ARITH_TAC;
  UNDH 2249 THEN REP_CASES_TAC;
  REWRITE_TAC[three_t_eq];
  UNDH 6857 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
  FULL_REWRITE_TAC[INTER_COMM];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* - *)
  PROOF_BY_CONTR_TAC;
  KILLH 1348;
  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `s` UNABBREV_TAC;
  USEH 4729 (REWRITE_RULE[IMAGE]);
  USEH 9244 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `u` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `x = x'` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / (&8) < &1`SUBAGOAL_TAC;
  UNDH 7394 THEN SIMP_TAC[REAL_LT_LDIV_EQ];
  REDUCE_TAC;
  THM_INTRO_TAC[`i`] rep3_lt;
  UNDH 1618 THEN ARITH_TAC;
  TYPE_THEN `&0 <= x /\ &0 <= x'` SUBAGOAL_TAC;
  ASM_MESON_TAC[REAL_LE_TRANS];
  CONJ_TAC THEN IMATCH_MP_TAC  REAL_LET_TRANS THEN UNIFY_EXISTS_TAC;
  (* - *)
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `(&2 * &(REP3 j') + &1) / &8 <= (&2 * &(REP3 i') + &2)/ &8` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS THEN UNIFY_EXISTS_TAC;
  (* - *)
  USEH 8118 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`));
  UNDH 4580 THEN REWRITE_TAC[];
  ASM_SIMP_TAC[REAL_LT_RDIV];
  REDUCE_TAC;
  UNDH 4372 THEN ARITH_TAC;
  (* Sun Jan  2 20:07:58 EST 2005 *)

  ]);;
  (* }}} *)

let abs3_distinct = 
prove_by_refinement(
  `~(ABS3 0 = ABS3 1) /\ ~(ABS3 0 = ABS3 2) /\ ~(ABS3 1 = ABS3 2)`,

  (* {{{ proof *)
  [
  TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3(ABS3 j))==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC;
  TYPE_THEN `ABS3 i` UNABBREV_TAC;
  REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC  THEN ASM_REWRITE_TAC[ABS3_012] THEN ARITH_TAC;
  ]);;
  (* }}} *)

let three_t_enum = 
prove_by_refinement(
  `!(a:A) b c. ?(f:three_t ->A). (f(ABS3 0) = a) /\
         (f(ABS3 1) = b) /\ (f(ABS3 2) = c)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `f = (\ i. (if (i = ABS3 0) then a else (if (i = ABS3 1) then b else c)))` ABBREV_TAC ;
  TYPE_THEN `f` EXISTS_TAC;
  TYPE_THEN `f` UNABBREV_TAC;
  REWRITE_TAC[abs3_distinct];
  ]);;
  (* }}} *)

let three_t_univ = 
prove_by_refinement(
  `!P. P (ABS3 0) /\ P(ABS3 1) /\ P(ABS3 2) ==> (!i. P i)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`i`] ABS3_onto;
  TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2)` SUBAGOAL_TAC;
  UNDH 4616 THEN ARITH_TAC;
 UNDH 2783 THEN REP_CASES_TAC  THEN (TYPE_THEN `j` UNABBREV_TAC);
  ]);;
  (* }}} *)

let simple_arc_sep_three_t = 
prove_by_refinement(
  `!C x p.
      (!(i:three_t). simple_arc_end (C i) x (p i)) /\
      (!i j. (C i) (p j) ==> (i = j)) ==>
   (?C' x.
      (!i. simple_arc_end (C' i) x (p i)) /\
      (!i j. ~(i = j) ==> (C' i INTER C' j = {x})) /\
      (!A. (!i. (C i) SUBSET A) ==> (!i. (C' i) SUBSET A)))  `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `A = C(ABS3 0) UNION C(ABS3 1) UNION C(ABS3 2)` ABBREV_TAC ;
  THM_INTRO_TAC[`A`;`C(ABS3 0)`;`C(ABS3 1)`;`C(ABS3 2)`;`x`;`p(ABS3 0)`;`p(ABS3 1)`;`p(ABS3 2)`] simple_arc_sep;
  REWRITE_TAC[SUBSET_REFL];
  TYPE_THEN `!i j. ~(i = j) ==> ~(C i (p j))` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3 (ABS3 j))  ==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC;
  TYPE_THEN `ABS3 i` UNABBREV_TAC;
  REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[ABS3_012] THEN ARITH_TAC ;
  THM_INTRO_TAC[`C1'`;`C2'`;`C3'`] three_t_enum;
  TYPE_THEN `f` EXISTS_TAC;
  TYPE_THEN `x'` EXISTS_TAC;
  TYPE_THEN `C1'` UNABBREV_TAC;
  TYPE_THEN `C2'` UNABBREV_TAC;
  TYPE_THEN `C3'` UNABBREV_TAC;
  (* - *)
  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ;ALL_TAC];
  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN (REPEAT   CONJ_TAC)  THEN IMATCH_MP_TAC  three_t_univ THEN FULL_REWRITE_TAC[INTER_ACI];ALL_TAC];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `A` EXISTS_TAC;
  FULL_REWRITE_TAC[union_subset];
  TYPE_THEN `!i. (f i SUBSET A)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  three_t_univ;ALL_TAC];
  (* - *)
  UNDH 2066 THEN UNDH 915 THEN POP_ASSUM_LIST (fun t->ALL_TAC);
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[union_subset];
  (* Sun Jan  2 21:17:07 EST 2005 *)

  ]);;
  (* }}} *)

let old_every_step_tac = !EVERY_STEP_TAC;;
EVERY_STEP_TAC :=
      REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN
      (REWRITE_TAC[]) ;;

let transpose = jordan_def `transpose (Q:A->B->C) i j = Q j i`;;

let transpose2 = 
prove_by_refinement(
  `!Q . (transpose (transpose Q))  = (Q:A->B->C) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[transpose];
  ]);;
  (* }}} *)

let k33_planar_graph_data_expand = 
prove_by_refinement(
  `(!q A CA B CB.
      (!(i:three_t) (j:three_t) i' j'.
          (q i j = q i' j') ==> (i = i') /\ (j = j')) /\
      (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\
      (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\
      (!i j i' j' u. (CB i j u /\ CA i' j' u) ==>
           (i = i') /\ (j = j') /\ (u = q i j)) /\
      (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\
      (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j'))
    ==> (?A' CA' B' CB'.
      (!i j. simple_arc_end (CA' i j) (A' i) (q i j)) /\
      (!i j. simple_arc_end (CB' i j) (B' j) (q i j)) /\
      (!i j i' j' u. (CB' i j u /\ CA' i' j' u) ==>
           (i = i') /\ (j = j') /\ (u = q i j)) /\
      (!i j i' j'. ~(CA' i j INTER CA' i' j' = EMPTY) ==> (i = i')) /\
      (!i j i' j'. ~(CB' i j INTER CB' i' j' = EMPTY) ==> (j = j')) /\
      (!i j k. ~(j = k) ==> (CA' i j INTER CA' i k = {(A' i)})) /\
      (!i j k. ~(j = k) ==> (CB' j i INTER CB' k i = {(B' i)}))
      ))
        `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `!i. ?CA' A'. (!j. simple_arc_end (CA' j) (A') (q i j)) /\ (!j k. ~(j = k) ==> (CA' j INTER CA' k = {(A')})) /\ (!U. (!j. (CA i j SUBSET U)) ==> (!j. CA' j SUBSET U))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_sep_three_t;
  TYPE_THEN `A i` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`q i j'`]);
  ASM_REWRITE_TAC[];
  UNDH 190 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`]);
  USEH 6066 (MATCH_MP simple_arc_end_end2);
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  RIGHTH 7847 "i";
  RIGHTH 705 "i";
  TYPE_THEN `A'` EXISTS_TAC;
  TYPE_THEN `CA'` EXISTS_TAC;
  TYPE_THEN `(!i j. simple_arc_end (CA' i j) (A' i) (q i j))` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -A *)
  TYPE_THEN `!i j u. CA' i j u ==> (?j'. CA i j' u)` SUBAGOAL_TAC;
  TSPECH `i` 6858;
  TSPECH `UNIONS (IMAGE (CA i) (UNIV))` 1295;
  UNDH 3086 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWRITE_TAC[SUBSET;UNIONS;IMAGE ];
  CONV_TAC (dropq_conv ("u"));
  UNIFY_EXISTS_TAC;
 ASM_REWRITE_TAC[];
  TSPECH `j` 7352;
  USEH 4766  (REWRITE_RULE[SUBSET;UNIONS;IMAGE]);
  TSPECH `u` 9646;
  REP_BASIC_TAC;
  TYPE_THEN `u'` UNABBREV_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(!i j i' j'. ~(CA' i j INTER CA' i' j' = {}) ==> (i = i'))` SUBAGOAL_TAC;
  USEH 3155 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  COPYH 6882;
  UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
  ASM_REWRITE_TAC[];
  UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
  ASM_REWRITE_TAC[];
  KILLH 33;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `j'''` EXISTS_TAC;
  TYPE_THEN `j''` EXISTS_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -B *)
  TYPE_THEN `!i. ?CBt' B'. (!j. simple_arc_end (CBt' j) (B') (transpose q i j)) /\ (!j k. ~(j = k) ==> (CBt' j INTER CBt' k = {(B')})) /\ (!U. (!j. (transpose CB i j SUBSET U)) ==> (!j. CBt' j SUBSET U))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_sep_three_t;
  TYPE_THEN `B i` EXISTS_TAC;
  REWRITE_TAC[transpose];
  ASM_REWRITE_TAC[];
  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`;`j'`;`i`;`q j' i`]);
  ASM_REWRITE_TAC[];
  UNDH 8461 THEN DISCH_THEN (THM_INTRO_TAC[`j'`;`i`]);
  USEH 6944 (MATCH_MP simple_arc_end_end2);
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  RIGHTH 2590 "i";
  RIGHTH 5199 "i";
  TYPE_THEN `B'` EXISTS_TAC;
  TYPE_THEN `CB' = transpose CBt'` ABBREV_TAC ;
  TYPE_THEN `CBt' = transpose CB'` SUBAGOAL_TAC;
  TYPE_THEN `CB'` UNABBREV_TAC;
  REWRITE_TAC[transpose2];
  TYPE_THEN `CBt'` UNABBREV_TAC;
  FULL_REWRITE_TAC[transpose];
  KILLH 87;
  TYPE_THEN `CB'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -C *)
  TYPE_THEN `!i j u. CB' i j u ==> (?i'. CB i' j u)` SUBAGOAL_TAC;
  TSPECH `j` 4587;
  TSPECH `UNIONS (IMAGE (transpose CB j) (UNIV))` 6357;
  UNDH 3701 THEN DISCH_THEN (THM_INTRO_TAC[]);
  REWRITE_TAC[SUBSET;UNIONS;IMAGE;transpose ];
  CONV_TAC (dropq_conv ("u"));
  UNIFY_EXISTS_TAC;
 ASM_REWRITE_TAC[];
  TSPECH `i` 8438;
  USEH 4864  (REWRITE_RULE[SUBSET;UNIONS;IMAGE]);
  TSPECH `u` 7999;
  FULL_REWRITE_TAC[transpose];
  TYPE_THEN `u'` UNABBREV_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(!i j i' j'. ~(CB' i j INTER CB' i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC;
  USEH 541 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  COPYH 5811;
  UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
  ASM_REWRITE_TAC[];
  UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
  ASM_REWRITE_TAC[];
  KILLH 3657;
  KILLH 6409;
  FIRST_ASSUM IMATCH_MP_TAC ;
  REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `i'''` EXISTS_TAC;
  TYPE_THEN `i''` EXISTS_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -D *)
  UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
  ASM_REWRITE_TAC[];
  UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
  ASM_REWRITE_TAC[];
  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i''`;`j`;`i'`;`j''`;`u`]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `j''` UNABBREV_TAC;
  TYPE_THEN `i''` UNABBREV_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  TSPECH `i'` 6858;
  (* -- *)
  TYPE_THEN `~(j = j')` ASM_CASES_TAC;
  UNDH 1784 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`j'`]);
  UNDH 2577 THEN ASM_REWRITE_TAC[];
  USEH 6310 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  TSPECH `q i' j` 3488;
  REWRH 4791;
  TSPECH `j` 1529;
  COPYH 3976;
  USEH 3976 (MATCH_MP simple_arc_end_distinct);
  UNDH 587 THEN ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  USEH 3976 (MATCH_MP  simple_arc_end_end2);
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[];
  TYPE_THEN `j'` UNABBREV_TAC;
  (* -E *)
  TYPE_THEN `(i = i')` BACK_TAC;
  TYPE_THEN `i'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  TSPECH `j` 4587;
  UNDH 5789 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`]);
  UNDH 3113 THEN ASM_REWRITE_TAC[];
  USEH 3441 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  TSPECH `q i' j` 7938;
  REWRH 5749;
  TSPECH `i'` 7762;
  COPYH 8730;
  USEH 8730 (MATCH_MP simple_arc_end_distinct);
  UNDH 586 THEN ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  USEH 8730 (MATCH_MP  simple_arc_end_end2);
  ASM_REWRITE_TAC[];
  (* Tue Jan  4 10:50:14 EST 2005 *)

  ]);;
  (* }}} *)

let three_t_size3 = 
prove_by_refinement(
  `(UNIV:three_t->bool) HAS_SIZE 3`,

  (* {{{ proof *)
  [
  ASSUME_TAC (ARITH_RULE `3 = SUC 2`);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[HAS_SIZE_SUC];
  REWRITE_TAC[three_delete_size];
  ]);;
  (* }}} *)

let no_k33_planar_graph_data = 
prove_by_refinement(
  `(!q A CA B CB.
      (!(i:three_t) (j:three_t) i' j'.
          (q i j = q i' j') ==> (i = i') /\ (j = j')) /\
      (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\
      (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\
      (!i j i' j' u. (CB i j u /\ CA i' j' u) ==>
           (i = i') /\ (j = j') /\ (u = q i j)) /\
      (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\
      (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j')) ==>
     F)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`q`;`A`;`CA`;`B`;`CB`] k33_planar_graph_data_expand;
  ASM_REWRITE_TAC[];
  KILLH 33 THEN KILLH 3657 THEN KILLH 8763 THEN KILLH 190 THEN KILLH 8461;
  TYPE_THEN `CE = ( \i j. CA' i j UNION CB' i j)` ABBREV_TAC ;
  TYPE_THEN `!i j. CE i j = CA' i j UNION CB' i j` SUBAGOAL_TAC;
  TYPE_THEN `CE` UNABBREV_TAC;
  TYPE_THEN `!i j. simple_arc_end (CE i j) (A' i) (B' j)` SUBAGOAL_TAC;
  TYPE_THEN `CE` UNABBREV_TAC;
  IMATCH_MP_TAC  simple_arc_end_trans;
  TYPE_THEN `q i j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[INTER;SUBSET;INR IN_SING];
  ASM_MESON_TAC[];
  REWRITE_TAC[SUBSET;INR IN_SING;INTER];
  TYPE_THEN `x` UNABBREV_TAC;
  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  (* - *)
  TYPE_THEN `A = IMAGE A' UNIV` ABBREV_TAC ;
  TYPE_THEN `B = IMAGE B' UNIV` ABBREV_TAC ;
  TYPE_THEN `E = IMAGE (\ (i,j).  (CE i j)) (cartesian UNIV UNIV)` ABBREV_TAC ;
  (* - *)
  TYPE_THEN `!i j. CA' i j (q i j)` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end2];
  TYPE_THEN `!i j. CB' i j (q i j)` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end2];
  TYPE_THEN `!i j. CA' i j (A' i)` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  TYPE_THEN `!i j. CB' i j (B' j)` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  (* - *)
  TYPE_THEN `!i i' j. CA' i j (A' i') ==> (i = i')` SUBAGOAL_TAC;
  KILLH 5790;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `j` EXISTS_TAC;
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `j` EXISTS_TAC;
  TYPE_THEN `(A' i')` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j j'. CB' i j (B' j') ==> (j = j')` SUBAGOAL_TAC;
  KILLH 6409;
  KILLH 1344;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `(B' j')` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i i' j. ~CB' i j (A' i') ` SUBAGOAL_TAC;
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`A' i'`]);
  ASM_REWRITE_TAC[];
  USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  UNDH 6711 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`]);
  TYPE_THEN `A' i'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `i'` UNABBREV_TAC;
  ASM_MESON_TAC[simple_arc_end_distinct];
  (* - *)
  TYPE_THEN `!i  j j'. ~CA' i j (B' j') ` SUBAGOAL_TAC;
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`B' j'`]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `j'` UNABBREV_TAC;
  ASM_MESON_TAC[simple_arc_end_distinct];
  (* - *)
  TYPE_THEN `!i j. CE i j INTER A = {(A' i)}` SUBAGOAL_TAC;
  REWRITE_TAC[eq_sing;INR IN_SING;INTER];
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `CE` UNABBREV_TAC;
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  CONJ_TAC;
  MESON_TAC[];
  TYPE_THEN `u'` UNABBREV_TAC ;
  TYPE_THEN `x' = i` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j. CE i j INTER B = {(B' j)}` SUBAGOAL_TAC;
  REWRITE_TAC[eq_sing;INR IN_SING;INTER];
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  TYPE_THEN `CE` UNABBREV_TAC;
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  NAME_CONFLICT_TAC;
  CONJ_TAC;
  MESON_TAC[];
  TYPE_THEN `u'` UNABBREV_TAC ;
  TYPE_THEN `x' = j` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* -A *)
  TYPE_THEN `!i i'. (A' i = A' i') ==> (i = i')` SUBAGOAL_TAC;
  UNDH 1344 THEN DISCH_THEN IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!j j'. (B' j = B' j') ==> (j = j')` SUBAGOAL_TAC;
  UNDH 6780 THEN DISCH_THEN IMATCH_MP_TAC ;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i j i' j'. ~(CE i j INTER CE i' j' = EMPTY) ==> (i = i') \/ (j = j')` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  TYPE_THEN `CE` UNABBREV_TAC;
  USEH 672 (REWRITE_RULE[EMPTY_EXISTS;INTER;UNION]);
  USEH 5790  (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  FIRST_ASSUM DISJ_CASES_TAC THEN KILLH 7160 THEN (FIRST_ASSUM DISJ_CASES_TAC) ;
  UNDH 3113 THEN REWRITE_TAC[] THEN UNDH 6711 THEN DISCH_THEN IMATCH_MP_TAC ;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`u`]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`i`;`j`;`u`]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  UNDH 2577 THEN REWRITE_TAC[] THEN UNDH 6981 THEN DISCH_THEN IMATCH_MP_TAC ;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -B *)
  TYPE_THEN `!i j. ~(A' i = B' j)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i j j'. ~(j = j') ==>  (CE i j INTER CE i j' = {(A' i)})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `CE` UNABBREV_TAC;
  REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING];
  FIRST_ASSUM DISJ_CASES_TAC   THEN (KILLH 2709) THEN (FIRST_ASSUM DISJ_CASES_TAC  );
  USEH 6932  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[];
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`j'`;`x`]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`x`]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  USEH 5790 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  ASM_MESON_TAC[];
  REWRITE_TAC[INR IN_SING;SUBSET;INTER];
  TYPE_THEN `x` UNABBREV_TAC;
  USEH 9014 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i i' j. ~(i = i') ==>  (CE i j INTER CE i' j = {(B' j)})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  TYPE_THEN `CE` UNABBREV_TAC;
  REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING];
  FIRST_ASSUM DISJ_CASES_TAC   THEN (KILLH 3625) THEN (FIRST_ASSUM DISJ_CASES_TAC  );
  USEH 6409  (REWRITE_RULE[EMPTY_EXISTS;INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[];
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`x`]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`i`;`j`;`x`]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  USEH 3599 (REWRITE_RULE[INTER;eq_sing;INR IN_SING;]);
  ASM_MESON_TAC[];
  REWRITE_TAC[INR IN_SING;SUBSET;INTER];
  TYPE_THEN `x` UNABBREV_TAC;
  USEH 4144 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
  ASM_MESON_TAC[];
  (* -C *)
  TYPE_THEN `g = (\ (i,j). CE i j)` ABBREV_TAC ;
  TYPE_THEN `BIJ g (cartesian UNIV UNIV) E` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  IMATCH_MP_TAC  inj_bij;
  REWRITE_TAC[INJ];
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `?i j. x = (i,j)` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `?i j. y = (i,j)` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `y` UNABBREV_TAC;
(*** Removed by JRH; this happens automatically now
  USEH 8053 (GBETA_RULE);
 ***)
  REWRITE_TAC[PAIR_SPLIT];
  (* -- *)
  TYPE_THEN `!i j. INFINITE (CE i j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_infinite;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `(i = i') \/ (j = j')` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `CE i' j'` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_IDEMPOT];
  TSPECH `i` 6411;
  TSPECH `j` 2286;
  FULL_REWRITE_TAC[INFINITE];
  TYPE_THEN `CE i j` UNABBREV_TAC;
  FULL_REWRITE_TAC[FINITE_RULES];
  ASM_REWRITE_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  UNDH 2315 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]);
  ASM_MESON_TAC[];
  TYPE_THEN `i'` UNABBREV_TAC;
  TYPE_THEN `CE i j'` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_IDEMPOT];
  FULL_REWRITE_TAC[INFINITE];
  UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[];
  TYPE_THEN `CE i j` UNABBREV_TAC;
  FULL_REWRITE_TAC[FINITE_SING];
  ASM_REWRITE_TAC[];
  TYPE_THEN `j'` UNABBREV_TAC;
  PROOF_BY_CONTR_TAC;
  UNDH 3532 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]);
  ASM_MESON_TAC[];
  TYPE_THEN `CE i' j` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_IDEMPOT];
  FULL_REWRITE_TAC[INFINITE];
  UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[];
  TYPE_THEN `CE i j` UNABBREV_TAC;
  FULL_REWRITE_TAC[FINITE_SING];
  ASM_REWRITE_TAC[];
  (* -D *)
  COPYH 1061;
  USEH 1061 (MATCH_MP INVERSE_BIJ);
  TYPE_THEN `h = INV g (cartesian UNIV UNIV) E` ABBREV_TAC ;
  TYPE_THEN `hh = (\ x. (A' (FST (h x)), B' (SND (h x))))` ABBREV_TAC ;
  TYPE_THEN `BIJ hh E (cartesian A B)` SUBAGOAL_TAC;
  TYPE_THEN `hh` UNABBREV_TAC;
  REWRITE_TAC[BIJ];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC;
  REWRITE_TAC[cartesian];
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[IMAGE;PAIR_SPLIT ];
  MESON_TAC[];
  FULL_REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `h x = h y` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[BIJ;INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SURJ];
  CONJ_TAC;
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  USEH 807 (REWRITE_RULE[cartesian;PAIR_SPLIT]);
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `FST x` UNABBREV_TAC;
  TYPE_THEN `SND x` UNABBREV_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  USEH 6050 (REWRITE_RULE[IMAGE]);
  USEH 2264 (REWRITE_RULE[IMAGE]);
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `y` UNABBREV_TAC;
  TYPE_THEN `g (x'',x)` EXISTS_TAC;
  (* -- *)
  TYPE_THEN `h (g (x'',x)) = (x'',x)` SUBAGOAL_TAC;
  TYPE_THEN `h` UNABBREV_TAC;
  IMATCH_MP_TAC  inv_comp_left;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[cartesian_univ];
  ASM_REWRITE_TAC[];
  TYPE_THEN `E` UNABBREV_TAC;
  IMATCH_MP_TAC  image_imp;
  REWRITE_TAC[cartesian_univ];
  (* -E *)
  TYPE_THEN `G = mk_graph_t (A UNION B,E,(\ e . {(FST (hh e)), (SND (hh e)) }))` ABBREV_TAC   ;
  TYPE_THEN `graph_isomorphic k33_graph G` SUBAGOAL_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  IMATCH_MP_TAC  k33_iso;
  ASM_REWRITE_TAC[];
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  (* -- *)
  REWRITE_TAC[HAS_SIZE] ;
  TYPE_THEN `FINITE (IMAGE A' UNIV) /\ FINITE (IMAGE B' UNIV)` SUBAGOAL_TAC;
  ASSUME_TAC three_t_size3;
  FULL_REWRITE_TAC[HAS_SIZE];
  CONJ_TAC THEN IMATCH_MP_TAC  FINITE_IMAGE THEN ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  ASSUME_TAC three_t_size3;
  FULL_REWRITE_TAC[HAS_SIZE];
  TYPE_THEN `(CARD (IMAGE A' UNIV) = 3) /\ (CARD (IMAGE B' UNIV) = 3)` SUBAGOAL_TAC;
  USEH 6784 SYM;
  ASM_REWRITE_TAC[];
  CONJ_TAC THEN IMATCH_MP_TAC  (INR CARD_IMAGE_INJ) THEN ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  USEH 9575 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]);
  TYPE_THEN `u` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* -F *)
  THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph;
  ASM_REWRITE_TAC[k33_isgraph];
  THM_INTRO_TAC[] k33_nonplanar;
  FULL_REWRITE_TAC[planar_graph];
  UNDH 3419 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `G` EXISTS_TAC;
  THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_symm;
  ASM_REWRITE_TAC[k33_isgraph];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[plane_graph];
  ASM_REWRITE_TAC[];
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  REWRITE_TAC[graph_vertex_mk_graph];
  REWRITE_TAC[UNION;SUBSET];
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  USEH 986 (REWRITE_RULE[IMAGE]);
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  UNDH 2402 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]);
  TYPE_THEN `x` UNABBREV_TAC;
  UNDH 7678 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]);
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  REWRITE_TAC[graph_edge_mk_graph];
  TYPE_THEN `E` UNABBREV_TAC;
  REWRITE_TAC[IMAGE;SUBSET];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  TYPE_THEN `?i j. (x' = (i,j))` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  MESON_TAC[];
  TYPE_THEN `x' ` UNABBREV_TAC;
  GBETA_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  TYPE_THEN `(A' i)` EXISTS_TAC;
  TYPE_THEN `(B' j)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  REWRITE_TAC[graph_edge_mk_graph;graph_inc_mk_graph;graph_vertex_mk_graph];
  KILLH 6876 THEN KILLH 5591 THEN KILLH 6365;
  FULL_REWRITE_TAC[graph_edge_mk_graph];
  TYPE_THEN `E` UNABBREV_TAC;
  USEH 1953 (REWRITE_RULE[IMAGE;cartesian_univ]);
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `hh` UNABBREV_TAC;
  (* -- *)
  TYPE_THEN `h (g (x)) = x` SUBAGOAL_TAC;
  TYPE_THEN `h` UNABBREV_TAC;
  IMATCH_MP_TAC  inv_comp_left;
  ASM_REWRITE_TAC[cartesian_univ];
  ASM_REWRITE_TAC[];
  TYPE_THEN `?i j. (x = (i,j))` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  GBETA_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;UNION;INR in_pair];
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  FULL_REWRITE_TAC[eq_sing; INTER; INR IN_SING];
  TYPE_THEN `x` UNABBREV_TAC;
  GBETA_TAC;
  ASM_MESON_TAC[];
  (* -G *)
  KILLH 7987 THEN KILLH 6305 THEN KILLH 5812 THEN KILLH 3738 THEN KILLH 8499;
    TYPE_THEN `!e. E e ==> (?i j. (e = CE i j))` SUBAGOAL_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `g` UNABBREV_TAC;
  USEH 7673 (REWRITE_RULE[cartesian_univ;IMAGE]);
  TYPE_THEN `(? i j. x = (i,j))` SUBAGOAL_TAC;
  REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `e''` UNABBREV_TAC;
  GBETA_TAC;
  MESON_TAC[];
  (* - *)
  TYPE_THEN `G` UNABBREV_TAC;
  FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph];
  KILLH 4886 THEN KILLH 6107 THEN KILLH 6780 THEN KILLH 1344;
  COPYH  1159;
  TSPECH `e` 1159;
  TSPECH `e'` 1159;
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  KILLH 5790 THEN KILLH 6409 THEN KILLH 5249 THEN KILLH 5804;
  REWRITE_TAC[INTER;SUBSET;UNION];
  TYPE_THEN `(i' = i)` ASM_CASES_TAC;
  DISJ1_TAC;
  FULL_REWRITE_TAC[eq_sing;INTER;INR IN_SING];
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[IMAGE];
  NAME_CONFLICT_TAC;
  TYPE_THEN `i'` UNABBREV_TAC;
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `~(j' = j)` SUBAGOAL_TAC;
  TYPE_THEN `j'` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  UNDH 221 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]);
  UNDH 7790 THEN ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(i' = i) \/ (j' = j)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USEH 5273 (REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  REWRH 5596;
  TYPE_THEN `j'` UNABBREV_TAC;
  DISJ2_TAC;
  (* - *)
  TYPE_THEN `x = B' j` BACK_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `B` UNABBREV_TAC;
  IMATCH_MP_TAC  image_imp;
  (* - *)
  USEH 3532  (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
  UNDH 9432 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]);
  UNDH 7528 THEN ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Tue Jan  4 15:3282:39 EST 2005 *)
  ]);;
  (* }}} *)

let simple_arc_midpoint = 
prove_by_refinement(
  `!C v w. simple_arc_end C v w ==>
        (?u. (C u /\ ~(u = v) /\ ~(u = w)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] simple_arc_infinite;
  IMATCH_MP_TAC  simple_arc_end_simple;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`{v,w}`;] INFINITE_DIFF_FINITE;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`v`;`w`] pair_size_2;
  ASM_MESON_TAC[simple_arc_end_distinct];
  FULL_REWRITE_TAC[HAS_SIZE];
  ASM_REWRITE_TAC[];
  USEH 3168 (MATCH_MP INFINITE_NONEMPTY);
  FULL_REWRITE_TAC[DIFF;EMPTY_EXISTS;INR in_pair];
  TYPE_THEN `u` EXISTS_TAC;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let simple_arc_choose_end = 
prove_by_refinement(
  `!C. simple_arc top2 C ==> (?v w. simple_arc_end C v w)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_arc;simple_arc_end];
  FULL_REWRITE_TAC[top2_unions];
  LEFT_TAC "f";
  LEFT_TAC "f";
  TYPE_THEN  `f` EXISTS_TAC;
  TYPE_THEN `f(&0)` EXISTS_TAC;
  TYPE_THEN `f(&1)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let cut_arc_replace = 
prove_by_refinement(
  `!A B u v. A SUBSET B /\ simple_arc top2 A /\ simple_arc top2 B /\
      A u /\ A v /\ ~(u = v) ==> (cut_arc B u v = cut_arc A u v)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  cut_arc_unique;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `A` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let cut_arc_order = 
prove_by_refinement(
  `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==>
     ~(cut_arc C v u w)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`;`u`;`v`;`w`] cut_arc_inter;
  ASM_REWRITE_TAC[];
  USEH 1187 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  TSPECH `w` 5795;
  COPYH 1985;
  UNDH 1985 THEN REWRITE_TAC [];
  IMATCH_MP_TAC  EQ_SYM;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  TYPE_THEN `u` EXISTS_TAC;
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)


(* First direction  of Jordan curve theorem. *)

let jordan_curve_no_inj3 = 
prove_by_refinement(
  `!C p.
     simple_closed_curve top2 C /\
     INJ p (UNIV:three_t ->bool) (euclid 2) /\
     (!i. ~C (p i)) /\
     (!i j A. simple_arc_end A (p i) (p j) ==> ~(A INTER C = EMPTY))
     ==> F`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] jordan_curve_seg3;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i. ?v w. simple_arc_end (s i) v w` SUBAGOAL_TAC;
  THM_INTRO_TAC[`s i`] simple_arc_choose_end;
  ASM_MESON_TAC[];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  LEFTH 4671 "v";
  LEFTH 2518 "w";
  (* - *)
  TYPE_THEN `!i. ?B. s i B /\ ~(B = v i) /\ ~(B = w i)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`s i`;`v i`;`w i`] simple_arc_midpoint;
  ASM_REWRITE_TAC[];
  TYPE_THEN `u` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  LEFTH 9437 "B";
  (* -A *)
  TYPE_THEN `!i. euclid 2 (p i)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INJ];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j. ?E. simple_arc_end E (p i) (B j) /\ (E INTER C SUBSET (s j)) /\ (!e. E e /\ ~C e /\ ~(p i = e) ==> (cut_arc E (p i) e INTER C = EMPTY))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  jordan_curve_access;
  TYPE_THEN `v j` EXISTS_TAC;
  TYPE_THEN `w j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[`i`] three_t_not_sing;
  TYPE_THEN `p j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNDH 7630 THEN FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  LEFTH 4024 "E";
  LEFTH 1449 "E";
  (* -B *)
  TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ C u ==> (j = j') /\ s j u` SUBAGOAL_TAC;
  COPYH 807;
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
  USEH 6239 (REWRITE_RULE[INTER;SUBSET]);
  USEH 4225 (REWRITE_RULE[INTER;SUBSET]);
  SUBCONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USEH 9012 (REWRITE_RULE[EQ_EMPTY;INTER]);
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i j. (p i = p j) ==> (i = j)` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INJ];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j. E i j (p i)` SUBAGOAL_TAC;
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  USEH 3415 (MATCH_MP simple_arc_end_end);
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ ~C u ==> (i = i')` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  (* -- *)
  TYPE_THEN `u = p i` ASM_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
  UNDH 8557 THEN DISCH_THEN (THM_INTRO_TAC[`p i`]);
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`i`;`cut_arc (E i' j') (p i') (p i)`]);
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  UNDH 1303 THEN ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `u = p i'` ASM_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  UNDH 3041 THEN DISCH_THEN (THM_INTRO_TAC[`p i'`]);
  ASM_REWRITE_TAC[];
  UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`cut_arc (E i j) (p i) (p i')`]);
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNDH 9380 THEN ASM_REWRITE_TAC[];
  (* -- *)
  COPYH 807;
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
  TYPE_THEN `cut_arc (E i j) (p i) u INTER C = EMPTY` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN `cut_arc (E i' j') (p i') u INTER C = EMPTY` SUBAGOAL_TAC;
  FIRST_ASSUM  IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`E i j`;`p i`;`u`] cut_arc_simple;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`E i' j'`;`p i'`;`u`] cut_arc_simple;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[`cut_arc (E i j) (p i) u`;`cut_arc (E i' j') (p i') u`;`p i`;`u`;`p i'`] simple_arc_end_subset_trans;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  UNDH 3113 THEN ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* -- *)
  UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`U`]);
  ASM_REWRITE_TAC[];
  UNDH 3232 THEN UNDH 5860 THEN UNDH 4934 THEN UNDH 7573 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;SUBSET] THEN REWRITE_TAC[EQ_EMPTY;UNION] THEN MESON_TAC[];
  (* -C *)
  TYPE_THEN `!i j. ?E'' u u''. E'' SUBSET E i j /\ simple_arc_end E'' u u'' /\ (E'' INTER (UNIONS (IMAGE (E i) {k | ~(k = j)})) = {u}) /\ (E'' INTER {(B j)} = {u''})` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_restriction;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  top_closed_unions;
  REWRITE_TAC[top2_top];
  CONJ_TAC;
  IMATCH_MP_TAC  FINITE_IMAGE;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN   `UNIV:three_t -> bool` EXISTS_TAC ;
  REWRITE_TAC[three_t_finite];
  REWRITE_TAC[SUBSET;IMAGE];
  TYPE_THEN `x` UNABBREV_TAC;
  ASM_MESON_TAC[simple_arc_end_closed];
  (* -- *)
  CONJ_TAC;
  ASM_MESON_TAC[simple_arc_end_end_closed2];
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[EQ_EMPTY;INTER;UNIONS;IMAGE;INR IN_SING ];
  TYPE_THEN `u` UNABBREV_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x'`;`B j`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `s j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNDH 7917 THEN ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  TYPE_THEN `p i` EXISTS_TAC;
  REWRITE_TAC[INTER;UNIONS;IMAGE];
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "u");
  THM_INTRO_TAC[`j`] three_t_not_sing;
  TYPE_THEN `j'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER];
  TYPE_THEN `B j` EXISTS_TAC;
  ASM_REWRITE_TAC[INR IN_SING ];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* - *)
  LEFTH 4870 "E''";
  LEFTH 4064 "E''";
  LEFTH 544 "u''";
  LEFTH 659 "u''";
  LEFTH 239 "u''";
  TYPE_THEN `u'' =  (\ i j. B j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  IMATCH_MP_TAC  EQ_EXT;
  TSPECH `x` 3583;
  TSPECH `x'` 7705;
  USEH 2213 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  IMATCH_MP_TAC  EQ_SYM;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USEH 3027 SYM;
  ASM_REWRITE_TAC[];
  TYPE_THEN `u''` UNABBREV_TAC;
  (* - *)
  LEFTH 1162 "u";
  LEFTH 3727 "u";
  TYPE_THEN `!i j. (?E' ua u'. E' SUBSET (E'' i j) /\ simple_arc_end E' ua u' /\ (E' INTER {(u i j)} = {ua}) /\ (E' INTER (s j) = {u'}))` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_restriction;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC [];
  (* -- *)
  CONJ_TAC;
  ASM_MESON_TAC[simple_arc_end_end_closed];
  CONJ_TAC;
  ASM_MESON_TAC[simple_arc_end_closed];
  (* -- *)
  CONJ_TAC;
  PROOF_BY_CONTR_TAC;
  USEH 4139 (REWRITE_RULE[INTER;EMPTY_EXISTS;INR IN_SING]);
  TYPE_THEN `u'` UNABBREV_TAC;
  TSPECH `i` 2275;
  TSPECH `j` 631;
  USEH 9848 (REWRITE_RULE[eq_sing;INR IN_SING;INTER;UNIONS;IMAGE]);
  TYPE_THEN `u''` UNABBREV_TAC;
  UNDH 9165 THEN REWRITE_TAC[];
  UNDH 3778 THEN DISCH_THEN IMATCH_MP_TAC ;
  UNDH 1277 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `u i j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C (u i j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `s j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x`;`u i j`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `E'' i j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `j` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ];
  CONJ_TAC;
  TYPE_THEN `u i j` EXISTS_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `B j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  LEFTH 5131 "E'";
  LEFTH 6920 "E'";
  (* -D *)
  TYPE_THEN `!i j k q x. E i k x /\ E'' i j q /\ ~(q = u i j) /\ ~(q  = B j) /\ cut_arc (E i j) (q) (B j) x ==> (j = k)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  (* -- *)
  TYPE_THEN `cut_arc (E i j) q (B j)   = cut_arc (E'' i j) q (B j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_replace;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* -- *)
  REWRH 4315;
  TYPE_THEN `E'' i j x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `cut_arc (E'' i j) q (B j)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* -- *)
  UNDH 2275 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  USEH 9848 (REWRITE_RULE[INTER;UNIONS;IMAGE;eq_sing;INR IN_SING]);
  TYPE_THEN `x = u i j` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `k` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `x` UNABBREV_TAC;
  (* -- *)
  THM_INTRO_TAC[`E'' i j`;`q`;`B j`;`u i j`] cut_arc_order;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  UNDH 1152 THEN ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[cut_arc_symm];
  ASM_REWRITE_TAC[];
  (* -Da *)
  TYPE_THEN `?u'. !i j. E' i j SUBSET E'' i j /\ simple_arc_end (E' i j) (u i j) (u' i j) /\ (E' i j INTER s j = {(u' i j)})` SUBAGOAL_TAC;
  LEFTH 2832 "ua";
  LEFTH 6021 "ua";
  LEFTH 4322 "u'";
  LEFTH 1946 "u'";
  TYPE_THEN `u'` EXISTS_TAC;
  TSPECH `i` 1323;
  TSPECH `j` 1285;
  ASM_REWRITE_TAC[];
  USEH 7215 (REWRITE_RULE[INTER;INR IN_SING;eq_sing;]);
  TYPE_THEN `ua i j` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  KILLH 2832;
  (* - *)
  TYPE_THEN `!i j. E' i j SUBSET E i j` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `E'' i j` EXISTS_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i j. ?q. (E' i j q) /\ (E'' i j q) /\ (E i j q) /\ ~(q = u i j) /\ ~(q = u' i j) /\ ~(s j q) /\ (!k. E i k q ==> (j = k))` SUBAGOAL_TAC;
  TSPECH `i` 7629;
  TSPECH `j` 6300;
  THM_INTRO_TAC[`E' i j`;`u i j`;`u' i j`] simple_arc_midpoint;
  ASM_REWRITE_TAC[];
  TYPE_THEN `q = u''` ABBREV_TAC ;
  TYPE_THEN `u''` UNABBREV_TAC;
  TYPE_THEN `q` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `E' i j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `E' i j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  SUBCONJ_TAC;
  USEH 3228 (REWRITE_RULE[INR IN_SING;eq_sing;INTER]);
  ASM_MESON_TAC[];
  TSPECH `i` 6619;
  TSPECH `j` 4357;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `q` EXISTS_TAC;
  TYPE_THEN `q` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  SUBCONJ_TAC;
  UNDH 9552 THEN REWRITE_TAC[];
  TYPE_THEN `q` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`E i j`;`q`;`B j`] cut_arc_simple;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  LEFTH 7093 "q";
  LEFTH 7917 "q";
  (* -E *)
  TYPE_THEN `CA = (\ i j. cut_arc (E i j) (p i) (q i j))` ABBREV_TAC ;
  TYPE_THEN `CB = (\ i j. cut_arc (E i j) (q i j) (B j))` ABBREV_TAC ;
  TYPE_THEN `!i j. ~(q i j = p i)` SUBAGOAL_TAC;
  TSPECH `i` 3615;
  TSPECH `j` 524;
  THM_INTRO_TAC[`j`] three_t_not_sing;
  UNDH 2577 THEN REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j. ~(q i j = B j)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i j. simple_arc_end (CA i j) (p i) (q i j)` SUBAGOAL_TAC;
  TYPE_THEN `CA` UNABBREV_TAC;
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC simple_arc_end_simple;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i j. simple_arc_end (CB i j) (q i j) (B j)` SUBAGOAL_TAC;
  TYPE_THEN `CB` UNABBREV_TAC;
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* -F *)
  THM_INTRO_TAC[`q`;`p`;`CA`;`B`;`CB`] no_k33_planar_graph_data THENL [ALL_TAC;ASM_REWRITE_TAC[]];
  ASM_REWRITE_TAC[];
  TYPE_THEN `(!i j. simple_arc_end (CB i j) (B j) (q i j)) ` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j. CA i j INTER C = EMPTY` SUBAGOAL_TAC;
  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
  TYPE_THEN `CA` UNABBREV_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  USEH 6239 (REWRITE_RULE[INTER;SUBSET]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!i j j' u. CB i j u /\ E i j' u ==> (j = j')` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `q i j` EXISTS_TAC;
  TYPE_THEN `u''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `CB` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j. CB i j = cut_arc (E'' i j) (q i j) (B j)` SUBAGOAL_TAC;
  TYPE_THEN `CB` UNABBREV_TAC;
  IMATCH_MP_TAC  cut_arc_replace;
  ASM_REWRITE_TAC[];
  TYPE_THEN `simple_arc top2 (E i j)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
  (* - *)
  TYPE_THEN `!i i' j j' u. ~(i = i') /\ CB i j u /\ E i' j' u ==> (j = j') /\ s j u` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `i` EXISTS_TAC;
  TYPE_THEN `i'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `CB` UNABBREV_TAC;
  SUBCONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `cut_arc (E i j) (q i j) (B j)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `E'' i j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
  PROOF_BY_CONTR_TAC;
  UNDH 3113 THEN REWRITE_TAC[];
  UNDH 6138 THEN DISCH_THEN (IMATCH_MP_TAC );
  TYPE_THEN `j` EXISTS_TAC;
  TYPE_THEN `j'` EXISTS_TAC;
  TYPE_THEN `u''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -G *)
  USEH 9121 GSYM;
  TYPE_THEN `!i j. CB i j SUBSET E i j` SUBAGOAL_TAC;
  TYPE_THEN `CB` UNABBREV_TAC;
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
  (* - *)
  TYPE_THEN `(!i j i' j'. ~(CB i j INTER CB i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC;
  USEH 2001  (REWRITE_RULE [INTER;EMPTY_EXISTS]);
  TYPE_THEN `i = i'` ASM_CASES_TAC;
  UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `CB i' j'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -- *)
  UNDH 3773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `CB i' j'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `j'` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!i j. CA i j SUBSET E i j` SUBAGOAL_TAC;
  TYPE_THEN `CA` UNABBREV_TAC;
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_simple];
  (* -H *)
  TYPE_THEN `(!i j i' j' u. CB i j u /\ CA i' j' u ==> (i = i') /\ (j = j') /\ (u = q i j))` SUBAGOAL_TAC;
  TYPE_THEN `i = i'` ASM_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `i'` UNABBREV_TAC;
  UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `CA i j'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `j'` UNABBREV_TAC;
  THM_INTRO_TAC[`E i j`;`q i j`;`p i`;`B j`] cut_arc_inter;
  ASM_REWRITE_TAC[];
  USEH 699 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `CA` UNABBREV_TAC;
  TYPE_THEN `CB` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  UNDH 3773 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `CA i' j'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `j'` UNABBREV_TAC;
  (* -- *)
  USEH 682 (REWRITE_RULE[INTER;EQ_EMPTY]);
  UNDH 218 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`u''`]);
  UNDH 2186 THEN ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `s j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -I *)
  CONJ_TAC;
  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`q i j`]);
  CONJ_TAC;
  TYPE_THEN `CB` UNABBREV_TAC;
  ASM_MESON_TAC[simple_arc_end_end];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_end2];
  TYPE_THEN `i'` UNABBREV_TAC;
  TYPE_THEN `j'` UNABBREV_TAC;
  (* - *)
  USEH 6538 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
  UNDH 6138 THEN DISCH_THEN IMATCH_MP_TAC ;
  TYPE_THEN `j` EXISTS_TAC;
  TYPE_THEN `j'` EXISTS_TAC;
  TYPE_THEN `u''` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `CA i j` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `CA i' j'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNDH 682 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER ];
  UNDH 7281 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
 UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Sun Jan 16 08:48:56 EST 2005 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION CC *)
(* ------------------------------------------------------------------ *)

(* finish off Jordan curve *)

let simple_closed_curve_compact = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> compact top2 C`,

  (* {{{ proof *)

  [
  REWRITE_TAC[simple_closed_curve];
  TYPE_THEN `C` UNABBREV_TAC;
  IMATCH_MP_TAC  image_compact;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[top2_unions];
  CONJ_TAC;
  REWRITE_TAC[interval_compact];
  REWRITE_TAC[IMAGE;SUBSET];
  FULL_REWRITE_TAC[INJ];
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `x' = &1` ASM_CASES_TAC;
  TYPE_THEN `x'` UNABBREV_TAC;
  USEH 5825 SYM;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  REAL_ARITH_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  UNDH 6268 THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC;
  (* Sun Jan 16 09:13:09 EST 2005 *)

  ]);;
  (* }}} *)

let ymaxQexists_lemma = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==>
         (?p. C p /\ (!q. C q ==> (q 1 <=. p 1)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`1`;`2`] continuous_euclid1;
  FULL_REWRITE_TAC[GSYM top2];
  THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_max_real;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_closed_curve_compact;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[simple_closed_curve];
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 2198 GSYM;
  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
  TSPECH `f (&0)` 9716;
  UNDH 5422 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  FULL_REWRITE_TAC[coord];
  ASM_REWRITE_TAC[];
  (* Sun Jan 16 09:16:3282 EST 2005 *)

  ]);;
  (* }}} *)

let yminQexists_lemma = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==>
         (?p. C p /\ (!q. C q ==> (p 1 <=. q 1)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`1`;`2`] continuous_euclid1;
  FULL_REWRITE_TAC[GSYM top2];
  THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_min_real;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_closed_curve_compact;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[simple_closed_curve];
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 2198 GSYM;
  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
  TSPECH `f (&0)` 9716;
  UNDH 5422 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  FULL_REWRITE_TAC[coord];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let xmaxQexists_lemma = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==>
         (?p. C p /\ (!q. C q ==> (q 0 <=. p 0)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`0`;`2`] continuous_euclid1;
  FULL_REWRITE_TAC[GSYM top2];
  THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_max_real;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_closed_curve_compact;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[simple_closed_curve];
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 2198 GSYM;
  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
  TSPECH `f (&0)` 9716;
  UNDH 5422 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  FULL_REWRITE_TAC[coord];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let xminQexists_lemma = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==>
         (?p. C p /\ (!q. C q ==> (p 0 <=. q 0)))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`0`;`2`] continuous_euclid1;
  FULL_REWRITE_TAC[GSYM top2];
  THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_min_real;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_closed_curve_compact;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[simple_closed_curve];
  TYPE_THEN `C` UNABBREV_TAC;
  USEH 2198 GSYM;
  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
  TSPECH `f (&0)` 9716;
  UNDH 5422 THEN ASM_REWRITE_TAC[];
  TYPE_THEN `&0` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  FULL_REWRITE_TAC[coord];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

(* state pSC *)
let ymaxQ = jordan_def `ymaxQ C = supm { y | ?x. (C (point(x,y))) }`;;
let yminQ = jordan_def `yminQ C = inf { y | ?x. (C (point(x,y))) }`;;
let xmaxQ = jordan_def `xmaxQ C = supm { x | ?y. (C (point(x,y))) }`;;
let xminQ = jordan_def `xminQ C = inf { x | ?y. (C (point(x,y))) }`;;

let inf_unique = 
prove_by_refinement(
  `!X s. X s /\ (!t. X t ==> (s <= t)) ==> (s = inf X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`X`] inf_LB;
  REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `s` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN   `(s <= inf X) /\ (inf X <= s)` BACK_TAC;
  UNDH 9491 THEN UNDH 1818 THEN REAL_ARITH_TAC;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let supm_unique = 
prove_by_refinement(
  `!X s. X s /\ (!t. X t ==> (t <= s)) ==> (s = supm X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`X`] supm_UB;
  REWRITE_TAC[EMPTY_EXISTS];
  CONJ_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `s` EXISTS_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  TYPE_THEN   `(s <= supm X) /\ (supm X <= s)` BACK_TAC;
  UNDH 4025 THEN UNDH 5913 THEN REAL_ARITH_TAC;
  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Sun Jan 16 09:42:06 EST 2005 *)

  ]);;
  (* }}} *)

let euclid2_point = 
prove_by_refinement(
  `!p. euclid 2 p ==> (point (p 0, p 1) = p)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USEH 7802 (MATCH_MP   point_onto);
  TYPE_THEN `p` UNABBREV_TAC;
  REWRITE_TAC[point_inj];
  REWRITE_TAC[coord01];
  ]);;
  (* }}} *)

let ymaxQ_exists = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = ymaxQ C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] ymaxQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[ymaxQ];
  IMATCH_MP_TAC  supm_unique;
  CONJ_TAC;
  TYPE_THEN `p 0` EXISTS_TAC;
  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_SIMP_TAC[simple_closed_curve_euclid];
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC;
  REWRITE_TAC[coord01];
  UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `A = point(x,t)` ABBREV_TAC  ;
  REWRITE_TAC[ETA_AX];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let yminQ_exists = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = yminQ C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] yminQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[yminQ];
  IMATCH_MP_TAC  inf_unique;
  CONJ_TAC;
  TYPE_THEN `p 0` EXISTS_TAC;
  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_SIMP_TAC[simple_closed_curve_euclid];
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC;
  REWRITE_TAC[coord01];
  UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `A = point(x,t)` ABBREV_TAC  ;
  REWRITE_TAC[ETA_AX];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let xmaxQ_exists = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xmaxQ C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] xmaxQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[xmaxQ];
  IMATCH_MP_TAC  supm_unique;
  CONJ_TAC;
  TYPE_THEN `p 1` EXISTS_TAC;
  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_SIMP_TAC[simple_closed_curve_euclid];
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC;
  REWRITE_TAC[coord01];
  UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `A = point(t,y)` ABBREV_TAC  ;
  REWRITE_TAC[ETA_AX];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let xminQ_exists = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xminQ C))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] xminQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[xminQ];
  IMATCH_MP_TAC  inf_unique;
  CONJ_TAC;
  TYPE_THEN `p 1` EXISTS_TAC;
  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_SIMP_TAC[simple_closed_curve_euclid];
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC;
  REWRITE_TAC[coord01];
  UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `A = point(t,y)` ABBREV_TAC  ;
  REWRITE_TAC[ETA_AX];
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let ymaxQ_max = 
prove_by_refinement(
  `!C p. simple_closed_curve top2 C /\ C p ==> (p 1 <= ymaxQ C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[ymaxQ];
  THM_INTRO_TAC[`C`] ymaxQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] supm_UB;
  REWRITE_TAC[EMPTY_EXISTS];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `p 1` EXISTS_TAC;
  TYPE_THEN `p 0` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `p' 1` EXISTS_TAC;
  TSPECH `point(x',x)` 1647;
  FULL_REWRITE_TAC[coord01];
  ASM_REWRITE_TAC[];
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `p 0` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  ]);;
  (* }}} *)

let yminQ_min = 
prove_by_refinement(
  `!C p. simple_closed_curve top2 C /\ C p ==> (yminQ C <= p 1)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[yminQ];
  THM_INTRO_TAC[`C`] yminQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] inf_LB;
  REWRITE_TAC[EMPTY_EXISTS];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `p 1` EXISTS_TAC;
  TYPE_THEN `p 0` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `p' 1` EXISTS_TAC;
  TSPECH `point(x',x)` 2887;
  FULL_REWRITE_TAC[coord01];
  ASM_REWRITE_TAC[];
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `p 0` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  ]);;
  (* }}} *)

let xmaxQ_max = 
prove_by_refinement(
  `!C p. simple_closed_curve top2 C /\ C p ==> (p 0 <= xmaxQ C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[xmaxQ];
  THM_INTRO_TAC[`C`] xmaxQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] supm_UB;
  REWRITE_TAC[EMPTY_EXISTS];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `p 0` EXISTS_TAC;
  TYPE_THEN `p 1` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `p' 0` EXISTS_TAC;
  TSPECH `point(x,y)` 3013;
  FULL_REWRITE_TAC[coord01];
  ASM_REWRITE_TAC[];
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `p 1` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  ]);;
  (* }}} *)

let xminQ_min = 
prove_by_refinement(
  `!C p. simple_closed_curve top2 C /\ C p ==> (xminQ C <= p 0)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[xminQ];
  THM_INTRO_TAC[`C`] xminQexists_lemma;
  ASM_REWRITE_TAC[];
  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] inf_LB;
  REWRITE_TAC[EMPTY_EXISTS];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `p 0` EXISTS_TAC;
  TYPE_THEN `p 1` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  TYPE_THEN `p' 0` EXISTS_TAC;
  TSPECH `point(x,y)` 4062;
  FULL_REWRITE_TAC[coord01];
  ASM_REWRITE_TAC[];
  (* - *)
  FIRST_ASSUM IMATCH_MP_TAC ;
  TYPE_THEN `p 1` EXISTS_TAC;
  ASM_SIMP_TAC[euclid2_point];
  (* Sun Jan 16 13:15:02 EST 2005 *)
  ]);;
  (* }}} *)

extend_simp_rewrites[prove_by_refinement(
  `!x. x <=. x`,
  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REAL_ARITH_TAC;
  ])];;
  (* }}} *)

let real012 = 
prove_by_refinement(
  `&0 < &1 /\ &0 <= &1 /\ &0 <= &1 / &2 /\ &0 < &1 / &2 /\ &1/ &2 < &1 /\ &1 / &2 <= &1 `,

  (* {{{ proof *)
  [
  CONJ_TAC;
  REAL_ARITH_TAC;
  CONJ_TAC;
  REAL_ARITH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_RDIV;
  REAL_ARITH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_DIV;
  REAL_ARITH_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LT_1;
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  REAL_LE_LDIV;
  REAL_ARITH_TAC;
  ]);;
  (* }}} *)

extend_simp_rewrites[real012];;

let simple_closed_curve_nonempty = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (?p. C p)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_closed_curve];
  KILLH 5825;
  TYPE_THEN `f (&0)` EXISTS_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  IMATCH_MP_TAC  image_imp;
  ASM_RSIMP_TAC[];
  ]);;
  (* }}} *)

let simple_closed_curve_2pt = 
prove_by_refinement(
  `!C p. simple_closed_curve top2 C /\ C p ==> (?q. C q /\ ~(q = p))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_closed_curve];
  USEH 5825 GSYM;
  TYPE_THEN `~(f (&0) = f( &1 / &2))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[INJ];
  TYPE_THEN `&0 = &1 / &2` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* --- *)
  ASM_RSIMP_TAC [];
  TYPE_THEN `&0 < &2` SUBAGOAL_TAC;
  REAL_ARITH_TAC;
  TYPE_THEN `&0 < &1 / &2` SUBAGOAL_TAC;
  ASM_RSIMP_TAC[];
  UNDH 4792 THEN UNDH 3735 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `C (f (&1 / &2))` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  IMATCH_MP_TAC  image_imp;
  ASM_RSIMP_TAC[];
  (* - *)
  TYPE_THEN `p = f (&0)` ASM_CASES_TAC;
  TYPE_THEN `p` UNABBREV_TAC;
  TYPE_THEN `f (&1 / &2)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `f (&0)` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  image_imp;
  ASM_RSIMP_TAC[];
  ]);;
  (* }}} *)

let xmin_le_xmax = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (xminQ C <= xmaxQ C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] xminQ_exists;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`p`] xmaxQ_max;
  ASM_REWRITE_TAC[];
  USEH 6458 GSYM;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let ymin_le_ymax = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (yminQ C <= ymaxQ C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] yminQ_exists;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`p`] ymaxQ_max;
  ASM_REWRITE_TAC[];
  USEH 4513 GSYM;
  ASM_REWRITE_TAC[];
  ]);;
  (* }}} *)

let simple_closed_curve_nsubset_arc = 
prove_by_refinement(
  `!C E. simple_closed_curve top2 C /\ simple_arc top2 E ==>
     ~(C SUBSET E)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C' SUBSET E /\ C'' SUBSET E` SUBAGOAL_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  UNDH 6378 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
  THM_INTRO_TAC[`E`;`p`;`q`;`C'`] cut_arc_unique;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`E`;`p`;`q`;`C''`] cut_arc_unique;
  ASM_REWRITE_TAC[];
  TYPE_THEN `cut_arc E p q` UNABBREV_TAC;
  TYPE_THEN `C''` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_IDEMPOT];
  TYPE_THEN `C'` UNABBREV_TAC;
  THM_INTRO_TAC[`{p,q}`] simple_arc_infinite;
  IMATCH_MP_TAC  simple_arc_end_simple;
 UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[INFINITE];
  FULL_REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
  ASM_REWRITE_TAC[];
  (* Sun Jan 16 15:22:30 EST 2005 *)
  ]);;
  (* }}} *)

let xmin_lt_xmax = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (xminQ C < xmaxQ C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
  ASM_SIMP_TAC [xmin_le_xmax];
  THM_INTRO_TAC[`C`] ymin_le_ymax;
  ASM_REWRITE_TAC[];
  TYPE_THEN `yminQ C < ymaxQ C` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
  ASM_SIMP_TAC[ymin_le_ymax];
  TYPE_THEN `!p. C p ==> (p = point(xminQ C,yminQ C))` SUBAGOAL_TAC;
  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  USEH 7802 (MATCH_MP point_onto);
(*** Modified by JRH for proper right associativity of "="
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;REAL_ARITH `x = y = (x <= y) /\ (y <= x)`];
 ***)
  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_LE_ANTISYM];
  TYPE_THEN `(FST p' = p 0) /\ (SND p' = p 1)` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[coord01];
  KILLH 5687;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  xmaxQ_max;
  ASM_REWRITE_TAC[];
  USEH 5418 GSYM;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  xminQ_min;
  ASM_REWRITE_TAC[];
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  ymaxQ_max;
  ASM_REWRITE_TAC[];
  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
  IMATCH_MP_TAC  yminQ_min;
  ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
  ASM_REWRITE_TAC[];
  COPYH 9414;
  TSPECH `p` 9414;
  TYPE_THEN `point(xminQ C,yminQ C)` UNABBREV_TAC;
  THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* -A  BACK ON *)
  TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!p. C p ==> (p 0 = xmaxQ C)` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`];
  CONJ_TAC;
  IMATCH_MP_TAC  xmaxQ_max;
  ASM_REWRITE_TAC[];
  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
  IMATCH_MP_TAC  xminQ_min;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!p. C p ==> (yminQ C <= p 1 /\ p 1 <= ymaxQ C)` SUBAGOAL_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  yminQ_min;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  ymaxQ_max;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`C`] yminQ_exists;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ;
  TYPE_THEN `p` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  TSPECH `p` 2734;
  USEH 7802 (MATCH_MP point_onto);
  TYPE_THEN `p` UNABBREV_TAC;
  REWRITE_TAC[point_inj];
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `yminQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  TSPECH `point p'` 111;
  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
  TYPE_THEN `xminQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  (* - *)
  TYPE_THEN `C (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`C`] ymaxQ_exists;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p = point(xminQ C, ymaxQ C)` BACK_TAC ;
  TYPE_THEN `p` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  TSPECH `p` 2734;
  USEH 7802 (MATCH_MP point_onto);
  TYPE_THEN `p` UNABBREV_TAC;
  REWRITE_TAC[point_inj];
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  TSPECH `point p'` 111;
  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
  TYPE_THEN `xminQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  (* - *)
  TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC;
  ASM_SIMP_TAC [SUBSET;mk_segment_v];
  TYPE_THEN `x 1` EXISTS_TAC;
  TYPE_THEN `yminQ C <= x 1 /\ x 1 <= ymaxQ C ` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  TSPECH `x` 2734;
  USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  REWRITE_TAC[point_inj];
  REWRITE_TAC[PAIR_SPLIT;coord01];
  TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC;
  REWRITE_TAC[coord01];
  ASM_REWRITE_TAC[];
  TYPE_THEN `q = point p` ABBREV_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* -B *)
  THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xminQ C,ymaxQ C))`] simple_closed_curve_nsubset_arc;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  TYPE_THEN `point(xmaxQ C,yminQ C)` EXISTS_TAC;
  TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC;
  IMATCH_MP_TAC  mk_segment_simple_arc_end;
  REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ];
  UNDH 1234 THEN UNDH 5378 THEN REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  (* Sun Jan 16 15:26:36 EST 2005 *)

  ]);;
  (* }}} *)

let ymin_lt_ymax = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (yminQ C < ymaxQ C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
  ASM_SIMP_TAC [ymin_le_ymax];
  THM_INTRO_TAC[`C`] xmin_lt_xmax;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!p. C p ==> (p 1 = ymaxQ C)` SUBAGOAL_TAC;
  REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`];
  CONJ_TAC;
  IMATCH_MP_TAC  ymaxQ_max;
  ASM_REWRITE_TAC[];
  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
  IMATCH_MP_TAC  yminQ_min;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!p. C p ==> (xminQ C <= p 0 /\ p 0 <= xmaxQ C)` SUBAGOAL_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  xminQ_min;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  xmaxQ_max;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`C`] xminQ_exists;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ;
  TYPE_THEN `p` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  TSPECH `p` 2734;
  USEH 7802 (MATCH_MP point_onto);
  TYPE_THEN `p` UNABBREV_TAC;
  REWRITE_TAC[point_inj];
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `xminQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  TSPECH `point p'` 4874;
  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
  TYPE_THEN `yminQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  (* - *)
  TYPE_THEN `C (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC;
  THM_INTRO_TAC[`C`] xmaxQ_exists;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p = point(xmaxQ C, yminQ C)` BACK_TAC ;
  TYPE_THEN `p` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  TSPECH `p` 2734;
  USEH 7802 (MATCH_MP point_onto);
  TYPE_THEN `p` UNABBREV_TAC;
  REWRITE_TAC[point_inj];
  REWRITE_TAC[PAIR_SPLIT];
  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  TSPECH `point p'` 4874;
  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
  TYPE_THEN `yminQ C` UNABBREV_TAC;
  REWRITE_TAC[coord01];
  (* - *)
  TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC;
  TYPE_THEN `xminQ C <= xmaxQ C` SUBAGOAL_TAC;
  UNDH 5679 THEN REAL_ARITH_TAC;
  ASM_SIMP_TAC [SUBSET;mk_segment_h];
  TYPE_THEN `x 0` EXISTS_TAC;
  TYPE_THEN `xminQ C <= x 0 /\ x 0 <= xmaxQ C ` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  TSPECH `x` 2734;
  USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  REWRITE_TAC[point_inj];
  REWRITE_TAC[PAIR_SPLIT;coord01];
  TYPE_THEN `SND  p = point p 1` SUBAGOAL_TAC;
  REWRITE_TAC[coord01];
  ASM_REWRITE_TAC[];
  TYPE_THEN `q = point p` ABBREV_TAC ;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* -B *)
  THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xmaxQ C,yminQ C))`] simple_closed_curve_nsubset_arc;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  TYPE_THEN `point(xminQ C,ymaxQ C)` EXISTS_TAC;
  TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC;
  IMATCH_MP_TAC  mk_segment_simple_arc_end;
  REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ];
  UNDH 5418 THEN UNDH 5679 THEN REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  (* Sun Jan 16 15:39:56 EST 2005 *)

  ]);;
  (* }}} *)

let simple_closed_curve_closed = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==> (closed_ top2 C)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C` UNABBREV_TAC;
  IMATCH_MP_TAC  closed_union;
  REWRITE_TAC[top2_top];
  CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_closed THEN UNIFY_EXISTS_TAC  THEN ASM_REWRITE_TAC[];
  (* Sun Jan 16 16:43:23 EST 2005 *)

  ]);;
  (* }}} *)

let simple_closed_curve_mk_C = 
prove_by_refinement(
  `!Q.  simple_closed_curve top2 Q ==>
       ?C v1 v2. simple_arc_end C v1 v2 /\
       (C INTER Q = {v1,v2}) /\
       (v2 1 = yminQ Q) /\
       (v1 1 = ymaxQ Q) /\
       (!x. C x ==>
           (x 1 = yminQ Q) \/ (x 1 = ymaxQ Q) \/ (xmaxQ Q < x 0))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `Ca = mk_segment (point(xminQ Q,yminQ Q)) (point(xmaxQ Q + &1,yminQ Q))` ABBREV_TAC ;
  (* - *)
  TYPE_THEN `xminQ Q <= xmaxQ Q + &1` SUBAGOAL_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `xmaxQ Q` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC xmin_le_xmax;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* - *)
  THM_INTRO_TAC[`Ca`;`Ca INTER Q`;`{(point(xmaxQ Q + &1,yminQ Q))}`] simple_arc_end_restriction;
  SUBCONJ_TAC;
  TYPE_THEN `Ca` UNABBREV_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  THM_INTRO_TAC[`point(xminQ Q,yminQ Q)`;`point(xmaxQ Q + &1,yminQ Q)`] mk_segment_simple_arc_end;
  REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT];
  THM_INTRO_TAC[`Q`] xmin_lt_xmax;
  ASM_REWRITE_TAC[];
  UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  closed_inter2;
  REWRITE_TAC[top2_top];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  ASM_MESON_TAC[simple_arc_choose_end];
  IMATCH_MP_TAC  simple_closed_curve_closed;
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[EMPTY_EXISTS;INTER;];
  REWRITE_TAC[INR IN_SING;EQ_EMPTY];
  CONJ_TAC;
  IMATCH_MP_TAC  closed_point;
  REWRITE_TAC[euclid_point];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  THM_INTRO_TAC[`Q`] xmaxQ_max;
  TSPECH  `(point (xmaxQ Q + &1, yminQ Q))` 9371;
  REWRH 3532;
  FULL_REWRITE_TAC[coord01];
  UNDH 3234 THEN REAL_ARITH_TAC;
  (* -- *)
  CONJ_TAC;
  THM_INTRO_TAC[`Q`] yminQ_exists;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Ca` UNABBREV_TAC;
  ASM_SIMP_TAC[mk_segment_h];
  TYPE_THEN `p 0` EXISTS_TAC;
  TYPE_THEN `yminQ Q` UNABBREV_TAC;
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  xminQ_min;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `xmaxQ Q` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  xmaxQ_max;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  (GSYM euclid2_point);
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `Q` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* -- *)
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `Ca` UNABBREV_TAC;
  ASM_SIMP_TAC[mk_segment_h];
  REWRITE_TAC[point_inj; PAIR_SPLIT;];
  CONV_TAC (dropq_conv "t");
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* -A *)
  TYPE_THEN `Cb = mk_segment(point(xminQ Q,ymaxQ Q)) (point(xmaxQ Q + &1,ymaxQ Q))` ABBREV_TAC ;
  THM_INTRO_TAC[`Cb`;`Cb INTER Q`;`{(point(xmaxQ Q + &1,ymaxQ Q))}`] simple_arc_end_restriction;
  SUBCONJ_TAC;
  TYPE_THEN `Cb` UNABBREV_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  THM_INTRO_TAC[`point(xminQ Q,ymaxQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] mk_segment_simple_arc_end;
  REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT];
  THM_INTRO_TAC[`Q`] xmin_lt_xmax;
  ASM_REWRITE_TAC[];
  UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC;
  ASM_MESON_TAC[];
  (* -- *)
  CONJ_TAC;
  IMATCH_MP_TAC  closed_inter2;
  REWRITE_TAC[top2_top];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  ASM_MESON_TAC[simple_arc_choose_end];
  IMATCH_MP_TAC  simple_closed_curve_closed;
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[EMPTY_EXISTS;INTER;];
  REWRITE_TAC[INR IN_SING;EQ_EMPTY];
  CONJ_TAC;
  IMATCH_MP_TAC  closed_point;
  REWRITE_TAC[euclid_point];
  (* -- *)
  CONJ_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  THM_INTRO_TAC[`Q`] xmaxQ_max;
  TSPECH  `(point (xmaxQ Q + &1, ymaxQ Q))` 9371;
  REWRH 5576;
  FULL_REWRITE_TAC[coord01];
  UNDH 3234 THEN REAL_ARITH_TAC;
  (* -- *)
  CONJ_TAC;
  THM_INTRO_TAC[`Q`] ymaxQ_exists;
  ASM_REWRITE_TAC[];
  TYPE_THEN `p` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Cb` UNABBREV_TAC;
  ASM_SIMP_TAC[mk_segment_h];
  TYPE_THEN `p 0` EXISTS_TAC;
  TYPE_THEN `ymaxQ Q` UNABBREV_TAC;
  (* --- *)
  CONJ_TAC;
  IMATCH_MP_TAC  xminQ_min;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  REAL_LE_TRANS;
  TYPE_THEN `xmaxQ Q` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  xmaxQ_max;
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  IMATCH_MP_TAC  (GSYM euclid2_point);
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `Q` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* -- *)
  CONV_TAC (dropq_conv "u");
  TYPE_THEN `Cb` UNABBREV_TAC;
  ASM_SIMP_TAC[mk_segment_h];
  REWRITE_TAC[point_inj; PAIR_SPLIT;];
  CONV_TAC (dropq_conv "t");
  ASM_REWRITE_TAC[];
  REAL_ARITH_TAC;
  (* -B *)
  TYPE_THEN `Cu = mk_segment (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` ABBREV_TAC ;
  TYPE_THEN `simple_arc_end Cu (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` SUBAGOAL_TAC;
  TYPE_THEN `Cu` UNABBREV_TAC;
  IMATCH_MP_TAC  mk_segment_simple_arc_end;
  REWRITE_TAC[euclid_point];
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  THM_INTRO_TAC[`Q`] ymin_lt_ymax;
  ASM_REWRITE_TAC[];
  UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `yminQ Q <= ymaxQ Q` SUBAGOAL_TAC;
  IMATCH_MP_TAC  ymin_le_ymax;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `v' = point (xmaxQ Q + &1,yminQ Q)` SUBAGOAL_TAC;
  USEH 1212 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `v'` UNABBREV_TAC;
  (* - *)
  TYPE_THEN `v''' = point (xmaxQ Q + &1,ymaxQ Q)` SUBAGOAL_TAC;
  USEH 7634 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `v'''` UNABBREV_TAC;
  (* - *)
  THM_INTRO_TAC[`C'`;`Cu`;`v`;`point(xmaxQ Q + &1,yminQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] simple_arc_end_trans;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[eq_sing;INR IN_SING;INTER;];
  CONJ_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_end2;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Cu` UNABBREV_TAC;
  REWRITE_TAC[mk_segment_end];
  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  USEH 2838 (MATCH_MP point_onto);
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  CONJ_TAC;
  TYPE_THEN `Cu` UNABBREV_TAC;
  UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_REWRITE_TAC[];
  TYPE_THEN `Ca (point p)` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `Ca` UNABBREV_TAC;
  UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_REWRITE_TAC[];
  (* -C *)
  TYPE_THEN `((C' UNION Cu) INTER Q = {v}) /\ ((C' UNION Cu) INTER C'' = {(point(xmaxQ Q + &1,ymaxQ Q))}) /\ (v 1 = yminQ Q) /\ (!x. (C' UNION Cu) x ==> (x 1 = yminQ Q) \/ (xmaxQ Q < x 0))` SUBAGOAL_TAC;
  CONJ_TAC;
  REWRITE_TAC[INTER;eq_sing;INR IN_SING];
  CONJ_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  USEH 2123 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_REWRITE_TAC[];
  USEH 579 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  USEH 2123 (REWRITE_RULE[eq_sing;INTER;INR IN_SING]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `Cu` UNABBREV_TAC;
  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `Q` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  USEH 2838 (MATCH_MP point_onto);
  TYPE_THEN `u` UNABBREV_TAC;
  UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
  FULL_REWRITE_TAC[PAIR_SPLIT;point_inj];
  THM_INTRO_TAC[`Q`] xmaxQ_max;
  TSPECH `(point p)` 9371;
  REWRH 375;
  TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC;
  REWRITE_TAC[coord01];
  TYPE_THEN `FST p` UNABBREV_TAC;
  TYPE_THEN `point p 0` UNABBREV_TAC;
  UNDH 3234 THEN REAL_ARITH_TAC;
  (* -- *)
  CONJ_TAC;
  REWRITE_TAC[eq_sing;INR IN_SING;INTER];
  CONJ_TAC;
  CONJ_TAC;
  REWRITE_TAC[UNION];
  DISJ2_TAC;
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  USEH 2838 (MATCH_MP point_onto);
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  (* --- *)
  USEH 311 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `Ca (point p) /\ Cb (point p)` SUBAGOAL_TAC;
  CONJ_TAC THEN IMATCH_MP_TAC  subset_imp THEN ASM_MESON_TAC[];
  TYPE_THEN `Ca` UNABBREV_TAC;
  TYPE_THEN `Cb` UNABBREV_TAC;
  UNDH 4559 THEN UNDH 3719 THEN ASM_SIMP_TAC[mk_segment_h];
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `SND p` UNABBREV_TAC;
  THM_INTRO_TAC[`Q`] ymin_lt_ymax;
  ASM_REWRITE_TAC[];
  UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC;
  THM_INTRO_TAC[`p`] (GSYM coord01);
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `Cu` UNABBREV_TAC;
  UNDH 5078 THEN ASM_SIMP_TAC[mk_segment_v];
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_MESON_TAC[];
  TYPE_THEN `Cb (point p)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C''` EXISTS_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `Cb` UNABBREV_TAC;
  UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `!x. C' x ==> (x 1 = yminQ Q)` SUBAGOAL_TAC;
  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C'` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `Ca (point p)` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `Ca` UNABBREV_TAC;
  UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_REWRITE_TAC[coord01];
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  (* -- *)
  USEH 9465 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  DISJ1_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISJ2_TAC;
  IMATCH_MP_TAC  (REAL_ARITH  `(u + &1  = v) ==> (u < v)`);
  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `Cu` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `Cu` UNABBREV_TAC;
  UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_SIMP_TAC[coord01];
  (* -D *)
  TYPE_THEN `Cf = C' UNION Cu` ABBREV_TAC ;
  KILLH 7427 THEN KILLH 6091 THEN KILLH 7407 THEN KILLH 1428 THEN KILLH 2123 THEN KILLH 7904 THEN KILLH 700 THEN KILLH 3022;
  (* - *)
  TYPE_THEN `!x. C'' x ==> (x 1 = ymaxQ Q)` SUBAGOAL_TAC;
  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C''` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
 USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `Cb (point p)` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `Cb` UNABBREV_TAC;
  UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_REWRITE_TAC[coord01];
  (* - *)
  TYPE_THEN `C'' INTER Q = {v''}` SUBAGOAL_TAC;
  REWRITE_TAC[eq_sing;INR IN_SING;INTER;];
  USEH 6873 (REWRITE_RULE[SUBSET]);
  USEH 6548 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`Cf`;`C''`;`v`;`point(xmaxQ Q + &1,ymaxQ Q)`;`v''`] simple_arc_end_trans;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Cf UNION C''` EXISTS_TAC;
  TYPE_THEN `v''` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -E *)
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  REWRITE_TAC[SUBSET;INTER ;INR in_pair;];
  CONJ_TAC;
  USEH 3594 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  DISJ1_TAC;
  USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  DISJ2_TAC;
  USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[UNION];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `x` UNABBREV_TAC;
  USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_REWRITE_TAC[];
  USEH 3594 (REWRITE_RULE[UNION]);
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* Sun Jan 16 18:43:03 EST 2005 *)
  ]);;
  (* }}} *)

let simple_arc_end_IVT = 
prove_by_refinement(
  `!C v w i y. simple_arc_end C v w /\ v i <= y /\ y <= w i ==>
           (?u. C u /\ (u i = y)) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] simple_arc_connected;
  IMATCH_MP_TAC  simple_arc_end_simple;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`i`;`2`] continuous_euclid1;
  FULL_REWRITE_TAC[GSYM top2];
  (* - *)
  THM_INTRO_TAC[`coord i`;`top2`;`top_of_metric(UNIV,d_real)`;`C`] connect_image;
  ASM_REWRITE_TAC[];
  ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions];
  (* - *)
  TYPE_THEN `!u. C u ==> (IMAGE (coord i) C) (u i)` SUBAGOAL_TAC;
  TYPE_THEN `u i = coord i u` SUBAGOAL_TAC;
  REWRITE_TAC[coord];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`IMAGE (coord i) C`;`v i`;`w i`] connected_nogap;
  ASM_REWRITE_TAC[];
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* - *)
  USEH 9674 (REWRITE_RULE[SUBSET;IMAGE;coord]);
  USEH 8862 GSYM;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 07:07:14 EST 2005 *)

  ]);;
  (* }}} *)

let simple_closed_curve_mk_ABD = 
prove_by_refinement(
  `!Q v1 v2. simple_closed_curve top2 Q /\
       Q v1 /\ Q v2 /\ (v2 1 = yminQ Q) /\ (v1 1 = ymaxQ Q) ==>
       (?A B D w1 w2.
          simple_arc_end A v1 v2 /\
          simple_arc_end B v1 v2 /\
          (A UNION B = Q) /\
          (A INTER B = {v1,v2}) /\
          ~(w1 = v1) /\
          ~(w1 = v2) /\
          ~(w2 = v1) /\
          ~(w2 = v2) /\
          A w1 /\ B w2 /\
          simple_arc_end D w1 w2 /\
          (D INTER Q = {w1,w2}) /\
          (!x. D x ==>
              (yminQ Q < x 1) /\ (x 1 < ymaxQ Q) /\ (x 0 <= xmaxQ Q))
       )`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `ymid = (yminQ Q + ymaxQ Q)/(&2)` ABBREV_TAC ;
  TYPE_THEN `yminQ Q < ymaxQ Q` SUBAGOAL_TAC;
  IMATCH_MP_TAC  ymin_lt_ymax;
  ASM_REWRITE_TAC[];
  TYPE_THEN `yminQ Q < ymid /\ ymid < ymaxQ Q` SUBAGOAL_TAC;
  TYPE_THEN `ymid` UNABBREV_TAC;
  CONJ_TAC THENL[IMATCH_MP_TAC  real_middle1_lt;IMATCH_MP_TAC  real_middle2_lt] THEN ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~(v1 = v2)` SUBAGOAL_TAC;
  TYPE_THEN `v2` UNABBREV_TAC;
  TYPE_THEN `v1 1` UNABBREV_TAC;
  UNDH 6716 THEN UNDH 6486 THEN REAL_ARITH_TAC;
  (* - *)
  THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_cut;
  ASM_REWRITE_TAC[];
  TYPE_THEN `A = C'` ABBREV_TAC ;
  TYPE_THEN `C'` UNABBREV_TAC;
  TYPE_THEN `B = C''` ABBREV_TAC ;
  TYPE_THEN `C''` UNABBREV_TAC;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `C = mk_segment (point(xminQ Q,ymid)) (point(xmaxQ Q,ymid))` ABBREV_TAC ;
  TYPE_THEN `xminQ Q <= xmaxQ Q` SUBAGOAL_TAC;
  IMATCH_MP_TAC  xmin_le_xmax;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`(point(xminQ Q,ymid))`;`point(xmaxQ Q,ymid)`] mk_segment_simple_arc_end;
  REWRITE_TAC[point_inj;PAIR_SPLIT;euclid_point];
  TYPE_THEN `xminQ Q < xmaxQ Q` SUBAGOAL_TAC;
  IMATCH_MP_TAC  xmin_lt_xmax;
  ASM_REWRITE_TAC[];
  UNDH 3331 THEN UNDH 9105 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  TYPE_THEN `C` UNABBREV_TAC;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `!x. C x ==> (x 1 = ymid)` SUBAGOAL_TAC;
  TSPECH `x` 2734;
  USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  UNDH 3980 THEN (ASM_SIMP_TAC[mk_segment_h]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_REWRITE_TAC[coord01];
  (* -A *)
  TYPE_THEN `!x. C x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q` SUBAGOAL_TAC;
  TSPECH `x` 2734;
  USEH 1837 (MATCH_MP point_onto);
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `C` UNABBREV_TAC;
  UNDH 3980 THEN UNDH 8406 THEN (SIMP_TAC[mk_segment_h]);
  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
  ASM_REWRITE_TAC[coord01];
  (* - *)
  THM_INTRO_TAC[`C`;`A INTER C`;`B INTER C`] simple_arc_end_restriction;
  ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[] top2_top;
  TYPE_THEN `!E v v'. simple_arc_end E v v' ==> closed_ top2 E` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  closed_inter2;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  closed_inter2;
  ASM_MESON_TAC[];
  REWRITE_TAC[INTER;EMPTY_EXISTS];
  REWRITE_TAC[EQ_EMPTY];
  CONJ_TAC;
  TYPE_THEN `(x 1 = ymid)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  TSPECH `x` 6622 ;
  USEH 3537 (REWRITE_RULE[INTER;INR in_pair]);
  REWRH 6257;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `v2 1` UNABBREV_TAC;
  UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `v1 1` UNABBREV_TAC;
  UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC;
  (* --  *)
  TYPE_THEN `!E. simple_arc_end E v1 v2 /\ (E SUBSET Q) ==> (?u. C u /\ E u)` BACK_TAC;
  CONJ_TAC;
  UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`A`]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `Q` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
  ASM_MESON_TAC[];
  UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`B`]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `Q` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
  ASM_MESON_TAC[];
  (* --B intermediate value theorem needed *)
  THM_INTRO_TAC[`E`;`v2`;`v1`;`1`;`ymid`] simple_arc_end_IVT;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  UNDH 3172 THEN UNDH 8976 THEN REAL_ARITH_TAC;
  TYPE_THEN `u` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C` UNABBREV_TAC;
  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `E` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  USEH 2838 (MATCH_MP point_onto);
  TYPE_THEN `u` UNABBREV_TAC;
  UNDH 8406 THEN SIMP_TAC[mk_segment_h];
  REWRITE_TAC[point_inj;PAIR_SPLIT];
  TYPE_THEN `FST p` EXISTS_TAC;
  USEH 6779 GSYM;
  ASM_REWRITE_TAC[coord01];
  (* -- *)
  TYPE_THEN `Q (point p)` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  THM_INTRO_TAC[`Q`;`point p`] xminQ_min;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`Q`;`point p`] xmaxQ_max;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[GSYM coord01];
  (* -C *)
  TYPE_THEN `D = C'''` ABBREV_TAC ;
  TYPE_THEN `C'''` UNABBREV_TAC;
  TYPE_THEN `w1 = v` ABBREV_TAC ;
  TYPE_THEN `v` UNABBREV_TAC;
  TYPE_THEN `w2 = v'` ABBREV_TAC ;
  TYPE_THEN `v'` UNABBREV_TAC;
  TYPE_THEN `D` EXISTS_TAC;
  TYPE_THEN `w1` EXISTS_TAC;
  TYPE_THEN `w2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `A w1 /\ B w2` SUBAGOAL_TAC;
  USEH 5104  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  USEH 7194  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `D INTER Q = {w1,w2}` SUBAGOAL_TAC;
  TYPE_THEN `Q` UNABBREV_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;UNION;INR in_pair];
  UNDH 5104 THEN UNDH 7194 THEN UNDH 2332 THEN (REWRITE_TAC [eq_sing;INR IN_SING;INTER;SUBSET]) THEN MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(!x. D x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q)` SUBAGOAL_TAC;
  TYPE_THEN `C x` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* -D *)
  TYPE_THEN `~(v1 1 = ymid)` SUBAGOAL_TAC;
  TYPE_THEN `v1 1` UNABBREV_TAC;
  UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC;
  TYPE_THEN `~(v2 1 = ymid)` SUBAGOAL_TAC;
  TYPE_THEN `v2 1` UNABBREV_TAC;
  UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC;
  (* - *)
  TYPE_THEN `!w. D w ==> (w 1 = ymid)` SUBAGOAL_TAC;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_MESON_TAC[subset_imp];
  (* - *)
  TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC;
  USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 5003 (REWRITE_RULE[INTER;INR in_pair]);
  UNDH 6817 THEN MESON_TAC[];
  TYPE_THEN `!w v. (D w) /\ ~(v 1 = ymid) ==> ~(w = v)` SUBAGOAL_TAC;
  TYPE_THEN `v''` UNABBREV_TAC;
  UNDH 5813 THEN ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC  THEN ASM_REWRITE_TAC[];
  (* Mon Jan 17 07:35:06 EST 2005 *)
  ]);;
  (* }}} *)

let one_sided_jordan_curve = jordan_def `one_sided_jordan_curve Q <=>
   (!v w. euclid 2 v /\ euclid 2 w /\ ~Q v /\ ~Q w /\ ~(v = w) ==>
       (?C. simple_arc_end C v w /\ (C INTER Q = EMPTY)))`;;

let simple_closed_curve_mk_E = 
prove_by_refinement(
  `!Q C D . simple_closed_curve top2 Q /\ one_sided_jordan_curve Q /\
    ~(C SUBSET Q) /\ ~(D SUBSET Q) /\
    simple_arc top2 C /\ simple_arc top2 D /\ (C INTER D = EMPTY) ==>
   (?E x1 x2. simple_arc_end E x1 x2 /\
       (E INTER C = {x2}) /\ (E INTER D = {x1}) /\ (E INTER Q = EMPTY))`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  TYPE_THEN `?c. C c /\ ~Q c` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  TYPE_THEN `?d. D d /\ ~Q d` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[SUBSET];
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[one_sided_jordan_curve];
  (* - *)
  TYPE_THEN `!R x. simple_arc top2 R /\ R x ==> euclid 2 x` SUBAGOAL_TAC;
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `R` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`c`;`d`]);
  ASM_REWRITE_TAC[];
  USEH 6641 (REWRITE_RULE[INTER;EQ_EMPTY]);
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`C'`;`C`;`D`] simple_arc_end_restriction;
  ASM_REWRITE_TAC[EMPTY_EXISTS; INTER_EMPTY; ];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  IMATCH_MP_TAC  simple_arc_choose_end;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_closed;
  IMATCH_MP_TAC  simple_arc_choose_end;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[INTER];
  CONJ_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end2;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -A *)
  TYPE_THEN `E = C''` ABBREV_TAC ;
  TYPE_THEN `C''` UNABBREV_TAC;
  TYPE_THEN `E` EXISTS_TAC;
  TYPE_THEN `v'` EXISTS_TAC;
  TYPE_THEN `v` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  (* - *)
  UNDH 3420 THEN UNDH 5123 THEN (REWRITE_TAC[EQ_EMPTY;INTER;SUBSET]) THEN MESON_TAC[];
  (* Mon Jan 17 08:50:35 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_k33_data = jordan_def
  `jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 <=>
     simple_closed_curve top2 Q /\
     simple_arc_end A v1 v2 /\
     simple_arc_end B v1 v2 /\
     simple_arc_end C v1 v2 /\
     simple_arc_end D w1 w2 /\
     simple_arc_end E x1 x2 /\
          ~(w1 = v1) /\
          ~(w1 = v2) /\
          ~(w2 = v1) /\
          ~(w2 = v2) /\
          A w1 /\ B w2 /\
       (A UNION B = Q) /\
       (A INTER B = {v1,v2}) /\
       (D INTER Q = {w1,w2}) /\
       (C INTER D = EMPTY) /\
       (C INTER Q = {v1,v2}) /\
       (E INTER C = {x2}) /\
       (E INTER D = {x1}) /\
       (E INTER Q = EMPTY)`;;


let jordan_curve_k33_data_exist = 
prove_by_refinement(
  `!Q. simple_closed_curve top2 Q /\ one_sided_jordan_curve Q ==>
    (?A B C D E v1 v2 w1 w2 x1 x2.
         jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[jordan_curve_k33_data];
  THM_INTRO_TAC[`Q`] simple_closed_curve_mk_C;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_curve_mk_ABD;
  ASM_REWRITE_TAC[];
  USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 7606 (REWRITE_RULE[INTER;INR in_pair]);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B` EXISTS_TAC;
  TYPE_THEN `C` EXISTS_TAC;
  TYPE_THEN `D` EXISTS_TAC;
  (* - *)
  TYPE_THEN `C INTER D = EMPTY` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  USEH 7282 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  TSPECH `u` 3184;
  TSPECH `u` 9655;
  UNDH 1134 THEN UNDH 2424 THEN UNDH 920 THEN UNDH 4468 THEN REAL_ARITH_TAC;
  (* - *)
  THM_INTRO_TAC[`Q`;`C`;`D`] simple_closed_curve_mk_E;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  TYPE_THEN `simple_arc top2 D` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `!R y1 y2. (R INTER Q = {y1,y2}) /\ simple_arc_end R y1 y2 ==> ~(R SUBSET Q)` SUBAGOAL_TAC;
  TYPE_THEN `R SUBSET {y1,y2}` SUBAGOAL_TAC;
  USEH 842 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  UNDH 4643 THEN UNDH 5847 THEN (REWRITE_TAC [SUBSET;INR in_pair;INTER]) THEN MESON_TAC[];
  TYPE_THEN `FINITE R` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `{y1,y2}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
  THM_INTRO_TAC[`R`] simple_arc_infinite;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  FULL_REWRITE_TAC[INFINITE];
  ASM_MESON_TAC[];
  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* -A *)
  TYPE_THEN `E` EXISTS_TAC;
  TYPE_THEN `v1` EXISTS_TAC;
  TYPE_THEN `v2` EXISTS_TAC;
  TYPE_THEN `w1` EXISTS_TAC;
  TYPE_THEN `w2` EXISTS_TAC;
  TYPE_THEN `x1` EXISTS_TAC;
  TYPE_THEN `x2` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 09:26:35 EST 2005 *)

  ]);;
  (* }}} *)

let has_size_insert = 
prove_by_refinement(
  `!X (x:A) n.  ~(X x) /\ X HAS_SIZE n ==>
          (x INSERT X HAS_SIZE SUC n)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[HAS_SIZE];
  ASM_SIMP_TAC [FINITE_RULES];
  TYPE_THEN `n` UNABBREV_TAC;
  IMATCH_MP_TAC  (GSYM card_suc_insert);
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 09:33:11 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_curve_x = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
      ~(Q x1) /\ ~(Q x2) /\ ~(A x1) /\ ~(A x2) /\ ~(B x1) /\ ~(B x2) /\
       ~C x1 /\ C x2 /\ D x1 /\ ~D x2 /\ E x1 /\ E x2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[jordan_curve_k33_data];
  TYPE_THEN `E x1 /\ E x2` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_end];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~Q x1 /\ ~Q x2` SUBAGOAL_TAC;
  USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]);
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~A x1 /\ ~A x2 /\ ~B x1 /\ ~B x2` SUBAGOAL_TAC;
  TYPE_THEN `Q` UNABBREV_TAC;
  FULL_REWRITE_TAC[UNION;DE_MORGAN_THM;];
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `D x1` SUBAGOAL_TAC;
  USEH 4975 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
  ASM_REWRITE_TAC[];
  TYPE_THEN `C x2` SUBAGOAL_TAC;
  USEH 1536 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`E`;`x1`;`x2`] simple_arc_end_distinct;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  USEH 1536 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_MESON_TAC[];
  USEH 4975 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
  ASM_MESON_TAC[];
  (* Mon Jan 17 09:56:00 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_curve_v = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
    Q v1 /\ Q v2 /\ A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2 /\
    ~D v1 /\ ~D v2 /\ ~E v1 /\ ~E v2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[jordan_curve_k33_data];
  TYPE_THEN `A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  ASM_REWRITE_TAC[];
  TYPE_THEN `Q v1 /\ Q v2` SUBAGOAL_TAC;
  TYPE_THEN `Q` UNABBREV_TAC;
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~E v1 /\ ~E v2` SUBAGOAL_TAC;
  USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]);
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 5003 (REWRITE_RULE[INTER;INR in_pair]);
  ASM_MESON_TAC[];
  (* Mon Jan 17 10:06:12 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_curve_w = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
   Q w1 /\ Q w2 /\ A w1 /\ ~A w2 /\ ~B w1 /\ B w2 /\ ~C w1 /\ ~C w2 /\
   D w1 /\ D w2 /\ ~E w1 /\ ~E w2`,

  (* {{{ proof *)
  [
  REWRITE_TAC[jordan_curve_k33_data];
  ASM_REWRITE_TAC[];
  TYPE_THEN `Q w1 /\ Q w2` SUBAGOAL_TAC;
  TYPE_THEN `Q` UNABBREV_TAC;
  REWRITE_TAC[UNION];
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~E w1 /\ ~E w2` SUBAGOAL_TAC;
  USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER;]);
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~C w1 /\ ~C w2` SUBAGOAL_TAC;
  USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 7606 (REWRITE_RULE[INTER;INR in_pair]);
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 6622 (REWRITE_RULE[INTER;INR in_pair]);
  ASM_MESON_TAC[];
  (* Mon Jan 17 10:14:46 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_curve_AP_size3 = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
      ({w1,w2,x2} HAS_SIZE 3)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  COPYH 2122;
  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
  (* - *)
  TYPE_THEN `{w1,w2,x2} = x2 INSERT {w1,w2}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_INSERT];
  MESON_TAC[];
  TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC;
  ARITH_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  has_size_insert;
  REWRITE_TAC[INR in_pair];
  REWRITE_TAC[DE_MORGAN_THM];
  (* - *)
  CONJ_TAC;
  ASM_MESON_TAC[jordan_curve_w;jordan_curve_x];
  (* - *)
  IMATCH_MP_TAC  pair_size_2;
  ASM_MESON_TAC[jordan_curve_w];
  (* Mon Jan 17 10:18:45 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_BP_size3 = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
      ({v1,v2,x1} HAS_SIZE 3)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  COPYH 2122;
  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
  (* - *)
  TYPE_THEN `{v1,v2,x1} = x1 INSERT {v1,v2}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_INSERT];
  MESON_TAC[];
  TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC;
  ARITH_TAC ;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  has_size_insert;
  REWRITE_TAC[INR in_pair];
  REWRITE_TAC[DE_MORGAN_THM];
  (* - *)
  CONJ_TAC;
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_v);
  USEH 2122 (MATCH_MP jordan_curve_x);
  UNDH 2724 THEN UNDH 3425 THEN UNDH 7579 THEN MESON_TAC[];
  (* - *)
  IMATCH_MP_TAC  pair_size_2;
  USEH 2191 (MATCH_MP simple_arc_end_distinct);
  ASM_MESON_TAC[];
  (* Mon Jan 17 10:26:14 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_AP_BP_empty = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
      ({w1,w2,x2} INTER {v1,v2,x1} = EMPTY)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  COPYH 2122;
  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `(u = x2) \/ (u = x1) \/ ({w1,w2} u /\ {v1,v2} u)` SUBAGOAL_TAC;
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  FULL_REWRITE_TAC[INR IN_INSERT];
  UNDH 911 THEN UNDH 96 THEN UNDH 5829 THEN UNDH 4124 THEN UNDH 8311 THEN MESON_TAC[];
  (* - *)
  UNDH 7992 THEN REP_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR IN_INSERT];
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_v);
  USEH 2122 (MATCH_MP jordan_curve_x);
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR IN_INSERT];
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_w);
  USEH 2122 (MATCH_MP jordan_curve_x);
  ASM_MESON_TAC[];
  (* - *)
  FULL_REWRITE_TAC[INR IN_INSERT];
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_w);
  USEH 2122 (MATCH_MP jordan_curve_v);
  ASM_MESON_TAC[];
  (* Mon Jan 17 10:36:27 EST 2005  *)

  ]);;
  (* }}} *)

let has_size_drop_le = 
prove_by_refinement(
  `!n X (x:A) . FINITE X /\ CARD X <=| n ==>
     FINITE (x INSERT X) /\ CARD (x INSERT X) <=| SUC n`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  ASM_SIMP_TAC[CARD_CLAUSES];
  CONJ_TAC;
  ASM_MESON_TAC[FINITE_RULES];
  COND_CASES_TAC;
  UNDH 2770 THEN ARITH_TAC;
  UNDH 2770 THEN ARITH_TAC;
  (* Mon Jan 17 10:45:48 EST 2005 *)
  ]);;
  (* }}} *)

let has_size_le9 = 
prove_by_refinement(
  `!(x1:A) x2 x3 x4 x5 x6 x7 x8 x9.
    CARD {x1,x2,x3,x4,x5,x6,x7,x8,x9} <=| 9 /\
    FINITE {x1,x2,x3,x4,x5,x6,x7,x8,x9}`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`0`;`EMPTY:A->bool`;`x9`] has_size_drop_le;
  REWRITE_TAC[FINITE_RULES;CARD_CLAUSES];
  ARITH_TAC;
  (* - *)
  THM_INTRO_TAC[`SUC 0`;`{x9}`;`x8`] has_size_drop_le;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`SUC(SUC 0)`;`{x8,x9}`;`x7`] has_size_drop_le;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`SUC(SUC(SUC 0))`;`{x7,x8,x9}`;`x6`] has_size_drop_le;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`SUC(SUC(SUC(SUC 0)))`;`{x6,x7,x8,x9}`;`x5`] has_size_drop_le;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC 0))))`;`{x5,x6,x7,x8,x9}`;`x4`] has_size_drop_le;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC 0)))))`;`{x4,x5,x6,x7,x8,x9}`;`x3`] has_size_drop_le;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC 0))))))`;`{x3,x4,x5,x6,x7,x8,x9}`;`x2`] has_size_drop_le;
  ASM_REWRITE_TAC[];
THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC(SUC 0)))))))`;`{x2,x3,x4,x5,x6,x7,x8,x9}`;`x1`] has_size_drop_le;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  UNDH 457 THEN ARITH_TAC;
  (* Mon Jan 17 10:58:38 EST 2005 *)

  ]);;
  (* }}} *)

let card_surj_bij = 
prove_by_refinement(
  `!(f:A->B) X Y . FINITE X /\ CARD X <=| CARD Y /\
     (!y. Y y ==> ?x. X x /\ (f x = y)) ==>
      BIJ f X Y`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`f`;`X`] CARD_IMAGE_LE;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`f`;`X`] FINITE_IMAGE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Y SUBSET IMAGE f X` SUBAGOAL_TAC;
  REWRITE_TAC[SUBSET;IMAGE];
  ASM_MESON_TAC[];
  TYPE_THEN `FINITE Y` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `CARD Y <=| CARD (IMAGE f X)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET;
  ASM_REWRITE_TAC[];
  TYPE_THEN `(CARD Y = CARD (IMAGE f X)) /\ (CARD (IMAGE f X) = CARD X)` SUBAGOAL_TAC;
  UNDH 5809 THEN UNDH 8940 THEN UNDH 3182 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `Y = IMAGE f X` SUBAGOAL_TAC;
  IMATCH_MP_TAC  CARD_SUBSET_EQ;
  ASM_REWRITE_TAC[];
  (* - *)
  REWRITE_TAC[BIJ];
  TYPE_THEN `SURJ f X Y` SUBAGOAL_TAC;
  REWRITE_TAC[SURJ];
  TYPE_THEN `Y` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  REWRITE_TAC[INJ];
  CONJ_TAC;
  IMATCH_MP_TAC  image_imp;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `Z = X DELETE x` ABBREV_TAC ;
  (* -A *)
  TYPE_THEN `IMAGE f Z = Y` SUBAGOAL_TAC;
  TYPE_THEN `Y` UNABBREV_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  IMATCH_MP_TAC  IMAGE_SUBSET;
  TYPE_THEN `Z` UNABBREV_TAC;
  REWRITE_TAC[DELETE;SUBSET];
  ASM_REWRITE_TAC[];
  (* -- *)
  REWRITE_TAC[SUBSET;IMAGE];
  TYPE_THEN `x'` UNABBREV_TAC;
  TYPE_THEN `x'' = x` ASM_CASES_TAC;
  TYPE_THEN `x''` UNABBREV_TAC;
  TYPE_THEN `y` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Z` UNABBREV_TAC;
  REWRITE_TAC[DELETE];
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `x''` EXISTS_TAC;
  TYPE_THEN `Z` UNABBREV_TAC;
  REWRITE_TAC[DELETE];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `FINITE Z` SUBAGOAL_TAC;
  TYPE_THEN `Z` UNABBREV_TAC;
  REWRITE_TAC[FINITE_DELETE];
  ASM_REWRITE_TAC[];
  TYPE_THEN `CARD Z <| CARD X` SUBAGOAL_TAC;
  THM_INTRO_TAC[`x`;`X`] CARD_SUC_DELETE;
  ASM_REWRITE_TAC[];
  TYPE_THEN `Z` UNABBREV_TAC;
  UNDH 481 THEN ARITH_TAC;
  (* - *)
  TYPE_THEN `CARD Y <= CARD Z` SUBAGOAL_TAC;
  TYPE_THEN `Y` UNABBREV_TAC;
  IMATCH_MP_TAC  CARD_IMAGE_LE;
  ASM_REWRITE_TAC[];
  UNDH 9361 THEN UNDH 6773 THEN UNDH 7923 THEN UNDH 193 THEN ARITH_TAC;
  (* Mon Jan 17 15:04:48 EST 2005 *)

  ]);;
  (* }}} *)

let select_inter = jordan_def
  `select_inter A C = @x. A (x:A) /\ C x` ;;

let k33f = jordan_def
  `k33f (A:A->bool) B E = (select_inter A E, select_inter B E)`;;

let incf = jordan_def
  `incf (f:A-> (B#B)) E = { (FST (f E)) , (SND(f E)) }`;;

let k33f_value = 
prove_by_refinement(
  `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==>
     (k33f A B E = (a,b))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[k33f;PAIR_SPLIT];
  CONJ_TAC;
  REWRITE_TAC[select_inter];
  USEH 5597 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 9224 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_REWRITE_TAC[];
  REWRITE_TAC[select_inter];
  USEH 6985 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 5555 (REWRITE_RULE[INTER;INR IN_SING]);
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 15:18:50 EST 2005 *)
  ]);;
  (* }}} *)

let incf_value = 
prove_by_refinement(
  `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==>
    (incf (k33f A B) E = {a,b})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[incf];
  THM_INTRO_TAC[`A`;`B`;`E`;`a`;`b`] k33f_value;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 15:22:22 EST 2005 *)
  ]);;
  (* }}} *)

let incf_V = 
prove_by_refinement(
  `!(A:A->bool) B E . SING(A INTER E) /\ SING(B INTER E) ==>
    (incf (k33f A B) E = E INTER (A UNION B))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SING];
  THM_INTRO_TAC[`A`;`B`;`E`;`x`;`x'`] incf_value;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[UNION_OVER_INTER];
  ONCE_REWRITE_TAC[INTER_COMM];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[UNION;INR IN_SING;INR in_pair];
  MESON_TAC[];
  (* Mon Jan 17 15:31:21 EST 2005 *)
  ]);;
  (* }}} *)

let k33f_E = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
    ({w1,w2,x2} INTER E = {x2}) /\
    ({v1,v2,x1} INTER E = {x1}) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  COPYH 2122;
  USEH 2122(MATCH_MP jordan_curve_w);
  COPYH 2122;
  USEH 2122(MATCH_MP jordan_curve_x);
  USEH 2122(MATCH_MP jordan_curve_v);
  CONJ_TAC;
  REWRITE_TAC[INTER;INR IN_INSERT;eq_sing];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  REWRITE_TAC[INTER;INR IN_INSERT;eq_sing];
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* Mon Jan 17 15:40:01 EST 2005 *)
  ]);;
  (* }}} *)

let k33f_cut_lemma = 
prove_by_refinement(
  `!C v1 v2 w A B. simple_arc_end C v1 v2 /\
         C w /\ ~(w = v1) /\ ~(w = v2) /\
         (A INTER C = {v1,v2}) /\
         (B INTER C = {w}) ==>
         (A INTER (cut_arc C v1 w) = {v1}) /\
         (B INTER (cut_arc C v1 w) = {w})
         `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  USEH 8436 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  THM_INTRO_TAC[`C`;`w`;`v1`;`v2`] cut_arc_inter;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[eq_sing;INR IN_INSERT;INTER;];
  (* - *)
  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  (* - *)
  TYPE_THEN `C v1 /\ C v2 ` SUBAGOAL_TAC;
  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
  (* - *)
  TYPE_THEN `simple_arc_end (cut_arc C v1 w) v1 w` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `simple_arc_end (cut_arc C v2 w) v2 w` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `cut_arc C v1 w SUBSET C ` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_REWRITE_TAC[];
  TYPE_THEN `cut_arc C v2 w SUBSET C ` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cut_arc_subset;
  ASM_REWRITE_TAC[];
  (* -A *)
  TYPE_THEN `cut_arc C w v1 = cut_arc C v1 w` SUBAGOAL_TAC;
  MESON_TAC [cut_arc_symm];
  TYPE_THEN `cut_arc C w v1` UNABBREV_TAC;
  TYPE_THEN `cut_arc C w v2 = cut_arc C v2 w` SUBAGOAL_TAC;
  MESON_TAC [cut_arc_symm];
  TYPE_THEN `cut_arc C w v2` UNABBREV_TAC;
  (* - *)
  CONJ_TAC;
  CONJ_TAC;
  CONJ_TAC;
  ASM_MESON_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  TYPE_THEN `C u` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TSPECH `u` 2825;
  REWRH 9519;
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `u` UNABBREV_TAC;
  UNDH 6835 THEN DISCH_THEN (THM_INTRO_TAC[`v2`]);
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* - *)
  UNDH 6153 THEN DISCH_THEN  IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[subset_imp];
  (* Mon Jan 17 16:10:38 EST 2005 *)

  ]);;
  (* }}} *)

let k33f_cut = 
prove_by_refinement(
  `!C v1 v2 w A B. simple_arc_end C v1 v2 /\
         C w /\ ~(w = v1) /\ ~(w = v2) /\
         (A INTER C = {v1,v2}) /\
         (B INTER C = {w}) ==>
         (A INTER (cut_arc C v1 w) = {v1}) /\
         (B INTER (cut_arc C v1 w) = {w}) /\
         (A INTER (cut_arc C v2 w) = {v2}) /\
         (B INTER (cut_arc C v2 w) = {w})`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`;`v1`;`v2`;`w`;`A`;`B`] k33f_cut_lemma;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`v2`;`v1`;`w`;`A`;`B`] k33f_cut_lemma;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INR IN_INSERT];
  MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 16:13:48 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_k33 = jordan_def
    `jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2 =
       mk_graph_t ({w1,w2,x2} UNION {v1,v2,x1},
         {E,
          (cut_arc A v1 w1), (cut_arc A v2 w1),
          (cut_arc B v1 w2), (cut_arc B v2 w2),
          (cut_arc C v1 x2), (cut_arc C v2 x2),
          (cut_arc D w1 x1),( cut_arc D w2 x1)},
         (\ e. {(FST (k33f {w1,w2,x2} {v1,v2,x1} e)),
                (SND (k33f {w1,w2,x2} {v1,v2,x1} e)) }))`;;

let jordan_curve_AP_euclid = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
      {w1,w2,x2} UNION {v1,v2,x1} SUBSET euclid 2`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  COPYH 2122;
  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
  REWRITE_TAC[UNION;SUBSET;INR IN_INSERT];
  IMATCH_MP_TAC  subset_imp;
  TYPE_THEN `simple_arc top2 A /\  simple_arc top2 D /\ simple_arc top2 E` SUBAGOAL_TAC;
  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
  USEH 9474 (MATCH_MP simple_arc_euclid);
  USEH 6512 (MATCH_MP simple_arc_euclid);
  USEH 7513 (MATCH_MP simple_arc_euclid);
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_x);
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_v);
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_w);
  UNDH 2244 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN ASM_MESON_TAC[];
  (* Mon Jan 17 17:05:26 EST 2005 *)
  ]);;
  (* }}} *)

let cut_arc_simple2 = 
prove_by_refinement(
  `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==>
       simple_arc top2 (cut_arc C v w)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`;`v`;`w`] cut_arc_simple;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_simple;
  ASM_MESON_TAC[];
  ]);;
  (* }}} *)

let jordan_curve_k33_plane_criterion = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
     (graph G) /\
     (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\
          (SING ({v1,v2,x1} INTER e))) /\
     (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
        e INTER e' SUBSET graph_vertex G) ==>
     plane_graph G
    `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  REWRITE_TAC[plane_graph];
  ASM_REWRITE_TAC[];
  TYPE_THEN `G` UNABBREV_TAC;
  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph];
  CONJ_TAC;
  IMATCH_MP_TAC  jordan_curve_AP_euclid;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  REWRITE_TAC[SUBSET;INR IN_INSERT];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  FULL_REWRITE_TAC[jordan_curve_k33_data];
  ASM_MESON_TAC[simple_arc_end_simple];
  KILLH 8072;
  (* -- *)
  TYPE_THEN `simple_arc top2 A /\ simple_arc top2 B /\ simple_arc top2 C /\ simple_arc top2 D` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[jordan_curve_k33_data];
  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
  (* -- *)
  COPYH 2122;
  USEH  2122 (MATCH_MP jordan_curve_v);
  COPYH 2122;
  USEH  2122 (MATCH_MP jordan_curve_x);
  USEH  2122 (MATCH_MP jordan_curve_w);
  UNDH 9236 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN IMATCH_MP_TAC  cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
  (* -A *)
  TYPE_THEN `{(FST (k33f {w1, w2, x2} {v1, v2, x1} e)), (SND (k33f {w1, w2, x2} {v1, v2, x1} e))} = (incf (k33f {w1, w2,x2} {v1,v2,x1} ) e)` SUBAGOAL_TAC;
  REWRITE_TAC[incf];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  incf_V;
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 17:27:23 EST 2005 *)

  ]);;
  (* }}} *)

(* ------------------------------------------------------------------ *)
(* SECTION DD *)
(* ------------------------------------------------------------------ *)


let cartesian_size = 
prove_by_refinement(
  `!(A:A->bool) (B:B->bool) m n. A HAS_SIZE m /\ B HAS_SIZE n ==>
    cartesian A B HAS_SIZE (m *| n)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`A`;`B`] CARD_PRODUCT;
  FULL_REWRITE_TAC[HAS_SIZE];
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[IN];
  TYPE_THEN `cartesian A B = {(x,y) | A x /\ B y}` SUBAGOAL_TAC;
  REWRITE_TAC[cartesian];
  ASM_REWRITE_TAC[];
  REWRITE_TAC[HAS_SIZE];
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[HAS_SIZE];
  ASM_REWRITE_TAC[];
  (* - *)
  IMATCH_MP_TAC  (INR FINITE_PRODUCT);
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 19:37:49 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_k33f_bij = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
     (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))  ==>
    (BIJ (k33f {w1,w2,x2} {v1,v2,x1})
      (graph_edge G)
      (cartesian {w1,w2,x2} {v1,v2,x1})) /\
    (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\
          (SING ({v1,v2,x1} INTER e))) `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  TYPE_THEN `L = (graph_edge (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))` ABBREV_TAC ;
  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph];
  (* - *)
  COPYH 2122;
  USEH 2122 (MATCH_MP k33f_E);
  (* - *)
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_x);
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_v);
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_w);
  COPYH 2122;
  USEH 2122 (REWRITE_RULE [jordan_curve_k33_data]);
  (* -A *)
  THM_INTRO_TAC[`A`;`v1`;`v2`;`w1`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[INTER;INR IN_INSERT];
  CONJ_TAC THEN ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`B`;`v1`;`v2`;`w2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[INTER;INR IN_INSERT];
  CONJ_TAC THEN ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`C`;`v1`;`v2`;`x2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(x2 = v1 ) /\ ~(x2 = v2)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[INTER;INR IN_INSERT];
  CONJ_TAC THEN ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`D`;`w1`;`w2`;`x1`;`{w1,w2,x2}`;`{v1,v2,x1}`] k33f_cut;
  ASM_REWRITE_TAC[];
  TYPE_THEN `~(x1 = w1 ) /\ ~(x1 = w2)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  ONCE_REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[INTER;INR IN_INSERT];
  CONJ_TAC THEN ASM_MESON_TAC[];
  (* -B *)
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  CONJ_TAC;
  TYPE_THEN `L` UNABBREV_TAC;
  USEH 3555 (REWRITE_RULE[INR IN_INSERT]);
  TYPE_THEN `!U V (x:num->real). (U INTER V = {x}) ==> (SING (U INTER V))` SUBAGOAL_TAC;
  REWRITE_TAC[SING];
  UNIFY_EXISTS_TAC ;
  ASM_REWRITE_TAC[];
  (* -- *)
  UNDH 4488 THEN DISCH_THEN (fun t-> RULE_ASSUM_TAC  (fun s -> try (MATCH_MP t s) with failure -> s));
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  KILLH 4869;
  UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_REWRITE_TAC[] ;
  (* -C *)
  IMATCH_MP_TAC card_surj_bij ;
  (* - *)
  SUBCONJ_TAC;
  TYPE_THEN `L` UNABBREV_TAC;
  REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
  (* - *)
  TYPE_THEN ` (cartesian {w1, w2, x2} {v1, v2, x1}) HAS_SIZE (3 *| 3)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  cartesian_size;
  CONJ_TAC;
  IMATCH_MP_TAC  jordan_curve_AP_size3;
 UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  jordan_curve_BP_size3;
 UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  TYPE_THEN `L` UNABBREV_TAC;
  FULL_REWRITE_TAC[HAS_SIZE];
  ASM_REWRITE_TAC[];
  TYPE_THEN `3 *| 3 = 9` SUBAGOAL_TAC;
  ARITH_TAC;
  ASM_REWRITE_TAC[];
  MESON_TAC[has_size_le9];
  (* -D *)
  TYPE_THEN `(y = (w1,v1)) \/ (y = (w1,v2)) \/ (y = (w1,x1)) \/ (y = (w2,v1)) \/ (y = (w2,v2)) \/ (y = (w2,x1)) \/ (y = (x2,v1)) \/ (y = (x2,v2)) \/ (y = (x2,x1))` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[cartesian];
  TYPE_THEN `y` UNABBREV_TAC;
  REWRITE_TAC[PAIR_SPLIT];
  USEH 8489 (REWRITE_RULE[INR IN_INSERT]);
  USEH 7329 (REWRITE_RULE[INR IN_INSERT]);
  UNDH 1878 THEN UNDH 8866 THEN MESON_TAC[];
  (* - *)
  TYPE_THEN `?x. L x /\ ({w1,w2,x2} INTER x = {(FST y)}) /\ ({v1,v2,x1} INTER x = {(SND y)})` BACK_TAC;
  TYPE_THEN `x` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`{w1,w2,x2}`;`{v1,v2,x1}`;`x`;`FST y`;`SND y`] k33f_value;
  ASM_REWRITE_TAC[];
  USEH 5894 (REWRITE_RULE[]);
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `L` UNABBREV_TAC;
  REWRITE_TAC[INR IN_INSERT];
  UNDH 7966 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `y` UNABBREV_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[];
  (* Mon Jan 17 20:01:06 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_k33_isk33 = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
    graph_isomorphic k33_graph
         (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[jordan_curve_k33];
  IMATCH_MP_TAC  k33_iso;
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  jordan_curve_AP_size3;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  jordan_curve_BP_size3;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  CONJ_TAC;
  IMATCH_MP_TAC  jordan_curve_AP_BP_empty;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2`] jordan_k33f_bij;
  ASM_REWRITE_TAC[];
  KILLH 2219;
  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;];
  TYPE_THEN `fn = k33f {w1,w2,x2} {v1,v2,x1}` ABBREV_TAC ;
  TYPE_THEN `(\ e. fn e) = fn` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  ASM_REWRITE_TAC[];
  (* Mon Jan 17 20:12:31 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_k33_data_inter = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
     (A INTER B = {v1,v2}) /\
     (A INTER C = {v1,v2}) /\
     (A INTER D = {w1}) /\
     (A INTER E = EMPTY) /\
     (B INTER C = {v1,v2}) /\
     (B INTER D = {w2}) /\
     (B INTER E = EMPTY) /\
     (C INTER D = EMPTY) /\
     (C INTER E = {x2}) /\
     (D INTER E = {x1})`,

  (* {{{ proof *)
  [
  REWRITE_TAC[jordan_curve_k33_data];
  FULL_REWRITE_TAC[INTER_COMM];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(A INTER E = EMPTY ) /\ (B INTER E = EMPTY)` SUBAGOAL_TAC;
  TYPE_THEN `Q` UNABBREV_TAC;
  USEH 2576 (REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
  REWRITE_TAC[EQ_EMPTY;INTER];
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(A INTER C = {v1, v2}) /\ (B INTER C = {v1, v2})` SUBAGOAL_TAC;
  ONCE_REWRITE_TAC[FUN_EQ_THM];
  REWRITE_TAC[INTER;INR IN_INSERT];
  USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 7606 (REWRITE_RULE[INTER;INR IN_INSERT]);
  TYPE_THEN `Q` UNABBREV_TAC;
  FULL_REWRITE_TAC[UNION];
  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]);
  CONJ_TAC THEN ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* -A *)
  REWRITE_TAC[INTER;eq_sing;INR IN_INSERT];
  TYPE_THEN `Q` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  USEH 1691 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 4348 (REWRITE_RULE[INTER;UNION;INR IN_INSERT]);
  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
  USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]);
  ASM_MESON_TAC[];
  (* Mon Jan 17 20:35:28 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_edge_inter = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
    (!e e'. {A,B,C,D,E} e /\ {A,B,C,D,E} e' /\ ~(e = e') ==>
         (e INTER e' SUBSET ({w1,w2,x2} UNION {v1,v2,x1})))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INR IN_INSERT];
  TYPE_THEN `V = {w1, w2, x2} UNION {v1, v2, x1}` ABBREV_TAC ;
  TYPE_THEN `{v1,v2} SUBSET V /\ {w1} SUBSET V /\ EMPTY SUBSET V /\ {w2} SUBSET V /\ {x2} SUBSET V /\ {x1} SUBSET V` SUBAGOAL_TAC;
  TYPE_THEN `V` UNABBREV_TAC;
  REWRITE_TAC[SUBSET;UNION;INR IN_INSERT];
  REPEAT CONJ_TAC THEN MESON_TAC[];
  (* - *)
  JOIN 2 1 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
  USEH 2122 (MATCH_MP jordan_curve_k33_data_inter);
  UNDH 4732 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN TYPE_THEN `e'` UNABBREV_TAC THEN FULL_REWRITE_TAC[] THEN ASM_REWRITE_TAC[INTER_COMM ] THEN ASM_MESON_TAC[];
  (* Mon Jan 17 20:46:56 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_k33_plane_criterion2 = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
     (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
        e INTER e' SUBSET graph_vertex G) ==>
     plane_graph G`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  jordan_curve_k33_plane_criterion;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  SUBCONJ_TAC;
  THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph;
  REWRITE_TAC[k33_isgraph];
  TYPE_THEN `G` UNABBREV_TAC;
  IMATCH_MP_TAC  jordan_curve_k33_isk33;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `G` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  ASM_MESON_TAC[jordan_k33f_bij];
  (* Tue Jan 18 06:14:19 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_curve_edge_arc = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
    (graph_edge G e) ==> (simple_arc top2 e)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33];
  FULL_REWRITE_TAC[INR IN_INSERT];
  COPYH 2122;
  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
  RULE_ASSUM_TAC   (fun s-> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
  (* - *)
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `e` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  KILLH 4869;
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_x);
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_v);
  COPYH 2122;
  USEH 2122 (MATCH_MP jordan_curve_w);
  UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN IMATCH_MP_TAC  cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
  (* Tue Jan 18 06:28:31 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_curve_guider_inj = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e U V.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
    (graph_edge G e) /\ {A,B,C,D,E} U /\ {A,B,C,D,E} V /\
     (e SUBSET U) /\ (e SUBSET V) ==> (U = V)  `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  PROOF_BY_CONTR_TAC;
  TYPE_THEN `INFINITE e` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_infinite;
  IMATCH_MP_TAC  jordan_curve_edge_arc;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(U INTER V) SUBSET ({w1,w2,x2} UNION {v1,v2,x1})` SUBAGOAL_TAC;
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_edge_inter;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `e SUBSET {w1, w2, x2} UNION {v1, v2, x1}` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `U INTER V` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC [SUBSET;INTER];
  ASM_MESON_TAC[subset_imp];
  (* - *)
  TYPE_THEN `FINITE ({w1, w2, x2} UNION {v1, v2, x1})` SUBAGOAL_TAC;
  REWRITE_TAC[  FINITE_UNION];
  REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
  TYPE_THEN `FINITE e` SUBAGOAL_TAC;
  IMATCH_MP_TAC  FINITE_SUBSET;
  TYPE_THEN `{w1, w2, x2} UNION {v1, v2, x1}` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[INFINITE];
  ASM_MESON_TAC[];
  (* Tue Jan 18 06:3282:02 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_guider_disj = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
     ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(A = E) /\ ~(B = C) /\
     ~(B = D) /\ ~(B = E) /\ ~(C = D) /\ ~(C = E) /\ ~(D = E)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_k33_data_inter;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[DE_MORGAN_THM];
  (* - *)
  TYPE_THEN `INFINITE A /\ INFINITE B /\ INFINITE C /\ INFINITE D /\ INFINITE E` SUBAGOAL_TAC;
  FULL_REWRITE_TAC[jordan_curve_k33_data];
  RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
  RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_infinite s) with failure -> s);
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `FINITE (A INTER B) /\ FINITE (A INTER C) /\ FINITE (A INTER D) /\ FINITE (A INTER E) /\ FINITE (B INTER C) /\ FINITE (B INTER D) /\ FINITE (B INTER E) /\ FINITE (C INTER D) /\ FINITE(C INTER E) /\ FINITE (D INTER E)` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
  FULL_REWRITE_TAC[INFINITE];
  (* - *)
  KILLH 3523 THEN KILLH 1286 THEN KILLH 6641 THEN KILLH 4962 THEN KILLH 3223 THEN KILLH 6941 THEN KILLH 9399 THEN KILLH 3259 THEN KILLH 8436 THEN KILLH 2195 THEN KILLH 2122;
  UNDH 5285 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TRY (TYPE_THEN `A` UNABBREV_TAC) THEN TRY (TYPE_THEN `B` UNABBREV_TAC) THEN TRY (TYPE_THEN `C` UNABBREV_TAC) THEN TRY (TYPE_THEN `D` UNABBREV_TAC) THEN FULL_REWRITE_TAC[INTER_IDEMPOT] THEN ASM_MESON_TAC[];
  (* Tue Jan 18 07:01:04 EST 2005 *)

  ]);;
  (* }}} *)

let jordan_curve_guider_enum = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
    (E SUBSET E) /\
    (cut_arc A v1 w1 SUBSET A) /\
    (cut_arc A v2 w1 SUBSET A) /\
    (cut_arc B v1 w2 SUBSET B) /\
    (cut_arc B v2 w2 SUBSET B) /\
    (cut_arc C v1 x2 SUBSET C) /\
    (cut_arc C v2 x2 SUBSET C) /\
    (cut_arc D w1 x1 SUBSET D) /\
    (cut_arc D w2 x1 SUBSET D)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[SUBSET_REFL];
  COPYH 2122;
  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
  RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
  COPYH 2122 ;
  USEH 2122 (MATCH_MP jordan_curve_x);
  COPYH 2122 ;
  USEH 2122 (MATCH_MP jordan_curve_v);
  COPYH 2122 ;
  USEH 2122 (MATCH_MP jordan_curve_w);
  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  cut_arc_subset THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
  (* Tue Jan 18 07:12:33 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_guider_exists = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
    graph_edge G e ==>
   (?U. {A,B,C,D,E} U /\ e SUBSET U)`,

  (* {{{ proof *)
  [
  REWRITE_TAC[INR IN_INSERT];
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum;
  ASM_REWRITE_TAC[];
  TYPE_THEN `G` UNABBREV_TAC;
  FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33];
  FULL_REWRITE_TAC[INR IN_INSERT];
  UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN UNIFY_EXISTS_TAC THEN ASM_REWRITE_TAC[];
  (* Tue Jan 18 07:43:50 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_guider_sep_lemma = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
    graph_edge G e  ==>
   (((e SUBSET A) ==> (e = cut_arc A v1 w1) \/ (e = cut_arc A v2 w1)) /\
    ((e SUBSET B) ==> (e = cut_arc B v1 w2) \/ (e = cut_arc B v2 w2)) /\
    ((e SUBSET C) ==> (e = cut_arc C v1 x2) \/ (e = cut_arc C v2 x2)) /\
    ((e SUBSET D) ==> (e = cut_arc D w1 x1) \/ (e = cut_arc D w2 x1)) /\
    ((e SUBSET E) ==> (e = E)))
    `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_disj;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`] jordan_curve_guider_inj;
  REWRH 1245;
  TYPE_THEN `G` UNABBREV_TAC;
  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;INR IN_INSERT];
  REPEAT CONJ_TAC THEN UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_MESON_TAC[];
  (* Tue Jan 18 09:38:07 EST 2005 *)
  ]);;
  (* }}} *)

let cut_arc_inter_lemma = 
prove_by_refinement(
  `!X R u v w.  X u /\
     simple_arc_end R v w /\ R u /\ ~(u = v) /\ ~(u = w) ==>
    (cut_arc R v u INTER cut_arc R w u SUBSET X)`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`R`;`u`;`v`;`w`] cut_arc_inter;
  ASM_REWRITE_TAC[];
  TYPE_THEN `cut_arc R u w = cut_arc R w u` SUBAGOAL_TAC;
  MESON_TAC[cut_arc_symm];
  TYPE_THEN `cut_arc R u w` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[SUBSET;INR IN_SING];
  TYPE_THEN `x` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* Tue Jan 18 09:55:17 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_cut_inter = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
   (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==>
    (cut_arc A v1 w1 INTER cut_arc A v2 w1 SUBSET graph_vertex G) /\
    (cut_arc B v1 w2 INTER cut_arc B v2 w2 SUBSET graph_vertex G) /\
    (cut_arc C v1 x2 INTER cut_arc C v2 x2 SUBSET graph_vertex G) /\
    (cut_arc D w1 x1 INTER cut_arc D w2 x1 SUBSET graph_vertex G)
   `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `G` UNABBREV_TAC;
  FULL_REWRITE_TAC[graph_vertex_mk_graph;jordan_curve_k33];
  COPYH 2122 ;
  COPYH 2122 ;
  COPYH 2122 ;
  USEH 2122 (MATCH_MP jordan_curve_x);
  USEH 2122 (MATCH_MP jordan_curve_v);
  USEH 2122 (MATCH_MP jordan_curve_w);
  FULL_REWRITE_TAC[jordan_curve_k33_data];
  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  cut_arc_inter_lemma THEN ASM_REWRITE_TAC[UNION;INR IN_INSERT ] THEN ASM_MESON_TAC[] ;
  (* Tue Jan 18 10:00:14 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_guider_separate = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G U e e'.
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
    {A,B,C,D,E} U /\ e SUBSET U /\ e' SUBSET U /\
    graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
    (e INTER e' SUBSET graph_vertex G)
   `,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  TYPE_THEN `?a b. ((e = a) \/ (e = b)) /\ ((e' = a) \/ (e' = b)) /\ (a INTER b SUBSET graph_vertex G)` BACK_TAC;
  TYPE_THEN `((e = a) /\ (e' = b)) \/ ((e = b) /\ (e' = a))` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  FIRST_ASSUM DISJ_CASES_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `e` UNABBREV_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  FULL_REWRITE_TAC[INTER_COMM];
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`] jordan_curve_cut_inter;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`]  jordan_curve_guider_sep_lemma ;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e'`]  jordan_curve_guider_sep_lemma ;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[INR IN_INSERT];
  TYPE_THEN `U = E` ASM_CASES_TAC;
  TYPE_THEN `U` UNABBREV_TAC;
  TYPE_THEN `E` UNABBREV_TAC;
  TYPE_THEN `e'` UNABBREV_TAC;
  UNDH 4836 THEN MESON_TAC[];
  REWRH 4440;
  TYPE_THEN `G` UNABBREV_TAC;
  UNDH 7811 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `U` UNABBREV_TAC THEN REP_BASIC_TAC;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  KILLH 2881;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  KILLH 2881 THEN KILLH 1255;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  KILLH 2881 THEN KILLH 1255 THEN KILLH 2514;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* Tue Jan 18 10:22:53 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_k33_plane = 
prove_by_refinement(
  `!Q A B C D E v1 v2 w1 w2 x1 x2 G .
      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==>
    plane_graph G`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  IMATCH_MP_TAC  jordan_curve_k33_plane_criterion2;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `(?U. {A,B,C,D,E} U /\ e SUBSET U)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  jordan_curve_guider_exists;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
TYPE_THEN `(?U'. {A,B,C,D,E} U' /\ e' SUBSET U')` SUBAGOAL_TAC;
  IMATCH_MP_TAC  jordan_curve_guider_exists;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  TYPE_THEN `U = U'` ASM_CASES_TAC;
  TYPE_THEN `U'` UNABBREV_TAC;
  IMATCH_MP_TAC  jordan_curve_guider_separate;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `U INTER U'` EXISTS_TAC;
  CONJ_TAC;
  IMATCH_MP_TAC  subset_inter_pair;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[jordan_curve_k33;graph_vertex_mk_graph];
  ASM_MESON_TAC[jordan_curve_edge_inter];
  (* Tue Jan 18 10:32:34 EST 2005 *)
  ]);;
  (* }}} *)

let jordan_curve_not_one_sided = 
prove_by_refinement(
  `!Q. simple_closed_curve top2 Q ==> ~(one_sided_jordan_curve Q)`,

  (* {{{ proof *)

  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`Q`] jordan_curve_k33_data_exist;
  ASM_REWRITE_TAC[];
  TYPE_THEN `plane_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  jordan_curve_k33_plane;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `graph_isomorphic k33_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC;
  IMATCH_MP_TAC  jordan_curve_k33_isk33;
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[] k33_nonplanar;
  FULL_REWRITE_TAC[planar_graph];
  UNDH 3419 THEN ASM_REWRITE_TAC[];
  UNIFY_EXISTS_TAC;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  graph_isomorphic_symm;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[k33_isgraph];
  (* Tue Jan 18 10:43:40 EST 2005 *)
  ]);;
  (* }}} *)

(*
Tue Jan 18 10:44:07 EST 2005

I'M DONE! The Jordan Curve Theorem is proved.

The statements jordan_curve_not_one_sided
  and jordan_curve_no_inj3 give a form of the Jordan Curve Theorem.

Now lets put it in a simple form.

*)

let component_simple_arc_ver2 = 
prove_by_refinement(
  `!G x y. (closed_ top2 G ) /\ ~(x = y) ==>
      (component  (induced_top top2 (euclid 2 DIFF G)) x y <=>
        (?C. simple_arc_end C x y /\
             (C INTER G = EMPTY)))`,

  (* {{{ proof *)
  [
  (*
   string together :component-imp-connected, connected-induced2,
                    p_conn_conn, p_conn_hv_finite;
   other_direction : simple_arc_connected, connected-induced,
                    connected-component; *)
  REP_BASIC_TAC;
  ASSUME_TAC top2_top;
  THM_INTRO_TAC[`top2`;`(euclid 2 DIFF G)`] induced_top_top;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `top2 (euclid 2 DIFF G)` SUBAGOAL_TAC;
  USEH 4142 (MATCH_MP closed_open);
  FULL_REWRITE_TAC[top2_unions;open_DEF ];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `A = euclid 2 DIFF G` ABBREV_TAC ;
  TYPE_THEN `UNIONS (induced_top top2 A) = A` SUBAGOAL_TAC;
  THM_INTRO_TAC[`top2`;`A`] induced_top_support;
  ASM_REWRITE_TAC[top2_unions;];
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;DIFF];
  MESON_TAC[];
  (* - *)
  IMATCH_MP_TAC  EQ_ANTISYM;
  CONJ_TAC;
  THM_INTRO_TAC[`induced_top top2 A`;`x`] component_imp_connected;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`(top2)`;`A`;`(component  (induced_top top2 A) x)`] connected_induced2;
  ASM_REWRITE_TAC[top2_unions];
  IMATCH_MP_TAC  SUBSET_TRANS;
  TYPE_THEN `UNIONS (induced_top top2 A)` EXISTS_TAC;
  CONJ_TAC;
  KILLH 9392;
  REWRITE_TAC[component_unions];
  UNDH 250 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  ASM_REWRITE_TAC[];
  REWRH 486;
  (* --A *)
  TYPE_THEN `B = component  (induced_top top2 A) x` ABBREV_TAC ;
  TYPE_THEN `B x /\ B y` SUBAGOAL_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`(induced_top top2 A)`;`x`;`y`] component_replace;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  component_symm;
  ASM_REWRITE_TAC[];
  (* -- *)
  ASSUME_TAC loc_path_conn_top2;
  TYPE_THEN `top_of_metric(A,d_euclid) = (induced_top top2 A)` SUBAGOAL_TAC;
  REWRITE_TAC[top2];
  ONCE_REWRITE_TAC[EQ_SYM_EQ];
  IMATCH_MP_TAC  top_of_metric_induced;
  TYPE_THEN `A` UNABBREV_TAC;
  REWRITE_TAC[DIFF;SUBSET];
  MESON_TAC[metric_euclid];
  (* -- *)
  TYPE_THEN `loc_path_conn (induced_top top2 A)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
  FULL_REWRITE_TAC[top2];
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* -- *)
  THM_INTRO_TAC[`top2`] loc_path_conn;
  REWRH 6586;
  TSPECH `A` 7522;
  REWRH 4569;
  TSPECH `x` 6750;
  TYPE_THEN `A x` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `top2 B` SUBAGOAL_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  ASM_MESON_TAC[path_eq_conn];
  (* --B *)
  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn;
  ASM_REWRITE_TAC[];
  (* -- *)
  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite;
  ASM_MESON_TAC[];
  REWRH 7914;
  TYPE_THEN `C` EXISTS_TAC;
  ASM_REWRITE_TAC[];
  PROOF_BY_CONTR_TAC;
  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
  TYPE_THEN `B u` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `A u` SUBAGOAL_TAC;
  ASM_MESON_TAC[subset_imp];
  TYPE_THEN `A` UNABBREV_TAC;
  USEH 1911 (REWRITE_RULE[DIFF]);
  ASM_MESON_TAC[];
  (* -C *)
  (* other_direction : simple_arc_connected, connected-induced,
                    connected-component; *)
  THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`] simple_arc_connected;
  ASM_REWRITE_TAC[];
  TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC;
  IMATCH_MP_TAC  simple_arc_euclid;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
  ASM_REWRITE_TAC[top2_unions];
  REWRH 8620;
  (* - *)
  TYPE_THEN `C SUBSET A` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  ASM_REWRITE_TAC[DIFF_SUBSET];
  REWRH 9619;
  (* - *)
  THM_INTRO_TAC[`induced_top top2 A`;`C`;`x`] connected_component;
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  USEH 5951(REWRITE_RULE[SUBSET]);
  TSPECH `y` 4625;
  FIRST_ASSUM IMATCH_MP_TAC ;
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* Tue Jan 18 12:54:06 EST 2005 *)

  ]);;
  (* }}} *)

let component_properties = 
prove_by_refinement(
  `!C A v. closed_ top2 C /\ (euclid 2 v) /\ ~C v /\
      (A = component  (induced_top top2 (euclid 2 DIFF C)) v) ==>
      top2 A /\ connected top2 A /\
     ~(A = EMPTY) /\ (A INTER C = EMPTY) /\ A v /\
      (A SUBSET euclid 2) /\
    (!w. ~(w = v) ==>
     (A w = (?P. simple_arc_end P v w /\ (P INTER C = EMPTY))))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  (* - *)
  ASSUME_TAC top2_top;
  (* -A *)
  THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support;
  FULL_REWRITE_TAC[top2_unions];
  (* - *)
  TYPE_THEN `euclid 2 INTER (euclid 2 DIFF C) = euclid 2 DIFF C` SUBAGOAL_TAC;
  IMATCH_MP_TAC  EQ_EXT;
  REWRITE_TAC[INTER;DIFF];
  MESON_TAC[];
  REWRH 972;
  KILLH 105;
  (* - *)
  TYPE_THEN `top2 (euclid 2 DIFF C)` SUBAGOAL_TAC;
  THM_INTRO_TAC[`top2`;`C`] (REWRITE_RULE[open_DEF] closed_open);
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[top2_unions];
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`2`;`(euclid 2 DIFF C)`] loc_path_conn_euclid;
  REWRITE_TAC[GSYM top2];
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`2`;`euclid 2`] loc_path_conn_euclid;
  REWRITE_TAC[GSYM top2];
  THM_INTRO_TAC[`top2`] top_univ;
  REWRITE_TAC[top2_top];
  FULL_REWRITE_TAC[top2_unions];
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[GSYM top2];
  (* - *)
  USEH 7343 GSYM;
  ASM_REWRITE_TAC[];
  TYPE_THEN `A v` SUBAGOAL_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  component_refl THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[DIFF];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC THENL[ REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
  ASM_MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* -B *)
  TYPE_THEN `A INTER C = EMPTY` SUBAGOAL_TAC;
  THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions;
  REWRH 7860;
  UNDH 4798 THEN REWRITE_TAC[INTER;SUBSET;DIFF;EQ_EMPTY] THEN MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `A SUBSET euclid 2` SUBAGOAL_TAC;
  THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions;
  REWRH 7860;
  UNDH 4798 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `top_of_metric(euclid 2 DIFF C,d_euclid) = induced_top top2 (euclid 2 DIFF C)` SUBAGOAL_TAC;
  REWRITE_TAC[top2];
  IMATCH_MP_TAC  (GSYM top_of_metric_induced);
  REWRITE_TAC[metric_euclid];
  REWRITE_TAC[DIFF;SUBSET] THEN MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`2`;`euclid 2 DIFF C`] loc_path_euclid_cor;
  REWRITE_TAC[GSYM top2];
  ASM_REWRITE_TAC[];
  (* - *)
  THM_INTRO_TAC[`top2`] loc_path_conn;
  REWRH 6586;
  SUBCONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  USEH 7626 GSYM;
  USEH 4421 GSYM;
  ASM_REWRITE_TAC[];
  USEH 1238 GSYM;
  ASM_REWRITE_TAC[];
  FIRST_ASSUM IMATCH_MP_TAC ;
  ASM_REWRITE_TAC[];
  REWRITE_TAC[DIFF];
  ASM_REWRITE_TAC[];
  (* -C *)
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  SUBCONJ_TAC;
  TYPE_THEN `A` UNABBREV_TAC;
  IMATCH_MP_TAC  component_simple_arc_ver2;
  ASM_REWRITE_TAC[];
  (* - *)
  TYPE_THEN `A = UNIONS ({v} INSERT {P | (?w. simple_arc_end P v w) /\ (P INTER C = {}) })` SUBAGOAL_TAC;
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[SUBSET;UNIONS];
  TYPE_THEN `x = v` ASM_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  TYPE_THEN `{v}` EXISTS_TAC;
  REWRITE_TAC[INR IN_INSERT];
  TSPECH `x` 9360;
  REWRH 8744;
  TYPE_THEN`P` EXISTS_TAC;
  REWRITE_TAC[INR IN_INSERT];
  ASM_REWRITE_TAC[];
  CONJ_TAC;
  DISJ2_TAC;
  ASM_MESON_TAC[simple_arc_end_simple];
  IMATCH_MP_TAC  simple_arc_end_end2;
  ASM_MESON_TAC[];
  (* -- *)
  REWRITE_TAC[UNIONS;INR IN_INSERT;SUBSET];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  FULL_REWRITE_TAC[INR IN_INSERT];
  TYPE_THEN `x` UNABBREV_TAC;
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `x = v` ASM_CASES_TAC;
  ASM_MESON_TAC[];
  TSPECH `x` 9360;
  ASM_REWRITE_TAC[];
  (* -- *)
  TYPE_THEN `x = w` ASM_CASES_TAC;
  TYPE_THEN `x` UNABBREV_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `cut_arc u v x` EXISTS_TAC;
  (* -- *)
  SUBCONJ_TAC;
  IMATCH_MP_TAC  cut_arc_simple;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end];
  (* -- *)
  THM_INTRO_TAC[`u`;`v`;`x`] cut_arc_subset;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end];
  ASM_REWRITE_TAC[];
  UNDH 4401 THEN UNDH 2627 THEN REWRITE_TAC[SUBSET;INTER;EQ_EMPTY] THEN MESON_TAC[];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  connected_unions_common;
  (* -D *)
  CONJ_TAC;
  FULL_REWRITE_TAC[INR IN_INSERT];
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `Z` UNABBREV_TAC;
  IMATCH_MP_TAC  connected_sing;
  ASM_REWRITE_TAC[top2_unions];
  IMATCH_MP_TAC  simple_arc_connected;
  ASM_MESON_TAC[simple_arc_end_simple];
  (* - *)
  UNDH 281 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
  TYPE_THEN `v` EXISTS_TAC;
  FULL_REWRITE_TAC[INR IN_INSERT];
  TYPE_THEN `!Z. (Z = {v}) \/ (?w. simple_arc_end Z v w) /\ (Z INTER C = EMPTY) ==> Z v` SUBAGOAL_TAC;
  FIRST_ASSUM DISJ_CASES_TAC;
  TYPE_THEN `Z''` UNABBREV_TAC;
  REWRITE_TAC[INR IN_SING];
  IMATCH_MP_TAC  simple_arc_end_end;
  ASM_MESON_TAC[];
  ASM_MESON_TAC[];
  (* Tue Jan 18 19:38:27 EST 2005 *)
  ]);;
  (* }}} *)

let JORDAN_CURVE_THEOREM = 
prove_by_refinement(
  `!C. simple_closed_curve top2 C ==>
     (?A B.  top2 A /\ top2 B /\
       connected top2 A /\ connected top2 B /\
     ~(A = EMPTY) /\ ~(B = EMPTY) /\
      (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\
          (B INTER C = EMPTY) /\
         (A UNION B UNION C = euclid 2))`,

  (* {{{ proof *)
  [
  REP_BASIC_TAC;
  THM_INTRO_TAC[`C`] jordan_curve_not_one_sided;
  ASM_REWRITE_TAC[];
  FULL_REWRITE_TAC[one_sided_jordan_curve];
  ASM_REWRITE_TAC[];
  (* - *)
  LEFTH  1701 "v";
  LEFTH  7038 "w";
  TYPE_THEN `euclid 2 v /\ euclid 2 w /\ ~C v /\ ~C w /\ ~(v = w) /\ (!C'. simple_arc_end C' v w ==> ~(C' INTER C = EMPTY))` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  KILLH 9332;
  (* - *)
  TYPE_THEN `A = component  (induced_top top2 (euclid 2 DIFF C)) v` ABBREV_TAC ;
  TYPE_THEN `A` EXISTS_TAC;
  TYPE_THEN `B = component  (induced_top top2 (euclid 2 DIFF C)) w` ABBREV_TAC ;
  TYPE_THEN `B` EXISTS_TAC;
  (* - *)
  ASSUME_TAC top2_top;
  (* -A *)
  THM_INTRO_TAC[`C`] simple_closed_curve_closed;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`A`;`v`] component_properties;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`C`;`B`;`w`] component_properties;
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC[];
  (* - *)
  SUBCONJ_TAC;
  PROOF_BY_CONTR_TAC;
  USEH 2797 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
  TYPE_THEN `u = v` ASM_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  TSPECH `v` 8396;
  REWRH 1610;
  TSPECH `P` 3407;
  UNDH 3395 THEN DISCH_THEN (THM_INTRO_TAC[]);
  IMATCH_MP_TAC  simple_arc_end_symm;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  (* -- *)
  TYPE_THEN `u = w` ASM_CASES_TAC;
  TYPE_THEN `u` UNABBREV_TAC;
  TSPECH `w` 9360;
  REWRH 3625;
  ASM_MESON_TAC[simple_arc_end_symm];
  (* -- *)
  TYPE_THEN `A` UNABBREV_TAC;
  TYPE_THEN `B` UNABBREV_TAC;
  USEH 9617 (MATCH_MP component_replace);
  USEH 8370 (MATCH_MP component_replace);
  TSPECH `v` 2427;
  TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) w` UNABBREV_TAC;
  TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) u` UNABBREV_TAC;
  TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) v v` SUBAGOAL_TAC;
  IMATCH_MP_TAC  component_refl;
  ASM_REWRITE_TAC[];
  THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support;
  FULL_REWRITE_TAC[top2_unions];
  ASM_REWRITE_TAC[];
  ASM_REWRITE_TAC [INTER;DIFF];
  REWRH 4538;
  USEH 1851 (MATCH_MP simple_arc_end_symm);
  ASM_MESON_TAC[];
  (* -B *)
  IMATCH_MP_TAC  SUBSET_ANTISYM;
  CONJ_TAC;
  REWRITE_TAC[union_subset];
  ASM_REWRITE_TAC[];
  IMATCH_MP_TAC  simple_closed_curve_euclid;
  ASM_REWRITE_TAC[];
  (* - *)
  PROOF_BY_CONTR_TAC;
  USEH 2025 (REWRITE_RULE[SUBSET;UNION]);
  LEFTH 2615 "x";
  TYPE_THEN `euclid 2 x /\ ~A x /\ ~ B x /\ ~ C x` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  (* - *)
  THM_INTRO_TAC[`v`;`w`;`x`] three_t_enum;
  TYPE_THEN `INJ f UNIV (euclid 2) /\ (!i. ~C (f i)) /\ (!i j A. simple_arc_end A (f i) (f j) ==> ~(A INTER C = {}))` ASM_CASES_TAC ;
  ASM_MESON_TAC[jordan_curve_no_inj3];
  UNDH 6935 THEN ASM_REWRITE_TAC[];
  (* -C *)
  TYPE_THEN `~(x = w) /\ ~(x = v) /\ ~(v = w)` SUBAGOAL_TAC;
  ASM_REWRITE_TAC[];
  ASM_MESON_TAC[];
  SUBCONJ_TAC;
  REWRITE_TAC[INJ];
  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN ASM_MESON_TAC[]; IMATCH_MP_TAC  three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC  three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]];
  (* - *)
  TYPE_THEN `!C'. simple_arc_end C' v x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `!C'. simple_arc_end C' w x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC;
  ASM_MESON_TAC[];
  TYPE_THEN `!x A. ~simple_arc_end A x x` SUBAGOAL_TAC;
  USEH 3186 (MATCH_MP simple_arc_end_distinct);
  ASM_MESON_TAC[];
  KILLH 8396 THEN KILLH 9360 THEN KILLH 3221 THEN KILLH 4325;
  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
  (* - *)
  TYPE_THEN `!C' w v. simple_arc_end C' w v = simple_arc_end C' v w` SUBAGOAL_TAC;
  MESON_TAC[simple_arc_end_symm];
  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC  three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] ; ALL_TAC];
  TYPE_THEN `!i. ~(C (f i))` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN ASM_REWRITE_TAC[];ALL_TAC];
  ASM_MESON_TAC[];
  (* Tue Jan 18 20:44:12 EST 2005 *)
  ]);;
  (* }}} *)

(* collect together the definitions in a single theorem.
   We leave out the definitions in the HOL-light distribution
   such as abs , sqrt, sum,
           IMAGE, INJ, INTER, EMPTY, UNION, SUBSET, UNIONS. *)

let JORDAN_CURVE_DEFS = 
prove_by_refinement(
  `(!x. euclid 2 x = (!n. 2 <=| n ==> (x n = &0))) /\
   (top2 = top_of_metric (euclid 2,d_euclid)) /\
   (!(X:A->bool) d. top_of_metric (X,d) =
         {A | ?F. F SUBSET open_balls (X,d) /\ (A = UNIONS F) }) /\
   (!(X:A->bool) d. open_balls(X,d) =
         {B | ?x r. (B = open_ball (X,d) x r) }) /\
   (!X d (x:A) r. open_ball (X,d) x r =
         {y | X x /\ X y /\ d x y < r}) /\
   (!U (Z:A->bool). connected U Z <=>
         Z SUBSET UNIONS U /\
         (!A B.
              U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B
              ==> Z SUBSET A \/ Z SUBSET B)) /\
   (!(C:A->bool) U. simple_closed_curve U C =
             (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
              continuous f (top_of_metric (UNIV,d_real)) U /\
              INJ f {x | &0 <= x /\ x < &1} (UNIONS U) /\
              (f (&0) = f (&1)))) /\
   (!(f:A->B) U V. continuous f U V =
         (!v. V v ==> U  { x | (UNIONS U) x /\ v (f x) })) /\
   (!x y. d_real x y = abs  (x - y)) /\
   (!x y. euclid 2 x /\ euclid 2 y
         ==> (d_euclid x y =
              sqrt (sum (0,2) (\i. (x i - y i) * (x i - y i)))))`,

  (* {{{ proof *)
  [
  REWRITE_TAC[simple_closed_curve;continuous;preimage;d_real;];
  REWRITE_TAC[d_euclid_n];
  REWRITE_TAC[euclid;top2;top_of_metric;open_balls;open_ball;connected;];
  (* Tue Jan 18 21:10:10 EST 2005 *)
  ]);;
  (* }}} *)

(* The interesting thing about these definitions is how the
   standard mathematical definitions are made total, as required
   by HOL.

   "continuous": There is no requirement that the IMAGE of f is
   a subset of UNIONS V.  This is contrary to the common mathematical
   requirement that a function f:X->Y maps X to Y.  The constraint
   on the IMAGE for a simple_closed_curve is contained in the definition
   of INJ.

   "simple_closed_curve": Continuity is required on the full real
   line, but injectivity is required only on the unit interval.

   "connected": Here there is a requirement that Z is a subset of
   UNIONS U

   "open_ball": If x is not in X, then the open ball is empty.

*)