Jordan/jordan_curve_theorem.ml

   1 (*
   2
   3    Proof of the Jordan curve theorem
   4    Format: HOL-LIGHT (OCaml version 2003)
   5    File started April 20, 2004
   6    Completed January 19, 2005
   7    Author: Thomas C. Hales
   8
   9    The proof follows
  10    Carsten Thomassen
  11    "The Jordan-Schoenflies theorem and the classification of
  12     surfaces"
  13    American Math Monthly 99 (1992) 116 - 130.
  14
  15    There is one major difference from Thomassen's proof.
  16    He uses general polygonal jordan curves in the "easy" case of the
  17    Jordan curve theorem.  This file restricts the "easy" case
  18    even further to jordan curves that are made of horizontal
  19    and vertical segments with integer length.
  20
  21    Thomassen shows finite planar graphs admit polygonal
  22    embeddings.  This file shows that finite planar graphs such
  23    that every vertex has degree at most 4 admit
  24    embeddings with edges that are piecewise horizontal and
  25    vertical segments of integer length.
  26
  27    I have apologies:
  28
  29    1. I'm still a novice and haven't settled on a style.  The
  30       entire proof is a clumsy experiment.
  31    2. The lemmas have been ordered by my stream of consciousness.
  32       The file is long, the dependencies are nontrivial, and reordering
  33       is best accomplished by an automated tool.
  34
  35 *)
  36
  37
  38 let jordan_def = local_definition "jordan";;
  39 mk_local_interface "jordan";;
  40 prioritize_real();;
  41
  42 let basic_rewrite_bak = basic_rewrites();;
  43 let basic_net_bak = basic_net();;
  44 let PARTIAL_REWRITE_CONV thl =
  45   GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net_bak) thl;;
  46 let PARTIAL_REWRITE_TAC thl = CONV_TAC(PARTIAL_REWRITE_CONV thl);;
  47
  48 let reset() = (set_basic_rewrites basic_rewrite_bak);;
  49 extend_basic_rewrites
  50   (* sets *)
  51   [(* UNIV *)
  52    INR IN_UNIV;
  53    UNIV_NOT_EMPTY;
  54    EMPTY_NOT_UNIV;
  55    DIFF_UNIV;
  56    INSERT_UNIV;
  57    INTER_UNIV ;
  58    EQ_UNIV;
  59    UNIV_SUBSET;
  60    SUBSET_UNIV;
  61    (* EMPTY *)
  62    IN;IN_ELIM_THM';
  63    (* EMPTY_EXISTS; *)  (* leave EMPTY EXISTS out next time *)
  64    EMPTY_DELETE;
  65    INTERS_EMPTY;
  66    INR NOT_IN_EMPTY;
  67    EMPTY_SUBSET;
  68    (* SUBSET_EMPTY; *)  (* leave out *)
  69    (* INTERS *)
  70    inters_singleton;
  71    (* SUBSET_INTER; *)
  72    (* unions *)
  73    UNIONS_0;
  74    UNIONS_1;
  75   ];;
  76
  77
  78 let DISCH_THEN_REWRITE = (DISCH_THEN (fun t -> REWRITE_TAC[t]));;
  79 let ISUBSET = INR SUBSET;;
  80
  81 (* ------------------------------------------------------------------ *)
  82 (* Logic, Sets, Metric Space Material *)
  83 (* ------------------------------------------------------------------ *)
  84
  85 (* logic *)
  86
  87
  88 (* sets *)
  89 let PAIR_LEMMAv2 = prove_by_refinement(
  90    `!x (i:A) (j:B). (x = (i,j)) <=> ((FST x = i) /\ (SND x = j))` ,
  91 (* {{{ proof *)
  92    [
  93    MESON_TAC[FST;SND;PAIR];
  94    ]);;
  95 (* }}} *)
  96
  97 let PAIR_SPLIT = prove_by_refinement(
  98    `!x (y:A#B). (x = y) <=> ((FST x = FST y) /\ (SND x = SND y))` ,
  99 (* {{{ proof *)
 100    [
 101    MESON_TAC[FST;SND;PAIR];
 102    ]);;
 103 (* }}} *)
 104
 105 let single_inter = prove_by_refinement(
 106   `!(a:A) U. ( ~({a} INTER U = EMPTY) <=> U a)`,
 107   (* {{{ proof *)
 108   [
 109   DISCH_ALL_TAC;
 110   REWRITE_TAC[INSERT;INTER;EMPTY_EXISTS ];
 111   ASM_MESON_TAC[];
 112   ]);;
 113   (* }}} *)
 114
 115 let inters_inter = prove_by_refinement(
 116   `!(X:A->bool) Y. (X INTER Y) = (INTERS {X,Y})`,
 117   (* {{{ proof *)
 118   [
 119   DISCH_ALL_TAC;
 120   TYPE_THEN `{X,Y} Y` SUBGOAL_TAC;
 121   REWRITE_TAC[INSERT ];
 122   DISCH_TAC;
 123   USE 0 (MATCH_MP delete_inters);
 124   ASM_REWRITE_TAC[DELETE_INSERT; ];
 125   COND_CASES_TAC;
 126   ASM_REWRITE_TAC[INTER;];
 127   ASM_REWRITE_TAC[];
 128   ]);;
 129   (* }}} *)
 130
 131 let unions_delete_choice = prove_by_refinement(
 132   `!(A:(A->bool)->bool). ~(A =EMPTY) ==>
 133      (UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A))`,
 134   (* {{{ proof *)
 135   [
 136   REWRITE_TAC[];
 137   DISCH_ALL_TAC;
 138   REWRITE_TAC[UNIONS;UNION;DELETE  ];
 139   IMATCH_MP_TAC  EQ_EXT;
 140   GEN_TAC;
 141   REWRITE_TAC[];
 142   TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
 143   IMATCH_MP_TAC  (INR CHOICE_DEF  );
 144   ASM_REWRITE_TAC[];
 145   ASM_MESON_TAC[];
 146   ]);;
 147   (* }}} *)
 148
 149 let image_delete_choice = prove_by_refinement(
 150   `!(A:(A->bool)) (f:A->B). ~(A= EMPTY) ==>
 151      (IMAGE f A =
 152         ((IMAGE f (A DELETE CHOICE A)) UNION {(f (CHOICE A))}))`,
 153   (* {{{ proof *)
 154   [
 155   REWRITE_TAC[];
 156   DISCH_ALL_TAC;
 157   REWRITE_TAC[IMAGE;UNION;DELETE];
 158   IMATCH_MP_TAC  EQ_EXT;
 159   GEN_TAC;
 160   REWRITE_TAC[INSERT ];
 161   TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
 162   IMATCH_MP_TAC  (INR CHOICE_DEF  );
 163   ASM_REWRITE_TAC[];
 164   ASM_MESON_TAC[];
 165   ]);;
 166   (* }}} *)
 167
 168 let UNIONS_UNION = prove_by_refinement(
 169   `!(A:(A->bool)->bool) B.
 170     UNIONS (A UNION B) = (UNIONS A) UNION (UNIONS B)`,
 171   (* {{{ proof *)
 172   [
 173   DISCH_ALL_TAC;
 174   REWRITE_TAC[UNIONS;UNION];
 175   IMATCH_MP_TAC EQ_EXT;
 176   GEN_TAC;
 177   REWRITE_TAC[];
 178   MESON_TAC[];
 179   ]);;
 180   (* }}} *)
 181
 182 (* reals *)
 183
 184 let half_pos = prove_by_refinement(
 185   `!x. (&.0 < x) ==> (&.0 < x/(&.2)) /\ (x/(&.2)) < x`,
 186   (* {{{ proof *)
 187   [
 188   MESON_TAC[REAL_LT_HALF2;REAL_LT_HALF1];
 189   ]);;
 190   (* }}} *)
 191
 192 (* topology *)
 193 let convex_inter = prove_by_refinement(
 194   `!S T. (convex S) /\ (convex T) ==> (convex (S INTER T))`,
 195   (* {{{ proof *)
 196
 197   [
 198   REWRITE_TAC[convex;mk_segment;INTER;SUBSET_INTER  ];
 199   DISCH_ALL_TAC;
 200   DISCH_ALL_TAC;
 201   TYPEL_THEN [`x`;`y`] (USE 0 o ISPECL);
 202   REWR 0;
 203   TYPEL_THEN [`x`;`y`] (USE 1 o ISPECL);
 204   REWR 1;
 205   ]);;
 206
 207   (* }}} *)
 208
 209 let closed_inter2 = prove_by_refinement(
 210   `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==>
 211    (closed_ U (A INTER B))`,
 212   (* {{{ proof *)
 213   [
 214   DISCH_ALL_TAC;
 215   REWRITE_TAC[inters_inter];
 216   IMATCH_MP_TAC  closed_inter ;
 217   ASM_REWRITE_TAC[INR INSERT;EMPTY_EXISTS ];
 218   ASM_MESON_TAC[];
 219   ]);;
 220   (* }}} *)
 221
 222 let closure_univ = prove_by_refinement(
 223   `!U (X:A->bool). ~(X SUBSET UNIONS U) ==> (closure U X = UNIV)`,
 224   (* {{{ proof *)
 225
 226   [
 227   DISCH_ALL_TAC;
 228   REWRITE_TAC[closure;closed];
 229   TYPE_THEN `{B | (B SUBSET UNIONS U /\ open_ U (UNIONS U DIFF B)) /\ X SUBSET B} = EMPTY ` SUBGOAL_TAC;
 230   PROOF_BY_CONTR_TAC;
 231   USE 1 (REWRITE_RULE[EMPTY_EXISTS ]);
 232   CHO 1;
 233   ASM_MESON_TAC[SUBSET_TRANS];
 234   DISCH_THEN_REWRITE;
 235   ]);;
 236
 237   (* }}} *)
 238
 239 let closure_inter = prove_by_refinement(
 240   `!(X:A->bool) Y U.
 241    (topology_ U)
 242     ==> ((closure U (X INTER Y) SUBSET
 243    (closure U X) INTER closure U Y))`,
 244   (* {{{ proof *)
 245
 246   [
 247   DISCH_ALL_TAC;
 248   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 );
 249   ASM_REWRITE_TAC[];
 250   CONJ_TAC;
 251   IMATCH_MP_TAC  closed_inter2;
 252   ASM_SIMP_TAC[closure_closed ];
 253   REWRITE_TAC[INTER;ISUBSET ];
 254   ASM_MESON_TAC[subset_closure;ISUBSET];
 255   ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ];
 256   ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ];
 257   ]);;
 258
 259   (* }}} *)
 260
 261 let closure_open_ball = prove_by_refinement(
 262   `!(X:A->bool) d Z .
 263     ((metric_space(X,d)) /\ (Z SUBSET X)) ==>
 264      (({a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}
 265          = closure (top_of_metric(X,d)) Z))`,
 266   (* {{{ proof *)
 267   [
 268   DISCH_ALL_TAC;
 269   TYPE_THEN `topology_ (top_of_metric(X,d)) /\ (Z SUBSET (UNIONS (top_of_metric (X,d))))` SUBGOAL_TAC;
 270   ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions];
 271   DISCH_TAC;
 272   USE 2 (MATCH_MP closure_open);
 273   TYPE_THEN `{a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}` (USE 2 o SPEC);
 274   ASM_REWRITE_TAC[];
 275   CONJ_TAC; (* 1st prong *)
 276   REWRITE_TAC[ISUBSET;];
 277   GEN_TAC;
 278   DISCH_TAC;
 279   DISCH_ALL_TAC;
 280   TYPE_THEN `x` EXISTS_TAC;
 281   ASM_MESON_TAC[SUBSET;IN;INR open_ball_nonempty];
 282   CONJ_TAC;
 283   REWRITE_TAC[closed;open_DEF ];
 284   ASM_SIMP_TAC[GSYM top_of_metric_unions];
 285   CONJ_TAC;
 286   REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';open_ball ;];
 287   DISCH_ALL_TAC;
 288   TYPE_THEN `&.1` (USE 3 o SPEC);
 289   UND 3;
 290   REDUCE_TAC;
 291   DISCH_THEN (CHOOSE_THEN MP_TAC);
 292   MESON_TAC[];
 293   ASM_SIMP_TAC[top_of_metric_nbd];
 294   REWRITE_TAC[IN;DIFF; ISUBSET ];
 295   CONJ_TAC;
 296   MESON_TAC[];
 297   DISCH_ALL_TAC;
 298   LEFT 4 "r";
 299   CHO 4;
 300   USE 4 (REWRITE_RULE[NOT_IMP]);
 301   TYPE_THEN `r` EXISTS_TAC;
 302   NAME_CONFLICT_TAC;
 303   ASM_REWRITE_TAC[NOT_IMP];
 304   DISCH_ALL_TAC;
 305   AND 4;
 306   SUBCONJ_TAC;
 307   UND 5;
 308   REWRITE_TAC[open_ball;  ];
 309   MESON_TAC[];
 310   DISCH_TAC;
 311   LEFT_TAC "r'";
 312   JOIN 0 5;
 313   USE 0 (MATCH_MP (INR open_ball_center));
 314   CHO 0;
 315   TYPE_THEN `r'` EXISTS_TAC;
 316   UND 0;
 317   UND 4;
 318   MESON_TAC[SUBSET;IN];
 319   (* final prong *)
 320   (* fp  *)
 321   ONCE_REWRITE_TAC[TAUT (`a /\ b ==> e <=> (a /\ ~e ==> ~b)`)];
 322   REWRITE_TAC[open_DEF;EMPTY_EXISTS ];
 323   DISCH_ALL_TAC;
 324   CHO 4;
 325   USE 4 (REWRITE_RULE[INTER ]);
 326   AND 4;
 327   UND 3;
 328   ASM_SIMP_TAC[top_of_metric_nbd;];
 329   DISCH_ALL_TAC;
 330   TSPEC `u` 6;
 331   REWR 6;
 332   CHO 6;
 333   TSPEC `r` 4;
 334   REWR 4;
 335   CHO 4;
 336   TYPE_THEN `z` EXISTS_TAC;
 337   REWRITE_TAC[INTER];
 338   ASM_MESON_TAC[ISUBSET];
 339   ]);;
 340   (* }}} *)
 341
 342 let closed_union = prove_by_refinement(
 343   `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==>
 344      (closed_ U (A UNION B))`,
 345   (* {{{ proof *)
 346   [
 347   REWRITE_TAC[closed;open_DEF;union_subset  ];
 348   DISCH_ALL_TAC;
 349   ASM_REWRITE_TAC[];
 350   TYPE_THEN `UNIONS U DIFF (A UNION B) = (UNIONS U DIFF A) INTER  (UNIONS U DIFF B)` SUBGOAL_TAC;
 351   REWRITE_TAC[DIFF;UNION;IN;INTER;IN_ELIM_THM'];
 352   IMATCH_MP_TAC  EQ_EXT;
 353   GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
 354   ASM_MESON_TAC[SUBSET;IN];
 355   DISCH_THEN (fun t->REWRITE_TAC[t]);
 356   ASM_MESON_TAC[top_inter];
 357   ]);;
 358   (* }}} *)
 359
 360 (* euclid *)
 361 let euclid_scale0 = prove_by_refinement(
 362   `!x. (&.0 *# x) = (euclid0)`,
 363   (* {{{ proof *)
 364   [
 365   REWRITE_TAC[euclid_scale;euclid0];
 366   REDUCE_TAC;
 367   ]);;
 368   (* }}} *)
 369
 370 let euclid_minus0 = prove_by_refinement(
 371   `!x. (x - euclid0) = x`,
 372   (* {{{ proof *)
 373   [
 374   REWRITE_TAC[euclid0;euclid_minus];
 375   REDUCE_TAC;
 376 (*** Changed by JRH since MESON no longer automatically applies extensionality
 377   MESON_TAC[];
 378  ***)
 379   REWRITE_TAC[FUN_EQ_THM]
 380   ]);;
 381   (* }}} *)
 382
 383 let norm_scale2 = prove_by_refinement(
 384   `!t x. (euclidean x) ==> (norm (t *# x) = abs(t) * norm x)`,
 385   (* {{{ proof *)
 386   [
 387   DISCH_ALL_TAC;
 388   USE 0 (MATCH_MP norm_scale);
 389   TYPEL_THEN [`t`;`&.0`] (USE 0 o ISPECL);
 390   USE 0 (REWRITE_RULE[euclid_scale0;d_euclid;euclid_minus0]);
 391   UND 0;
 392   REDUCE_TAC;
 393   ]);;
 394   (* }}} *)
 395
 396
 397 (* ------------------------------------------------------------------ *)
 398 (* half-spaces  *)
 399 (* ------------------------------------------------------------------ *)
 400
 401 let closed_half_space = jordan_def `closed_half_space n v b =
 402   {z | (euclid n z) /\ (dot v z <=. b) }`;;
 403
 404 let open_half_space = jordan_def `open_half_space n v b =
 405   {z | (euclid n z) /\ (dot v z <. b) }`;;
 406
 407 let hyperplane = jordan_def `hyperplane n v b =
 408   {z | (euclid n z) /\ (dot v z = b) }`;;
 409
 410 let closed_half_space_euclid = prove_by_refinement(
 411   `!n v b. (closed_half_space n v b SUBSET euclid n)`,
 412   (* {{{ proof *)
 413   [
 414   REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM'  ];
 415   MESON_TAC[];
 416   ]);;
 417   (* }}} *)
 418
 419 let open_half_space_euclid = prove_by_refinement(
 420   `!n v b. (open_half_space n v b SUBSET euclid n)`,
 421   (* {{{ proof *)
 422   [
 423   REWRITE_TAC[open_half_space;SUBSET;IN;IN_ELIM_THM'  ];
 424   MESON_TAC[];
 425   ]);;
 426   (* }}} *)
 427
 428 let hyperplane_euclid = prove_by_refinement(
 429   `!n v b. (hyperplane n v b SUBSET euclid n)`,
 430   (* {{{ proof *)
 431   [
 432   REWRITE_TAC[hyperplane;SUBSET;IN;IN_ELIM_THM'  ];
 433   MESON_TAC[];
 434   ]);;
 435   (* }}} *)
 436
 437 let closed_half_space_scale = prove_by_refinement(
 438   `!n v b r. ( &.0 < r) /\ (euclid n v) ==>
 439    (closed_half_space n (r *# v) (r * b) = closed_half_space n v b)`,
 440   (* {{{ proof *)
 441   [
 442   DISCH_ALL_TAC;
 443   REWRITE_TAC[closed_half_space];
 444   IMATCH_MP_TAC  EQ_EXT ;
 445   GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
 446   IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
 447   DISCH_ALL_TAC;
 448   JOIN 1 2;
 449   USE 1 (MATCH_MP dot_scale);
 450   ASM_REWRITE_TAC[];
 451   ASM_SIMP_TAC[dot_scale];
 452   IMATCH_MP_TAC  REAL_LE_LMUL_EQ;
 453   ASM_REWRITE_TAC[];
 454   ]);;
 455   (* }}} *)
 456
 457 let open_half_space_scale = prove_by_refinement(
 458   `!n v b r. ( &.0 < r) /\ (euclid n v) ==>
 459    (open_half_space n (r *# v) (r * b) = open_half_space n v b)`,
 460   (* {{{ proof *)
 461   [
 462   DISCH_ALL_TAC;
 463   REWRITE_TAC[open_half_space];
 464   IMATCH_MP_TAC  EQ_EXT ;
 465   GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
 466   IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
 467   DISCH_ALL_TAC;
 468   JOIN 1 2;
 469   USE 1 (MATCH_MP dot_scale);
 470   ASM_REWRITE_TAC[];
 471   ASM_SIMP_TAC[dot_scale];
 472   IMATCH_MP_TAC  REAL_LT_LMUL_EQ;
 473   ASM_REWRITE_TAC[];
 474   ]);;
 475   (* }}} *)
 476
 477 let hyperplane_scale = prove_by_refinement(
 478   `!n v b r. ~( r = &.0) /\ (euclid n v) ==>
 479    (hyperplane n (r *# v) (r * b)= hyperplane n v  b)`,
 480   (* {{{ proof *)
 481   [
 482   DISCH_ALL_TAC;
 483   REWRITE_TAC[hyperplane];
 484   IMATCH_MP_TAC  EQ_EXT ;
 485   GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
 486   IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
 487   DISCH_ALL_TAC;
 488   JOIN 1 2;
 489   USE 1 (MATCH_MP dot_scale);
 490   ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL ];
 491   ]);;
 492   (* }}} *)
 493
 494 let open_half_space_diff = prove_by_refinement(
 495   `!n v b. (euclid n v) ==>
 496      ((euclid n) DIFF (open_half_space n v b) =
 497        (closed_half_space n (-- v) (--. b)))`,
 498   (* {{{ proof *)
 499   [
 500   DISCH_ALL_TAC;
 501   REWRITE_TAC[open_half_space;closed_half_space;DIFF ];
 502   REWRITE_TAC[IN; IN_ELIM_THM'];
 503   IMATCH_MP_TAC  EQ_EXT;
 504   REWRITE_TAC[IN_ELIM_THM;dot_neg ];
 505   GEN_TAC;
 506   IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
 507   DISCH_TAC;
 508   ASM_REWRITE_TAC[];
 509   REAL_ARITH_TAC;
 510   ]);;
 511   (* }}} *)
 512
 513 let closed_half_space_diff = prove_by_refinement(
 514   `!n v b. (euclid n v) ==>
 515      ((euclid n) DIFF (closed_half_space n v b) =
 516        (open_half_space n (-- v) (--. b)))`,
 517   (* {{{ proof *)
 518   [
 519   DISCH_ALL_TAC;
 520   REWRITE_TAC[open_half_space;closed_half_space;DIFF ];
 521   REWRITE_TAC[IN; IN_ELIM_THM'];
 522   IMATCH_MP_TAC  EQ_EXT;
 523   REWRITE_TAC[IN_ELIM_THM;dot_neg ];
 524   GEN_TAC;
 525   IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
 526   DISCH_TAC;
 527   ASM_REWRITE_TAC[];
 528   REAL_ARITH_TAC;
 529   ]);;
 530   (* }}} *)
 531
 532 let closed_half_space_inter = prove_by_refinement(
 533   `!n v b. (euclid n v) ==>
 534     (closed_half_space n v b INTER closed_half_space n (-- v) (--b) =
 535     hyperplane n v b)`,
 536   (* {{{ proof *)
 537   [
 538   DISCH_ALL_TAC;
 539   REWRITE_TAC[closed_half_space;INTER;IN;hyperplane;IN_ELIM_THM' ];
 540   IMATCH_MP_TAC  EQ_EXT;
 541   GEN_TAC;
 542   REWRITE_TAC[IN_ELIM_THM'];
 543   REWRITE_TAC[GSYM CONJ_ASSOC ];
 544   IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
 545   DISCH_TAC;
 546   ASM_REWRITE_TAC[dot_neg ];
 547   REAL_ARITH_TAC;
 548   ]);;
 549   (* }}} *)
 550
 551 let open_half_space_convex = prove_by_refinement(
 552   `!n v b. (euclid n v) ==> (convex (open_half_space n v b))`,
 553   (* {{{ proof *)
 554   [
 555   DISCH_ALL_TAC;
 556   REWRITE_TAC[convex;open_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN  ];
 557   DISCH_ALL_TAC;
 558   DISCH_ALL_TAC;
 559   CHO 5;
 560   UND 5;
 561   DISCH_ALL_TAC;
 562   ASM_REWRITE_TAC[];
 563   KILL 7;
 564   ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;];
 565   TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC;
 566   ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ];
 567   DISCH_THEN (fun t -> REWRITE_TAC[t]);
 568   ASM_CASES_TAC `&.0 = a`;
 569   EXPAND_TAC "a";
 570   REDUCE_TAC;
 571   ASM_REWRITE_TAC[];
 572   GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`];
 573   IMATCH_MP_TAC  REAL_LTE_ADD2;
 574   CONJ_TAC;
 575   MP_TAC (REAL_ARITH `~(&.0 = a) /\ (&.0 <= a) ==> (&.0 < a)`);
 576   ASM_REWRITE_TAC[];
 577   ASM_MESON_TAC[REAL_LT_LMUL_EQ];
 578   REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
 579   IMATCH_MP_TAC  REAL_LE_LMUL;
 580   UND 6;
 581   UND 4;
 582   REAL_ARITH_TAC;
 583   ]);;
 584   (* }}} *)
 585
 586 let closed_half_space_convex = prove_by_refinement(
 587   `!n v b. (euclid n v) ==> (convex (closed_half_space n v b))`,
 588   (* {{{ proof *)
 589   [
 590   DISCH_ALL_TAC;
 591   REWRITE_TAC[convex;closed_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN];
 592   DISCH_ALL_TAC;
 593   DISCH_ALL_TAC;
 594   CHO 5;
 595   UND 5;
 596   DISCH_ALL_TAC;
 597   ASM_REWRITE_TAC[];
 598   KILL 7;
 599   ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;];
 600   TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC;
 601   ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ];
 602   DISCH_THEN (fun t -> REWRITE_TAC[t]);
 603   GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`];
 604   IMATCH_MP_TAC  REAL_LE_ADD2;
 605   REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
 606   USE 6 (MATCH_MP (REAL_ARITH `(a <= &.1) ==> (&.0 <= (&1-a))`));
 607   CONJ_TAC THEN (IMATCH_MP_TAC REAL_LE_LMUL) THEN ASM_REWRITE_TAC[];
 608   ]);;
 609   (* }}} *)
 610
 611 let hyperplane_convex = prove_by_refinement(
 612   `!n v b. (euclid n v) ==> convex(hyperplane n v b)`,
 613   (* {{{ proof *)
 614
 615   [
 616   DISCH_ALL_TAC;
 617   ASM_SIMP_TAC[GSYM closed_half_space_inter];
 618   IMATCH_MP_TAC  convex_inter;
 619   ASM_MESON_TAC[closed_half_space_convex;neg_dim ];
 620   ]);;
 621
 622   (* }}} *)
 623
 624 let open_half_space_open = prove_by_refinement(
 625   `!n v b. (euclid n v) ==>
 626     (top_of_metric(euclid n,d_euclid)) (open_half_space n v b)`,
 627   (* {{{ proof *)
 628
 629   [
 630   DISCH_ALL_TAC;
 631   ASM_SIMP_TAC[top_of_metric_nbd;metric_euclid;SUBSET;IN;IN_ELIM_THM' ];
 632   REWRITE_TAC[open_half_space;open_ball;IN_ELIM_THM' ];
 633   CONJ_TAC ;
 634   MESON_TAC[];
 635   DISCH_ALL_TAC;
 636   ASM_CASES_TAC `v = euclid0`;
 637   UND 2;
 638   ASM_REWRITE_TAC[dot_lzero];
 639   MESON_TAC[];
 640   TYPE_THEN `(b - (dot v a))/(norm v)` EXISTS_TAC;
 641   TYPE_THEN `&.0 < (norm v)` SUBGOAL_TAC;
 642   IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ (~(x = &.0)) ==> (&.0 < x)`);
 643   ASM_MESON_TAC[norm;norm_nonneg;dot_nonneg;SQRT_EQ_0;dot_zero];
 644   DISCH_ALL_TAC;
 645   SUBCONJ_TAC;
 646   ASM_SIMP_TAC[REAL_LT_RDIV_0];
 647   UND 2;
 648   REAL_ARITH_TAC;
 649   DISCH_ALL_TAC;
 650   DISCH_ALL_TAC;
 651   ASM_REWRITE_TAC[];
 652   TYPE_THEN `(x:num->real) = a + (x - a)` SUBGOAL_TAC;
 653   REWRITE_TAC[euclid_plus;euclid_minus];
 654   IMATCH_MP_TAC  EQ_EXT;
 655   GEN_TAC THEN BETA_TAC;
 656   REAL_ARITH_TAC;
 657   DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
 658   TYPE_THEN `dot v (a + (x - a)) = (dot v a) + (dot v (x-a))` SUBGOAL_TAC;
 659   IMATCH_MP_TAC  dot_linear2;
 660   TYPE_THEN `n` EXISTS_TAC;
 661   ASM_SIMP_TAC[euclid_sub_closure];
 662   DISCH_THEN (fun t -> REWRITE_TAC[t]);
 663   IMATCH_MP_TAC  (REAL_ARITH `(?d. (b<=d) /\ d < C - a) ==> a +b < C`);
 664   TYPE_THEN `(norm v)*. (d_euclid a x)` EXISTS_TAC;
 665   CONJ_TAC;
 666   ASSUME_TAC metric_euclid;
 667   TYPE_THEN `n` (USE 9 o SPEC);
 668   COPY 7;
 669   JOIN  6 7;
 670   JOIN 9 6;
 671   USE 6 (MATCH_MP metric_space_symm);
 672   ASM_REWRITE_TAC[];
 673   REWRITE_TAC[d_euclid];
 674   IMATCH_MP_TAC  (REAL_ARITH `||. u <=. C ==> (u <=. C)`);
 675   IMATCH_MP_TAC  cauchy_schwartz;
 676   ASM_MESON_TAC[euclidean;euclid_sub_closure];
 677   UND 8;
 678   ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
 679   REAL_ARITH_TAC;
 680   ]);;
 681
 682   (* }}} *)
 683
 684 let closed_half_space_closed = prove_by_refinement(
 685   `!n v b. (euclid n v) ==>
 686      closed_ (top_of_metric(euclid n,d_euclid))
 687       (closed_half_space n v b)`,
 688   (* {{{ proof *)
 689   [
 690   REWRITE_TAC[closed;open_DEF ];
 691   DISCH_ALL_TAC;
 692   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;closed_half_space_diff;open_half_space_open;euclid_neg_closure ];
 693   REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM' ];
 694   MESON_TAC[];
 695   ]);;
 696   (* }}} *)
 697
 698 let hyperplane_closed = prove_by_refinement(
 699   `!n v b. (euclid n v) ==>
 700      closed_ (top_of_metric(euclid n,d_euclid))
 701      (hyperplane n v b)`,
 702   (* {{{ proof *)
 703   [
 704   DISCH_ALL_TAC;
 705   ASM_SIMP_TAC[GSYM closed_half_space_inter];
 706   IMATCH_MP_TAC  closed_inter2;
 707   ASM_MESON_TAC[euclid_neg_closure;top_of_metric_top ;metric_euclid ;closed_half_space_closed;];
 708   ]);;
 709   (* }}} *)
 710
 711 let closure_half_space = prove_by_refinement(
 712   `!n v b. (euclid n v) /\ (~(v = euclid0)) ==>
 713    ((closure (top_of_metric(euclid n,d_euclid))
 714     (open_half_space n v b)) = (closed_half_space n v b))`,
 715   (* {{{ proof *)
 716
 717   [
 718   DISCH_ALL_TAC;
 719   IMATCH_MP_TAC  SUBSET_ANTISYM;
 720   CONJ_TAC;
 721   IMATCH_MP_TAC  closure_subset;
 722   ASM_SIMP_TAC [top_of_metric_top;metric_euclid];
 723   ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;closed_half_space_closed];
 724   REWRITE_TAC[SUBSET;IN;closed_half_space;open_half_space;IN_ELIM_THM' ];
 725   MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
 726   ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;open_half_space_euclid];
 727   REWRITE_TAC[open_half_space;closed_half_space;SUBSET;IN;IN_ELIM_THM'];
 728   DISCH_ALL_TAC;
 729   DISCH_ALL_TAC;
 730   TYPE_THEN `t = ((r/(&.2))/(norm v ))` ABBREV_TAC;
 731   TYPE_THEN `u = x - (t)*# v` ABBREV_TAC;
 732   TYPE_THEN `u` EXISTS_TAC;
 733   TYPE_THEN `&.0 < (dot v v)` SUBGOAL_TAC;
 734   IMATCH_MP_TAC  (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 < x)`);
 735   REWRITE_TAC[dot_nonneg];
 736   ASM_MESON_TAC[euclidean;dot_zero_euclidean ];
 737   DISCH_TAC;
 738   TYPE_THEN `&.0 < t` SUBGOAL_TAC;
 739   EXPAND_TAC "t";
 740   IMATCH_MP_TAC  REAL_LT_DIV;
 741   ASM_REWRITE_TAC[REAL_LT_HALF1];
 742   REWRITE_TAC[norm];
 743   IMATCH_MP_TAC  SQRT_POS_LT;
 744   ASM_REWRITE_TAC[];
 745   DISCH_TAC;
 746   SUBCONJ_TAC;
 747   CONJ_TAC;
 748   ASM_MESON_TAC[euclid_sub_closure ;euclid_scale_closure ];
 749   TYPE_THEN `dot v u = (dot v x - t* (dot v v))` SUBGOAL_TAC;
 750   EXPAND_TAC "u";
 751   ASM_MESON_TAC[dot_minus_linear2;dot_scale2;euclid_sub_closure;euclid_scale_closure];
 752   DISCH_THEN (fun t->REWRITE_TAC[t]);
 753   IMATCH_MP_TAC  (REAL_ARITH `(a <= b) /\ (&.0 < C) ==> (a - C < b)`);
 754   ASM_REWRITE_TAC[];
 755   IMATCH_MP_TAC  REAL_LT_MUL;
 756   ASM_REWRITE_TAC[];
 757   DISCH_ALL_TAC;
 758   ASM_REWRITE_TAC[open_ball;IN_ELIM_THM' ];
 759   EXPAND_TAC "u";
 760   REWRITE_TAC[d_euclid];
 761   TYPE_THEN `euclid_minus x (euclid_minus x (t *# v)) = ( t) *# v` SUBGOAL_TAC;
 762   REWRITE_TAC[euclid_minus;euclid_scale];
 763   IMATCH_MP_TAC  EQ_EXT;
 764   GEN_TAC THEN BETA_TAC;
 765   REAL_ARITH_TAC ;
 766   DISCH_THEN (fun t-> REWRITE_TAC[t]);
 767   TYPE_THEN `norm (t *# v) = t * norm v` SUBGOAL_TAC;
 768   ASM_MESON_TAC[euclidean;norm_scale2;ABS_REFL;REAL_ARITH `&.0 < t ==> &.0 <= t`];
 769   DISCH_THEN (fun t -> REWRITE_TAC[t]);
 770   EXPAND_TAC "t";
 771   TYPE_THEN `((r / &2) / norm v) * norm v = r/(&.2)` SUBGOAL_TAC;
 772   IMATCH_MP_TAC  REAL_DIV_RMUL;
 773   REWRITE_TAC[norm];
 774   ASM_MESON_TAC[SQRT_POS_LT;REAL_ARITH `&.0 < x ==> ~(x = &.0)`];
 775   DISCH_THEN (fun t-> REWRITE_TAC[t]);
 776   ASM_MESON_TAC[half_pos];
 777   ]);;
 778
 779   (* }}} *)
 780
 781
 782 let subset_of_closure = prove_by_refinement(
 783   `!(A:A->bool) B U. (topology_ U) /\ (A SUBSET B) ==>
 784     (closure U A SUBSET closure U B)`,
 785   (* {{{ proof *)
 786   [
 787   DISCH_ALL_TAC;
 788   TYPE_THEN `(A SUBSET (UNIONS U))` ASM_CASES_TAC;
 789   TYPE_THEN `(B SUBSET (UNIONS U))` ASM_CASES_TAC;
 790   IMATCH_MP_TAC  closure_subset;
 791   ASM_REWRITE_TAC[];
 792   WITH 0 (MATCH_MP subset_closure);
 793   USE 4 (ISPEC `B:A->bool`);
 794   JOIN 1 4;
 795   USE 1 (MATCH_MP SUBSET_TRANS);
 796   ASM_REWRITE_TAC[];
 797   ASM_MESON_TAC [closure_closed;];
 798   USE 3 (MATCH_MP closure_univ);
 799   ASM_REWRITE_TAC[];
 800   TYPE_THEN `~(B SUBSET UNIONS U)` SUBGOAL_TAC;
 801   UND 2;
 802   UND 1;
 803   REWRITE_TAC[ISUBSET];
 804   MESON_TAC[];
 805   DISCH_TAC;
 806   USE 2 (MATCH_MP closure_univ);
 807   USE 3 (MATCH_MP closure_univ);
 808   ASM_REWRITE_TAC[];
 809   ]);;
 810   (* }}} *)
 811
 812 let closure_union = prove_by_refinement(
 813   `!(A:A->bool)  B U. (topology_ U) ==>
 814     (closure U (A UNION B) = (closure U A) UNION (closure U B))`,
 815   (* {{{ proof *)
 816   [
 817   DISCH_ALL_TAC;
 818   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 `(~)`);
 819   IMATCH_MP_TAC  SUBSET_ANTISYM;
 820   CONJ_TAC;
 821   IMATCH_MP_TAC closure_subset;
 822   ASM_REWRITE_TAC[];
 823   CONJ_TAC;
 824   ASM_MESON_TAC[closed_union; closure_closed];
 825   REWRITE_TAC[union_subset];
 826   TYPE_THEN `(A SUBSET closure U A) /\ (B SUBSET closure U B)` SUBGOAL_TAC;
 827   ASM_SIMP_TAC[subset_closure];
 828   REWRITE_TAC[UNION;ISUBSET ];
 829   ASM_MESON_TAC[];
 830   REWRITE_TAC[union_subset];
 831   CONJ_TAC THEN IMATCH_MP_TAC  subset_of_closure THEN ASM_REWRITE_TAC[ISUBSET;UNION ] THEN (MESON_TAC []);
 832   REWRITE_TAC [UNION;SUBSET; ];
 833   MESON_TAC[];
 834   REWRITE_TAC[UNION;SUBSET];
 835   MESON_TAC[];
 836   REWRITE_TAC[UNION;SUBSET];
 837   MESON_TAC[];
 838   ]);;
 839   (* }}} *)
 840
 841 let closure_empty = prove_by_refinement(
 842   `!U. (topology_ U) ==> (closure U (EMPTY:A->bool) = EMPTY)`,
 843   (* {{{ proof *)
 844   [
 845   DISCH_ALL_TAC;
 846   IMATCH_MP_TAC  SUBSET_ANTISYM;
 847   ASM_MESON_TAC[SUBSET_EMPTY;closure_subset;empty_closed];
 848   ]);;
 849   (* }}} *)
 850
 851 let closure_unions = prove_by_refinement(
 852   `!(A:(A->bool)->bool) U. (topology_ U) /\ (FINITE A) ==>
 853     (closure U (UNIONS A) = UNIONS (IMAGE (closure U) A))`,
 854   (* {{{ proof *)
 855   [
 856   REP_GEN_TAC;
 857   TYPE_THEN `n = CARD A` ABBREV_TAC;
 858   UND 0;
 859   TYPE_THEN `A` (fun t-> SPEC_TAC (t,t));
 860   TYPE_THEN `n` (fun t-> SPEC_TAC (t,t));
 861   INDUCT_TAC;
 862   DISCH_ALL_TAC;
 863   TYPE_THEN `A HAS_SIZE 0` SUBGOAL_TAC;
 864   ASM_REWRITE_TAC[HAS_SIZE];
 865   ASM_REWRITE_TAC[HAS_SIZE_0];
 866   DISCH_THEN_REWRITE;
 867   ASM_SIMP_TAC [closure_empty;IMAGE_CLAUSES];
 868   DISCH_ALL_TAC;
 869   TYPE_THEN `~(A HAS_SIZE 0)` SUBGOAL_TAC;
 870   ASM_REWRITE_TAC[HAS_SIZE];
 871   ARITH_TAC;
 872   TYPE_THEN `A` (MP_TAC o ((C ISPEC)  CARD_DELETE_CHOICE));
 873   REWRITE_TAC[HAS_SIZE_0];
 874   DISCH_ALL_TAC;
 875   REWR 5;
 876   USE 5 (CONV_RULE REDUCE_CONV );
 877   TYPE_THEN `(A DELETE CHOICE A)` (USE 0 o ISPEC);
 878   USE 0 (REWRITE_RULE[FINITE_DELETE]);
 879   REWR 0;
 880   TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
 881   IMATCH_MP_TAC  (INR CHOICE_DEF);
 882   ASM_REWRITE_TAC[];
 883   DISCH_TAC;
 884   TYPE_THEN `UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A)` SUBGOAL_TAC;
 885   IMATCH_MP_TAC  unions_delete_choice;
 886   ASM_REWRITE_TAC[];
 887   DISCH_THEN_REWRITE;
 888   TYPE_THEN `(IMAGE  (closure U) A) = (IMAGE (closure U) (A DELETE CHOICE A) UNION {(closure U (CHOICE A))})` SUBGOAL_TAC;
 889   IMATCH_MP_TAC  image_delete_choice ;
 890   ASM_REWRITE_TAC[];
 891   DISCH_THEN_REWRITE;
 892   ASM_SIMP_TAC[closure_union];
 893   REWRITE_TAC[UNIONS_UNION];
 894   ]);;
 895   (* }}} *)
 896
 897 let metric_space_zero2 = prove_by_refinement(
 898   `!X d (x:A) y. (metric_space(X,d) /\ (X x) /\ (X y)) ==>
 899    ((d x y = &.0) <=> (x = y))`,
 900   (* {{{ proof *)
 901   [
 902   DISCH_ALL_TAC;
 903   USE 0 (REWRITE_RULE[metric_space]);
 904   TYPEL_THEN [`x`;`y`;`x`] (USE 0 o ISPECL);
 905   ASM_MESON_TAC[];
 906   ]);;
 907   (* }}} *)
 908
 909 let d_euclid_zero = prove_by_refinement(
 910   `!n x y. (euclid n x) /\ (euclid n y)  ==>
 911     ((d_euclid x y = &.0) <=> (x = y))`,
 912   (* {{{ proof *)
 913   [
 914   DISCH_ALL_TAC;
 915   TYPEL_THEN [`euclid n`;`d_euclid`;`x`;`y`] (ASSUME_TAC o (C ISPECL) metric_space_zero2);
 916   ASM_MESON_TAC[metric_euclid];
 917   ]);;
 918   (* }}} *)
 919
 920 let d_euclid_pos2 = prove_by_refinement(
 921   `!x y n. ~(x = y) /\ euclid n x /\ euclid n y ==> &0 <. d_euclid x y`,
 922   (* {{{ proof *)
 923   [
 924   DISCH_ALL_TAC;
 925   IMATCH_MP_TAC  (REAL_ARITH `&.0 <= x /\ ~(x = &.0) ==> (&.0 < x)`);
 926   ASM_MESON_TAC[d_euclid_pos;d_euclid_zero];
 927   ]);;
 928   (* }}} *)
 929
 930 let euclid_segment = prove_by_refinement(
 931   `!n x y. (euclid n x) /\
 932    (!t. (&.0 <. t) /\ (t <=. &.1) ==>
 933          (euclid n (t *# x + (&.1 - t)*# y)))
 934      ==>
 935    (euclid n y)`,
 936   (* {{{ proof *)
 937   [
 938   DISCH_ALL_TAC;
 939   TYPE_THEN `t = &.1/(&.2)` ABBREV_TAC;
 940   TYPE_THEN `y = ((&.2) *# ((t *# x) + (&.1 - t)*# y)) - x` SUBGOAL_TAC;
 941   REWRITE_TAC[euclid_minus;euclid_scale;euclid_plus];
 942   IMATCH_MP_TAC  EQ_EXT;
 943   GEN_TAC THEN BETA_TAC ;
 944   REWRITE_TAC[REAL_ADD_LDISTRIB];
 945   REWRITE_TAC[REAL_MUL_ASSOC;REAL_SUB_LDISTRIB ];
 946   EXPAND_TAC "t";
 947   SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&.2 = &.0)`];
 948   REAL_ARITH_TAC;
 949   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
 950   TYPE_THEN `t` (USE 1 o SPEC);
 951   TYPE_THEN `v = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC;
 952   KILL 3;
 953   TYPE_THEN `&0 < t /\ t <= &1` SUBGOAL_TAC;
 954   EXPAND_TAC "t";
 955   CONJ_TAC ;
 956   IMATCH_MP_TAC  REAL_LT_DIV;
 957   REAL_ARITH_TAC;
 958   IMATCH_MP_TAC  REAL_LE_LDIV;
 959   REAL_ARITH_TAC;
 960   DISCH_TAC;
 961   REWR 1;
 962   ASM_SIMP_TAC[euclid_sub_closure;euclid_scale_closure];
 963   ]);;
 964   (* }}} *)
 965
 966 let euclid_xy = prove_by_refinement(
 967   `!n x y. (!t . (&.0 < t) /\ (t < &.1) ==>
 968     (euclid n (t *# x + (&.1-t)*# y))) ==> (euclid n x) /\ (euclid n y)`,
 969   (* {{{ proof *)
 970
 971   [
 972   DISCH_ALL_TAC;
 973   TYPE_THEN `u = (&.1/(&.3))*# x + (&.1 - (&.1/(&.3))) *# y` ABBREV_TAC;
 974   TYPE_THEN `v = (&.2/(&.3))*# x + (&.1 - (&.2/(&.3))) *# y` ABBREV_TAC;
 975   TYPE_THEN `euclid n u` SUBGOAL_TAC;
 976   EXPAND_TAC "u";
 977   UND 0;
 978   DISCH_THEN IMATCH_MP_TAC ;
 979   CONV_TAC REAL_RAT_REDUCE_CONV;
 980   DISCH_TAC;
 981   TYPE_THEN `euclid n v` SUBGOAL_TAC;
 982   EXPAND_TAC "v";
 983   UND 0;
 984   DISCH_THEN IMATCH_MP_TAC ;
 985   CONV_TAC REAL_RAT_REDUCE_CONV;
 986   DISCH_TAC;
 987   TYPE_THEN `x = (&.2)*# v - (&.1) *# u` SUBGOAL_TAC;
 988   EXPAND_TAC "u";
 989   EXPAND_TAC "v";
 990   REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
 991   IMATCH_MP_TAC  EQ_EXT;
 992   DISCH_ALL_TAC;
 993   BETA_TAC;
 994   TYPE_THEN `a = x x'`  ABBREV_TAC ;
 995   TYPE_THEN `b= y x'`  ABBREV_TAC ;
 996   real_poly_tac;
 997   DISCH_THEN_REWRITE;
 998   ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure];
 999   TYPE_THEN `y = (&.2)*# u - (&.1) *# v` SUBGOAL_TAC;
1000   EXPAND_TAC "u";
1001   EXPAND_TAC "v";
1002   REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
1003   IMATCH_MP_TAC  EQ_EXT;
1004   DISCH_ALL_TAC;
1005   BETA_TAC;
1006   TYPE_THEN `a = x x'`  ABBREV_TAC ;
1007   TYPE_THEN `b= y x'`  ABBREV_TAC ;
1008   real_poly_tac;
1009   DISCH_THEN_REWRITE;
1010   ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure];
1011   ]);;
1012   (* }}} *)
1013
1014
1015 let closure_segment = prove_by_refinement(
1016   `!C n x y. (C SUBSET (euclid n)) /\
1017       (!t. (&.0 < t) /\ (t < &.1) ==> (C (t *# x + (&.1-t)*# y))) ==>
1018       (closure (top_of_metric(euclid n,d_euclid)) C y)`,
1019   (* {{{ proof *)
1020
1021   [
1022   DISCH_ALL_TAC;
1023   TYPE_THEN `euclid n x /\ (euclid n y)` SUBGOAL_TAC;
1024   IMATCH_MP_TAC  euclid_xy;
1025   ASM_MESON_TAC[ISUBSET];
1026   DISCH_ALL_TAC;
1027   (* case x=y *)
1028   TYPE_THEN `x = y` ASM_CASES_TAC ;
1029   TYPE_THEN `C SUBSET (closure (top_of_metric (euclid n,d_euclid)) C)` SUBGOAL_TAC ;
1030   IMATCH_MP_TAC  subset_closure;
1031   ASM_SIMP_TAC [top_of_metric_top;metric_euclid];
1032   REWRITE_TAC[ISUBSET];
1033   TYPE_THEN `C x` SUBGOAL_TAC;
1034   REWR 1;
1035   USE 1 (REWRITE_RULE[trivial_lin_combo]);
1036   TSPEC `&.1/(&.2)` 1;
1037   USE 1 (CONV_RULE (REAL_RAT_REDUCE_CONV));
1038   ASM_REWRITE_TAC[];
1039   ASM_MESON_TAC[];
1040   (* now ~(x=y) *)
1041   TYPE_THEN `&.0 < d_euclid x y` SUBGOAL_TAC;
1042   ASM_MESON_TAC[d_euclid_pos2];
1043   DISCH_TAC;
1044   ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid];
1045   DISCH_ALL_TAC;
1046   REWRITE_TAC[open_ball];
1047   (* ## *)
1048   TYPE_THEN `?t. (&.0 <. t) /\ (t <. &.1) /\ (t *. (d_euclid x y) <. r)` SUBGOAL_TAC;
1049   TYPE_THEN  `(&.1/(&.2))*. d_euclid x y < r` ASM_CASES_TAC;
1050   TYPE_THEN `(&.1/(&.2))` EXISTS_TAC;
1051   CONV_TAC (REAL_RAT_REDUCE_CONV);
1052   ASM_REWRITE_TAC[];
1053   TYPE_THEN `(r/(&.2))/(d_euclid x y)` EXISTS_TAC;
1054   ASM_SIMP_TAC[REAL_LT_DIV;REAL_LT_HALF1];
1055   CONJ_TAC;
1056   ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
1057   REDUCE_TAC;
1058   TYPE_THEN `s = d_euclid x y ` ABBREV_TAC;
1059   ineq_lt_tac `r/(&.2) + ( (&1/(&2))*s - r)*(&1/(&2)) + (s)*(&3/(&4)) = s`;
1060   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ;REAL_LT_RDIV;half_pos];
1061   DISCH_TAC;
1062   CHO 7;
1063   TYPE_THEN `t` (USE 1 o SPEC);
1064   REWR 1;
1065   TYPE_THEN `z = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC ;
1066   TYPE_THEN `z` EXISTS_TAC;
1067   ASM_REWRITE_TAC[];
1068   SUBCONJ_TAC;
1069   EXPAND_TAC "z";
1070   ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure];
1071   DISCH_TAC;
1072   TYPE_THEN `y = (t *# y) + ((&.1 - t)*# y)` SUBGOAL_TAC;
1073   ASM_MESON_TAC[trivial_lin_combo];
1074   DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
1075   EXPAND_TAC "z";
1076   TYPE_THEN `euclid n (t*# y) /\  (euclid n (t *# x)) /\ (euclid n ((&.1-t)*# y))` SUBGOAL_TAC;
1077   ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure];
1078   DISCH_TAC;
1079   USE 10 (MATCH_MP metric_translate);
1080   KILL 8;
1081   ASM_REWRITE_TAC[];
1082   TYPE_THEN `d_euclid (t *# y) (t *# x) = d_euclid (t *# x) (t *# y)` SUBGOAL_TAC;
1083   ASM_MESON_TAC [ISPEC `euclid n` metric_space_symm; euclid_scale_closure;metric_euclid];
1084   DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
1085   JOIN 2 3;
1086   USE 2 (MATCH_MP norm_scale_vec);
1087   TSPEC `t` 2;
1088   ASM_REWRITE_TAC[];
1089   AND 7;
1090   USE 7 (MATCH_MP (REAL_ARITH `&.0 < t ==> (&.0 <=. t)`));
1091   USE 7 (REWRITE_RULE[GSYM ABS_REFL]);
1092   ASM_REWRITE_TAC [];
1093   ]);;
1094
1095   (* }}} *)
1096
1097
1098
1099 (* ------------------------------------------------------------------ *)
1100 (* POINTS *)
1101 (* ------------------------------------------------------------------ *)
1102
1103
1104 let point = jordan_def `point z =
1105    (FST z) *# (dirac_delta 0) + (SND z) *# (dirac_delta 1)`;;
1106
1107 let dest_pt = jordan_def `dest_pt p =
1108    @u.  p = point u`;;
1109
1110 let point_xy = prove_by_refinement(
1111   `!x y. point(x,y) = x *# (dirac_delta 0) + y *# (dirac_delta 1)`,
1112   (* {{{ proof *)
1113   [
1114   REWRITE_TAC[point;];
1115   ]);;
1116   (* }}} *)
1117
1118 let coord01 = prove_by_refinement(
1119   `!p. (point p 0 = FST p) /\ (point p 1 = SND p)`,
1120   (* {{{ proof *)
1121   [
1122   REWRITE_TAC[point;euclid_plus;euclid_scale ];
1123   REWRITE_TAC[dirac_delta;ARITH_RULE   `~(1=0) /\ ~(0=1)`];
1124   REDUCE_TAC ;
1125   ]);;
1126   (* }}} *)
1127
1128 let euclid_point = prove_by_refinement(
1129   `!p. euclid 2 (point p)`,
1130   (* {{{ proof *)
1131   [
1132   REWRITE_TAC[point;euclid];
1133   REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta ];
1134   DISCH_ALL_TAC;
1135   USE 0 (MATCH_MP (ARITH_RULE `(2 <=| m) ==> (~(0=m) /\ (~(1=m)))`));
1136   ASM_REWRITE_TAC[];
1137   REDUCE_TAC ;
1138   ]);;
1139   (* }}} *)
1140
1141 let point_inj = prove_by_refinement(
1142   `!p q. (point p = point q) <=> (p = q)`,
1143   (* {{{ proof *)
1144
1145   [
1146   DISCH_ALL_TAC;
1147   EQ_TAC ;
1148   DISCH_TAC ;
1149   WITH  0 (fun t -> AP_THM t `0`);
1150   USE 0 (fun t-> AP_THM t `1`);
1151   UND 0;
1152   UND 1;
1153   REWRITE_TAC[coord01;];
1154   ASM_MESON_TAC[PAIR];
1155   ASM_MESON_TAC[];
1156   ]);;
1157
1158   (* }}} *)
1159
1160 let point_onto = prove_by_refinement(
1161   `!v. (euclid 2 v) ==> ?p. (v = point p)`,
1162   (* {{{ proof *)
1163   [
1164   DISCH_ALL_TAC;
1165   TYPE_THEN `(v 0 ,v 1)` EXISTS_TAC;
1166   IMATCH_MP_TAC  EQ_EXT ;
1167   GEN_TAC ;
1168   REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta];
1169   MP_TAC (ARITH_RULE `(0 = x) \/ ( 1 = x) \/ (2 <= x)`);
1170   REP_CASES_TAC;
1171   WITH 1 (MATCH_MP (ARITH_RULE  `(0=x) ==> ~(1=x)`));
1172   ASM_REWRITE_TAC[];
1173   EXPAND_TAC "x";
1174   REDUCE_TAC;
1175   WITH 1 (MATCH_MP (ARITH_RULE  `(1=x) ==> ~(0=x)`));
1176   ASM_REWRITE_TAC[];
1177   EXPAND_TAC "x";
1178   REDUCE_TAC;
1179   WITH 1 (MATCH_MP (ARITH_RULE  `(2 <=| x) ==> (~(0=x)/\ ~(1=x))`));
1180   ASM_REWRITE_TAC[];
1181   REDUCE_TAC;
1182   ASM_MESON_TAC[euclid];
1183   ]);;
1184   (* }}} *)
1185
1186 let dest_pt_point = prove_by_refinement(
1187   `!p. dest_pt(point p) = p`,
1188   (* {{{ proof *)
1189   [
1190   REWRITE_TAC[dest_pt];
1191   DISCH_ALL_TAC;
1192   SELECT_TAC;
1193   ASM_MESON_TAC[point_inj];
1194   ASM_MESON_TAC[];
1195   ]);;
1196   (* }}} *)
1197
1198 let point_dest_pt = prove_by_refinement(
1199   `!v. (euclid 2 v) <=> (point (dest_pt v) = v)`,
1200   (* {{{ proof *)
1201   [
1202   GEN_TAC;
1203   EQ_TAC;
1204   REWRITE_TAC[dest_pt];
1205   DISCH_ALL_TAC;
1206   SELECT_TAC;
1207   ASM_MESON_TAC[];
1208   ASM_MESON_TAC[point_onto];
1209   ASM_MESON_TAC[euclid_point];
1210   ]);;
1211   (* }}} *)
1212
1213 let Q_POINT = prove_by_refinement(
1214   `!Q z. (?u v. (point z = point (u,v)) /\ (Q z u v)) <=> (Q z (FST z) (SND z))`,
1215   (* {{{ proof *)
1216   [
1217   DISCH_ALL_TAC;
1218   REWRITE_TAC[point_inj];
1219   EQ_TAC;
1220   DISCH_TAC;
1221   CHO 0;
1222   CHO 0;
1223   ASM_REWRITE_TAC[];
1224   ASM_MESON_TAC[];
1225   DISCH_TAC;
1226   TYPE_THEN `FST z` EXISTS_TAC;
1227   TYPE_THEN `SND z` EXISTS_TAC;
1228   ASM_REWRITE_TAC[];
1229   ]);;
1230   (* }}} *)
1231
1232 let pointI = jordan_def `pointI p =
1233    point(real_of_int (FST p),real_of_int (SND p))`;;
1234
1235 let convex_pointI = prove_by_refinement(
1236   `!p. (convex {(pointI p)})`,
1237   (* {{{ proof *)
1238
1239   [
1240   REWRITE_TAC[convex;mk_segment;INSERT;IN_ELIM_THM';SUBSET; ];
1241   REWRITE_TAC[IN;EMPTY];
1242   DISCH_ALL_TAC;
1243   ASM_REWRITE_TAC[trivial_lin_combo];
1244   DISCH_ALL_TAC;
1245   CHO 2;
1246   ASM_REWRITE_TAC[];
1247   ]);;
1248
1249   (* }}} *)
1250
1251 let point_closure = prove_by_refinement(
1252   `!p q a b. (?r. (a *# (point p) + (b *# (point q)) = (point r)))`,
1253   (* {{{ proof *)
1254   [
1255   DISCH_ALL_TAC;
1256   TYPE_THEN `euclid 2 (a *# (point p) + (b *# (point q)))` SUBGOAL_TAC;
1257   IMATCH_MP_TAC euclid_add_closure;
1258   CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN REWRITE_TAC [euclid_point];
1259   MESON_TAC[point_onto];
1260   ]);;
1261   (* }}} *)
1262
1263 let point_scale = prove_by_refinement(
1264   `!a u v. a *# (point (u,v)) = point(a* u,a* v)`,
1265   (* {{{ proof *)
1266   [
1267   REWRITE_TAC[point;euclid_scale;euclid_plus ];
1268   DISCH_ALL_TAC;
1269   IMATCH_MP_TAC  EQ_EXT;
1270   GEN_TAC THEN BETA_TAC;
1271   REAL_ARITH_TAC;
1272   ]);;
1273   (* }}} *)
1274
1275 let point_add = prove_by_refinement(
1276   `!u v u' v'. (point(u,v))+(point(u',v')) = (point(u+u',v+v'))`,
1277   (* {{{ proof *)
1278   [
1279   REWRITE_TAC[point;euclid_plus;euclid_scale];
1280   DISCH_ALL_TAC;
1281   IMATCH_MP_TAC  EQ_EXT;
1282   GEN_TAC THEN BETA_TAC;
1283   REAL_ARITH_TAC;
1284   ]);;
1285   (* }}} *)
1286
1287
1288
1289 (* ------------------------------------------------------------------ *)
1290 (* the FLOOR function *)
1291 (* ------------------------------------------------------------------ *)
1292
1293
1294 let floor = jordan_def `floor x =
1295    @m. (real_of_int m <=. x /\ (x < (real_of_int (m + &:1))))`;;
1296
1297 let int_suc = prove_by_refinement(
1298   `!m. (real_of_int (m + &:1) = real_of_int m + &.1)`,
1299   (* {{{ proof *)
1300   [
1301   REWRITE_TAC[int_add_th;INT_NUM_REAL ];
1302   ]);;
1303   (* }}} *)
1304
1305 let floor_ineq = prove_by_refinement(
1306   `!x. (real_of_int (floor x) <=. x) /\ (x <. (real_of_int (floor x)) + &.1)`,
1307   (* {{{ proof *)
1308   [
1309   DISCH_ALL_TAC;
1310   REWRITE_TAC[floor];
1311   SELECT_TAC;
1312   REWRITE_TAC[int_suc];
1313   MP_TAC (SPEC `&.1` REAL_ARCH_LEAST);
1314   REDUCE_TAC;
1315   DISCH_TAC;
1316   ASM_CASES_TAC `&.0 <= x`;
1317   TSPEC `x` 1;
1318   REWR 1;
1319   CHO 1;
1320   LEFT 0 "y";
1321   TSPEC `&:n` 0;
1322   USE 0  (REWRITE_RULE[INT_NUM_REAL;int_add_th;REAL_OF_NUM_ADD ]);
1323   ASM_MESON_TAC[];
1324   TSPEC `--. x` 1;
1325     COPY 2;
1326   IMP_REAL `~(&.0 <=. x) ==> (&.0 <=. (-- x))` 2;
1327   REWR 1;
1328   CHO 1;
1329   LEFT 0 "y";
1330   ASM_CASES_TAC `&.n = --x`;
1331   TSPEC `-- (&:n)` 0;
1332   USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL;REAL_OF_NUM_ADD]);
1333   JOIN 0 1;
1334   USE 0 (REWRITE_RULE[ GSYM REAL_OF_NUM_ADD]);
1335   PROOF_BY_CONTR_TAC;
1336   UND 0;
1337   UND 4;
1338   REAL_ARITH_TAC ;
1339   TSPEC `--: (&:(n+| 1))` 0;
1340   JOIN 1 0;
1341   USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL; GSYM REAL_OF_NUM_ADD;]);
1342   JOIN 4 0;
1343   PROOF_BY_CONTR_TAC;
1344   UND 0;
1345   REAL_ARITH_TAC;
1346   ]);;
1347   (* }}} *)
1348
1349 let int_arch = prove_by_refinement(
1350   `!m n. (n <=: m) /\ (m <: (n +: (&:1))) <=> (n = m)`,
1351   (* {{{ proof *)
1352   [
1353   REWRITE_TAC[int_lt;int_le;int_eq ;int_add_th;int_of_num_th   ];
1354   DISCH_ALL_TAC;
1355   EQ_TAC;
1356   MP_TAC (SPEC `m:int` dest_int_rep);
1357   DISCH_THEN (CHOOSE_THEN MP_TAC);
1358   MP_TAC (SPEC `n:int` dest_int_rep);
1359   DISCH_THEN (CHOOSE_THEN MP_TAC);
1360   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;
1361   REAL_ARITH_TAC;
1362   ]);;
1363   (* }}} *)
1364
1365 let floor_int = prove_by_refinement(
1366   `!m. (floor (real_of_int m) = m)`,
1367   (* {{{ proof *)
1368   [
1369   DISCH_ALL_TAC;
1370   TYPE_THEN `floor (real_of_int m) <=: m /\ (m <: (floor (real_of_int m)) + (&:1))` SUBGOAL_TAC;
1371   REWRITE_TAC[int_le;int_lt;int_add_th ;int_of_num_th;floor_ineq  ];
1372   REWRITE_TAC[int_arch ];
1373   ]);;
1374   (* }}} *)
1375
1376 let int_lt_suc_le = prove_by_refinement(
1377   `!m n. m <: n + &:1 <=> m <=: n`,
1378   (* {{{ proof *)
1379   [
1380   DISCH_ALL_TAC;
1381   EQ_TAC;
1382   MP_TAC (SPEC `m:int` dest_int_rep);
1383   DISCH_THEN (CHOOSE_THEN MP_TAC);
1384   MP_TAC (SPEC `n:int` dest_int_rep);
1385   DISCH_THEN (CHOOSE_THEN MP_TAC);
1386   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;
1387   REWRITE_TAC[int_le;int_lt;int_add_th;int_of_num_th];
1388   REAL_ARITH_TAC;
1389   ]);;
1390   (* }}} *)
1391
1392 let floor_le = prove_by_refinement(
1393   `!m x. (real_of_int m <=. x) <=> (m <=: (floor x))`,
1394   (* {{{ proof *)
1395   [
1396   REP_GEN_TAC;
1397   EQ_TAC;
1398   DISCH_TAC;
1399   REWRITE_TAC[int_le];
1400   REWRITE_TAC[GSYM int_le ;GSYM   int_lt_suc_le;];
1401   REWRITE_TAC[int_lt ;int_add_th;int_of_num_th;];
1402   ASM_MESON_TAC[floor_ineq; REAL_LET_TRANS];
1403   REWRITE_TAC[int_le];
1404   MP_TAC (SPEC `x:real` floor_ineq);
1405   REAL_ARITH_TAC;
1406   ]);;
1407   (* }}} *)
1408
1409 let floor_lt = prove_by_refinement(
1410   `!m x. (x < real_of_int m + &.1) <=> (floor x <=: m)`,
1411   (* {{{ proof *)
1412   [
1413   REP_GEN_TAC;
1414   EQ_TAC;
1415   DISCH_TAC;
1416   REWRITE_TAC[GSYM int_lt_suc_le ;];
1417   REWRITE_TAC[int_lt;int_add_th;int_of_num_th;];
1418   UND 0;
1419   MP_TAC (SPEC `x:real` floor_ineq);
1420   REAL_ARITH_TAC;
1421   REWRITE_TAC[int_le;];
1422   MP_TAC (SPEC `x:real` floor_ineq);
1423   REAL_ARITH_TAC;
1424   ]);;
1425   (* }}} *)
1426
1427 let floor_mono = prove_by_refinement(
1428   `!x y. (x <=. y) ==> (floor x <=: floor y)`,
1429   (* {{{ proof *)
1430   [
1431   REWRITE_TAC[GSYM floor_le];
1432   REP_GEN_TAC;
1433   MP_TAC (SPEC `x:real` floor_ineq);
1434   REAL_ARITH_TAC;
1435   ]);;
1436   (* }}} *)
1437
1438 let floor_level = prove_by_refinement(
1439   `!m x. ((&.0 <=. x) /\ (x <. &.1)) ==> (floor (real_of_int(m) + x) = m)`,
1440   (* {{{ proof *)
1441   [
1442   DISCH_ALL_TAC;
1443   SUBGOAL_TAC  `!a b. (b <=: a /\ ~(b <: a)) ==> (a = b)`;
1444   REWRITE_TAC[int_le;int_lt;int_eq];
1445   REAL_ARITH_TAC;
1446   DISCH_THEN IMATCH_MP_TAC ;
1447   SUBCONJ_TAC;
1448   REWRITE_TAC[GSYM floor_le];
1449   UND 0;
1450   REAL_ARITH_TAC;
1451   DISCH_TAC;
1452   PROOF_BY_CONTR_TAC;
1453   USE 3 (REWRITE_RULE[]);
1454   USE 3 (ONCE_REWRITE_RULE[GSYM INT_LT_RADD ]);
1455   USE 3 (GEN `z:int`);
1456   TSPEC `&:1` 3;
1457   USE 3 (REWRITE_RULE [int_lt_suc_le ;]);
1458   MP_TAC (SPEC `real_of_int m + x` floor_ineq);
1459   UND 3;
1460   UND 1;
1461   REWRITE_TAC[int_add_th;int_le;int_of_num_th];
1462   REAL_ARITH_TAC;
1463   ]);;
1464   (* }}} *)
1465
1466
1467 let floor_range = prove_by_refinement(
1468   `!x m. (floor x = m) <=> (real_of_int m <=. x /\ x <. real_of_int m +. &.1)`,
1469   (* {{{ proof *)
1470   [
1471   DISCH_ALL_TAC;
1472   EQ_TAC;
1473   DISCH_THEN (fun t -> REWRITE_TAC[GSYM t;floor_ineq]);
1474   DISCH_ALL_TAC;
1475   ASM_REWRITE_TAC[GSYM INT_LE_ANTISYM;GSYM floor_lt;GSYM floor_le;];
1476   ]);;
1477   (* }}} *)
1478
1479
1480 (* ------------------------------------------------------------------ *)
1481 (* edges and squares *)
1482 (* ------------------------------------------------------------------ *)
1483
1484
1485 let h_edge = jordan_def `h_edge p =
1486    { Z  | ?u v. (Z = point(u,v)) /\
1487     (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p)+: (&:1)))) /\
1488        (v = real_of_int (SND p)) }`;;
1489
1490 let v_edge = jordan_def `v_edge p =
1491    { Z  | ?u v. (Z = point(u,v)) /\
1492     (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) /\
1493        (u = real_of_int (FST p)) }`;;
1494
1495 let squ = jordan_def `squ p =
1496    {Z | ?u v. (Z = point(u,v)) /\
1497     (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p) +: (&:1)))) /\
1498     (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) }`;;
1499
1500 let row = jordan_def `row k = {Z | ?u . (Z = point(u,real_of_int k))}`;;
1501
1502 let col = jordan_def `col k = {Z | ?v . (Z = point(real_of_int k ,v))}`;;
1503
1504
1505 let pointI_inj = prove_by_refinement(
1506   `!p q. (pointI p = pointI q) <=> (p = q) `,
1507   (* {{{ proof *)
1508   [
1509   REWRITE_TAC[pointI;point_inj;PAIR_EQ;GSYM int_eq ];
1510   MESON_TAC[PAIR;PAIR_EQ];
1511   ]);;
1512   (* }}} *)
1513
1514 let h_edge_row = prove_by_refinement(
1515   `!p . h_edge p  SUBSET  row (SND p) `,
1516   (* {{{ proof *)
1517   [
1518   REWRITE_TAC[SUBSET;IN;h_edge;row;IN_ELIM_THM';];
1519   DISCH_ALL_TAC;
1520   CHO 0;
1521   CHO 0;
1522   TYPE_THEN `u` EXISTS_TAC;
1523   ASM_MESON_TAC[];
1524   ]);;
1525   (* }}} *)
1526
1527 let h_edge_floor = prove_by_refinement(
1528   `!p. h_edge p SUBSET { z | floor (z 0)  = FST p }`,
1529   (* {{{ proof *)
1530   [
1531   REWRITE_TAC[SUBSET;IN;h_edge;IN_ELIM_THM';int_of_num_th;int_add_th;];
1532   DISCH_ALL_TAC;
1533   CHO 0;
1534   CHO 0;
1535   ASM_REWRITE_TAC[coord01;floor_range];
1536   UND 0;
1537   REAL_ARITH_TAC;
1538   ]);;
1539   (* }}} *)
1540
1541 let row_disj = prove_by_refinement(
1542   `!a b. ~((row a) INTER (row b) = EMPTY) <=> (a = b)`,
1543   (* {{{ proof *)
1544   [
1545   DISCH_ALL_TAC;
1546   REWRITE_TAC[EMPTY_EXISTS;IN;INTER;row;IN_ELIM_THM'  ];
1547   EQ_TAC;
1548   DISCH_ALL_TAC;
1549   CHO 0;
1550   AND 0;
1551   CHO 0;
1552   CHO 1;
1553   REWRITE_TAC[int_eq];
1554   USE 1 (GSYM);
1555   REWR 1;
1556   USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]);
1557   ASM_REWRITE_TAC[];
1558   DISCH_THEN (fun t-> REWRITE_TAC [t]);
1559   MESON_TAC[];
1560    ]);;
1561   (* }}} *)
1562
1563 let h_edge_disj = prove_by_refinement(
1564   `!p q. ~(h_edge p INTER h_edge q = EMPTY) <=> (p = q)`,
1565   (* {{{ proof *)
1566   [
1567   DISCH_ALL_TAC;
1568   REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM'];
1569   EQ_TAC;
1570   DISCH_TAC;
1571   CHO 0;
1572   ONCE_REWRITE_TAC [GSYM PAIR];
1573   REWRITE_TAC[PAIR_EQ];
1574   CONJ_TAC;
1575   MP_TAC h_edge_floor;
1576   REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
1577   ASM_MESON_TAC[];
1578   MP_TAC h_edge_row;
1579   MP_TAC row_disj;
1580   REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;];
1581   ASM_MESON_TAC[];
1582   REWRITE_TAC[h_edge;IN_ELIM_THM' ];
1583   DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]);
1584   NAME_CONFLICT_TAC;
1585   LEFT_TAC "u'";
1586   TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC;
1587   TYPE_THEN `&.1/(&.2)` EXISTS_TAC;
1588   IMATCH_MP_TAC  half_pos;
1589   ARITH_TAC;
1590   DISCH_THEN CHOOSE_TAC;
1591   TYPE_THEN `real_of_int (FST q) + x` EXISTS_TAC;
1592   LEFT_TAC "v'";
1593   TYPE_THEN `real_of_int (SND q)` EXISTS_TAC ;
1594   TYPE_THEN `point (real_of_int (FST q) + x,real_of_int (SND q))` EXISTS_TAC;
1595   ASM_REWRITE_TAC[];
1596   UND 0;
1597   REAL_ARITH_TAC;
1598   ]);;
1599   (* }}} *)
1600
1601 let h_edge_pointI = prove_by_refinement(
1602   `!p q. ~(h_edge p (pointI q))`,
1603   (* {{{ proof *)
1604   [
1605   REP_GEN_TAC;
1606   REWRITE_TAC[pointI;h_edge;IN_ELIM_THM' ];
1607   PROOF_BY_CONTR_TAC;
1608   USE 0 (REWRITE_RULE[]);
1609   CHO 0;
1610   CHO 0;
1611   UND 0;
1612   DISCH_ALL_TAC;
1613   USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]);
1614   USE 0 GSYM ;
1615   REWR 1;
1616   REWR 2;
1617   USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]);
1618   USE 2 (REWRITE_RULE[int_le]);
1619   UND 2;
1620   UND 1;
1621   REAL_ARITH_TAC;
1622   ]);;
1623   (* }}} *)
1624
1625 let v_edge_col = prove_by_refinement(
1626   `!p . v_edge p  SUBSET  col (FST p) `,
1627   (* {{{ proof *)
1628   [
1629   REWRITE_TAC[SUBSET;IN;v_edge;col;IN_ELIM_THM';];
1630   DISCH_ALL_TAC;
1631   CHO 0;
1632   CHO 0;
1633   TYPE_THEN `v` EXISTS_TAC;
1634   ASM_MESON_TAC[];
1635   ]);;
1636   (* }}} *)
1637
1638 let v_edge_floor = prove_by_refinement(
1639   `!p. v_edge p SUBSET { z | floor (z 1)  = SND  p }`,
1640   (* {{{ proof *)
1641   [
1642   REWRITE_TAC[SUBSET;IN;v_edge;IN_ELIM_THM';int_of_num_th;int_add_th;];
1643   DISCH_ALL_TAC;
1644   CHO 0;
1645   CHO 0;
1646   ASM_REWRITE_TAC[coord01;floor_range];
1647   UND 0;
1648   REAL_ARITH_TAC;
1649   ]);;
1650   (* }}} *)
1651
1652 let col_disj = prove_by_refinement(
1653   `!a b. ~((col a) INTER (col b) = EMPTY) <=> (a = b)`,
1654   (* {{{ proof *)
1655   [
1656   DISCH_ALL_TAC;
1657   REWRITE_TAC[EMPTY_EXISTS;IN;INTER;col;IN_ELIM_THM'  ];
1658   EQ_TAC;
1659   DISCH_ALL_TAC;
1660   CHO 0;
1661   AND 0;
1662   CHO 0;
1663   CHO 1;
1664   REWRITE_TAC[int_eq];
1665   USE 1 (GSYM);
1666   REWR 1;
1667   USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]);
1668   ASM_REWRITE_TAC[];
1669   DISCH_THEN (fun t-> REWRITE_TAC [t]);
1670   MESON_TAC[];
1671    ]);;
1672   (* }}} *)
1673
1674 let v_edge_disj = prove_by_refinement(
1675   `!p q. ~(v_edge p INTER v_edge q = EMPTY) <=> (p = q)`,
1676   (* {{{ proof *)
1677   [
1678   DISCH_ALL_TAC;
1679   REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM'];
1680   EQ_TAC;
1681   DISCH_TAC;
1682   CHO 0;
1683   ONCE_REWRITE_TAC [GSYM PAIR];
1684   REWRITE_TAC[PAIR_EQ];
1685   IMATCH_MP_TAC  (TAUT `a /\ b ==> b/\ a`);
1686   CONJ_TAC;
1687   MP_TAC v_edge_floor;
1688   REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
1689   ASM_MESON_TAC[];
1690   MP_TAC v_edge_col;
1691   MP_TAC col_disj;
1692   REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;];
1693   ASM_MESON_TAC[];
1694   REWRITE_TAC[v_edge;IN_ELIM_THM' ];
1695   DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]);
1696   NAME_CONFLICT_TAC;
1697   LEFT_TAC "u'";
1698   TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC;
1699   TYPE_THEN `&.1/(&.2)` EXISTS_TAC;
1700   IMATCH_MP_TAC  half_pos;
1701   ARITH_TAC;
1702   DISCH_THEN CHOOSE_TAC;
1703   LEFT_TAC "v'";
1704   LEFT_TAC "v'";
1705   TYPE_THEN `real_of_int (SND q) + x` EXISTS_TAC;
1706   TYPE_THEN `real_of_int (FST  q)` EXISTS_TAC ;
1707   TYPE_THEN `point (real_of_int (FST q),real_of_int (SND q) +x)` EXISTS_TAC;
1708   ASM_REWRITE_TAC[];
1709   UND 0;
1710   REAL_ARITH_TAC;
1711   ]);;
1712   (* }}} *)
1713
1714 let v_edge_pointI = prove_by_refinement(
1715   `!p q. ~(v_edge p (pointI q))`,
1716   (* {{{ proof *)
1717   [
1718   REP_GEN_TAC;
1719   REWRITE_TAC[pointI;v_edge;IN_ELIM_THM' ];
1720   PROOF_BY_CONTR_TAC;
1721   USE 0 (REWRITE_RULE[]);
1722   CHO 0;
1723   CHO 0;
1724   UND 0;
1725   DISCH_ALL_TAC;
1726   USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]);
1727   USE 0 GSYM ;
1728   REWR 1;
1729   REWR 2;
1730   USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]);
1731   USE 2 (REWRITE_RULE[int_le]);
1732   UND 2;
1733   UND 1;
1734   REAL_ARITH_TAC;
1735   ]);;
1736   (* }}} *)
1737
1738 let row_col = prove_by_refinement(
1739   `!a b. (row b INTER col a) = { (pointI(a,b)) }`,
1740   (* {{{ proof *)
1741   [
1742   DISCH_ALL_TAC;
1743   REWRITE_TAC[col;row;INTER;IN;IN_ELIM_THM';pointI];
1744   IMATCH_MP_TAC  EQ_EXT;
1745   REWRITE_TAC[IN_ELIM_THM';INSERT;NOT_IN_EMPTY ];
1746   GEN_TAC;
1747   ASM_MESON_TAC[PAIR_EQ ;point_inj];
1748   ]);;
1749   (* }}} *)
1750
1751 let hv_edge = prove_by_refinement(
1752   `!p q. h_edge p INTER v_edge q = EMPTY`,
1753   (* {{{ proof *)
1754   [
1755   DISCH_ALL_TAC;
1756   TYPE_THEN `h_edge p INTER v_edge q SUBSET (row (SND p)) INTER (col (FST q))` SUBGOAL_TAC;
1757   REWRITE_TAC[SUBSET_INTER;];
1758   MESON_TAC[h_edge_row;v_edge_col;SUB_IMP_INTER ];
1759   REWRITE_TAC[row_col];
1760   DISCH_TAC;
1761   PROOF_BY_CONTR_TAC;
1762   USE 1 (REWRITE_RULE[EMPTY_EXISTS;IN  ]);
1763   CHO 1;
1764   USE 0 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM';INSERT;EMPTY ]);
1765   TSPEC `u` 0;
1766   REWR 0;
1767   REWR 1;
1768   USE 1 (REWRITE_RULE[INTER;IN;IN_ELIM_THM';h_edge_pointI]);
1769   ASM_REWRITE_TAC[];
1770   ]);;
1771   (* }}} *)
1772
1773 let square_col = prove_by_refinement(
1774   `!p a. (squ p INTER col a) = EMPTY `,
1775   (* {{{ proof *)
1776
1777   [
1778   REWRITE_TAC[squ;col];
1779   DISCH_ALL_TAC;
1780   PROOF_BY_CONTR_TAC;
1781   USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]);
1782   CHO 0;
1783   USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
1784   AND 0;
1785   CHO 0;
1786   CHO 1;
1787   CHO 1;
1788   UND 1;
1789   DISCH_ALL_TAC;
1790   REWR 0;
1791   USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]);
1792   REWR 3;
1793   REWR 2;
1794   USE 3 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]);
1795   USE 3 (REWRITE_RULE[ int_le;]);
1796   UND 2;
1797   UND 3;
1798   REAL_ARITH_TAC;
1799   ]);;
1800
1801   (* }}} *)
1802
1803 let square_row = prove_by_refinement(
1804   `!p a. (squ p INTER row a) = EMPTY `,
1805   (* {{{ proof *)
1806   [
1807   REWRITE_TAC[squ;row];
1808   DISCH_ALL_TAC;
1809   PROOF_BY_CONTR_TAC;
1810   USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]);
1811   CHO 0;
1812   USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
1813   AND 0;
1814   CHO 0;
1815   CHO 1;
1816   CHO 1;
1817   UND 1;
1818   DISCH_ALL_TAC;
1819   REWR 0;
1820   USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]);
1821   REWR 5;
1822   REWR 4;
1823   USE 5 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]);
1824   USE 5 (REWRITE_RULE[ int_le;]);
1825   UND 5;
1826   UND 4;
1827   REAL_ARITH_TAC;
1828   ]);;
1829   (* }}} *)
1830
1831 let pointI_row = prove_by_refinement(
1832   `!p.   (row (SND p)) (pointI p)`,
1833   (* {{{ proof *)
1834   [
1835   GEN_TAC;
1836   REWRITE_TAC[row;pointI;IN_ELIM_THM' ];
1837   MESON_TAC[];
1838   ]);;
1839   (* }}} *)
1840
1841 let pointI_col = prove_by_refinement(
1842   `!p.   (col (FST p)) (pointI p)`,
1843   (* {{{ proof *)
1844   [
1845   GEN_TAC;
1846   REWRITE_TAC[col;pointI;IN_ELIM_THM' ];
1847   MESON_TAC[];
1848   ]);;
1849   (* }}} *)
1850
1851 let square_v_edge = prove_by_refinement(
1852   `!p q. (squ p INTER v_edge q = EMPTY)`,
1853   (* {{{ proof *)
1854   [
1855   REP_GEN_TAC;
1856   TYPE_THEN `squ p INTER v_edge q SUBSET squ p INTER col (FST q)` SUBGOAL_TAC;
1857   REWRITE_TAC[SUBSET_INTER];
1858   MESON_TAC[SUB_IMP_INTER;v_edge_col;SUBSET_REFL];
1859   REWRITE_TAC[square_col;SUBSET_EMPTY ];
1860   ]);;
1861   (* }}} *)
1862
1863 let square_h_edge = prove_by_refinement(
1864   `!p q. (squ p INTER h_edge q = EMPTY)`,
1865   (* {{{ proof *)
1866   [
1867   REP_GEN_TAC;
1868   TYPE_THEN `squ p INTER h_edge q SUBSET squ p INTER row (SND  q)` SUBGOAL_TAC;
1869   REWRITE_TAC[SUBSET_INTER];
1870   MESON_TAC[SUB_IMP_INTER;h_edge_row;SUBSET_REFL];
1871   REWRITE_TAC[square_row;SUBSET_EMPTY ];
1872   ]);;
1873   (* }}} *)
1874
1875 let square_pointI = prove_by_refinement(
1876   `!p q. ~(squ p (pointI q))`,
1877   (* {{{ proof *)
1878   [
1879   REP_GEN_TAC;
1880   TYPE_THEN `q` (fun t -> ASSUME_TAC (SPEC t pointI_col));
1881   TYPEL_THEN [`p`;`FST q`] (fun t -> MP_TAC (SPECL t square_col));
1882   REWRITE_TAC[INTER;IN;];
1883   IMATCH_MP_TAC  (TAUT `(a ==> ~b) ==> (b ==> ~ a)`);
1884   DISCH_TAC;
1885   REWRITE_TAC[EMPTY_EXISTS;IN ];
1886   TYPE_THEN `pointI q` EXISTS_TAC;
1887   ASM_REWRITE_TAC[IN_ELIM_THM'];
1888   ]);;
1889   (* }}} *)
1890
1891 let square_floor0 = prove_by_refinement(
1892   `!p. (squ p SUBSET { z | (floor (z 0)) = (FST p) })`,
1893   (* {{{ proof *)
1894   [
1895   GEN_TAC;
1896   REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ];
1897   DISCH_ALL_TAC;
1898   CHO 0;
1899   CHO 0;
1900   UND 0;
1901   DISCH_ALL_TAC;
1902   ASM_REWRITE_TAC[coord01;floor_range];
1903   UND 1;
1904   UND 2;
1905   REWRITE_TAC[int_add_th;int_of_num_th];
1906   REAL_ARITH_TAC;
1907   ]);;
1908   (* }}} *)
1909
1910 let square_floor1 = prove_by_refinement(
1911   `!p. (squ p SUBSET { z | (floor (z 1)) = (SND p) })`,
1912   (* {{{ proof *)
1913   [
1914   GEN_TAC;
1915   REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ];
1916   DISCH_ALL_TAC;
1917   CHO 0;
1918   CHO 0;
1919   UND 0;
1920   DISCH_ALL_TAC;
1921   ASM_REWRITE_TAC[coord01;floor_range];
1922   UND 3;
1923   UND 4;
1924   REWRITE_TAC[int_add_th;int_of_num_th];
1925   REAL_ARITH_TAC;
1926   ]);;
1927   (* }}} *)
1928
1929 let square_square = prove_by_refinement(
1930   `!p q. ~(squ p INTER squ q = {}) ==> (squ p = squ q)`,
1931   (* {{{ proof *)
1932   [
1933   MP_TAC square_floor0;
1934   MP_TAC square_floor1;
1935   REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS  ];
1936   DISCH_ALL_TAC;
1937   REP_GEN_TAC;
1938   DISCH_THEN CHOOSE_TAC;
1939   TYPE_THEN `p = q` SUBGOAL_TAC;
1940   ONCE_REWRITE_TAC [GSYM PAIR];
1941   REWRITE_TAC[PAIR_EQ];
1942   ASM_MESON_TAC[];
1943   MESON_TAC[];
1944   ]);;
1945   (* }}} *)
1946
1947 let square_disj = prove_by_refinement(
1948   `!p q. ~(squ p INTER squ q = EMPTY) <=> (p = q)`,
1949   (* {{{ proof *)
1950   [
1951   MP_TAC square_floor0;
1952   MP_TAC square_floor1;
1953   REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS  ];
1954   DISCH_ALL_TAC;
1955   REP_GEN_TAC;
1956   EQ_TAC;
1957   DISCH_THEN CHOOSE_TAC;
1958   ONCE_REWRITE_TAC [GSYM PAIR];
1959   REWRITE_TAC[PAIR_EQ];
1960   ASM_MESON_TAC[];
1961   DISCH_THEN_REWRITE;
1962   REWRITE_TAC[squ];
1963   NAME_CONFLICT_TAC;
1964   CONV_TAC (dropq_conv "u''");
1965   TYPE_THEN `real_of_int (FST q) + (&.1/(&.2))` EXISTS_TAC;
1966   TYPE_THEN `real_of_int (SND q) + (&.1/(&.2))` EXISTS_TAC;
1967   REWRITE_TAC[int_suc];
1968   TYPE_THEN `a = real_of_int(FST q)` ABBREV_TAC;
1969 (*** Modified by JRH since ABBREV_TAC now forbids existing variables
1970   TYPE_THEN `a = real_of_int(SND  q)` ABBREV_TAC;
1971  ****)
1972   TYPE_THEN `a' = real_of_int(SND  q)` ABBREV_TAC;
1973   MP_TAC (REAL_RAT_REDUCE_CONV `&.0 < &.1/(&.2) /\ (&.1/(&.2)) < &.1`);
1974   REAL_ARITH_TAC;
1975   ]);;
1976   (* }}} *)
1977
1978
1979 (* ------------------------------------------------------------------ *)
1980 (*  cells *)
1981 (* ------------------------------------------------------------------ *)
1982
1983
1984 let cell = jordan_def `cell =
1985   {z | (?p. (z = { (pointI p) }) \/ (z = h_edge p) \/
1986               (z = v_edge p) \/ (z = squ p))}`;;
1987
1988 let cell_rules = prove_by_refinement(
1989   `!p. cell {(pointI p)} /\ (cell (h_edge p)) /\
1990       (cell (v_edge p)) /\ (cell (squ p))`,
1991   (* {{{ proof *)
1992   [
1993   REWRITE_TAC[cell;IN_ELIM_THM';];
1994   MESON_TAC[];
1995   ]);;
1996   (* }}} *)
1997
1998 let cell_mem = prove_by_refinement(
1999   `!C. (cell C) <=> (?p. C = ({(pointI p)})) \/ (?p. C = h_edge p) \/
2000     (?p. C = v_edge p) \/ (?p. C = squ p)`,
2001   (* {{{ proof *)
2002   [
2003   REWRITE_TAC[cell;IN_ELIM_THM'];
2004   MESON_TAC[];
2005   ]);;
2006   (* }}} *)
2007
2008 let square_domain = prove_by_refinement(
2009   `!z.  (let (p = (floor(FST z),floor(SND z))) in
2010        (({(pointI p)} UNION
2011         (h_edge p) UNION
2012         (v_edge p) UNION
2013         (squ p) ))) (point z) `,
2014   (* {{{ proof *)
2015   [
2016   GEN_TAC;
2017   LET_TAC;
2018   REWRITE_TAC[UNION;IN;IN_ELIM_THM' ];
2019   REWRITE_TAC[pointI;h_edge;v_edge;squ;int_add_th;int_of_num_th;IN_ELIM_THM';INSERT;EMPTY;point_inj;Q_POINT ];
2020   ASSUME_TAC floor_ineq;
2021   TYPE_THEN `FST z` (WITH 0 o SPEC);
2022   TSPEC `SND z` 0;
2023   UND 0;
2024   UND 1;
2025   REWRITE_TAC[PAIR_LEMMAv2];
2026   REWRITE_TAC[REAL_ARITH `(a <= b) <=> ((a = b) \/ (a < b))`];
2027   ASM_MESON_TAC[];
2028   ]);;
2029   (* }}} *)
2030
2031 let square_cell = prove_by_refinement(
2032   `!z. (let (p = (floor(FST z),floor(SND z))) in
2033        (({(pointI p)} UNION
2034         (h_edge p) UNION
2035         (v_edge p) UNION
2036         (squ p) ))) SUBSET (UNIONS cell) `,
2037   (* {{{ proof *)
2038   [
2039   GEN_TAC;
2040   LET_TAC;
2041   REWRITE_TAC[union_subset];
2042   REPEAT CONJ_TAC THEN (IMATCH_MP_TAC  sub_union) THEN (REWRITE_TAC[cell_rules]);
2043   ]);;
2044   (* }}} *)
2045
2046 let cell_unions = prove_by_refinement(
2047   `!z. (UNIONS cell (point z))`,
2048   (* {{{ proof *)
2049   [
2050   GEN_TAC;
2051   ASM_MESON_TAC[square_cell;square_domain;SUBSET;IN];
2052   ]);;
2053   (* }}} *)
2054
2055 let cell_partition = prove_by_refinement(
2056   `!C D. (cell C) /\ (cell D) /\ ~(C INTER D = EMPTY) ==> (C = D)`,
2057   (* {{{ proof *)
2058   let revr = PURE_ONCE_REWRITE_RULE [INTER_COMM] in
2059   [
2060   PARTIAL_REWRITE_TAC[cell_mem;];
2061   PARTIAL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR ];
2062   REP_GEN_TAC;
2063   PARTIAL_REWRITE_TAC[TAUT `((a \/ b ==> C)) <=> ((a ==> C) /\ (b ==> C))`];
2064   PARTIAL_REWRITE_TAC[TAUT `((a /\ b) ==> C) <=> (a ==> b ==> C)`];
2065   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]));
2066   ]);;
2067   (* }}} *)
2068
2069 (* ------------------------------------------------------------------ *)
2070 (* adjacency, closure, convexity, AND strict dominance on cells. *)
2071 (* ------------------------------------------------------------------ *)
2072
2073
2074 let top2 = jordan_def `top2 = top_of_metric (euclid 2,d_euclid)`;;
2075
2076 let adj = jordan_def `adj X Y <=> (~(X = Y) /\
2077    ~(closure top2 X INTER (closure top2 Y) = EMPTY))`;;
2078
2079 let strict_dom = jordan_def `strict_dom X Y <=> (cell X) /\ (cell Y) /\
2080   (closure top2 Y PSUBSET (closure top2 X))`;;
2081
2082 let adj_symm = prove_by_refinement(
2083   `!X Y. (adj X Y) <=> (adj Y X)`,
2084   (* {{{ proof *)
2085   [
2086   REP_GEN_TAC;
2087   REWRITE_TAC[adj];
2088   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM];
2089   ASM_MESON_TAC[];
2090   ]);;
2091   (* }}} *)
2092
2093 let adj_irrefl = prove_by_refinement(
2094   `!X. (~(adj X X))`,
2095   (* {{{ proof *)
2096   [
2097   REWRITE_TAC[adj;];
2098   ]);;
2099   (* }}} *)
2100
2101 let strict_dom_trans = prove_by_refinement(
2102   `!X Y Z. (strict_dom X Y) /\ (strict_dom Y Z) ==> (strict_dom X Z)`,
2103   (* {{{ proof *)
2104   [
2105   REWRITE_TAC[strict_dom];
2106   MESON_TAC[PSUBSET_TRANS];
2107   ]);;
2108   (* }}} *)
2109
2110 let strict_dom_irrefl = prove_by_refinement(
2111   `!X. ~(strict_dom X X)`,
2112   (* {{{ proof *)
2113   [
2114   REWRITE_TAC[strict_dom;PSUBSET_IRREFL ];
2115   ]);;
2116   (* }}} *)
2117
2118 let dot_point = prove_by_refinement(
2119   `!p q . (dot (point p) (point q)) = (FST p)*(FST q) + (SND p)*(SND q)`,
2120   (* {{{ proof *)
2121   [
2122   DISCH_ALL_TAC;
2123   TYPE_THEN `dot (point p) (point q) = sum (0,2) (\i. (point p i)*(point q i))` SUBGOAL_TAC;
2124   IMATCH_MP_TAC dot_euclid;
2125   ASM_SIMP_TAC[euclid_point];
2126   DISCH_THEN_REWRITE;
2127   REWRITE_TAC[ARITH_RULE `2 = SUC 1`];
2128   REWRITE_TAC[sum];
2129   REWRITE_TAC[ARITH_RULE `1 = SUC 0`];
2130   REWRITE_TAC[sum];
2131   REDUCE_TAC;
2132   REWRITE_TAC[ARITH_RULE `SUC 0 = 1`;coord01];
2133   ]);;
2134   (* }}} *)
2135
2136
2137 (* 2d half planes *)
2138 let open_half_plane2D_FLT = prove_by_refinement(
2139   `!r. { z | ?p. ((z = point p) /\ (FST p <. r))  } =
2140      open_half_space 2 (point (&.1,&.0)) r `,
2141   (* {{{ proof *)
2142
2143   [
2144   DISCH_ALL_TAC;
2145   IMATCH_MP_TAC  EQ_EXT;
2146   GEN_TAC;
2147   REWRITE_TAC[open_half_space ];
2148   EQ_TAC;
2149   DISCH_ALL_TAC;
2150   CHO 0;
2151   ASM_REWRITE_TAC[dot_point;euclid_point;];
2152   REDUCE_TAC;
2153   ASM_REWRITE_TAC [];
2154   DISCH_ALL_TAC;
2155   USE 0 (MATCH_MP point_onto);
2156   CHO 0;
2157   REWR 1;
2158   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2159   USE 1 (CONV_RULE REDUCE_CONV);
2160   ASM_MESON_TAC[];
2161   ]);;
2162
2163   (* }}} *)
2164
2165 let open_half_plane2D_LTF = prove_by_refinement(
2166   `!r. { z | ?p. ((z = point p) /\ (r <. FST p ))  } =
2167      open_half_space 2 (point (--. (&.1),&.0)) (--. r) `,
2168   (* {{{ proof *)
2169   [
2170   DISCH_ALL_TAC;
2171   IMATCH_MP_TAC  EQ_EXT;
2172   GEN_TAC;
2173   REWRITE_TAC[open_half_space ];
2174   EQ_TAC;
2175   DISCH_ALL_TAC;
2176   CHO 0;
2177   ASM_REWRITE_TAC[dot_point;euclid_point;];
2178   REDUCE_TAC;
2179   ASM_REWRITE_TAC[];
2180   DISCH_ALL_TAC;
2181   USE 0 (MATCH_MP point_onto);
2182   CHO 0;
2183   REWR 1;
2184   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2185   USE 1 (CONV_RULE REDUCE_CONV);
2186   ASM_MESON_TAC[];
2187   ]);;
2188   (* }}} *)
2189
2190 let open_half_plane2D_SLT = prove_by_refinement(
2191   `!r. { z | ?p. ((z = point p) /\ (SND p <. r ))  } =
2192      open_half_space 2 (point (&.0,&.1)) ( r) `,
2193   (* {{{ proof *)
2194   [
2195   DISCH_ALL_TAC;
2196   IMATCH_MP_TAC  EQ_EXT;
2197   GEN_TAC;
2198   REWRITE_TAC[open_half_space ];
2199   EQ_TAC;
2200   DISCH_ALL_TAC;
2201   CHO 0;
2202   ASM_REWRITE_TAC[dot_point;euclid_point;];
2203   REDUCE_TAC;
2204   ASM_REWRITE_TAC[];
2205   DISCH_ALL_TAC;
2206   USE 0 (MATCH_MP point_onto);
2207   CHO 0;
2208   REWR 1;
2209   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2210   USE 1 (CONV_RULE REDUCE_CONV);
2211   ASM_MESON_TAC[];
2212   ]);;
2213   (* }}} *)
2214
2215 let open_half_plane2D_LTS = prove_by_refinement(
2216   `!r. { z | ?p. ((z = point p) /\ (r <. SND p  ))  } =
2217      open_half_space 2 (point (&.0,--.(&.1))) (--. r) `,
2218   (* {{{ proof *)
2219   [
2220   DISCH_ALL_TAC;
2221   IMATCH_MP_TAC  EQ_EXT;
2222   GEN_TAC;
2223   REWRITE_TAC[open_half_space ];
2224   EQ_TAC;
2225   DISCH_ALL_TAC;
2226   CHO 0;
2227   ASM_REWRITE_TAC[dot_point;euclid_point;];
2228   REDUCE_TAC;
2229   ASM_REWRITE_TAC[];
2230   DISCH_ALL_TAC;
2231   USE 0 (MATCH_MP point_onto);
2232   CHO 0;
2233   REWR 1;
2234   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2235   USE 1 (CONV_RULE REDUCE_CONV);
2236   ASM_MESON_TAC[];
2237   ]);;
2238   (* }}} *)
2239
2240 let closed_half_plane2D_FLE = prove_by_refinement(
2241   `!r. { z | ?p. ((z = point p) /\ (FST p <=. r))  } =
2242      closed_half_space 2 (point (&.1,&.0)) r `,
2243   (* {{{ proof *)
2244   [
2245   DISCH_ALL_TAC;
2246   IMATCH_MP_TAC  EQ_EXT;
2247   GEN_TAC;
2248   REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
2249   EQ_TAC;
2250   DISCH_ALL_TAC;
2251   CHO 0;
2252   ASM_REWRITE_TAC[dot_point;euclid_point;];
2253   REDUCE_TAC;
2254   ASM_REWRITE_TAC [];
2255   DISCH_ALL_TAC;
2256   USE 0 (MATCH_MP point_onto);
2257   CHO 0;
2258   REWR 1;
2259   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2260   USE 1 (CONV_RULE REDUCE_CONV);
2261   ASM_MESON_TAC[];
2262   ]);;
2263   (* }}} *)
2264
2265 let closed_half_plane2D_LEF = prove_by_refinement(
2266   `!r. { z | ?p. ((z = point p) /\ (r <=. FST p))  } =
2267      closed_half_space 2 (point (--.(&.1),&.0)) (--. r) `,
2268   (* {{{ proof *)
2269   [
2270   DISCH_ALL_TAC;
2271   IMATCH_MP_TAC  EQ_EXT;
2272   GEN_TAC;
2273   REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
2274   EQ_TAC;
2275   DISCH_ALL_TAC;
2276   CHO 0;
2277   ASM_REWRITE_TAC[dot_point;euclid_point;];
2278   REDUCE_TAC;
2279   ASM_REWRITE_TAC [];
2280   DISCH_ALL_TAC;
2281   USE 0 (MATCH_MP point_onto);
2282   CHO 0;
2283   REWR 1;
2284   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2285   USE 1 (CONV_RULE REDUCE_CONV);
2286   ASM_MESON_TAC[];
2287   ]);;
2288   (* }}} *)
2289
2290 let closed_half_plane2D_SLE = prove_by_refinement(
2291   `!r. { z | ?p. ((z = point p) /\ (SND p <=. r))  } =
2292      closed_half_space 2 (point (&.0,&.1)) r `,
2293   (* {{{ proof *)
2294   [
2295   DISCH_ALL_TAC;
2296   IMATCH_MP_TAC  EQ_EXT;
2297   GEN_TAC;
2298   REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
2299   EQ_TAC;
2300   DISCH_ALL_TAC;
2301   CHO 0;
2302   ASM_REWRITE_TAC[dot_point;euclid_point;];
2303   REDUCE_TAC;
2304   ASM_REWRITE_TAC [];
2305   DISCH_ALL_TAC;
2306   USE 0 (MATCH_MP point_onto);
2307   CHO 0;
2308   REWR 1;
2309   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2310   USE 1 (CONV_RULE REDUCE_CONV);
2311   ASM_MESON_TAC[];
2312   ]);;
2313   (* }}} *)
2314
2315 let closed_half_plane2D_LES = prove_by_refinement(
2316   `!r. { z | ?p. ((z = point p) /\ (r <=. SND p ))  } =
2317      closed_half_space 2 (point (&.0,(--. (&.1)))) (--. r) `,
2318   (* {{{ proof *)
2319   [
2320   DISCH_ALL_TAC;
2321   IMATCH_MP_TAC  EQ_EXT;
2322   GEN_TAC;
2323   REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
2324   EQ_TAC;
2325   DISCH_ALL_TAC;
2326   CHO 0;
2327   ASM_REWRITE_TAC[dot_point;euclid_point;];
2328   REDUCE_TAC;
2329   ASM_REWRITE_TAC [];
2330   DISCH_ALL_TAC;
2331   USE 0 (MATCH_MP point_onto);
2332   CHO 0;
2333   REWR 1;
2334   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2335   USE 1 (CONV_RULE REDUCE_CONV);
2336   ASM_MESON_TAC[];
2337   ]);;
2338   (* }}} *)
2339
2340 let line2D_F = prove_by_refinement(
2341   `!r. { z | ?p. ((z = point p) /\ (FST p = r))  } =
2342      hyperplane 2 (point (&.1,&.0)) r `,
2343   (* {{{ proof *)
2344   [
2345   DISCH_ALL_TAC;
2346   IMATCH_MP_TAC  EQ_EXT;
2347   GEN_TAC;
2348   REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
2349   EQ_TAC;
2350   DISCH_ALL_TAC;
2351   CHO 0;
2352   ASM_REWRITE_TAC[dot_point;euclid_point;];
2353   REDUCE_TAC;
2354   ASM_REWRITE_TAC [];
2355   DISCH_ALL_TAC;
2356   USE 0 (MATCH_MP point_onto);
2357   CHO 0;
2358   REWR 1;
2359   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2360   USE 1 (CONV_RULE REDUCE_CONV);
2361   ASM_MESON_TAC[];
2362   ]);;
2363   (* }}} *)
2364
2365 let line2D_S = prove_by_refinement(
2366   `!r. { z | ?p. ((z = point p) /\ (SND p = r))  } =
2367      hyperplane 2 (point (&.0,&.1)) r `,
2368   (* {{{ proof *)
2369   [
2370   DISCH_ALL_TAC;
2371   IMATCH_MP_TAC  EQ_EXT;
2372   GEN_TAC;
2373   REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
2374   EQ_TAC;
2375   DISCH_ALL_TAC;
2376   CHO 0;
2377   ASM_REWRITE_TAC[dot_point;euclid_point;];
2378   REDUCE_TAC;
2379   ASM_REWRITE_TAC [];
2380   DISCH_ALL_TAC;
2381   USE 0 (MATCH_MP point_onto);
2382   CHO 0;
2383   REWR 1;
2384   USE 1 (REWRITE_RULE[dot_point;euclid_point]);
2385   USE 1 (CONV_RULE REDUCE_CONV);
2386   ASM_MESON_TAC[];
2387   ]);;
2388   (* }}} *)
2389
2390 let open_half_plane2D_FLT_open = prove_by_refinement(
2391   `!r. top2 { z | ?p. ((z = point p) /\ (FST p <. r))  }`,
2392   (* {{{ proof *)
2393   [
2394   GEN_TAC;
2395   REWRITE_TAC[open_half_plane2D_FLT;top2];
2396   SIMP_TAC[open_half_space_open;euclid_point];
2397   ]);;
2398   (* }}} *)
2399
2400 let open_half_plane2D_LTF_open = prove_by_refinement(
2401   `!r. top2 { z | ?p. ((z = point p) /\ (r <. FST p ))  }`,
2402   (* {{{ proof *)
2403   [
2404   GEN_TAC;
2405   REWRITE_TAC[open_half_plane2D_LTF;top2];
2406   SIMP_TAC[open_half_space_open;euclid_point];
2407   ]);;
2408   (* }}} *)
2409
2410 let open_half_plane2D_SLT_open = prove_by_refinement(
2411   `!r. top2 { z | ?p. ((z = point p) /\ (SND p <. r  ))  }`,
2412   (* {{{ proof *)
2413   [
2414   GEN_TAC;
2415   REWRITE_TAC[open_half_plane2D_SLT;top2];
2416   SIMP_TAC[open_half_space_open;euclid_point];
2417   ]);;
2418   (* }}} *)
2419
2420 let open_half_plane2D_LTS_open = prove_by_refinement(
2421   `!r. top2 { z | ?p. ((z = point p) /\ (r <. SND p   ))  }`,
2422   (* {{{ proof *)
2423   [
2424   GEN_TAC;
2425   REWRITE_TAC[open_half_plane2D_LTS;top2];
2426   SIMP_TAC[open_half_space_open;euclid_point];
2427   ]);;
2428   (* }}} *)
2429
2430 let closed_half_plane2D_FLT_closed = prove_by_refinement(
2431   `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p <=. r))  }`,
2432   (* {{{ proof *)
2433   [
2434   GEN_TAC;
2435   REWRITE_TAC[closed_half_plane2D_FLE;top2];
2436   SIMP_TAC[closed_half_space_closed;euclid_point];
2437   ]);;
2438   (* }}} *)
2439
2440 let closed_half_plane2D_LTF_closed = prove_by_refinement(
2441   `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. FST p ))  }`,
2442   (* {{{ proof *)
2443   [
2444   GEN_TAC;
2445   REWRITE_TAC[closed_half_plane2D_LEF;top2];
2446   SIMP_TAC[closed_half_space_closed;euclid_point];
2447   ]);;
2448   (* }}} *)
2449
2450 let closed_half_plane2D_SLT_closed = prove_by_refinement(
2451   `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p <=. r  ))  }`,
2452   (* {{{ proof *)
2453   [
2454   GEN_TAC;
2455   REWRITE_TAC[closed_half_plane2D_SLE;top2];
2456   SIMP_TAC[closed_half_space_closed;euclid_point];
2457   ]);;
2458   (* }}} *)
2459
2460 let closed_half_plane2D_LTS_closed = prove_by_refinement(
2461   `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. SND p   ))  }`,
2462   (* {{{ proof *)
2463   [
2464   GEN_TAC;
2465   REWRITE_TAC[closed_half_plane2D_LES;top2];
2466   SIMP_TAC[closed_half_space_closed;euclid_point];
2467   ]);;
2468   (* }}} *)
2469
2470 let line2D_F_closed = prove_by_refinement(
2471   `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p = r))  }`,
2472   (* {{{ proof *)
2473   [
2474   GEN_TAC;
2475   REWRITE_TAC[line2D_F;top2];
2476   SIMP_TAC[hyperplane_closed;euclid_point];
2477   ]);;
2478   (* }}} *)
2479
2480 let line2D_S_closed = prove_by_refinement(
2481   `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p = r))  }`,
2482   (* {{{ proof *)
2483   [
2484   GEN_TAC;
2485   REWRITE_TAC[line2D_S;top2];
2486   SIMP_TAC[hyperplane_closed;euclid_point];
2487   ]);;
2488   (* }}} *)
2489
2490 let open_half_plane2D_FLT_convex = prove_by_refinement(
2491   `!r. convex { z | ?p. ((z = point p) /\ (FST p <. r))  }`,
2492   (* {{{ proof *)
2493   [
2494   GEN_TAC;
2495   REWRITE_TAC[open_half_plane2D_FLT;];
2496   SIMP_TAC[open_half_space_convex;euclid_point];
2497   ]);;
2498   (* }}} *)
2499
2500 let open_half_plane2D_LTF_convex = prove_by_refinement(
2501   `!r. convex { z | ?p. ((z = point p) /\ (r <. FST p ))  }`,
2502   (* {{{ proof *)
2503   [
2504   GEN_TAC;
2505   REWRITE_TAC[open_half_plane2D_LTF;];
2506   SIMP_TAC[open_half_space_convex;euclid_point];
2507   ]);;
2508   (* }}} *)
2509
2510 let open_half_plane2D_SLT_convex = prove_by_refinement(
2511   `!r. convex { z | ?p. ((z = point p) /\ (SND p <. r))  }`,
2512   (* {{{ proof *)
2513   [
2514   GEN_TAC;
2515   REWRITE_TAC[open_half_plane2D_SLT;];
2516   SIMP_TAC[open_half_space_convex;euclid_point];
2517   ]);;
2518   (* }}} *)
2519
2520 let open_half_plane2D_LTS_convex = prove_by_refinement(
2521   `!r. convex { z | ?p. ((z = point p) /\ (r <. SND p ))  }`,
2522   (* {{{ proof *)
2523   [
2524   GEN_TAC;
2525   REWRITE_TAC[open_half_plane2D_LTS;];
2526   SIMP_TAC[open_half_space_convex;euclid_point];
2527   ]);;
2528   (* }}} *)
2529
2530 let closed_half_plane2D_FLT_convex = prove_by_refinement(
2531   `!r. convex { z | ?p. ((z = point p) /\ (FST p <=. r))  }`,
2532   (* {{{ proof *)
2533   [
2534   GEN_TAC;
2535   REWRITE_TAC[closed_half_plane2D_FLE;];
2536   SIMP_TAC[closed_half_space_convex;euclid_point];
2537   ]);;
2538   (* }}} *)
2539
2540 let closed_half_plane2D_LTF_convex = prove_by_refinement(
2541   `!r. convex { z | ?p. ((z = point p) /\ (r <=. FST p ))  }`,
2542   (* {{{ proof *)
2543   [
2544   GEN_TAC;
2545   REWRITE_TAC[closed_half_plane2D_LEF;];
2546   SIMP_TAC[closed_half_space_convex;euclid_point];
2547   ]);;
2548   (* }}} *)
2549
2550 let closed_half_plane2D_SLT_convex = prove_by_refinement(
2551   `!r. convex { z | ?p. ((z = point p) /\ (SND p <=. r))  }`,
2552   (* {{{ proof *)
2553   [
2554   GEN_TAC;
2555   REWRITE_TAC[closed_half_plane2D_SLE;];
2556   SIMP_TAC[closed_half_space_convex;euclid_point];
2557   ]);;
2558   (* }}} *)
2559
2560 let closed_half_plane2D_LTS_convex = prove_by_refinement(
2561   `!r. convex { z | ?p. ((z = point p) /\ (r <=. SND p ))  }`,
2562   (* {{{ proof *)
2563   [
2564   GEN_TAC;
2565   REWRITE_TAC[closed_half_plane2D_LES;];
2566   SIMP_TAC[closed_half_space_convex;euclid_point];
2567   ]);;
2568   (* }}} *)
2569
2570 let line2D_F_convex = prove_by_refinement(
2571   `!r. convex { z | ?p. ((z = point p) /\ ( FST p = r ))  }`,
2572   (* {{{ proof *)
2573   [
2574   GEN_TAC;
2575   REWRITE_TAC[line2D_F;];
2576   SIMP_TAC[hyperplane_convex;euclid_point];
2577   ]);;
2578   (* }}} *)
2579
2580 let line2D_S_convex = prove_by_refinement(
2581   `!r. convex { z | ?p. ((z = point p) /\ (SND p = r))  }`,
2582   (* {{{ proof *)
2583   [
2584   GEN_TAC;
2585   REWRITE_TAC[line2D_S;];
2586   SIMP_TAC[hyperplane_convex;euclid_point];
2587   ]);;
2588   (* }}} *)
2589
2590 let closure_FLT = prove_by_refinement(
2591   `!r. (closure top2 { z | ?p. ((z = point p) /\ (FST p <. r))  } =
2592        { z | ?p. ((z = point p) /\ (FST p <=. r))  })`,
2593   (* {{{ proof *)
2594
2595   [
2596   GEN_TAC;
2597   REWRITE_TAC[open_half_plane2D_FLT;closed_half_plane2D_FLE;top2];
2598   TYPE_THEN `~(point(&.1,&.0) = euclid0)` SUBGOAL_TAC;
2599   PROOF_BY_CONTR_TAC;
2600   USE 0(REWRITE_RULE[]);
2601   USE 0  (fun t -> AP_THM t `0`);
2602   USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]);
2603   ASM_REWRITE_TAC[];
2604   SIMP_TAC[closure_half_space;euclid_point];
2605   ]);;
2606
2607   (* }}} *)
2608
2609 let closure_LTF = prove_by_refinement(
2610   `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. FST p))  } =
2611        { z | ?p. ((z = point p) /\ (r <=. FST p ))  })`,
2612   (* {{{ proof *)
2613
2614   [
2615   GEN_TAC;
2616   REWRITE_TAC[open_half_plane2D_LTF;closed_half_plane2D_LEF;top2];
2617   TYPE_THEN `~(point(--. (&.1),&.0) = euclid0)` SUBGOAL_TAC;
2618   PROOF_BY_CONTR_TAC;
2619   USE 0(REWRITE_RULE[]);
2620   USE 0  (fun t -> AP_THM t `0`);
2621   USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]);
2622   ASM_REWRITE_TAC[];
2623   SIMP_TAC[closure_half_space;euclid_point];
2624   ]);;
2625
2626   (* }}} *)
2627
2628 let closure_SLT = prove_by_refinement(
2629   `!r. (closure top2 { z | ?p. ((z = point p) /\ (SND  p <. r))  } =
2630        { z | ?p. ((z = point p) /\ (SND  p <=. r))  })`,
2631   (* {{{ proof *)
2632
2633   [
2634   GEN_TAC;
2635   REWRITE_TAC[open_half_plane2D_SLT;closed_half_plane2D_SLE;top2];
2636   TYPE_THEN `~(point(&.0,&.1) = euclid0)` SUBGOAL_TAC;
2637   PROOF_BY_CONTR_TAC;
2638   USE 0(REWRITE_RULE[]);
2639   USE 0  (fun t -> AP_THM t `1`);
2640   USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]);
2641   ASM_REWRITE_TAC[];
2642   SIMP_TAC[closure_half_space;euclid_point];
2643   ]);;
2644
2645   (* }}} *)
2646
2647 let closure_LTS = prove_by_refinement(
2648   `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. SND  p))  } =
2649        { z | ?p. ((z = point p) /\ (r <=. SND  p ))  })`,
2650   (* {{{ proof *)
2651
2652   [
2653   GEN_TAC;
2654   REWRITE_TAC[open_half_plane2D_LTS;closed_half_plane2D_LES;top2];
2655   TYPE_THEN `~(point(&.0, --. (&.1)) = euclid0)` SUBGOAL_TAC;
2656   PROOF_BY_CONTR_TAC;
2657   USE 0(REWRITE_RULE[]);
2658   USE 0  (fun t -> AP_THM t `1`);
2659   USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]);
2660   ASM_REWRITE_TAC[];
2661   SIMP_TAC[closure_half_space;euclid_point];
2662   ]);;
2663
2664   (* }}} *)
2665
2666
2667
2668 (* ------------------------------------------------------------------ *)
2669 (* SECTION B *)
2670 (* ------------------------------------------------------------------ *)
2671
2672 (* -> sets *)
2673 let single_subset = prove_by_refinement(
2674   `!(x:A) A. ({x} SUBSET A) <=> (A x)`,
2675   (* {{{ proof *)
2676   [
2677   REWRITE_TAC[SUBSET;INSERT];
2678   MESON_TAC[];
2679   ]);;
2680   (* }}} *)
2681
2682 let top2_top = prove_by_refinement(
2683   `topology_ top2  `,
2684   (* {{{ proof *)
2685   [
2686   ASM_SIMP_TAC [top2;top_of_metric_top;metric_euclid];
2687   ]);;
2688   (* }}} *)
2689
2690
2691 (* ------------------------------------------------------------------ *)
2692 (* H_edge & v_edge, convexity, closure, closed, adj, etc. *)
2693 (* ------------------------------------------------------------------ *)
2694
2695 let e1 = jordan_def `e1 = point(&.1,&.0)`;;
2696 let e2 = jordan_def `e2 = point(&.0,&.1)`;;
2697
2698 let hc_edge = jordan_def `hc_edge m =
2699    (h_edge m) UNION {(pointI m)} UNION {(pointI m + e1)}`;;
2700
2701 let vc_edge = jordan_def `vc_edge m =
2702    (v_edge m) UNION {(pointI m)} UNION {(pointI m + e2)}`;;
2703
2704
2705
2706 (* H edge *)
2707 let h_edge_inter = prove_by_refinement(
2708   `!m. (h_edge m) =
2709    ({z | ?p. (z = point p) /\ (real_of_int (FST  m) <. FST p)}
2710       INTER {z | ?p. (z = point p) /\ (FST p <. real_of_int(FST  m +: &:1))}
2711       INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND  m))})`,
2712   (* {{{ proof *)
2713
2714   [
2715   DISCH_ALL_TAC;
2716   REWRITE_TAC[INTER;h_edge];
2717   IMATCH_MP_TAC  EQ_EXT;
2718   GEN_TAC;
2719   REWRITE_TAC[];
2720   EQ_TAC;
2721   DISCH_ALL_TAC;
2722   CHO 0;
2723   CHO 0;
2724   ASM_REWRITE_TAC[point_inj];
2725   REPEAT CONJ_TAC THEN (TYPE_THEN `(u,real_of_int(SND m))` EXISTS_TAC) THEN ASM_REWRITE_TAC[PAIR_SPLIT];
2726   DISCH_ALL_TAC;
2727   CHO 0;
2728   CHO 1;
2729   CHO 2;
2730   TYPE_THEN `FST p` EXISTS_TAC;
2731   TYPE_THEN `SND  p` EXISTS_TAC;
2732   REWR 1;
2733   REWR 2;
2734   USE 2 (REWRITE_RULE[point_inj]);
2735   USE 1 (REWRITE_RULE[point_inj]);
2736   AND 1;
2737   AND 2;
2738   ASM_REWRITE_TAC[];
2739   ASM_MESON_TAC[];
2740   ]);;
2741
2742   (* }}} *)
2743
2744 let h_edge_convex = prove_by_refinement(
2745   `!m. (convex (h_edge m))`,
2746   (* {{{ proof *)
2747   [
2748   DISCH_ALL_TAC;
2749   REWRITE_TAC[h_edge_inter;];
2750   IMATCH_MP_TAC convex_inter;
2751   CONJ_TAC;
2752   REWRITE_TAC [open_half_plane2D_LTF_convex;];
2753   IMATCH_MP_TAC  convex_inter;
2754   REWRITE_TAC[open_half_plane2D_FLT_convex;line2D_S_convex];
2755   ]);;
2756   (* }}} *)
2757
2758 let hc_edge_inter = prove_by_refinement(
2759   `!m. (hc_edge m) =
2760    ({z | ?p. (z = point p) /\ (real_of_int (FST  m) <=. FST p)}
2761       INTER {z | ?p. (z = point p) /\ (FST p <=. real_of_int(FST  m +: &:1))}
2762       INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND  m))})`,
2763   (* {{{ proof *)
2764   [
2765   GEN_TAC;
2766   REWRITE_TAC[hc_edge;e1];
2767   IMATCH_MP_TAC  SUBSET_ANTISYM;
2768   CONJ_TAC;
2769   REWRITE_TAC[union_subset];
2770   REPEAT (CONJ_TAC);
2771   REWRITE_TAC[h_edge_inter];
2772   REWRITE_TAC[SUBSET;INTER];
2773   ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
2774   REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc];
2775   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`];
2776   REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc];
2777   REDUCE_TAC;
2778   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`];
2779   REWRITE_TAC[INTER;SUBSET;UNION;e1;h_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ];
2780   GEN_TAC;
2781   DISCH_ALL_TAC;
2782   CHO 0;
2783   REWR 1;
2784   REWR 2;
2785   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ];
2786   REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])];
2787   UND 2;
2788   UND 1;
2789   REWRITE_TAC[point_inj;];
2790   REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])];
2791   AND 0;
2792   UND 0;
2793   REAL_ARITH_TAC;
2794   ]);;
2795   (* }}} *)
2796
2797 let hc_edge_closed = prove_by_refinement(
2798   `!m. (closed_ top2 (hc_edge m))`,
2799   (* {{{ proof *)
2800   [
2801   REWRITE_TAC[hc_edge_inter];
2802   GEN_TAC;
2803   IMATCH_MP_TAC  closed_inter2;
2804   REWRITE_TAC[top2_top;closed_half_plane2D_LTF_closed];
2805   IMATCH_MP_TAC  closed_inter2;
2806   REWRITE_TAC[top2_top;closed_half_plane2D_FLT_closed;line2D_S_closed;];
2807   ]);;
2808   (* }}} *)
2809
2810 let hc_edge_convex = prove_by_refinement(
2811   `!m. (convex (hc_edge m))`,
2812   (* {{{ proof *)
2813   [
2814   REWRITE_TAC[hc_edge_inter];
2815   GEN_TAC;
2816   IMATCH_MP_TAC convex_inter;
2817   REWRITE_TAC[closed_half_plane2D_LTF_convex];
2818   IMATCH_MP_TAC  convex_inter;
2819   REWRITE_TAC[closed_half_plane2D_FLT_convex;line2D_S_convex;];
2820   ]);;
2821   (* }}} *)
2822
2823 let h_edge_subset = prove_by_refinement(
2824   `!m. (h_edge m SUBSET hc_edge m)`,
2825   (* {{{ proof *)
2826   [
2827   REWRITE_TAC[hc_edge;SUBSET;UNION;];
2828   MESON_TAC[];
2829   ]);;
2830   (* }}} *)
2831
2832 let h_edge_euclid = prove_by_refinement(
2833   `!m. (h_edge m) SUBSET (euclid 2)`,
2834   (* {{{ proof *)
2835   [
2836   REWRITE_TAC[SUBSET;h_edge];
2837   MESON_TAC[euclid_point];
2838   ]);;
2839   (* }}} *)
2840
2841 let h_edge_closure = prove_by_refinement(
2842   `!m. (closure top2 (h_edge m)) = hc_edge m`,
2843   (* {{{ proof *)
2844   [
2845   GEN_TAC;
2846   IMATCH_MP_TAC  SUBSET_ANTISYM;
2847   CONJ_TAC;
2848   IMATCH_MP_TAC  closure_subset;
2849   REWRITE_TAC[h_edge_subset;top2_top;hc_edge_closed];
2850   REWRITE_TAC[hc_edge];
2851   REWRITE_TAC[union_subset;e1;pointI;single_subset;point_add];
2852   CONJ_TAC;
2853   IMATCH_MP_TAC  subset_closure;
2854   REWRITE_TAC[top2_top];
2855   REWRITE_TAC[top2];
2856   SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ;
2857   REWRITE_TAC[GSYM REAL_RDISTRIB];
2858   REAL_ARITH_TAC;
2859   DISCH_TAC;
2860   CONJ_TAC THEN (IMATCH_MP_TAC  closure_segment) THEN REWRITE_TAC[h_edge_euclid];
2861   TYPE_THEN `(pointI m)+point(&.1,&.0)` EXISTS_TAC;
2862   DISCH_ALL_TAC;
2863   ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
2864   CONV_TAC (dropq_conv "u");
2865   CONV_TAC (dropq_conv "v");
2866   REDUCE_TAC;
2867   ASM_REWRITE_TAC[int_suc];
2868   TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
2869   UND 1;
2870   UND 2;
2871   REAL_ARITH_TAC ;
2872   TYPE_THEN `pointI m` EXISTS_TAC;
2873   DISCH_ALL_TAC;
2874   ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
2875   CONV_TAC (dropq_conv "u");
2876   CONV_TAC (dropq_conv "v");
2877   REDUCE_TAC;
2878   ASM_REWRITE_TAC[int_suc];
2879   TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
2880   UND 1;
2881   UND 2;
2882   REAL_ARITH_TAC ;
2883   ]);;
2884
2885   (* }}} *)
2886
2887 (* move up *)
2888 let point_split = prove_by_refinement(
2889   `!z u v. (z = point(u,v)) <=> (u = z 0) /\ (v = z 1) /\ (euclid 2 z)`,
2890   (* {{{ proof *)
2891   [
2892   DISCH_ALL_TAC;
2893   EQ_TAC ;
2894   DISCH_THEN_REWRITE;
2895   REWRITE_TAC[coord01;euclid_point];
2896   DISCH_ALL_TAC;
2897   IMATCH_MP_TAC  EQ_EXT;
2898   GEN_TAC;
2899   DISJ_CASES_TAC (ARITH_RULE  `(x = 0) \/ (x = 1) \/ (2 <= x)`);
2900   ASM_REWRITE_TAC[coord01];
2901   UND 3;
2902   DISCH_THEN DISJ_CASES_TAC;
2903   ASM_REWRITE_TAC[coord01];
2904   ASM_MESON_TAC[euclid;euclid_point]
2905   ]);;
2906   (* }}} *)
2907
2908
2909 (* V edge *)
2910 let v_edge_inter = prove_by_refinement(
2911   `!m. (v_edge m) =
2912    ({z | ?p. (z = point p) /\ (real_of_int (SND   m) <. SND  p)}
2913       INTER {z | ?p. (z = point p) /\ (SND  p <. real_of_int(SND  m +: &:1))}
2914       INTER {z | ?p. (z = point p) /\ (FST p = real_of_int(FST  m))})`,
2915   (* {{{ proof *)
2916   [
2917   DISCH_ALL_TAC;
2918   REWRITE_TAC[INTER;v_edge;int_suc ];
2919   IMATCH_MP_TAC  EQ_EXT;
2920   GEN_TAC;
2921   REWRITE_TAC[];
2922   EQ_TAC;
2923   DISCH_ALL_TAC;
2924   CHO 0;
2925   CHO 0;
2926   ASM_REWRITE_TAC[point_inj];
2927   CONV_TAC (dropq_conv "p");
2928   ASM_REWRITE_TAC[];
2929   CONV_TAC (dropq_conv "p");
2930   CONV_TAC (dropq_conv "p'");
2931   ASM_REWRITE_TAC[];
2932   DISCH_ALL_TAC;
2933   CONV_TAC (dropq_conv "u");
2934   REWRITE_TAC[point_split;];
2935   CONV_TAC (dropq_conv "v");
2936   ASM_MESON_TAC[FST;SND;PAIR;coord01;euclid_point;point_onto];
2937   ]);;
2938   (* }}} *)
2939
2940 let v_edge_convex = prove_by_refinement(
2941   `!m. (convex (v_edge m))`,
2942   (* {{{ proof *)
2943   [
2944   DISCH_ALL_TAC;
2945   REWRITE_TAC[v_edge_inter;];
2946   IMATCH_MP_TAC convex_inter;
2947   CONJ_TAC;
2948   REWRITE_TAC [open_half_plane2D_LTS_convex;];
2949   IMATCH_MP_TAC  convex_inter;
2950   REWRITE_TAC[open_half_plane2D_SLT_convex;line2D_F_convex];
2951   ]);;
2952   (* }}} *)
2953
2954 let vc_edge_inter = prove_by_refinement(
2955   `!m. (vc_edge m) =
2956    ({z | ?p. (z = point p) /\ (real_of_int (SND   m) <=. SND  p)}
2957       INTER {z | ?p. (z = point p) /\ (SND p <=. real_of_int(SND  m +: &:1))}
2958       INTER {z | ?p. (z = point p) /\ (FST  p = real_of_int(FST   m))})`,
2959   (* {{{ proof *)
2960   [
2961   GEN_TAC;
2962   REWRITE_TAC[vc_edge;e2];
2963   IMATCH_MP_TAC  SUBSET_ANTISYM;
2964   CONJ_TAC;
2965   REWRITE_TAC[union_subset];
2966   REPEAT (CONJ_TAC);
2967   REWRITE_TAC[v_edge_inter];
2968   REWRITE_TAC[SUBSET;INTER];
2969   ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
2970   REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc];
2971   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`];
2972   REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc];
2973   REDUCE_TAC;
2974   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`];
2975   REWRITE_TAC[INTER;SUBSET;UNION;e2;v_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ];
2976   GEN_TAC;
2977   DISCH_ALL_TAC;
2978   CHO 0;
2979   REWR 1;
2980   REWR 2;
2981   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ];
2982   REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])];
2983   UND 2;
2984   UND 1;
2985   REWRITE_TAC[point_inj;];
2986   REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])];
2987   AND 0;
2988   UND 0;
2989   REAL_ARITH_TAC;
2990   ]);;
2991   (* }}} *)
2992
2993 let vc_edge_closed = prove_by_refinement(
2994   `!m. (closed_ top2 (vc_edge m))`,
2995   (* {{{ proof *)
2996   [
2997   REWRITE_TAC[vc_edge_inter];
2998   GEN_TAC;
2999   IMATCH_MP_TAC  closed_inter2;
3000   REWRITE_TAC[top2_top;closed_half_plane2D_LTS_closed];
3001   IMATCH_MP_TAC  closed_inter2;
3002   REWRITE_TAC[top2_top;closed_half_plane2D_SLT_closed;line2D_F_closed;];
3003   ]);;
3004   (* }}} *)
3005
3006 let vc_edge_convex = prove_by_refinement(
3007   `!m. (convex (vc_edge m))`,
3008   (* {{{ proof *)
3009   [
3010   REWRITE_TAC[vc_edge_inter];
3011   GEN_TAC;
3012   IMATCH_MP_TAC convex_inter;
3013   REWRITE_TAC[closed_half_plane2D_LTS_convex];
3014   IMATCH_MP_TAC  convex_inter;
3015   REWRITE_TAC[closed_half_plane2D_SLT_convex;line2D_F_convex;];
3016   ]);;
3017   (* }}} *)
3018
3019 let v_edge_subset = prove_by_refinement(
3020   `!m. (v_edge m SUBSET vc_edge m)`,
3021   (* {{{ proof *)
3022   [
3023   REWRITE_TAC[vc_edge;SUBSET;UNION;];
3024   MESON_TAC[];
3025   ]);;
3026   (* }}} *)
3027
3028 let v_edge_euclid = prove_by_refinement(
3029   `!m. (v_edge m) SUBSET (euclid 2)`,
3030   (* {{{ proof *)
3031   [
3032   REWRITE_TAC[SUBSET;v_edge];
3033   MESON_TAC[euclid_point];
3034   ]);;
3035   (* }}} *)
3036
3037 let v_edge_closure = prove_by_refinement(
3038   `!m. (closure top2 (v_edge m)) = vc_edge m`,
3039   (* {{{ proof *)
3040   [
3041   GEN_TAC;
3042   IMATCH_MP_TAC  SUBSET_ANTISYM;
3043   CONJ_TAC;
3044   IMATCH_MP_TAC  closure_subset;
3045   REWRITE_TAC[v_edge_subset;top2_top;vc_edge_closed];
3046   REWRITE_TAC[vc_edge];
3047   REWRITE_TAC[union_subset;e2;pointI;single_subset;point_add];
3048   CONJ_TAC;
3049   IMATCH_MP_TAC  subset_closure;
3050   REWRITE_TAC[top2_top];
3051   REWRITE_TAC[top2];
3052   SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ;
3053   REWRITE_TAC[GSYM REAL_RDISTRIB];
3054   REAL_ARITH_TAC;
3055   DISCH_TAC;
3056   CONJ_TAC THEN (IMATCH_MP_TAC  closure_segment) THEN REWRITE_TAC[v_edge_euclid];
3057   TYPE_THEN `(pointI m)+point(&.0,&.1)` EXISTS_TAC;
3058   DISCH_ALL_TAC;
3059   ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
3060   CONV_TAC (dropq_conv "u");
3061   CONV_TAC (dropq_conv "v");
3062   REDUCE_TAC;
3063   ASM_REWRITE_TAC[int_suc];
3064   TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
3065   UND 1;
3066   UND 2;
3067   REAL_ARITH_TAC ;
3068   TYPE_THEN `pointI m` EXISTS_TAC;
3069   DISCH_ALL_TAC;
3070   ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
3071   CONV_TAC (dropq_conv "u");
3072   CONV_TAC (dropq_conv "v");
3073   REDUCE_TAC;
3074   ASM_REWRITE_TAC[int_suc];
3075   TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
3076   UND 1;
3077   UND 2;
3078   REAL_ARITH_TAC ;
3079   ]);;
3080
3081   (* }}} *)
3082
3083 let squ_euclid = prove_by_refinement(
3084   `!m. (squ m) SUBSET (euclid 2)`,
3085   (* {{{ proof *)
3086   [
3087   REWRITE_TAC[SUBSET;squ];
3088   MESON_TAC[euclid_point];
3089   ]);;
3090   (* }}} *)
3091
3092 let cell_euclid = prove_by_refinement(
3093   `!X. (cell X) ==> (X SUBSET euclid 2)`,
3094   (* {{{ proof *)
3095   [
3096   REWRITE_TAC[cell];
3097   GEN_TAC;
3098   DISCH_THEN (CHOOSE_THEN MP_TAC);
3099   REP_CASES_TAC THEN ASM_REWRITE_TAC[h_edge_euclid;squ_euclid;v_edge_euclid];
3100   REWRITE_TAC[ISUBSET;INR IN_SING;pointI;euclid_point];
3101   ASM_MESON_TAC[euclid_point];
3102   ]);;
3103   (* }}} *)
3104
3105 let edge = jordan_def `edge C <=> ?m. ((C = v_edge m) \/ (C = h_edge m))`;;
3106
3107 let edge_v = prove_by_refinement(
3108   `!m. edge (v_edge m)`,
3109   (* {{{ proof *)
3110   [
3111   ASM_MESON_TAC[edge];
3112   ]);;
3113   (* }}} *)
3114
3115 let edge_h = prove_by_refinement(
3116   `!m. edge (h_edge m)`,
3117   (* {{{ proof *)
3118   [
3119   ASM_MESON_TAC[edge];
3120   ]);;
3121   (* }}} *)
3122
3123 let num_closure = jordan_def `num_closure G x =
3124       CARD { C | (G C) /\ (closure top2 C x) }`;;
3125
3126 let num_lower = jordan_def `num_lower G n =
3127    CARD { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;;
3128
3129 let set_lower = jordan_def `set_lower G n =
3130     { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;;
3131
3132 let num_lower_set = prove_by_refinement(
3133   `!G n. num_lower G n = CARD (set_lower G n)`,
3134   (* {{{ proof *)
3135   [
3136   REWRITE_TAC[num_lower;set_lower];
3137   ]);;
3138   (* }}} *)
3139
3140 let even_cell = jordan_def `even_cell G C <=>
3141    (?m. (C = {(pointI m)}) /\ (EVEN (num_lower G m))) \/
3142    (?m. (C = h_edge m) /\ (EVEN (num_lower G m))) \/
3143    (?m. (C = v_edge m) /\ (EVEN (num_lower G m))) \/
3144    (?m. (C = squ m) /\ (EVEN (num_lower G m)))`;;
3145
3146 (* set *)
3147 let eq_sing = prove_by_refinement(
3148 (*** Parens added by JRH; parser no longer hacks "=" specially
3149      so it is really right associative
3150   `!X (y:A). X = {y} = ((X y) /\ (!u. (X u) ==> (u=y)))`,
3151  ***)
3152   `!X (y:A). (X = {y}) <=> ((X y) /\ (!u. (X u) ==> (u=y)))`,
3153   (* {{{ proof *)
3154   [
3155   REWRITE_TAC[INSERT ;];
3156   DISCH_ALL_TAC;
3157   EQ_TAC ;
3158   DISCH_THEN_REWRITE;
3159   DISCH_ALL_TAC;
3160   IMATCH_MP_TAC  EQ_EXT;
3161   REWRITE_TAC[];
3162   ASM_MESON_TAC[];
3163   ]);;
3164   (* }}} *)
3165
3166 let h_edge_pointIv2 = prove_by_refinement(
3167   `!p q. ~(h_edge p = {(pointI q)})`,
3168   (* {{{ proof *)
3169   [
3170   REWRITE_TAC[eq_sing;h_edge_pointI];
3171   ]);;
3172   (* }}} *)
3173
3174 let v_edge_pointIv2 = prove_by_refinement(
3175   `!p q. ~(v_edge p = {(pointI q)})`,
3176   (* {{{ proof *)
3177   [
3178   REWRITE_TAC[eq_sing;v_edge_pointI];
3179   ]);;
3180   (* }}} *)
3181
3182 let square_pointIv2 = prove_by_refinement(
3183   `!p q. ~(squ p = {(pointI q)})`,
3184   (* {{{ proof *)
3185   [
3186   REWRITE_TAC[eq_sing;square_pointI];
3187   ]);;
3188   (* }}} *)
3189
3190 let cell_nonempty = prove_by_refinement(
3191   `!z. (cell z) ==> ~(z = EMPTY)`,
3192   (* {{{ proof *)
3193   [
3194   REWRITE_TAC[cell_mem];
3195   GEN_TAC;
3196   REP_CASES_TAC ;
3197   CHO 1;
3198   USE 1(  REWRITE_RULE [eq_sing]);
3199   ASM_MESON_TAC[EMPTY];
3200   CHO 1;
3201   ASM_MESON_TAC[h_edge_disj;INTER_EMPTY];
3202   CHO 1;
3203   ASM_MESON_TAC[v_edge_disj;INTER_EMPTY];
3204   CHO 1;
3205   ASM_MESON_TAC[square_disj;INTER_EMPTY];
3206   ]);;
3207   (* }}} *)
3208
3209 let hv_edgeV2 = prove_by_refinement(
3210   `!p q. ~(h_edge p = v_edge q)`,
3211   (* {{{ proof *)
3212   [
3213   ASM_MESON_TAC[cell_rules;cell_nonempty;hv_edge;INTER_IDEMPOT];
3214   ]);;
3215   (* }}} *)
3216
3217 let square_v_edgeV2 = prove_by_refinement(
3218   `!p q. ~(squ p = v_edge q)`,
3219   (* {{{ proof *)
3220   [
3221   ASM_MESON_TAC[cell_rules;cell_nonempty;square_v_edge;INTER_IDEMPOT];
3222   ]);;
3223   (* }}} *)
3224
3225 let square_h_edgeV2 = prove_by_refinement(
3226   `!p q. ~(squ p = h_edge q)`,
3227   (* {{{ proof *)
3228   [
3229   ASM_MESON_TAC[cell_rules;cell_nonempty;square_h_edge;INTER_IDEMPOT];
3230   ]);;
3231   (* }}} *)
3232
3233 let h_edge_inj = prove_by_refinement(
3234   `!p q . (h_edge p = h_edge q) <=> (p = q)`,
3235   (* {{{ proof *)
3236   [
3237   ASM_MESON_TAC[cell_rules;cell_nonempty;h_edge_disj;INTER_IDEMPOT];
3238   ]);;
3239   (* }}} *)
3240
3241 let v_edge_inj = prove_by_refinement(
3242   `!p q . (v_edge p = v_edge q) <=> (p = q)`,
3243   (* {{{ proof *)
3244   [
3245   ASM_MESON_TAC[cell_rules;cell_nonempty;v_edge_disj;INTER_IDEMPOT];
3246   ]);;
3247   (* }}} *)
3248
3249 let squ_inj = prove_by_refinement(
3250   `!p q . (squ p = squ q) <=> (p = q)`,
3251   (* {{{ proof *)
3252   [
3253   ASM_MESON_TAC[cell_rules;cell_nonempty;square_disj;INTER_IDEMPOT];
3254   ]);;
3255   (* }}} *)
3256
3257 let finite_set_lower = prove_by_refinement(
3258   `!G n. (FINITE G) ==> (FINITE (set_lower G n))`,
3259   (* {{{ proof *)
3260   [
3261   DISCH_ALL_TAC;
3262   TYPE_THEN `INJ h_edge (set_lower G n) G` SUBGOAL_TAC;
3263   REWRITE_TAC[INJ;set_lower;h_edge_inj];
3264   ASM_MESON_TAC[];
3265   DISCH_TAC;
3266   JOIN  0 1;
3267   USE 0 (MATCH_MP FINITE_INJ);
3268   ASM_REWRITE_TAC[];
3269   ]);;
3270   (* }}} *)
3271
3272 let even_cell_point = prove_by_refinement(
3273   `!G m. even_cell G {(pointI m)} <=> EVEN(num_lower G m)`,
3274   (* {{{ proof *)
3275   [
3276   REWRITE_TAC[even_cell;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2];
3277   REWRITE_TAC[pointI_inj;INSERT;eq_sing];
3278   ASM_MESON_TAC[];
3279   ]);;
3280   (* }}} *)
3281
3282 let even_cell_h_edge = prove_by_refinement(
3283   `!G m. even_cell G (h_edge m) <=> EVEN(num_lower G m)`,
3284   (* {{{ proof *)
3285   [
3286   REWRITE_TAC[even_cell;h_edge_pointIv2];
3287   REWRITE_TAC[pointI_inj;INSERT;h_edge_inj;GSYM square_h_edgeV2;hv_edgeV2;eq_sing];
3288   ASM_MESON_TAC[];
3289   ]);;
3290   (* }}} *)
3291
3292 let even_cell_v_edge = prove_by_refinement(
3293   `!G m. even_cell G (v_edge m) <=> EVEN(num_lower G m)`,
3294   (* {{{ proof *)
3295   [
3296   REWRITE_TAC[even_cell;v_edge_pointIv2];
3297   REWRITE_TAC[pointI_inj;INSERT;v_edge_inj;GSYM square_v_edgeV2;hv_edgeV2;eq_sing];
3298   ASM_MESON_TAC[];
3299   ]);;
3300   (* }}} *)
3301
3302 let even_cell_squ = prove_by_refinement(
3303   `!G m. even_cell G (squ m) <=> EVEN(num_lower G m)`,
3304   (* {{{ proof *)
3305   [
3306   REWRITE_TAC[even_cell;v_edge_pointIv2];
3307   REWRITE_TAC[pointI_inj;INSERT;squ_inj;GSYM square_v_edgeV2;GSYM square_h_edgeV2;square_pointI;eq_sing];
3308   ASM_MESON_TAC[];
3309   ]);;
3310   (* }}} *)
3311
3312 let h_edge_squ_parity = prove_by_refinement(
3313   `!G m. even_cell G (h_edge m) <=> even_cell G (squ m)`,
3314   (* {{{ proof *)
3315   [
3316   REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower];
3317   ]);;
3318   (* }}} *)
3319
3320 let up = jordan_def `up (m:int#int) = (FST m,SND m +: (&:1))`;;
3321 let down = jordan_def `down (m:int#int) = (FST m,SND m -: (&:1))`;;
3322 let left = jordan_def `left (m:int#int) = (FST m -: (&:1),SND m)`;;
3323 let right = jordan_def `right (m:int#int) = (FST m +: (&:1),SND m)`;;
3324
3325 let set_lower_delete = prove_by_refinement(
3326   `!G n. set_lower G (down n) = (set_lower G n) DELETE n`,
3327   (* {{{ proof *)
3328   [
3329   REWRITE_TAC[set_lower;down;DELETE ];
3330   DISCH_ALL_TAC;
3331   IMATCH_MP_TAC  EQ_EXT;
3332   GEN_TAC;
3333   REWRITE_TAC[PAIR_SPLIT;INT_LE_SUB_LADD;GSYM INT_LT_DISCRETE;];
3334   REWRITE_TAC[int_le;int_lt;];
3335   REWRITE_TAC[ (ARITH_RULE `! x y. (x <. y) <=> ((x <= y) /\ ~(x = y))`)];
3336   REWRITE_TAC[GSYM int_eq];
3337   MESON_TAC[];
3338   ]);;
3339   (* }}} *)
3340
3341 let set_lower_n = prove_by_refinement(
3342   `!G n. set_lower G n n = (G (h_edge n))`,
3343   (* {{{ proof *)
3344   [
3345   REWRITE_TAC[set_lower;int_le ; REAL_LE_REFL];
3346   ]);;
3347   (* }}} *)
3348
3349 (* set *)
3350 let CARD_SUC_DELETE = prove_by_refinement(
3351   `!(x:A) s. FINITE s /\ s x ==>
3352     ((SUC (CARD (s DELETE x))) = CARD s)`,
3353   (* {{{ proof *)
3354   [
3355   DISCH_ALL_TAC;
3356   TYPE_THEN `s = (x INSERT (s DELETE x))` SUBGOAL_TAC;
3357   ASM_MESON_TAC[INR INSERT_DELETE];
3358   USE 0 (ONCE_REWRITE_RULE[GSYM FINITE_DELETE]);
3359   TYPE_THEN `b = s DELETE x`  ABBREV_TAC ;
3360   DISCH_THEN_REWRITE;
3361   ASM_SIMP_TAC [INR CARD_CLAUSES];
3362   COND_CASES_TAC;
3363   ASM_MESON_TAC[INR IN_DELETE];
3364   REWRITE_TAC[];
3365   ]);;
3366   (* }}} *)
3367
3368 let even_delete = prove_by_refinement(
3369   `!(x:A) s. FINITE s ==>
3370      ((EVEN (CARD (s DELETE x)) <=> EVEN (CARD s)) <=> ~(s x))`,
3371   (* {{{ proof *)
3372   [
3373   DISCH_ALL_TAC;
3374   TYPE_THEN `s x`  ASM_CASES_TAC ;
3375   ASM_MESON_TAC[CARD_SUC_DELETE;EVEN ];
3376   ASM_SIMP_TAC[CARD_DELETE];
3377   ]);;
3378   (* }}} *)
3379
3380 let num_lower_down = prove_by_refinement(
3381   `!G m. (FINITE G) ==>
3382        ((EVEN (num_lower G (down m)) <=> EVEN (num_lower G m)) <=>
3383            ~(set_lower G m m))`,
3384   (* {{{ proof *)
3385   [
3386   DISCH_ALL_TAC;
3387   REWRITE_TAC[num_lower_set;set_lower_delete];
3388   IMATCH_MP_TAC  even_delete;
3389   REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower;down];
3390   ASM_MESON_TAC[finite_set_lower];
3391   ]);;
3392   (* }}} *)
3393
3394 let squ_down = prove_by_refinement(
3395   `!G m. (FINITE G) ==>
3396         ((even_cell G (squ (down m)) <=> even_cell G (squ m)) <=>
3397              ~(set_lower G m m))`,
3398   (* {{{ proof *)
3399   [
3400   REWRITE_TAC[even_cell_squ;num_lower_down];
3401   ]);;
3402   (* }}} *)
3403
3404 (* ------------------------------------------------------------------ *)
3405 (*  edge combinatorics *)
3406 (* ------------------------------------------------------------------ *)
3407
3408 let pair_size_2 = prove_by_refinement(
3409   `!(a:A) b. ~(a= b) ==> ({a, b} HAS_SIZE 2)`,
3410   (* {{{ proof *)
3411   [
3412   DISCH_ALL_TAC;
3413   REWRITE_TAC[HAS_SIZE];
3414   ASM_SIMP_TAC[FINITE_SING;CARD_CLAUSES;INR IN_SING ];
3415   CONJ_TAC;
3416   REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
3417   REWRITE_TAC[ARITH_RULE `2 = SUC 1`;SUC_INJ;];
3418   MESON_TAC[SING;CARD_SING];
3419   ]);;
3420   (* }}} *)
3421
3422 let has_size2 = prove_by_refinement(
3423   `!u. (u HAS_SIZE 2) <=> (?(a:A) b. (u = {a , b}) /\ ~(a=b))`,
3424   (* {{{ proof *)
3425   [
3426   DISCH_ALL_TAC;
3427   EQ_TAC;
3428   REWRITE_TAC[HAS_SIZE];
3429   DISCH_ALL_TAC;
3430   TYPE_THEN `~(u = EMPTY)` SUBGOAL_TAC;
3431   PROOF_BY_CONTR_TAC;
3432   REWR 2;
3433   REWR 1;
3434   USE 1 (REWRITE_RULE[CARD_CLAUSES]);
3435   UND 1;
3436   ARITH_TAC;
3437   DISCH_TAC;
3438   COPY 0;
3439   COPY 2;
3440   JOIN 0 2;
3441   USE 0 (MATCH_MP CARD_DELETE_CHOICE);
3442   TYPE_THEN `CARD (u DELETE CHOICE u) = 1` SUBGOAL_TAC;
3443   ONCE_REWRITE_TAC [GSYM SUC_INJ];
3444   ASM_REWRITE_TAC[];
3445   ARITH_TAC;
3446   DISCH_TAC;
3447   TYPE_THEN `u DELETE CHOICE u HAS_SIZE 1` SUBGOAL_TAC;
3448   REWRITE_TAC[HAS_SIZE];
3449   ASM_REWRITE_TAC[FINITE_DELETE];
3450   DISCH_TAC;
3451   USE 5 (MATCH_MP CARD_SING_CONV);
3452   USE 5 (REWRITE_RULE [SING]);
3453   CHO 5;
3454   TYPE_THEN `CHOICE u` EXISTS_TAC;
3455   TYPE_THEN `x` EXISTS_TAC;
3456   USE 5 (SYM);
3457   ASM_REWRITE_TAC[];
3458   USE 4 (MATCH_MP CHOICE_DEF);
3459   ASM_SIMP_TAC[INSERT_DELETE];
3460   TYPE_THEN `(u DELETE (CHOICE u)) x` SUBGOAL_TAC;
3461   USE 5 (SYM);
3462   ASM_REWRITE_TAC[INR IN_SING ];
3463   DISCH_TAC;
3464   TYPE_THEN `~((u DELETE CHOICE u) (CHOICE u))` SUBGOAL_TAC;
3465   REWRITE_TAC[INR IN_DELETE];
3466   ASM_MESON_TAC[];
3467   DISCH_ALL_TAC;
3468   CHO 0;
3469   CHO 0;
3470   ASM_REWRITE_TAC[];
3471   ASM_MESON_TAC[pair_size_2];
3472   ]);;
3473   (* }}} *)
3474
3475 let in_pair = prove_by_refinement(
3476   `!(a:A) b t. {a , b} t <=> (t = b) \/ (t = a)`,
3477   (* {{{ proof *)
3478   [
3479   REWRITE_TAC[INSERT];
3480   ]);;
3481   (* }}} *)
3482
3483 let pair_swap_select =
3484    jordan_def `pair_swap u (x:A) = @y. ~(x = y) /\ (u y)`;;
3485
3486 let pair_swap_pair = prove_by_refinement(
3487   `!(a:A) b. ~(a = b) ==>
3488        (pair_swap {a,b} a = b) /\ (pair_swap {a,b} b = a)`,
3489   (* {{{ proof *)
3490   [
3491   DISCH_ALL_TAC;
3492   REWRITE_TAC[pair_swap_select];
3493   REWRITE_TAC[in_pair];
3494   CONJ_TAC THEN SELECT_TAC THEN (ASM_MESON_TAC[]);
3495   ]);;
3496   (* }}} *)
3497
3498 let pair_swap = prove_by_refinement(
3499   `!u (x:A). (u HAS_SIZE 2)/\ (u x) ==>
3500          (~(pair_swap u x = x)) /\ (u (pair_swap u x))`,
3501   (* {{{ proof *)
3502   [
3503   REWRITE_TAC[has_size2];
3504   DISCH_ALL_TAC;
3505   CHO 0;
3506   CHO 0;
3507   ASM_REWRITE_TAC[];
3508   REWR 1;
3509   USE 1 (REWRITE_RULE[in_pair]);
3510   CONJ_TAC;
3511   ASM_MESON_TAC[pair_swap_pair];
3512   UND 1;
3513   DISCH_THEN (DISJ_CASES_TAC) THEN ASM_SIMP_TAC [pair_swap_pair] THEN REWRITE_TAC[INSERT];
3514   ]);;
3515   (* }}} *)
3516
3517 let pair_swap_invol = prove_by_refinement(
3518   `!u (x:A). (u HAS_SIZE 2) /\ (u x) ==>
3519        (pair_swap u (pair_swap u x) = x)`,
3520   (* {{{ proof *)
3521   [
3522   REWRITE_TAC[has_size2];
3523   DISCH_ALL_TAC;
3524   CHO 0;
3525   CHO 0;
3526   ASM_REWRITE_TAC[];
3527   REWR 1;
3528   USE 1 (REWRITE_RULE[in_pair]);
3529   UND 1;
3530   DISCH_THEN (DISJ_CASES_TAC);
3531   ASM_SIMP_TAC [pair_swap_pair];
3532   ASM_SIMP_TAC [pair_swap_pair];
3533   ]);;
3534   (* }}} *)
3535
3536
3537
3538 (* ------------------------------------------------------------------ *)
3539 (* SECTION C *)
3540 (* ------------------------------------------------------------------ *)
3541
3542 (* ------------------------------------------------------------------ *)
3543 (* rectagons *)
3544 (* ------------------------------------------------------------------ *)
3545
3546 let rectagon = jordan_def `rectagon G <=>
3547   (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\
3548       (!m . ({0,2} (num_closure G (pointI m)))) /\
3549       (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\
3550         (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==>
3551         (S = G))`;;
3552
3553 let segment = jordan_def `segment G <=>
3554   (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\
3555       (!m . ({0,1,2} (num_closure G (pointI m)))) /\
3556       (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\
3557         (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==>
3558         (S = G))`;;
3559
3560 let psegment = jordan_def `psegment G <=>
3561    segment G /\ ~(rectagon G)`;;
3562
3563 let rectagon_segment = prove_by_refinement(
3564   `!G. (rectagon G ) ==> (segment G)`,
3565   (* {{{ proof *)
3566   [
3567   REWRITE_TAC[segment;rectagon;INSERT ];
3568   ASM_MESON_TAC[];
3569   ]);;
3570   (* }}} *)
3571
3572 let endpoint = jordan_def `endpoint G m <=>
3573   (num_closure G (pointI m) = 1)`;;
3574
3575 let midpoint = jordan_def `midpoint G m <=>
3576   (num_closure G (pointI m) = 2)`;;
3577
3578 let psegment_endpoint = prove_by_refinement(
3579   `!G. (psegment G) ==> (?m. (endpoint G m))`,
3580   (* {{{ proof *)
3581   [
3582   REWRITE_TAC[psegment;rectagon;segment;endpoint];
3583   DISCH_ALL_TAC;
3584   UND 5;
3585   ASM_REWRITE_TAC[];
3586   DISCH_TAC;
3587   LEFT 5 "m";
3588   CHO 5;
3589   TSPEC `m` 3;
3590   USE 3 (REWRITE_RULE[INSERT]);
3591   USE 5 (REWRITE_RULE[INSERT]);
3592   ASM_MESON_TAC[];
3593   ]);;
3594   (* }}} *)
3595
3596 let rectagon_endpoint = prove_by_refinement(
3597   `!G. (rectagon G) ==> ~(?m. (endpoint G m))`,
3598   (* {{{ proof *)
3599   [
3600   REWRITE_TAC[rectagon;endpoint;INSERT ];
3601   DISCH_ALL_TAC;
3602   CHO 0;
3603   ASM_MESON_TAC[ARITH_RULE `(~(1=2)) /\ ~(1=0)` ];
3604   ]);;
3605   (* }}} *)
3606
3607 let num_closure_mono = prove_by_refinement(
3608   `!G G' x. (FINITE G') /\ (G SUBSET G') ==>
3609        (num_closure G x <= num_closure G' x)`,
3610   (* {{{ proof *)
3611   [
3612   REWRITE_TAC[num_closure];
3613   DISCH_ALL_TAC;
3614   IMATCH_MP_TAC CARD_SUBSET ;
3615   REWRITE_TAC[ISUBSET];
3616   CONJ_TAC;
3617   ASM_MESON_TAC[ISUBSET];
3618   IMATCH_MP_TAC  FINITE_SUBSET;
3619   TYPE_THEN `G'` EXISTS_TAC;
3620   ASM_REWRITE_TAC[ISUBSET];
3621   MESON_TAC[];
3622   ]);;
3623   (* }}} *)
3624
3625 let endpoint_psegment = prove_by_refinement(
3626   `!G. (?m. (endpoint G m)) /\ (segment G) ==> (psegment G)`,
3627   (* {{{ proof *)
3628   [
3629   ASM_MESON_TAC  [psegment;rectagon_endpoint];
3630   ]);;
3631   (* }}} *)
3632
3633 let num_closure_size = prove_by_refinement(
3634   `!G x. FINITE G ==>
3635      ({C | G C /\ closure top2 C x} HAS_SIZE (num_closure G x) )`,
3636   (* {{{ proof *)
3637   [
3638   REWRITE_TAC[HAS_SIZE;num_closure];
3639   DISCH_ALL_TAC;
3640   IMATCH_MP_TAC  FINITE_SUBSET;
3641   TYPE_THEN `G` EXISTS_TAC;
3642   REWRITE_TAC[ISUBSET];
3643   ASM_MESON_TAC[];
3644   ]);;
3645   (* }}} *)
3646
3647 let endpoint_edge = prove_by_refinement(
3648   `!G m.  (FINITE G) /\ (endpoint G m) ==> (?! e. (G e) /\
3649      (closure top2 e (pointI m)))`,
3650   (* {{{ proof *)
3651
3652   [
3653   REWRITE_TAC[endpoint;];
3654   DISCH_ALL_TAC;
3655   TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} HAS_SIZE 1` SUBGOAL_TAC;
3656   UND 1;
3657   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
3658   IMATCH_MP_TAC  num_closure_size;
3659   ASM_REWRITE_TAC[];
3660   DISCH_TAC;
3661   USE 2 (MATCH_MP CARD_SING_CONV);
3662   USE 2 (REWRITE_RULE[SING]);
3663   CHO 2;
3664   USE 2 (REWRITE_RULE[eq_sing]);
3665   REWRITE_TAC[EXISTS_UNIQUE_ALT];
3666   ASM_MESON_TAC[];
3667   ]);;
3668
3669   (* }}} *)
3670
3671 let midpoint_edge = prove_by_refinement(
3672   `!G m. (FINITE G) /\ (midpoint G m) ==>
3673      {C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2`,
3674   (* {{{ proof *)
3675   [
3676   REWRITE_TAC[midpoint;];
3677   DISCH_ALL_TAC;
3678   UND 1;
3679   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
3680   IMATCH_MP_TAC  num_closure_size;
3681   ASM_REWRITE_TAC[];
3682   ]);;
3683   (* }}} *)
3684
3685 let two_endpoint = prove_by_refinement(
3686   `!e. (edge e) ==> ({ m | (closure top2 e (pointI m)) } HAS_SIZE 2)`,
3687   (* {{{ proof *)
3688   [
3689   REWRITE_TAC[edge];
3690   DISCH_ALL_TAC;
3691   CHO 0;
3692   UND 0;
3693   DISCH_THEN DISJ_CASES_TAC;
3694   ASM_REWRITE_TAC[v_edge_closure;h_edge_closure];
3695   REWRITE_TAC[vc_edge;UNION;has_size2];
3696   TYPE_THEN `m` EXISTS_TAC;
3697   TYPE_THEN `(FST m,SND m +: (&:1))` EXISTS_TAC;
3698   CONJ_TAC;
3699   IMATCH_MP_TAC  EQ_EXT;
3700   GEN_TAC;
3701   REWRITE_TAC[INR IN_SING ;];
3702   TYPE_THEN `euclid_plus (pointI m) e2 = pointI (FST m,SND m +: (&:1))` SUBGOAL_TAC ;
3703   REWRITE_TAC[pointI;e2;point_add;int_suc ];
3704   REDUCE_TAC;
3705   DISCH_THEN_REWRITE;
3706   REWRITE_TAC[v_edge_pointI;pointI_inj;];
3707   REWRITE_TAC[INSERT];
3708   MESON_TAC[];
3709   REWRITE_TAC[PAIR_SPLIT];
3710   INT_ARITH_TAC;
3711   (* 2nd case: *)
3712   ASM_REWRITE_TAC[v_edge_closure;h_edge_closure];
3713   REWRITE_TAC[hc_edge;UNION;has_size2];
3714   TYPE_THEN `m` EXISTS_TAC;
3715   TYPE_THEN `(FST m +: (&:1),SND m )` EXISTS_TAC;
3716   CONJ_TAC;
3717   IMATCH_MP_TAC  EQ_EXT;
3718   GEN_TAC;
3719   REWRITE_TAC[INR IN_SING ;];
3720   TYPE_THEN `euclid_plus (pointI m) e1 = pointI (FST m +: (&:1),SND m )` SUBGOAL_TAC ;
3721   REWRITE_TAC[pointI;e1;point_add;int_suc ];
3722   REDUCE_TAC;
3723   DISCH_THEN_REWRITE;
3724   REWRITE_TAC[h_edge_pointI;pointI_inj;];
3725   REWRITE_TAC[INSERT];
3726   MESON_TAC[];
3727   REWRITE_TAC[PAIR_SPLIT];
3728   INT_ARITH_TAC;
3729   ]);;
3730   (* }}} *)
3731
3732 let edge_midend = prove_by_refinement(
3733   `!G e m. (segment G) /\ (G e) /\ (closure top2 e (pointI m)) ==>
3734       (midpoint G m) \/ (endpoint G m)`,
3735   (* {{{ proof *)
3736   [
3737   REWRITE_TAC[segment;midpoint;endpoint];
3738   DISCH_ALL_TAC;
3739   TSPEC `m` 3;
3740   USE 3 (REWRITE_RULE[INSERT]);
3741   TYPE_THEN `~(num_closure G (pointI m) = 0)` SUBGOAL_TAC;
3742   USE 0 (MATCH_MP num_closure_size);
3743   TSPEC `pointI m` 0;
3744   PROOF_BY_CONTR_TAC;
3745   REWR 7;
3746   REWR 0;
3747   USE 0(REWRITE_RULE[HAS_SIZE_0]);
3748   UND 0;
3749   REWRITE_TAC[EMPTY_EXISTS];
3750   TYPE_THEN `e` EXISTS_TAC;
3751   ASM_REWRITE_TAC[];
3752   UND 3;
3753   ARITH_TAC;
3754   ]);;
3755   (* }}} *)
3756
3757 let plus_e12 = prove_by_refinement(
3758   `!m. ((pointI m) + e2 = pointI (FST m,SND m +: (&:1))) /\
3759       ((pointI m) + e1 = pointI (FST m +: (&:1),SND m))`,
3760   (* {{{ proof *)
3761   [
3762   REWRITE_TAC[e1;e2];
3763   REWRITE_TAC[pointI;point_add;int_suc];
3764   REDUCE_TAC;
3765   ]);;
3766   (* }}} *)
3767
3768 let c_edge_euclid = prove_by_refinement(
3769   `!e. (edge e) ==> (closure top2 e) SUBSET (euclid 2)`,
3770   (* {{{ proof *)
3771   [
3772   REWRITE_TAC[edge];
3773   GEN_TAC;
3774   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];
3775   ]);;
3776   (* }}} *)
3777
3778 (* slow proof... *)
3779 let inter_lattice = prove_by_refinement(
3780   `!x e e'. (edge e) /\ (edge e') /\ (~(e=e')) /\
3781     ((closure top2 e INTER closure top2 e') x) ==>
3782        (?m. x = pointI m)`,
3783   (* {{{ proof *)
3784   [
3785   DISCH_ALL_TAC;
3786   TYPE_THEN `euclid 2 x` SUBGOAL_TAC;
3787   USE 3 (REWRITE_RULE[INTER]);
3788   AND 3;
3789   USE 0 (MATCH_MP c_edge_euclid);
3790   USE 0 (REWRITE_RULE[ISUBSET]);
3791   ASM_MESON_TAC[];
3792   DISCH_THEN (MP_TAC o (MATCH_MP point_onto));
3793   DISCH_TAC;
3794   CHO 4;
3795   ASM_REWRITE_TAC[];
3796   ASSUME_TAC square_domain;
3797   TSPEC `p` 5;
3798   USE 5 (CONV_RULE (NAME_CONFLICT_CONV));
3799   UND 5;
3800   LET_TAC ;
3801   REWRITE_TAC[UNION];
3802   UND 3;
3803   ASM_REWRITE_TAC[INTER];
3804   KILL 4;
3805   UND 2;
3806   UND 0;
3807   REWRITE_TAC[edge] ;
3808   DISCH_THEN (CHOOSE_THEN MP_TAC);
3809   UND 1;
3810   REWRITE_TAC[edge] ;
3811   DISCH_THEN (CHOOSE_THEN MP_TAC);
3812   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
3813   (* 1st,2nd,3rd, *)
3814   (* tx *)
3815   (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]);
3816   ]);;
3817   (* }}} *)
3818
3819 let edgec_convex = prove_by_refinement(
3820   `!e. (edge e) ==> (convex (closure top2 e))`,
3821   (* {{{ proof *)
3822   [
3823   GEN_TAC;
3824   REWRITE_TAC[edge];
3825   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[v_edge_closure;h_edge_closure;hc_edge_convex;vc_edge_convex];
3826   ]);;
3827   (* }}} *)
3828
3829 let midpoint_h_edge = prove_by_refinement(
3830   `!m. (h_edge m) (((&.1)/(&.2))*# (pointI m) +
3831          ((&.1)/(&.2))*# (pointI m + e1))`,
3832   (* {{{ proof *)
3833   [
3834   REWRITE_TAC[plus_e12];
3835   REWRITE_TAC[h_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc];
3836   GEN_TAC;
3837   CONV_TAC (dropq_conv "u");
3838   CONV_TAC (dropq_conv "v");
3839   TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC;
3840   TYPE_THEN `b = real_of_int(FST  m)` ABBREV_TAC;
3841   CONJ_TAC;
3842   real_poly_tac ;
3843   CONJ_TAC;
3844   ineq_lt_tac `b + (&.1/(&.2)) = &1 / &2 * b + &1 / &2 * (b + &1)`;
3845   ineq_lt_tac `((&1 / &2) * b + &1 / &2 * (b + &1)) + (&1 / &2) = b +. &1`
3846   ]);;
3847   (* }}} *)
3848
3849 let midpoint_v_edge = prove_by_refinement(
3850   `!m. (v_edge m) (((&.1)/(&.2))*# (pointI m) +
3851          ((&.1)/(&.2))*# (pointI m + e2))`,
3852   (* {{{ proof *)
3853   [
3854   REWRITE_TAC[plus_e12];
3855   REWRITE_TAC[v_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc];
3856   GEN_TAC;
3857   CONV_TAC (dropq_conv "u");
3858   CONV_TAC (dropq_conv "v");
3859   TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC;
3860   TYPE_THEN `b = real_of_int(FST  m)` ABBREV_TAC;
3861   CONJ_TAC;
3862   real_poly_tac ;
3863   CONJ_TAC;
3864   ineq_lt_tac `a +. (&1/ &2)= &1 / &2 * a + &1 / &2 * (a + &1)`;
3865   ineq_lt_tac `(&1 / &2 * a + &1 / &2 * (a + &1)) +(&1/ &2) =  a + &1`;
3866   ]);;
3867   (* }}} *)
3868
3869 let midpoint_unique = prove_by_refinement(
3870   `!x y e e'. (edge e) /\ (edge e') /\ (~(e = e')) /\
3871     ((closure top2 e INTER closure top2 e') x) /\
3872     ((closure top2 e INTER closure top2 e') y) ==>
3873     ( x = y)`,
3874   (* {{{ proof *)
3875   [
3876   DISCH_ALL_TAC;
3877   TYPE_THEN `convex (closure top2 e INTER closure top2 e')` SUBGOAL_TAC;
3878   IMATCH_MP_TAC  convex_inter ;
3879   ASM_MESON_TAC[edgec_convex];
3880   TYPE_THEN `(?m. x = pointI m) /\ (?n. y = pointI n)` SUBGOAL_TAC;
3881   ASM_MESON_TAC[inter_lattice];
3882   DISCH_ALL_TAC;
3883   CHO 6;
3884   CHO 7;
3885   ASM_REWRITE_TAC[];
3886   REWR 3;
3887   REWR 4;
3888   KILL 6;
3889   KILL 7;
3890   TYPE_THEN `(closure top2 e (pointI n)) /\ closure top2 e (pointI m)` SUBGOAL_TAC;
3891   UND 4;
3892   UND 3;
3893   REWRITE_TAC[INTER];
3894   MESON_TAC[];
3895   DISCH_ALL_TAC;
3896   WITH 0 (MATCH_MP edgec_convex);
3897   UND 6;
3898   USE 0 (REWRITE_RULE[edge]);
3899   CHO 0;
3900   UND 0;
3901   DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[];
3902   (* ml -- start of 1st main branch. *)
3903   DISCH_ALL_TAC;
3904   TYPE_THEN `((n = m') \/ (n = (FST m',SND m' + &:1))) /\ ((m = m') \/ (m = (FST m',SND m' + &:1)))` SUBGOAL_TAC;
3905   UND 6;
3906   UND 7;
3907   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];
3908   MESON_TAC[];
3909   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
3910   TYPE_THEN  `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC;
3911   (* start A*)
3912   TYPE_THEN `X (pointI m') /\ X (pointI m' + e2) ==> ~(X INTER (v_edge m') = EMPTY)` SUBGOAL_TAC;
3913   REWRITE_TAC[EMPTY_EXISTS;INTER ];
3914   USE 5 (REWRITE_RULE[convex;mk_segment]);
3915   DISCH_TAC ;
3916   H_MATCH_MP (HYP "5") (HYP "10");
3917   USE 11 (REWRITE_RULE[ISUBSET]);
3918   TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e2)` ABBREV_TAC;
3919   TYPE_THEN `b` EXISTS_TAC;
3920   TSPEC `b` 11;
3921   CONJ_TAC;
3922   UND 11;
3923   DISCH_THEN IMATCH_MP_TAC  ;
3924   TYPE_THEN `&1/ &2` EXISTS_TAC;
3925   CONV_TAC REAL_RAT_REDUCE_CONV;
3926   EXPAND_TAC "b";
3927   MESON_TAC[];
3928   EXPAND_TAC "b";
3929   MATCH_ACCEPT_TAC midpoint_v_edge; (* end of goal A *)
3930   REWRITE_TAC[plus_e12];
3931   (* start  B*)
3932   TYPE_THEN `X INTER (v_edge m') = EMPTY ` SUBGOAL_TAC;
3933   REWRITE_TAC[EQ_EMPTY];
3934   DISCH_ALL_TAC;
3935   USE 10 (REWRITE_RULE[INTER]);
3936   TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC;
3937   ASM_MESON_TAC[inter_lattice;edge];
3938   DISCH_TAC;
3939   CHO 11;
3940   REWR 10;
3941   ASM_MESON_TAC[v_edge_pointI];
3942   DISCH_THEN_REWRITE;
3943   DISCH_TAC;
3944   REP_CASES_TAC THEN ASM_MESON_TAC[];
3945   (* end of FIRST main branch  -- snd main branch -- fully parallel *)
3946   DISCH_ALL_TAC;
3947   TYPE_THEN `((n = m') \/ (n = (FST m' + &:1,SND m'))) /\ ((m = m') \/ (m = (FST m' + &:1,SND m' )))` SUBGOAL_TAC;
3948   UND 6;
3949   UND 7;
3950   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];
3951   MESON_TAC[];
3952   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
3953   TYPE_THEN  `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC;
3954   (* start A'  *)
3955   TYPE_THEN `X (pointI m') /\ X (pointI m' + e1) ==> ~(X INTER (h_edge m') = EMPTY)` SUBGOAL_TAC;
3956   REWRITE_TAC[EMPTY_EXISTS;INTER ];
3957   USE 5 (REWRITE_RULE[convex;mk_segment]);
3958   DISCH_TAC ;
3959   H_MATCH_MP (HYP "5") (HYP "10");
3960   USE 11 (REWRITE_RULE[ISUBSET]);
3961   TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e1)` ABBREV_TAC;
3962   TYPE_THEN `b` EXISTS_TAC;
3963   TSPEC `b` 11;
3964   CONJ_TAC;
3965   UND 11;
3966   DISCH_THEN IMATCH_MP_TAC  ;
3967   TYPE_THEN `&1/ &2` EXISTS_TAC;
3968   CONV_TAC REAL_RAT_REDUCE_CONV;
3969   EXPAND_TAC "b";
3970   MESON_TAC[];
3971   EXPAND_TAC "b";
3972   MATCH_ACCEPT_TAC midpoint_h_edge; (* end of goal A' *)
3973   REWRITE_TAC[plus_e12];
3974   (* start  B' *)
3975   TYPE_THEN `X INTER (h_edge m') = EMPTY ` SUBGOAL_TAC;
3976   REWRITE_TAC[EQ_EMPTY];
3977   DISCH_ALL_TAC;
3978   USE 10 (REWRITE_RULE[INTER]);
3979   TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC;
3980   ASM_MESON_TAC[inter_lattice;edge];
3981   DISCH_TAC;
3982   CHO 11;
3983   REWR 10;
3984   ASM_MESON_TAC[h_edge_pointI];
3985   DISCH_THEN_REWRITE;
3986   DISCH_TAC;
3987   REP_CASES_TAC  THEN ASM_MESON_TAC[];
3988   ]);;
3989   (* }}} *)
3990
3991 let edge_inter = prove_by_refinement(
3992   `!C C'. (edge C) /\ (edge C') /\ (adj C C')  ==>
3993       (?m. (closure top2 C) INTER (closure top2 C') = {(pointI m)}) `,
3994   (* {{{ proof *)
3995
3996   [
3997   REWRITE_TAC[adj];
3998   DISCH_ALL_TAC;
3999   USE 3 (REWRITE_RULE[EMPTY_EXISTS]);
4000   CHO 3;
4001   TYPE_THEN `(?m. u = pointI m)` SUBGOAL_TAC;
4002   ASM_MESON_TAC[inter_lattice];
4003   DISCH_THEN (CHOOSE_TAC);
4004   REWR 3;
4005   TYPE_THEN `m` EXISTS_TAC;
4006   ASM_REWRITE_TAC [eq_sing];
4007   ASM_MESON_TAC[midpoint_unique];
4008   ]);;
4009
4010   (* }}} *)
4011
4012 let inter_midpoint = prove_by_refinement(
4013   `!G C C' m. (segment G) /\ (G C) /\ (G C') /\ (adj C C') /\
4014       (((closure top2 C) INTER (closure top2 C')) (pointI m)) ==>
4015     (midpoint G m) `,
4016   (* {{{ proof *)
4017   [
4018   REWRITE_TAC[midpoint;segment];
4019   DISCH_ALL_TAC;
4020   TSPEC `m` 3;
4021   USE 3 (REWRITE_RULE[INSERT]);
4022   UND 3;
4023   USE 0 (MATCH_MP num_closure_size);
4024   TSPEC `pointI m` 0;
4025   TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ;
4026   TYPE_THEN `X C /\ X C'` SUBGOAL_TAC;
4027   EXPAND_TAC "X";
4028   ASM_REWRITE_TAC[];
4029   UND 8;
4030   REWRITE_TAC[INTER]; (* done WITH subgoal *)
4031   DISCH_TAC;
4032   TYPE_THEN `~(C = C')` SUBGOAL_TAC;
4033   ASM_MESON_TAC[adj];
4034   DISCH_TAC;
4035   REP_CASES_TAC;
4036   ASM_REWRITE_TAC[];
4037   REWR 0;
4038   USE 0 (MATCH_MP CARD_SING_CONV);
4039   USE 0 (REWRITE_RULE[SING;eq_sing]);
4040   ASM_MESON_TAC[];
4041   REWR 0;
4042   USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY]);
4043   ASM_MESON_TAC[];
4044   ]);;
4045   (* }}} *)
4046
4047 let mid_end_disj = prove_by_refinement(
4048   `!G m. ~(endpoint G m /\ midpoint G m)`,
4049   (* {{{ proof *)
4050   [
4051   REWRITE_TAC[endpoint;midpoint];
4052   ASM_MESON_TAC[ARITH_RULE `~(1=2)`];
4053   ]);;
4054   (* }}} *)
4055
4056 let two_exclusion  = prove_by_refinement(
4057   `!X p q (r:A). (X HAS_SIZE 2) /\ (X p) /\ (X q) /\ (X r) /\ (~(p = r))
4058     /\ (~(q = r)) ==> (p = q)`,
4059   (* {{{ proof *)
4060   [
4061   REWRITE_TAC[has_size2;];
4062   DISCH_ALL_TAC;
4063   CHO 0;
4064   CHO 0;
4065   UND 1;
4066   UND 2;
4067   UND 3;
4068   ASM_REWRITE_TAC[INSERT];
4069   ASM_MESON_TAC[];
4070   ]);;
4071   (* }}} *)
4072
4073 let midpoint_exists = prove_by_refinement(
4074   `!G e. (segment G) /\ (G e) /\ (~(G = {e})) ==>
4075       (?m. (closure top2 e (pointI m)) /\ (midpoint G m))`,
4076   (* {{{ proof *)
4077   [
4078   DISCH_ALL_TAC;
4079   PROOF_BY_CONTR_TAC;
4080   TYPE_THEN `!m. (closure top2 e (pointI m)) ==> (endpoint G m)` SUBGOAL_TAC;
4081   ASM_MESON_TAC[edge_midend];
4082   DISCH_TAC;
4083   UND 2;
4084   REWRITE_TAC[];
4085   UND 0;
4086   REWRITE_TAC[segment];
4087   DISCH_ALL_TAC;
4088   TSPEC `{e}` 7;
4089   UND 7;
4090   DISCH_THEN (IMATCH_MP_TAC  o GSYM);
4091   ASM_REWRITE_TAC[ISUBSET;INR IN_SING;];
4092   CONJ_TAC;
4093   ASM_MESON_TAC[];
4094   CONJ_TAC;
4095   REWRITE_TAC [eq_sing];
4096   DISCH_ALL_TAC;
4097   TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 C') = {(pointI m)})` SUBGOAL_TAC;
4098   IMATCH_MP_TAC  edge_inter;
4099   ASM_MESON_TAC[ISUBSET];
4100   DISCH_THEN CHOOSE_TAC;
4101   TSPEC `m` 4;
4102   TYPE_THEN `endpoint G m` SUBGOAL_TAC;
4103   UND 4;
4104   DISCH_THEN IMATCH_MP_TAC ;
4105   UND 10;
4106   REWRITE_TAC[eq_sing];
4107   REWRITE_TAC[INTER];
4108   MESON_TAC[];
4109   REWRITE_TAC[endpoint];
4110   USE 0 (MATCH_MP num_closure_size);
4111   TSPEC `(pointI m)` 0;
4112   DISCH_TAC;
4113   REWR 0;
4114   USE 0 (MATCH_MP CARD_SING_CONV);
4115   USE 0 (REWRITE_RULE[SING]);
4116   CHO 0;
4117   USE 0 (REWRITE_RULE[eq_sing]);
4118   USE 10 (REWRITE_RULE[eq_sing]);
4119   USE 10 (REWRITE_RULE[INTER]);
4120   ASM_MESON_TAC[];
4121   ]);;
4122   (* }}} *)
4123
4124 let pair_swap_unique = prove_by_refinement(
4125   `!u x (y:A). (u HAS_SIZE 2) /\ (u x) /\ (u y) /\ ~(x = y) ==>
4126     (y = pair_swap u x)`,
4127   (* {{{ proof *)
4128   [
4129   DISCH_ALL_TAC;
4130   IMATCH_MP_TAC  two_exclusion ;
4131   TYPE_THEN `u` EXISTS_TAC;
4132   TYPE_THEN `x` EXISTS_TAC;
4133   ASM_REWRITE_TAC[];
4134   ASM_MESON_TAC[pair_swap];
4135   ]);;
4136   (* }}} *)
4137
4138 let pair_swap_adj = prove_by_refinement(
4139   `!G e m e'. (segment G) /\ (G e) /\ (midpoint G m) /\
4140      (closure top2 e (pointI m)) /\
4141      (e' = pair_swap {C | G C /\ closure top2 C (pointI m)} e) ==>
4142      ({C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2) /\
4143              G e' /\ adj e' e /\ (closure top2 e' (pointI m)) `,
4144   (* {{{ proof *)
4145   [
4146   REP_GEN_TAC;
4147   TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC;
4148   DISCH_ALL_TAC;
4149   TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
4150   USE 3 (REWRITE_RULE[midpoint]);
4151   USE 1 (REWRITE_RULE[segment]);
4152   UND 1;
4153   DISCH_ALL_TAC;
4154   USE 1 (MATCH_MP num_closure_size);
4155   TSPEC `pointI m` 1;
4156   REWR 1;
4157   DISCH_TAC;
4158   CONJ_TAC;
4159   ASM_REWRITE_TAC[];
4160   TYPE_THEN `X e` SUBGOAL_TAC;
4161   EXPAND_TAC "X";
4162   ASM_REWRITE_TAC[];
4163   DISCH_TAC;
4164   (*  SUBCONJ_TAC; *)
4165   TYPE_THEN `X e'` SUBGOAL_TAC;
4166   ASM_MESON_TAC[pair_swap];
4167   DISCH_TAC;
4168   SUBCONJ_TAC;
4169   UND 8;
4170   EXPAND_TAC "X";
4171   REWRITE_TAC[];
4172   MESON_TAC[];
4173   DISCH_TAC;
4174   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
4175   SUBCONJ_TAC;
4176   UND 8;
4177   EXPAND_TAC "X";
4178   REWRITE_TAC[];
4179   MESON_TAC[];
4180   ASM_REWRITE_TAC[adj];
4181   ASM_SIMP_TAC[pair_swap];
4182   REWRITE_TAC[EMPTY_EXISTS];
4183   ASM_REWRITE_TAC[INTER];
4184   ASM_MESON_TAC[];
4185   ]);;
4186   (* }}} *)
4187
4188
4189 (*
4190    A terminal edge is expressed as
4191    (endpoint G m) /\ (closure top2 e (pointI m))
4192 *)
4193
4194 let terminal_edge_adj = prove_by_refinement(
4195   `!G e m. (segment G) /\ (G e) /\ (~(G = {e})) /\
4196      (endpoint G m) /\ (closure top2 e (pointI m))
4197      ==>
4198        (?! e'. (G e') /\ (adj e e')) `,
4199   (* {{{ proof *)
4200   [
4201   REP_GEN_TAC;
4202   DISCH_ALL_TAC;
4203   REWRITE_TAC[EXISTS_UNIQUE_ALT ];
4204   TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
4205   IMATCH_MP_TAC  midpoint_exists;
4206   ASM_REWRITE_TAC[];
4207   DISCH_THEN CHOOSE_TAC;
4208   AND 5;
4209   COPY 5;
4210   USE 5 (REWRITE_RULE[midpoint]);
4211   TYPE_THEN `FINITE G` SUBGOAL_TAC;
4212   ASM_MESON_TAC[segment];
4213   DISCH_TAC;
4214   USE 8 (MATCH_MP num_closure_size);
4215   TSPEC `pointI m'` 8;
4216   REWR 8;
4217   TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m')}` ABBREV_TAC;
4218   TYPE_THEN `X e` SUBGOAL_TAC;
4219   EXPAND_TAC "X";
4220   ASM_REWRITE_TAC[];
4221   DISCH_TAC;
4222   TYPE_THEN `pair_swap X e` EXISTS_TAC;
4223   GEN_TAC;
4224
4225   EQ_TAC;
4226   DISCH_ALL_TAC;
4227   TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 y) = {(pointI m)}) ` SUBGOAL_TAC;
4228   IMATCH_MP_TAC  edge_inter;
4229   ASM_MESON_TAC[segment;ISUBSET;];
4230   DISCH_THEN CHOOSE_TAC;
4231   (* show m''=m', then X y, then y != e, then it is the PAIR swap *)
4232   TYPE_THEN `ec = (closure top2 e)` ABBREV_TAC;
4233   TYPE_THEN `ec (pointI m'')` SUBGOAL_TAC;
4234   UND 13;
4235   REWRITE_TAC[eq_sing];
4236   REWRITE_TAC[INTER];
4237   ASM_MESON_TAC[];
4238   DISCH_TAC;
4239   TYPE_THEN `m'' = m'` SUBGOAL_TAC;
4240   TYPE_THEN `Z = {m | ec (pointI m)}` ABBREV_TAC;
4241   IMATCH_MP_TAC  two_exclusion;
4242   TYPE_THEN `Z` EXISTS_TAC;
4243   TYPE_THEN `m` EXISTS_TAC;
4244   CONJ_TAC;
4245   EXPAND_TAC "Z";
4246   EXPAND_TAC "ec";
4247   IMATCH_MP_TAC  two_endpoint;
4248   ASM_MESON_TAC[segment;ISUBSET];
4249   EXPAND_TAC "Z";
4250   ASM_REWRITE_TAC[];
4251   TYPE_THEN `midpoint G m''` SUBGOAL_TAC ;
4252   IMATCH_MP_TAC  inter_midpoint;
4253   TYPE_THEN `e` EXISTS_TAC;
4254   TYPE_THEN `y` EXISTS_TAC;
4255   ASM_REWRITE_TAC[INR IN_SING ];
4256   ASM_MESON_TAC[mid_end_disj]; (* m'' = m' done *)
4257   DISCH_TAC;
4258   TYPE_THEN `X y` SUBGOAL_TAC;
4259   EXPAND_TAC "X";
4260   ASM_REWRITE_TAC[];
4261   USE 13 (REWRITE_RULE[INTER;eq_sing]);
4262   ASM_MESON_TAC[];
4263   DISCH_TAC;
4264   TYPE_THEN `~(y = e)` SUBGOAL_TAC;
4265   UND 12;
4266   MESON_TAC[adj];
4267   DISCH_TAC;
4268   IMATCH_MP_TAC  (GSYM pair_swap_unique);
4269   ASM_REWRITE_TAC[];
4270   (* now second direction nsd *)
4271   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
4272   ASSUME_TAC pair_swap_adj;
4273   TYPEL_THEN [`G`;`e`;`m'`;`pair_swap X e`] (USE 11 o ISPECL);
4274   UND 11;
4275   ASM_REWRITE_TAC[];
4276   TYPE_THEN `X (pair_swap X e)` SUBGOAL_TAC;
4277   ASM_MESON_TAC[pair_swap];
4278   DISCH_TAC;
4279   TYPE_THEN `closure top2 (pair_swap X e) (pointI m')` SUBGOAL_TAC;
4280   UND 11;
4281   TYPE_THEN  `e'' = pair_swap X e` ABBREV_TAC ;
4282   EXPAND_TAC "X";
4283   REWRITE_TAC[];
4284   MESON_TAC[];
4285   ASM_MESON_TAC[adj_symm];
4286   ]);;
4287   (* }}} *)
4288
4289 let psegment_edge = prove_by_refinement(
4290   `!e. (edge e) ==> (psegment {e})`,
4291   (* {{{ proof *)
4292   [
4293   DISCH_ALL_TAC;
4294   IMATCH_MP_TAC  endpoint_psegment;
4295   ASM_REWRITE_TAC[endpoint;segment;EQ_EMPTY ;INR IN_SING;FINITE_SING;ISUBSET;num_closure];
4296   CONJ_TAC;
4297   UND 0;
4298   REWRITE_TAC[edge];
4299   DISCH_TAC ;
4300   CHO 0;
4301   TYPE_THEN `m` EXISTS_TAC;
4302   UND 0;
4303   DISCH_THEN DISJ_CASES_TAC;
4304   ASM_REWRITE_TAC[];
4305   IMATCH_MP_TAC  CARD_SING;
4306   REWRITE_TAC[SING];
4307   TYPE_THEN `v_edge m` EXISTS_TAC;
4308   REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ];
4309   MESON_TAC[];
4310   ASM_REWRITE_TAC[];
4311   IMATCH_MP_TAC  CARD_SING;
4312   REWRITE_TAC[SING];
4313   TYPE_THEN `h_edge m` EXISTS_TAC;
4314   REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ];
4315   MESON_TAC[];
4316   CONJ_TAC;
4317   MESON_TAC[];
4318   CONJ_TAC ;
4319   ASM_MESON_TAC[];
4320   CONJ_TAC;
4321   REWRITE_TAC[INSERT];
4322   GEN_TAC;
4323   TYPE_THEN `closure top2 e (pointI m)`  ASM_CASES_TAC ;
4324   DISJ1_TAC THEN DISJ2_TAC ;
4325   IMATCH_MP_TAC  CARD_SING;
4326   REWRITE_TAC[SING ;eq_sing];
4327   ASM_MESON_TAC[];
4328   DISJ2_TAC ;
4329   TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI m)} = {}` SUBGOAL_TAC;
4330   PROOF_BY_CONTR_TAC;
4331   USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
4332   CHO 2;
4333   ASM_MESON_TAC[];
4334   DISCH_THEN_REWRITE;
4335   REWRITE_TAC[CARD_CLAUSES];
4336   DISCH_ALL_TAC;
4337   REWRITE_TAC[eq_sing];
4338   ASM_MESON_TAC[];
4339   ]);;
4340   (* }}} *)
4341
4342 let segment_delete = prove_by_refinement(
4343   `!G e m. (segment G) /\ (endpoint G m) /\
4344         (closure top2 e (pointI m)) /\ (~(G = {e}))
4345                 ==> (segment (G DELETE e))`,
4346   (* {{{ proof *)
4347   [
4348   REP_GEN_TAC;
4349   TYPE_THEN `~G e` ASM_CASES_TAC;
4350   USE 0 (REWRITE_RULE[INR DELETE_NON_ELEMENT]);
4351   ASM_MESON_TAC[];
4352   REWRITE_TAC[segment];
4353   DISCH_ALL_TAC;
4354   ASM_REWRITE_TAC[FINITE_DELETE;delete_empty];
4355   CONJ_TAC;
4356   UND 3;
4357   MESON_TAC[ISUBSET ;INR IN_DELETE];
4358   CONJ_TAC;
4359   GEN_TAC;
4360   REWRITE_TAC[INSERT];
4361   TYPE_THEN `num_closure (G DELETE e) (pointI m')  <=| (num_closure G (pointI m'))` SUBGOAL_TAC;
4362   IMATCH_MP_TAC  num_closure_mono;
4363   ASM_REWRITE_TAC[INR IN_DELETE;ISUBSET];
4364   MESON_TAC[];
4365   TSPEC `m'` 4;
4366   USE 4 (REWRITE_RULE[INSERT]);
4367   UND 4;
4368   ARITH_TAC;
4369   DISCH_ALL_TAC;
4370   (* tsh1 *)
4371   TYPE_THEN `(?! e'. (G e') /\ (adj e e'))` SUBGOAL_TAC;
4372   IMATCH_MP_TAC  terminal_edge_adj;
4373   REWRITE_TAC[segment];
4374   TYPE_THEN `m` EXISTS_TAC;
4375   ASM_MESON_TAC[];
4376   REWRITE_TAC[EXISTS_UNIQUE_ALT];
4377   DISCH_THEN CHOOSE_TAC;
4378   (* tsh2 *)
4379   TYPE_THEN `(e INSERT S = G) ==> (S = G DELETE e)` SUBGOAL_TAC;
4380   UND 9;
4381   IMATCH_MP_TAC  (TAUT `(a ==> b ==> C) ==> (b ==> a ==> C)`);
4382   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
4383   REWRITE_TAC[DELETE_INSERT];
4384   REWRITE_TAC[DELETE;ISUBSET;];
4385   DISCH_TAC;
4386   IMATCH_MP_TAC  EQ_EXT;
4387   REWRITE_TAC[];
4388   UND 9;
4389   MESON_TAC[];
4390   DISCH_THEN IMATCH_MP_TAC ;
4391   (* tsh3 *)
4392   TYPE_THEN `S e'` ASM_CASES_TAC;
4393   TSPEC `e INSERT S` 5;
4394   UND 5;
4395   DISCH_THEN IMATCH_MP_TAC ;
4396   REWR 0;
4397   ASM_REWRITE_TAC [INR INSERT_SUBSET;NOT_INSERT_EMPTY];
4398   CONJ_TAC;
4399   UND 9;
4400   MESON_TAC[ISUBSET;INR IN_DELETE];
4401   DISCH_ALL_TAC;
4402   TSPEC `C` 11;
4403   TSPEC `C'` 11;
4404   REWR 11; (* ok to here *)
4405   (* oth1 *)
4406   TYPE_THEN `C' = e` ASM_CASES_TAC;
4407   ASM_REWRITE_TAC[INSERT];
4408   ASM_REWRITE_TAC[INSERT]; (* *)
4409   (* UND 12; *)
4410   TYPE_THEN `C = e` ASM_CASES_TAC;
4411   REWR 15;
4412   TSPEC `C'` 12;
4413   REWR 12;
4414   ASM_MESON_TAC[];
4415   (* start not not -- *)
4416   UND 11;
4417   DISCH_THEN IMATCH_MP_TAC ;
4418   CONJ_TAC;
4419   UND 5;
4420   REWRITE_TAC[INSERT];
4421   ASM_MESON_TAC[];
4422   UND 14;
4423   REWRITE_TAC[DELETE];
4424   ASM_MESON_TAC[];
4425   (* LAST case *)
4426   TSPEC `S` 5;
4427   TYPE_THEN `S = G` SUBGOAL_TAC;
4428   UND 5;
4429   DISCH_THEN IMATCH_MP_TAC ;
4430   ASM_REWRITE_TAC[];
4431   SUBCONJ_TAC;
4432   UND 9;
4433   REWRITE_TAC[DELETE;ISUBSET];
4434   MESON_TAC[];
4435   DISCH_TAC;
4436   DISCH_ALL_TAC;
4437   TYPEL_THEN [`C`;`C'`] (USE 11 o ISPECL);
4438   UND 11;
4439   DISCH_THEN IMATCH_MP_TAC ;
4440   ASM_REWRITE_TAC[];
4441   REWRITE_TAC[DELETE];
4442   ASM_REWRITE_TAC[];
4443   DISCH_ALL_TAC;
4444   TSPEC `C` 12;
4445   TYPE_THEN `G C /\ adj e C` SUBGOAL_TAC;
4446   ASM_MESON_TAC[adj_symm;ISUBSET];
4447   DISCH_TAC;
4448   REWR 12;
4449   ASM_MESON_TAC[];
4450   TSPEC `e'` 12;
4451   ASM_MESON_TAC[];
4452   ]);;
4453   (* }}} *)
4454
4455 let other_end = jordan_def `other_end e m =
4456   pair_swap {m | closure top2 e (pointI m)} m`;;
4457
4458 let other_end_prop = prove_by_refinement(
4459   `!e m. (edge e) /\ (closure top2 e (pointI m))==>
4460    (closure top2 e (pointI (other_end e m))) /\
4461       (~(other_end e m = m)) /\
4462       (other_end e (other_end e m) = m)`,
4463   (* {{{ proof *)
4464   [
4465   REWRITE_TAC[other_end];
4466   DISCH_ALL_TAC;
4467   USE 0 (MATCH_MP two_endpoint);
4468   TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC;
4469   TYPE_THEN `X m` SUBGOAL_TAC;
4470   EXPAND_TAC "X";
4471   ASM_REWRITE_TAC [];
4472   DISCH_TAC;
4473   ASM_SIMP_TAC[pair_swap_invol;pair_swap];
4474   TYPE_THEN `X (pair_swap X m)` SUBGOAL_TAC ;
4475   ASM_SIMP_TAC[pair_swap];
4476   EXPAND_TAC "X";
4477   REWRITE_TAC[];
4478   ]);;
4479   (* }}} *)
4480
4481 let num_closure_delete = prove_by_refinement(
4482   `!G e p. (FINITE G) ==> ((num_closure (G DELETE e) p) =
4483     (if ((G e) /\ (closure top2 e p)) then ((num_closure G p) -| 1)
4484        else (num_closure G p)))`,
4485   (* {{{ proof *)
4486   [
4487   DISCH_ALL_TAC;
4488   COND_CASES_TAC;
4489   REWRITE_TAC[num_closure];
4490   TYPE_THEN `{C | (G DELETE e) C /\ closure top2 C p} = {C | G C /\ closure top2 C p} DELETE e` SUBGOAL_TAC;
4491   IMATCH_MP_TAC  EQ_EXT;
4492   REWRITE_TAC[DELETE ];
4493   ASM_MESON_TAC[];
4494   DISCH_THEN_REWRITE;
4495   TYPE_THEN `FINITE {C | G C /\ closure top2 C p}` SUBGOAL_TAC;
4496   IMATCH_MP_TAC  FINITE_SUBSET;
4497   TYPE_THEN `G` EXISTS_TAC;
4498   ASM_REWRITE_TAC[ISUBSET;];
4499   MESON_TAC[];
4500   DISCH_TAC;
4501   USE 2 (MATCH_MP CARD_DELETE);
4502   TSPEC `e` 2;
4503   ASM_REWRITE_TAC[];
4504   REWRITE_TAC[num_closure;DELETE ];
4505   AP_TERM_TAC;
4506   IMATCH_MP_TAC  EQ_EXT;
4507   REWRITE_TAC[];
4508   GEN_TAC;
4509   TYPE_THEN `x = e` ASM_CASES_TAC;
4510   ASM_REWRITE_TAC[];
4511   ASM_REWRITE_TAC[];
4512   ]);;
4513   (* }}} *)
4514
4515 let psegment_delete_end = prove_by_refinement(
4516   `!G m e. (psegment G) /\ (endpoint G m) /\ (G e) /\
4517         (closure top2 e (pointI m)) /\ (~(G = {e})) ==>
4518      (endpoint (G DELETE e) =
4519        (((other_end e m) INSERT (endpoint G)) DELETE m))`,
4520   (* {{{ proof *)
4521   [
4522   DISCH_ALL_TAC;
4523   TYPE_THEN `FINITE G` SUBGOAL_TAC;
4524   ASM_MESON_TAC[psegment;segment];
4525   DISCH_TAC;
4526   TYPE_THEN `edge e` SUBGOAL_TAC;
4527   ASM_MESON_TAC[psegment;segment;ISUBSET];
4528   DISCH_TAC;
4529   TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC;
4530   TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
4531   EXPAND_TAC "X";
4532   IMATCH_MP_TAC  two_endpoint;
4533   ASM_REWRITE_TAC[];
4534   DISCH_TAC;
4535   IMATCH_MP_TAC  SUBSET_ANTISYM;
4536   CONJ_TAC;
4537   REWRITE_TAC[endpoint;ISUBSET;INSERT;];
4538   GEN_TAC;
4539   ASM_SIMP_TAC[num_closure_delete];
4540   REWRITE_TAC[DELETE];
4541   TYPE_THEN `x = m` ASM_CASES_TAC;
4542   ASM_REWRITE_TAC[];
4543   USE 1 (REWRITE_RULE[endpoint]);
4544   ASM_REWRITE_TAC[];
4545   ARITH_TAC;
4546   ASM_REWRITE_TAC[];
4547   TYPE_THEN `x = other_end e m` ASM_CASES_TAC;
4548   ASM_REWRITE_TAC[];
4549   ASM_REWRITE_TAC[];
4550   COND_CASES_TAC;
4551   DISCH_TAC;
4552   TYPE_THEN `X x /\ X m /\ X (other_end e m) /\ (~(m= other_end e m))` SUBGOAL_TAC ;
4553   EXPAND_TAC "X";
4554   ASM_REWRITE_TAC[];
4555   ASM_MESON_TAC[other_end_prop];
4556   DISCH_ALL_TAC;
4557   ASM_MESON_TAC[two_exclusion];
4558   MESON_TAC[];
4559   (* snd half *)
4560   REWRITE_TAC[SUBSET;endpoint;DELETE_INSERT];
4561   ASM_SIMP_TAC[other_end_prop];
4562   ASM_SIMP_TAC[num_closure_delete];
4563   REWRITE_TAC[INSERT;DELETE ];
4564   GEN_TAC;
4565   TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
4566   ASM_MESON_TAC[psegment;midpoint_exists];
4567   DISCH_THEN CHOOSE_TAC;
4568   DISCH_THEN DISJ_CASES_TAC;
4569   (* ---m *)
4570   COND_CASES_TAC;
4571   TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m' = m)) /\ (~(x = m'))` SUBGOAL_TAC;
4572   EXPAND_TAC "X";
4573   ASM_REWRITE_TAC[];
4574   ASM_MESON_TAC[mid_end_disj];
4575   ASM_MESON_TAC[two_exclusion];
4576   USE 10 (REWRITE_RULE[endpoint]);
4577   ASM_MESON_TAC[];
4578   ASM_REWRITE_TAC[];
4579   ASM_SIMP_TAC[other_end_prop];
4580   TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m = m'))` SUBGOAL_TAC;
4581    EXPAND_TAC "X";
4582   ASM_REWRITE_TAC[];
4583   ASM_SIMP_TAC[other_end_prop];
4584   ASM_MESON_TAC[mid_end_disj];
4585   DISCH_TAC;
4586   TYPE_THEN `x = m'` SUBGOAL_TAC;
4587   ASM_MESON_TAC[two_exclusion];
4588   USE 9 (REWRITE_RULE[midpoint]);
4589   ASM_MESON_TAC[ARITH_RULE `(x = 2) ==> (x -| 1 = 1)`];
4590   ]);;
4591   (* }}} *)
4592
4593 let endpoint_size2 = prove_by_refinement(
4594   `!G. (psegment G) ==> (endpoint G HAS_SIZE 2)`,
4595   (* {{{ proof *)
4596   [
4597   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;
4598   DISCH_ALL_TAC;
4599   DISCH_ALL_TAC;
4600   TYPE_THEN `?n. G HAS_SIZE n` SUBGOAL_TAC;
4601   REWRITE_TAC[HAS_SIZE];
4602   CONV_TAC (dropq_conv "n");
4603   ASM_MESON_TAC[psegment;segment];
4604   DISCH_THEN CHOOSE_TAC;
4605   ASM_MESON_TAC[];
4606   DISCH_THEN IMATCH_MP_TAC ;
4607   INDUCT_TAC;
4608   REWRITE_TAC[psegment;segment];
4609   ASM_MESON_TAC[HAS_SIZE_0];
4610   DISCH_ALL_TAC;
4611   TYPE_THEN `(?m. (endpoint G m))` SUBGOAL_TAC;
4612   ASM_SIMP_TAC[psegment_endpoint];
4613   DISCH_THEN CHOOSE_TAC;
4614   TYPE_THEN `FINITE G` SUBGOAL_TAC ;
4615   ASM_MESON_TAC[psegment;segment];
4616   DISCH_TAC;
4617   TYPE_THEN `?e. (G e /\ closure top2 e (pointI m))` SUBGOAL_TAC;
4618   USE 3 (REWRITE_RULE[endpoint]);
4619   USE 4 (MATCH_MP num_closure_size);
4620   TSPEC `(pointI m)` 4;
4621   REWR 4;
4622   USE 4 (MATCH_MP CARD_SING_CONV);
4623   USE 4(REWRITE_RULE[SING]);
4624   CHO 4;
4625   USE 4 (REWRITE_RULE[eq_sing]);
4626   ASM_MESON_TAC[];
4627   DISCH_THEN CHOOSE_TAC;
4628   TYPE_THEN `G = {e}` ASM_CASES_TAC;
4629   TYPE_THEN `endpoint G = { m | closure top2 e (pointI m)}` SUBGOAL_TAC;
4630   MATCH_MP_TAC  EQ_EXT;
4631   REWRITE_TAC[endpoint];
4632   USE 4 (MATCH_MP num_closure_size );
4633   GEN_TAC;
4634   TSPEC `pointI x` 4;
4635   REWR 4;
4636   USE 4 (REWRITE_RULE[INR IN_SING]);
4637   EQ_TAC;
4638   DISCH_TAC;
4639   REWR 4;
4640   USE 4 (MATCH_MP CARD_SING_CONV);
4641   USE 4(REWRITE_RULE[SING;eq_sing]);
4642   ASM_MESON_TAC[];
4643   DISCH_TAC;
4644   TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI x)} ={e}` SUBGOAL_TAC;
4645   IMATCH_MP_TAC  EQ_EXT;
4646   REWRITE_TAC[INR IN_SING ];
4647   ASM_MESON_TAC[];
4648   DISCH_TAC;
4649   REWR 4;
4650   USE 4 (REWRITE_RULE[HAS_SIZE]);
4651   ASM_MESON_TAC[CARD_SING;SING];
4652   DISCH_THEN_REWRITE;
4653   IMATCH_MP_TAC  two_endpoint;
4654   ASM_MESON_TAC[psegment;segment;ISUBSET];
4655   (*pm*)
4656   (* main case *)
4657   TYPE_THEN `edge e` SUBGOAL_TAC;
4658   ASM_MESON_TAC[psegment;segment;ISUBSET];
4659   DISCH_TAC;
4660   TSPEC `G DELETE e` 0;
4661   TYPE_THEN `psegment (G DELETE e) /\ G DELETE e HAS_SIZE n` SUBGOAL_TAC;
4662   CONJ_TAC;
4663   REWRITE_TAC[psegment];
4664   CONJ_TAC;
4665   IMATCH_MP_TAC  segment_delete;
4666   TYPE_THEN `m` EXISTS_TAC;
4667   ASM_REWRITE_TAC[psegment];
4668   ASM_MESON_TAC[psegment];
4669   (* it isn't a rectagon if it has an endpoint *)
4670   TYPE_THEN `(endpoint (G DELETE e) (other_end e m)) ` SUBGOAL_TAC;
4671   ASM_SIMP_TAC[psegment_delete_end];
4672   REWRITE_TAC[DELETE_INSERT];
4673   COND_CASES_TAC;
4674   ASM_MESON_TAC[other_end_prop];
4675   REWRITE_TAC[INSERT];
4676   ASM_MESON_TAC[rectagon_endpoint];
4677   UND 2;
4678   REWRITE_TAC[HAS_SIZE];
4679   ASM_MESON_TAC[SUC_INJ;FINITE_DELETE_IMP;CARD_SUC_DELETE];
4680   DISCH_TAC;
4681   REWR 0;
4682   UND 0;
4683   ASM_SIMP_TAC[psegment_delete_end];
4684   DISCH_TAC;
4685   TYPE_THEN `G' = (other_end e m INSERT endpoint G)` ABBREV_TAC;
4686   TYPE_THEN `G' HAS_SIZE 3` SUBGOAL_TAC;
4687   UND 0;
4688   REWRITE_TAC[HAS_SIZE;ARITH_RULE `3 = SUC 2`;FINITE_DELETE];
4689   TYPE_THEN `G' m` SUBGOAL_TAC;
4690   EXPAND_TAC "G'";
4691   KILL 9;
4692   ASM_REWRITE_TAC [INSERT];
4693   ASM_MESON_TAC[CARD_SUC_DELETE];
4694   (* nearly there! *)
4695   EXPAND_TAC "G'";
4696   REWRITE_TAC[HAS_SIZE;FINITE_INSERT];
4697   DISCH_ALL_TAC;
4698   UND 11;
4699   ASM_SIMP_TAC [CARD_CLAUSES];
4700   COND_CASES_TAC;
4701   TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
4702   IMATCH_MP_TAC  midpoint_exists;
4703   ASM_MESON_TAC[psegment];
4704   DISCH_THEN CHOOSE_TAC;
4705   TYPE_THEN `X = { m | closure top2 e (pointI m) }` ABBREV_TAC;
4706   TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
4707   USE 7 (MATCH_MP two_endpoint);
4708   EXPAND_TAC "X";
4709   ASM_REWRITE_TAC[];
4710   DISCH_TAC;
4711   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;
4712   EXPAND_TAC "X";
4713   ASM_REWRITE_TAC[];
4714   ASM_SIMP_TAC[other_end_prop];
4715   ASM_MESON_TAC [mid_end_disj];
4716   ASM_MESON_TAC[two_exclusion];
4717   ARITH_TAC;
4718   ]);;
4719   (* }}} *)
4720
4721 let sing_has_size1 = prove_by_refinement(
4722   `!(x:A). {x} HAS_SIZE 1`,
4723   (* {{{ proof *)
4724   [
4725   REWRITE_TAC[HAS_SIZE];
4726   DISCH_ALL_TAC;
4727   CONJ_TAC;
4728   REWRITE_TAC[FINITE_SING ];
4729   ASM_MESON_TAC[CARD_SING;SING];
4730   ]);;
4731   (* }}} *)
4732
4733 let num_closure1 = prove_by_refinement(
4734   `!G x. (FINITE G) ==>
4735        ((num_closure G (x) = 1) <=>
4736           (?e. (!e'. (G e' /\ (closure top2 e' (x))) <=> (e = e'))))`,
4737   (* {{{ proof *)
4738   [
4739   DISCH_ALL_TAC;
4740   COPY 0;
4741   USE 0 (MATCH_MP (num_closure_size));
4742   TSPEC `x` 0;
4743   TYPE_THEN `t = num_closure G x` ABBREV_TAC;
4744   EQ_TAC;
4745   DISCH_TAC;
4746   REWR 0;
4747   USE 0 (MATCH_MP CARD_SING_CONV);
4748   USE 0 (REWRITE_RULE[SING;eq_sing]);
4749   CHO 0;
4750   TYPE_THEN `x'` EXISTS_TAC;
4751   ASM_MESON_TAC[];
4752   DISCH_TAC;
4753   CHO 3;
4754   TYPE_THEN `{C | G C /\ closure top2 C x} = {e}` SUBGOAL_TAC;
4755   REWRITE_TAC[eq_sing];
4756   ASM_MESON_TAC[];
4757   DISCH_TAC;
4758   REWR 0;
4759   TYPE_THEN `e` (fun t -> ASSUME_TAC (ISPEC t sing_has_size1));
4760   UND 5;
4761   UND 0;
4762   REWRITE_TAC [HAS_SIZE];
4763   MESON_TAC[];
4764   ]);;
4765   (* }}} *)
4766
4767
4768 (* ------------------------------------------------------------------ *)
4769 (* SECTION D *)
4770 (* ------------------------------------------------------------------ *)
4771
4772
4773
4774 let inductive_set = jordan_def `inductive_set G S <=>
4775    S SUBSET G /\
4776               ~(S = {}) /\
4777               (!C C'. S C /\ G C' /\ adj C C' ==> S C')`;;
4778
4779 let inductive_univ = prove_by_refinement(
4780   `!G. (~(G = EMPTY )) ==> (inductive_set G G)`,
4781   (* {{{ proof *)
4782   [
4783   REWRITE_TAC[inductive_set];
4784   DISCH_ALL_TAC;
4785   ASM_REWRITE_TAC[SUBSET_REFL];
4786   ASM_MESON_TAC[];
4787   ]);;
4788   (* }}} *)
4789
4790 let inductive_inter = prove_by_refinement(
4791   `!T G. (T SUBSET G) /\ (~(T = EMPTY )) ==>
4792         (inductive_set G
4793             (INTERS {S | (T SUBSET S) /\ (inductive_set G S)}))`,
4794   (* {{{ proof *)
4795   [
4796   DISCH_ALL_TAC;
4797   ONCE_REWRITE_TAC[inductive_set];
4798   CONJ_TAC;
4799   IMATCH_MP_TAC  INTERS_SUBSET2;
4800   TYPE_THEN `G` EXISTS_TAC;
4801   ASM_REWRITE_TAC[SUBSET_REFL];
4802   IMATCH_MP_TAC  inductive_univ;
4803   UND 1;
4804   REWRITE_TAC[EMPTY_EXISTS];
4805   ASM_MESON_TAC[ISUBSET];
4806   CONJ_TAC;
4807   USE 1 (REWRITE_RULE[EMPTY_EXISTS]);
4808   CHO 1;
4809   REWRITE_TAC[EMPTY_EXISTS];
4810   TYPE_THEN `u` EXISTS_TAC;
4811   REWRITE_TAC[INTERS];
4812   DISCH_ALL_TAC;
4813   ASM_MESON_TAC[ISUBSET];
4814   DISCH_ALL_TAC;
4815   USE  2 (REWRITE_RULE[INTERS]);
4816   REWRITE_TAC[INTERS];
4817   DISCH_ALL_TAC;
4818   TSPEC `u` 2;
4819   REWR 2;
4820   ASM_MESON_TAC[inductive_set];
4821   ]);;
4822   (* }}} *)
4823
4824 let segment_of = jordan_def `segment_of G e =
4825    INTERS { S | S e /\ inductive_set G S }`;;
4826
4827 let inductive_segment = prove_by_refinement(
4828   `!G e. (G e) ==> (inductive_set G (segment_of G e))`,
4829   (* {{{ proof *)
4830   [
4831   DISCH_ALL_TAC;
4832   REWRITE_TAC[segment_of];
4833   ASSUME_TAC inductive_inter;
4834   TYPEL_THEN [`{e}`;`G`] (USE 1 o ISPECL);
4835   USE 1 (REWRITE_RULE[single_subset;EMPTY_EXISTS;INR IN_SING ]);
4836   UND 1;
4837   DISCH_THEN IMATCH_MP_TAC ;
4838   ASM_MESON_TAC[];
4839   ]);;
4840   (* }}} *)
4841
4842 let segment_of_G = prove_by_refinement(
4843   `!G e. (G e) ==> (segment_of G e ) SUBSET G`,
4844   (* {{{ proof *)
4845   [
4846   REWRITE_TAC[segment_of];
4847   DISCH_ALL_TAC;
4848   IMATCH_MP_TAC  (INR INTERS_SUBSET2 );
4849   TYPE_THEN `G` EXISTS_TAC;
4850   ASM_REWRITE_TAC[SUBSET_REFL];
4851   IMATCH_MP_TAC  inductive_univ;
4852   REWRITE_TAC [EMPTY_EXISTS];
4853   ASM_MESON_TAC[];
4854   ]);;
4855   (* }}} *)
4856
4857 let segment_not_in = prove_by_refinement(
4858   `!G e. ~(G e) ==> (segment_of G e = UNIV)`,
4859   (* {{{ proof *)
4860   [
4861   REWRITE_TAC[segment_of;];
4862   DISCH_ALL_TAC;
4863   TYPE_THEN `{S | S e /\ inductive_set G S} = EMPTY ` SUBGOAL_TAC ;
4864   REWRITE_TAC[EQ_EMPTY];
4865   GEN_TAC;
4866   REWRITE_TAC[inductive_set];
4867   ASM_MESON_TAC[ISUBSET];
4868   DISCH_THEN_REWRITE;
4869   ]);;
4870   (* }}} *)
4871
4872 let segment_of_finite = prove_by_refinement(
4873   `!G e. (FINITE G) /\ (G e) ==> (FINITE (segment_of G e))`,
4874   (* {{{ proof *)
4875   [
4876   DISCH_ALL_TAC;
4877   IMATCH_MP_TAC  FINITE_SUBSET;
4878   ASM_MESON_TAC[segment_of_G];
4879   ]);;
4880   (* }}} *)
4881
4882 let segment_of_in = prove_by_refinement(
4883   `!G e.  (segment_of G e e)`,
4884   (* {{{ proof *)
4885   [
4886   DISCH_ALL_TAC;
4887   TYPE_THEN `G e` ASM_CASES_TAC;
4888   REWRITE_TAC[segment_of;INTERS;inductive_set ];
4889   MESON_TAC[];
4890   ASM_SIMP_TAC[segment_not_in];
4891   ]);;
4892   (* }}} *)
4893
4894 let segment_of_subset = prove_by_refinement(
4895   `!G e f. (G e) /\ (segment_of G e f) ==>
4896       (segment_of G f) SUBSET (segment_of G e)`,
4897   (* {{{ proof *)
4898   [
4899   REWRITE_TAC[ISUBSET;segment_of;INTERS ];
4900   DISCH_ALL_TAC;
4901   DISCH_ALL_TAC;
4902   DISCH_ALL_TAC;
4903   ASM_MESON_TAC[];
4904   ]);;
4905   (* }}} *)
4906
4907 let inductive_diff = prove_by_refinement(
4908   `!G S S'. (inductive_set G S) /\
4909         (inductive_set G S') /\ ~(S DIFF S' = {}) ==>
4910         (inductive_set G (S DIFF S'))`,
4911   (* {{{ proof *)
4912   [
4913   REWRITE_TAC[inductive_set;DIFF;SUBSET  ];
4914   ASM_MESON_TAC[adj_symm];
4915   ]);;
4916   (* }}} *)
4917
4918 (* sets *)
4919 let subset_imp_eq = prove_by_refinement(
4920   `!A (B:A->bool). (A SUBSET B) /\ (B DIFF A = EMPTY) ==> (A = B)`,
4921   (* {{{ proof *)
4922   [
4923   REWRITE_TAC[SUBSET;DIFF;EQ_EMPTY];
4924   MESON_TAC[EQ_EXT];
4925   ]);;
4926   (* }}} *)
4927
4928 let segment_of_eq = prove_by_refinement(
4929   `!G e f. (G e) /\ (segment_of G e f) ==>
4930       ((segment_of G e) = (segment_of G f))`,
4931   (* {{{ proof *)
4932   [
4933   DISCH_ALL_TAC;
4934   IMATCH_MP_TAC  (GSYM subset_imp_eq);
4935   CONJ_TAC;
4936   ASM_MESON_TAC[segment_of_subset];
4937   PROOF_BY_CONTR_TAC;
4938   TYPE_THEN `G f` SUBGOAL_TAC;
4939   USE 0 (MATCH_MP segment_of_G);
4940   USE 0 (REWRITE_RULE[SUBSET]);
4941   ASM_MESON_TAC[];
4942   DISCH_TAC;
4943   TYPE_THEN `X = (segment_of G e DIFF segment_of G f)` ABBREV_TAC;
4944   TYPE_THEN `X e` SUBGOAL_TAC;
4945   EXPAND_TAC "X";
4946   REWRITE_TAC[DIFF];
4947   ASM_SIMP_TAC [segment_of_in];
4948   DISCH_ALL_TAC;
4949   USE 2 (GSYM);
4950   USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
4951   CHO 2;
4952   UND 2;
4953   EXPAND_TAC "X";
4954   REWRITE_TAC[DIFF];
4955   JOIN 3 5;
4956   USE 2 (MATCH_MP segment_of_subset);
4957   ASM_MESON_TAC[ISUBSET]; (* done WITH X e *)
4958   DISCH_TAC;
4959   TYPE_THEN `inductive_set G (segment_of G e DIFF segment_of G f)` SUBGOAL_TAC ;
4960   IMATCH_MP_TAC  inductive_diff;
4961   ASM_SIMP_TAC[inductive_segment];
4962   DISCH_TAC;
4963   TYPE_THEN `segment_of G e SUBSET X` SUBGOAL_TAC;
4964   REWRITE_TAC[segment_of];
4965   IMATCH_MP_TAC  INTERS_SUBSET;
4966   REWRITE_TAC[];
4967   ASM_REWRITE_TAC[];
4968   ASM_MESON_TAC[];
4969   REWRITE_TAC[SUBSET];
4970   LEFT_TAC "x";
4971   TYPE_THEN `f` EXISTS_TAC;
4972   EXPAND_TAC "X";
4973   REWRITE_TAC[DIFF];
4974   ASM_MESON_TAC[segment_of_in];
4975   ]);;
4976   (* }}} *)
4977
4978 let segment_of_segment = prove_by_refinement(
4979   `!G P e. (segment G) /\ (P SUBSET G) /\ (P e) ==>
4980       (segment (segment_of P e))`,
4981   (* {{{ proof *)
4982   [
4983   DISCH_ALL_TAC;
4984   TYPE_THEN `FINITE G` SUBGOAL_TAC;
4985   ASM_MESON_TAC[segment];
4986   DISCH_TAC;
4987   TYPE_THEN `FINITE P` SUBGOAL_TAC;
4988   ASM_MESON_TAC[FINITE_SUBSET];
4989   DISCH_TAC;
4990   REWRITE_TAC[segment];
4991   ASM_SIMP_TAC[segment_of_finite;EMPTY_EXISTS];
4992   CONJ_TAC;
4993   ASM_MESON_TAC[segment_of_in];
4994   SUBCONJ_TAC;
4995   UND 1;
4996   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
4997   ASM_MESON_TAC[segment];
4998   MP_TAC  segment_of_G;
4999   REWRITE_TAC[SUBSET];
5000   ASM_MESON_TAC[];
5001   DISCH_TAC;
5002   ASSUME_TAC segment_of_G;
5003   (* ok to here *)
5004   CONJ_TAC;
5005   GEN_TAC;
5006   REWRITE_TAC[INSERT];
5007   TYPEL_THEN [`P`;`e`] (USE 6 o ISPECL);
5008   REWR 6;
5009   JOIN 4 6;
5010   USE 4 (MATCH_MP num_closure_mono);
5011   TSPEC `pointI m` 4;
5012   UND 4;
5013   JOIN 3 1;
5014   USE 1 (MATCH_MP num_closure_mono);
5015   TSPEC `(pointI m)` 1;
5016   UND 1;
5017   UND 0;
5018   REWRITE_TAC[segment];
5019   REWRITE_TAC[INSERT];
5020   DISCH_ALL_TAC;
5021   TSPEC `m` 7;
5022   UND 7;
5023   UND 0;
5024   UND 1;
5025   ARITH_TAC;
5026   (* ok2 *)
5027   DISCH_ALL_TAC;
5028   CHO 8;
5029   (* IMATCH_MP_TAC  subset_imp_eq; *)
5030   IMATCH_MP_TAC  SUBSET_ANTISYM;
5031   ASM_REWRITE_TAC[];
5032   (*   PROOF_BY_CONTR_TAC; *)
5033   TYPE_THEN `! C C'. S C /\ P C' /\ adj C C' ==> S C'` SUBGOAL_TAC;
5034   DISCH_ALL_TAC;
5035   TYPE_THEN `segment_of P C C'` SUBGOAL_TAC;
5036   REWRITE_TAC[segment_of;INTERS;];
5037   X_GEN_TAC `R:((num->real)->bool)->bool`;
5038   REWRITE_TAC[inductive_set];
5039   DISCH_ALL_TAC;
5040   ASM_MESON_TAC[];
5041   TYPE_THEN `segment_of P e = segment_of P C` SUBGOAL_TAC ;
5042   IMATCH_MP_TAC  segment_of_eq;
5043   ASM_MESON_TAC[ISUBSET];
5044   DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]);
5045   ASM_MESON_TAC[];
5046   DISCH_TAC;
5047   TYPE_THEN `inductive_set P S` SUBGOAL_TAC;
5048   REWRITE_TAC[inductive_set];
5049   ASM_REWRITE_TAC[EMPTY_EXISTS];
5050   ASM_MESON_TAC[ISUBSET;segment_of_G];
5051   TYPE_THEN `segment_of P e = segment_of P u` SUBGOAL_TAC;
5052   IMATCH_MP_TAC  segment_of_eq;
5053   ASM_MESON_TAC[ISUBSET];
5054   DISCH_TAC;
5055   ASM_REWRITE_TAC[];
5056   REWRITE_TAC[segment_of];
5057   DISCH_TAC;
5058   IMATCH_MP_TAC  (INR INTERS_SUBSET);
5059   ASM_REWRITE_TAC[];
5060   ]);;
5061   (* }}} *)
5062
5063 (* move up *)
5064 let rectagon_subset = prove_by_refinement(
5065   `!G S. (rectagon G) /\ (segment S) /\ (G SUBSET S) ==> (G = S)`,
5066   (* {{{ proof *)
5067
5068   [
5069   REWRITE_TAC[rectagon;segment];
5070   DISCH_ALL_TAC;
5071   TSPEC `G` 9;
5072   UND 9 ;
5073   DISCH_THEN IMATCH_MP_TAC ;
5074   ASM_REWRITE_TAC[];
5075   DISCH_ALL_TAC;
5076   TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
5077   ASM_MESON_TAC[ISUBSET];
5078   DISCH_TAC;
5079   TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC;
5080   ASM_MESON_TAC[edge_inter];
5081   DISCH_TAC;
5082   CHO 14;
5083   (*loss*)
5084   COPY 10;
5085   COPY 5;
5086   JOIN 5 10;
5087   USE 5 (MATCH_MP num_closure_mono);
5088   TSPEC `pointI m` 5;
5089   TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC;
5090   TSPEC `m` 3;
5091   USE 3 (REWRITE_RULE[INSERT]);
5092   UND 3;
5093   DISCH_THEN DISJ_CASES_TAC;
5094   ASM_REWRITE_TAC[];
5095   PROOF_BY_CONTR_TAC;
5096   UND 3;
5097   USE 0 (MATCH_MP num_closure_size);
5098   TSPEC  `(pointI m)` 0;
5099   DISCH_ALL_TAC;
5100   REWR 0;
5101   USE 0 (REWRITE_RULE[HAS_SIZE_0]);
5102   UND 0;
5103   REWRITE_TAC[EMPTY_EXISTS ];
5104   UND 14;
5105   REWRITE_TAC[INTER;eq_sing; ];
5106   ASM_MESON_TAC[];
5107   DISCH_TAC;
5108   TYPE_THEN `num_closure S (pointI m) = 2` SUBGOAL_TAC;
5109   TSPEC `m` 8;
5110   USE 8(REWRITE_RULE[INSERT]);
5111   UND 8;
5112   TSPEC `m` 3;
5113   USE 3 (REWRITE_RULE[INSERT]);
5114   UND 3;
5115   UND 5;
5116   UND 10;
5117   ARITH_TAC;
5118   DISCH_TAC;
5119   (* ok  *)
5120   (* num_closure G = num_closure S, C' in latter, so in former *)
5121   TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} = {C | S C /\ closure top2 C (pointI m)}`  SUBGOAL_TAC;
5122   IMATCH_MP_TAC  CARD_SUBSET_LE;
5123   CONJ_TAC;
5124   IMATCH_MP_TAC  FINITE_SUBSET;
5125   TYPE_THEN `S` EXISTS_TAC;
5126   ASM_REWRITE_TAC[SUBSET];
5127   MESON_TAC[];
5128   CONJ_TAC;
5129   UND 15;
5130   REWRITE_TAC[SUBSET];
5131   MESON_TAC[];
5132   USE 0 (MATCH_MP num_closure_size);
5133   TSPEC `pointI m` 0;
5134   USE 16 (MATCH_MP num_closure_size);
5135   TSPEC `pointI m` 16;
5136   UND 16;
5137   UND 0;
5138   ASM_REWRITE_TAC [HAS_SIZE];
5139   DISCH_ALL_TAC;
5140   ASM_REWRITE_TAC[];
5141   ARITH_TAC;
5142   DISCH_TAC;
5143   TAPP `C'` 18;
5144   UND 18;
5145   ASM_REWRITE_TAC[];
5146   UND 14;
5147   REWRITE_TAC[INTER;eq_sing];
5148   MESON_TAC[];
5149   ]);;
5150
5151   (* }}} *)
5152
5153 let rectagon_h_edge = prove_by_refinement(
5154   `!G. (rectagon G) ==> (?m. (G (h_edge m)))`,
5155   (* {{{ proof *)
5156   [
5157   DISCH_ALL_TAC;
5158   PROOF_BY_CONTR_TAC;
5159   TYPE_THEN `!e. G e ==> (?m. (e= (v_edge m))) ` SUBGOAL_TAC;
5160   DISCH_ALL_TAC;
5161   TYPE_THEN `edge e` SUBGOAL_TAC;
5162   ASM_MESON_TAC[rectagon;ISUBSET];
5163   REWRITE_TAC[edge];
5164   DISCH_THEN (CHOOSE_THEN MP_TAC);
5165   DISCH_THEN DISJ_CASES_TAC;
5166   ASM_MESON_TAC[];
5167   ASM_MESON_TAC[];
5168   DISCH_TAC;
5169   TYPE_THEN `X = {m | (G (v_edge m)) }` ABBREV_TAC;
5170   TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC;
5171   CONJ_TAC;
5172   TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (v_edge) C)` SUBGOAL_TAC ;
5173   IMATCH_MP_TAC  finite_subset;
5174   REWRITE_TAC[IMAGE;SUBSET];
5175   EXPAND_TAC "X";
5176   REWRITE_TAC[];
5177   NAME_CONFLICT_TAC;
5178   CONJ_TAC;
5179   DISCH_ALL_TAC;
5180   ASM_MESON_TAC[];
5181   ASM_MESON_TAC[rectagon];
5182   DISCH_THEN (CHOOSE_THEN MP_TAC);
5183   DISCH_ALL_TAC;
5184   TYPE_THEN `C = X` SUBGOAL_TAC;
5185   IMATCH_MP_TAC  SUBSET_ANTISYM;
5186   ASM_REWRITE_TAC[];
5187   REWRITE_TAC[SUBSET];
5188   DISCH_ALL_TAC;
5189   UND 7;
5190   EXPAND_TAC "X";
5191   REWRITE_TAC[];
5192   UND 6;
5193   REWRITE_TAC[IMAGE];
5194   DISCH_THEN_REWRITE ;
5195   DISCH_THEN CHOOSE_TAC;
5196   USE 6 (REWRITE_RULE[v_edge_inj;h_edge_inj]);
5197   ASM_MESON_TAC[];
5198   ASM_MESON_TAC[];
5199   USE 0 (REWRITE_RULE[rectagon]);
5200   UND 0;
5201   DISCH_ALL_TAC;
5202   USE 5(REWRITE_RULE[EMPTY_EXISTS]);
5203   CHO 5;
5204   TSPEC `u` 2;
5205   REWR 2;
5206   CHO 2;
5207   UND 0;
5208   EXPAND_TAC "X";
5209   REWRITE_TAC[EMPTY_EXISTS];
5210   ASM_MESON_TAC[];
5211   DISCH_TAC;
5212   (* dwf done finite X ...  Messed up. X must have type real->bool. *)
5213   TYPE_THEN `Y = IMAGE (real_of_int o SND ) X` ABBREV_TAC;
5214   TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC;
5215   CONJ_TAC;
5216   EXPAND_TAC "Y";
5217   IMATCH_MP_TAC  FINITE_IMAGE;
5218   ASM_REWRITE_TAC[];
5219   EXPAND_TAC "Y";
5220   REWRITE_TAC[IMAGE;EMPTY_EXISTS ];
5221   CONV_TAC (dropq_conv "u");
5222   AND 4;
5223   USE 4 (REWRITE_RULE[EMPTY_EXISTS]);
5224   CHO 4;
5225   ASM_MESON_TAC[];
5226   DISCH_TAC;
5227   USE 6 (MATCH_MP min_finite);
5228   CHO 6;
5229   TYPE_THEN `?m. (G (v_edge m)) /\ (real_of_int (SND m) = delta)` SUBGOAL_TAC;
5230   USE 5 (REWRITE_RULE[IMAGE;o_DEF]);
5231   TAPP `delta` 5;
5232   REWR 5;
5233   CHO 5;
5234   TAPP `x` 3;
5235   REWR 3;
5236   ASM_MESON_TAC[];
5237   DISCH_TAC;
5238   CHO 7;
5239   (* now show that m is an endpoint *)
5240   TYPE_THEN `endpoint G m` SUBGOAL_TAC;
5241   REWRITE_TAC[endpoint];
5242   TYPE_THEN `FINITE G` SUBGOAL_TAC;
5243   ASM_MESON_TAC[rectagon];
5244   DISCH_TAC;
5245   ASM_SIMP_TAC[num_closure1];
5246   TYPE_THEN `v_edge m` EXISTS_TAC;
5247   DISCH_ALL_TAC;
5248   EQ_TAC;
5249   DISCH_ALL_TAC;
5250   TYPE_THEN `edge e'` SUBGOAL_TAC;
5251   ASM_MESON_TAC[rectagon;ISUBSET];
5252   REWRITE_TAC[edge];
5253   DISCH_THEN (CHOOSE_THEN MP_TAC);
5254   DISCH_THEN DISJ_CASES_TAC;
5255   ASM_REWRITE_TAC[v_edge_inj];
5256   REWR 10;
5257   USE 10 (REWRITE_RULE[v_edge_closure;vc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; v_edge_pointI]);
5258   UND 10;
5259   DISCH_THEN   DISJ_CASES_TAC;
5260   ASM_REWRITE_TAC[];
5261   TYPE_THEN `  Y (real_of_int (SND m'))` SUBGOAL_TAC;
5262   EXPAND_TAC "Y";
5263   REWRITE_TAC[IMAGE];
5264   TYPE_THEN `m'` EXISTS_TAC;
5265   REWRITE_TAC[o_DEF];
5266   EXPAND_TAC "X";
5267   REWRITE_TAC[];
5268   ASM_MESON_TAC[];
5269   DISCH_TAC;
5270   AND 6;
5271   TSPEC `(real_of_int(SND m'))` 6;
5272   REWR 6;
5273   USE 7 GSYM;
5274   REWR 6;
5275   USE 6 (REWRITE_RULE[int_suc ]);
5276   ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`];
5277   ASM_MESON_TAC[hv_edgeV2];
5278   DISCH_TAC;
5279   EXPAND_TAC "e'";
5280   ASM_REWRITE_TAC[];
5281   EXPAND_TAC "e'";
5282   REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING ;];
5283   ASM_MESON_TAC[rectagon_endpoint];
5284   ]);;
5285   (* }}} *)
5286
5287 let rectagon_v_edge = prove_by_refinement(
5288   `!G. (rectagon G) ==> (?m. (G (v_edge m)))`,
5289   (* {{{ proof *)
5290
5291   [
5292   DISCH_ALL_TAC;
5293   PROOF_BY_CONTR_TAC;
5294   TYPE_THEN `!e. G e ==> (?m. (e= (h_edge m))) ` SUBGOAL_TAC;
5295   DISCH_ALL_TAC;
5296   TYPE_THEN `edge e` SUBGOAL_TAC;
5297   ASM_MESON_TAC[rectagon;ISUBSET];
5298   REWRITE_TAC[edge];
5299   DISCH_THEN (CHOOSE_THEN MP_TAC);
5300   DISCH_THEN DISJ_CASES_TAC;
5301   ASM_MESON_TAC[];
5302   ASM_MESON_TAC[];
5303   DISCH_TAC;
5304   TYPE_THEN `X = {m | (G (h_edge m)) }` ABBREV_TAC;
5305   TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC;
5306   CONJ_TAC;
5307   TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (h_edge) C)` SUBGOAL_TAC ;
5308   IMATCH_MP_TAC  finite_subset;
5309   REWRITE_TAC[IMAGE;SUBSET];
5310   EXPAND_TAC "X";
5311   REWRITE_TAC[];
5312   NAME_CONFLICT_TAC;
5313   CONJ_TAC;
5314   DISCH_ALL_TAC;
5315   ASM_MESON_TAC[];
5316   ASM_MESON_TAC[rectagon];
5317   DISCH_THEN (CHOOSE_THEN MP_TAC);
5318   DISCH_ALL_TAC;
5319   TYPE_THEN `C = X` SUBGOAL_TAC;
5320   IMATCH_MP_TAC  SUBSET_ANTISYM;
5321   ASM_REWRITE_TAC[];
5322   REWRITE_TAC[SUBSET];
5323   DISCH_ALL_TAC;
5324   UND 7;
5325   EXPAND_TAC "X";
5326   REWRITE_TAC[];
5327   UND 6;
5328   REWRITE_TAC[IMAGE];
5329   DISCH_THEN_REWRITE ;
5330   DISCH_THEN CHOOSE_TAC;
5331   USE 6 (REWRITE_RULE[h_edge_inj;v_edge_inj]);
5332   ASM_MESON_TAC[];
5333   ASM_MESON_TAC[];
5334   USE 0 (REWRITE_RULE[rectagon]);
5335   UND 0;
5336   DISCH_ALL_TAC;
5337   USE 5(REWRITE_RULE[EMPTY_EXISTS]);
5338   CHO 5;
5339   TSPEC `u` 2;
5340   REWR 2;
5341   CHO 2;
5342   UND 0;
5343   EXPAND_TAC "X";
5344   REWRITE_TAC[EMPTY_EXISTS];
5345   ASM_MESON_TAC[];
5346   DISCH_TAC;
5347   (* dwfx done finite X ...  Messed up. X must have type real->bool. *)
5348   TYPE_THEN `Y = IMAGE (real_of_int o FST ) X` ABBREV_TAC;
5349   TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC;
5350   CONJ_TAC;
5351   EXPAND_TAC "Y";
5352   IMATCH_MP_TAC  FINITE_IMAGE;
5353   ASM_REWRITE_TAC[];
5354   EXPAND_TAC "Y";
5355   REWRITE_TAC[IMAGE;EMPTY_EXISTS ];
5356   CONV_TAC (dropq_conv "u");
5357   AND 4;
5358   USE 4 (REWRITE_RULE[EMPTY_EXISTS]);
5359   CHO 4;
5360   ASM_MESON_TAC[];
5361   DISCH_TAC;
5362   USE 6 (MATCH_MP min_finite);
5363   CHO 6;
5364   TYPE_THEN `?m. (G (h_edge m)) /\ (real_of_int (FST  m) = delta)` SUBGOAL_TAC;
5365   USE 5 (REWRITE_RULE[IMAGE;o_DEF]);
5366   TAPP `delta` 5;
5367   REWR 5;
5368   CHO 5;
5369   TAPP `x` 3;
5370   REWR 3;
5371   ASM_MESON_TAC[];
5372   DISCH_TAC;
5373   CHO 7;
5374   (* now show that m is an endpoint *)
5375   TYPE_THEN `endpoint G m` SUBGOAL_TAC;
5376   REWRITE_TAC[endpoint];
5377   TYPE_THEN `FINITE G` SUBGOAL_TAC;
5378   ASM_MESON_TAC[rectagon];
5379   DISCH_TAC;
5380   ASM_SIMP_TAC[num_closure1];
5381   TYPE_THEN `h_edge m` EXISTS_TAC;
5382   DISCH_ALL_TAC;
5383   EQ_TAC;
5384   DISCH_ALL_TAC;
5385   TYPE_THEN `edge e'` SUBGOAL_TAC;
5386   ASM_MESON_TAC[rectagon;ISUBSET];
5387   REWRITE_TAC[edge];
5388   DISCH_THEN (CHOOSE_THEN MP_TAC);
5389   IMATCH_MP_TAC  (TAUT `((A \/ B) ==> C) ==> ((B \/ A) ==> C)`);
5390   DISCH_THEN DISJ_CASES_TAC;
5391   ASM_REWRITE_TAC[h_edge_inj];
5392   REWR 10;
5393   USE 10 (REWRITE_RULE[h_edge_closure;hc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; h_edge_pointI]);
5394   UND 10;
5395   DISCH_THEN   DISJ_CASES_TAC;
5396   ASM_REWRITE_TAC[];
5397   TYPE_THEN `  Y (real_of_int (FST  m'))` SUBGOAL_TAC;
5398   EXPAND_TAC "Y";
5399   REWRITE_TAC[IMAGE];
5400   TYPE_THEN `m'` EXISTS_TAC;
5401   REWRITE_TAC[o_DEF];
5402   EXPAND_TAC "X";
5403   REWRITE_TAC[];
5404   ASM_MESON_TAC[];
5405   DISCH_TAC;
5406   AND 6;
5407   TSPEC `(real_of_int(FST  m'))` 6;
5408   REWR 6;
5409   USE 7 GSYM;
5410   REWR 6;
5411   USE 6 (REWRITE_RULE[int_suc ]);
5412   ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`];
5413   ASM_MESON_TAC[hv_edgeV2];
5414   DISCH_TAC;
5415   EXPAND_TAC "e'";
5416   ASM_REWRITE_TAC[];
5417   EXPAND_TAC "e'";
5418   REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING ;];
5419   ASM_MESON_TAC[rectagon_endpoint];
5420   ]);;
5421
5422   (* }}} *)
5423
5424 (* move down *)
5425 let part_below = jordan_def `part_below G m =
5426    {C | G C /\
5427           ((?n. (C = v_edge n) /\ (SND n <=: SND m) /\ (FST n = FST m)) \/
5428            (?n. (C = h_edge n) /\ (SND n <=: SND m) /\
5429                  (closure top2 C (pointI (FST m,SND n))))) }`;;
5430
5431 let part_below_h = prove_by_refinement(
5432   `!G m n. part_below G m (h_edge n) <=>
5433          (set_lower G m n) \/ (set_lower G (left m) n)`,
5434   (* {{{ proof *)
5435
5436   [
5437   DISCH_ALL_TAC;
5438   REWRITE_TAC[part_below;set_lower;left ];
5439   REWRITE_TAC[h_edge_closure;hc_edge;UNION ;h_edge_pointI];
5440   REWRITE_TAC[hv_edgeV2;plus_e12;INR IN_SING ;pointI_inj ;PAIR_SPLIT ];
5441   REWRITE_TAC[h_edge_inj];
5442   CONV_TAC (dropq_conv "n'");
5443   REWRITE_TAC[INT_ARITH `(x = y+: &:1) <=> (x -: (&:1) = y)`];
5444   ASM_MESON_TAC[];
5445   ]);;
5446
5447   (* }}} *)
5448
5449 let part_below_v = prove_by_refinement(
5450   `!G m n. part_below G m (v_edge n) <=>
5451          (G (v_edge n)) /\ (FST n = FST m) /\ (SND n <=: SND m)`,
5452   (* {{{ proof *)
5453   [
5454   DISCH_ALL_TAC;
5455   REWRITE_TAC[part_below;v_edge_closure;vc_edge;UNION;plus_e12; INR IN_SING; pointI_inj ; PAIR_SPLIT; v_edge_inj; hv_edgeV2];
5456   ASM_MESON_TAC[];
5457   ]);;
5458   (* }}} *)
5459
5460 (* sets *)
5461 let has_size_bij = prove_by_refinement(
5462   `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f {m | m < n} A)`,
5463   (* {{{ proof *)
5464   [
5465   DISCH_ALL_TAC;
5466   EQ_TAC;
5467   DISCH_TAC;
5468   USE 0 (MATCH_MP (INR HAS_SIZE_INDEX));
5469   CHO 0;
5470   REWRITE_TAC[BIJ;INJ ;SURJ ;];
5471   TYPE_THEN `f` EXISTS_TAC;
5472   ASM_REWRITE_TAC[];
5473   USE 0 (REWRITE_RULE[EXISTS_UNIQUE_ALT]);
5474   ASM_MESON_TAC[];
5475   DISCH_THEN CHOOSE_TAC;
5476   REWRITE_TAC[HAS_SIZE];
5477   ASSUME_TAC CARD_NUMSEG_LT;
5478   TSPEC `n` 1;
5479   EXPAND_TAC "n";
5480   SUBCONJ_TAC;
5481   ASSUME_TAC FINITE_NUMSEG_LT;
5482   TSPEC `n` 2;
5483   JOIN 2 0;
5484   USE 0 (MATCH_MP FINITE_BIJ);
5485   ASM_REWRITE_TAC[];
5486   DISCH_TAC;
5487   IMATCH_MP_TAC  (GSYM BIJ_CARD);
5488   TYPE_THEN `f` EXISTS_TAC;
5489   ASM_REWRITE_TAC[];
5490   REWRITE_TAC[FINITE_NUMSEG_LT];
5491   ]);;
5492   (* }}} *)
5493
5494 let has_size_bij2 = prove_by_refinement(
5495   `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f A {m | m < n})`,
5496   (* {{{ proof *)
5497   [
5498   REWRITE_TAC[has_size_bij];
5499   DISCH_ALL_TAC;
5500   EQ_TAC;
5501   DISCH_THEN CHOOSE_TAC;
5502   TYPE_THEN `INV f {m | m <| n} A` EXISTS_TAC;
5503   IMATCH_MP_TAC  INVERSE_BIJ;
5504   ASM_REWRITE_TAC[];
5505   DISCH_THEN CHOOSE_TAC;
5506   TYPE_THEN `INV f A {m | m <| n}` EXISTS_TAC;
5507   IMATCH_MP_TAC  INVERSE_BIJ;
5508   ASM_REWRITE_TAC[];
5509   ]);;
5510   (* }}} *)
5511
5512 let fibre_card = prove_by_refinement(
5513   `!(f:A->B) A B m n.  (B HAS_SIZE n) /\ (IMAGE f A SUBSET B) /\
5514         (!b. (B b) ==> ({u | (A u) /\ (f u = b)} HAS_SIZE m)) ==>
5515            (A HAS_SIZE m*n)`,
5516   (* {{{ proof *)
5517   [
5518   DISCH_ALL_TAC;
5519   TYPE_THEN `!b. ?g. (B b) ==> (BIJ g {u | (A u) /\ (f u = b)} {j | j <| m})` SUBGOAL_TAC;
5520   DISCH_ALL_TAC;
5521   RIGHT_TAC "g";
5522   DISCH_TAC;
5523   REWRITE_TAC[GSYM has_size_bij2];
5524   TSPEC `b` 2;
5525   REWR 2;
5526   DISCH_TAC;
5527   LEFT 3 "g";
5528   CHO 3;
5529   (* case m=0 *)
5530   DISJ_CASES_TAC (ARITH_RULE `(m=0) \/ 0 < m`);
5531   ASM_REWRITE_TAC[];
5532   REDUCE_TAC;
5533   REWRITE_TAC[HAS_SIZE_0];
5534   REWR 2;
5535   USE 2 (REWRITE_RULE[HAS_SIZE_0]);
5536   USE 1 (REWRITE_RULE[IMAGE;ISUBSET ]);
5537   PROOF_BY_CONTR_TAC;
5538   USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
5539   CHO 5;
5540   USE 1 (CONV_RULE NAME_CONFLICT_CONV);
5541   USE 1 (CONV_RULE (dropq_conv "x''"));
5542   TSPEC `u` 1;
5543   REWR 1;
5544   TSPEC `f u` 2;
5545   REWR 2;
5546   USE 2 (REWRITE_RULE[EQ_EMPTY]);
5547   ASM_MESON_TAC[];
5548   TYPE_THEN `BIJ (\x. (f x, g (f x) x)) A {(x,y) | B x /\ {j|j <|m} y}` SUBGOAL_TAC;
5549   REWRITE_TAC[BIJ;INJ;SURJ];
5550   SUBCONJ_TAC;
5551   SUBCONJ_TAC;
5552   DISCH_ALL_TAC;
5553   TYPE_THEN `f x` EXISTS_TAC;
5554   REWRITE_TAC[PAIR_SPLIT];
5555   CONV_TAC (dropq_conv "y");
5556   SUBCONJ_TAC;
5557   UND 1;
5558   REWRITE_TAC[IMAGE;SUBSET];
5559   ASM_MESON_TAC[];
5560   DISCH_TAC;
5561   TSPEC `f x` 3;
5562   REWR 3;
5563   UND 3;
5564   REWRITE_TAC[BIJ;SURJ];
5565   DISCH_ALL_TAC;
5566   ASM_MESON_TAC[];
5567   DISCH_TAC;
5568   DISCH_ALL_TAC;
5569   USE 8(REWRITE_RULE[PAIR_SPLIT]);
5570   AND 8;
5571   REWR 8;
5572   (* r8 *)
5573   TYPE_THEN `B (f y)` SUBGOAL_TAC;
5574   UND 1;
5575   REWRITE_TAC [IMAGE;SUBSET];
5576   ASM_MESON_TAC[];
5577   DISCH_TAC;
5578   TSPEC `f y` 3;
5579   REWR 3;
5580   USE 3 (REWRITE_RULE[BIJ;INJ]);
5581   ASM_MESON_TAC[];
5582   DISCH_ALL_TAC;
5583   ASM_REWRITE_TAC[];
5584   GEN_TAC;
5585   NAME_CONFLICT_TAC;
5586   REWRITE_TAC[PAIR_SPLIT];
5587   CONV_TAC (dropq_conv "x'");
5588   NAME_CONFLICT_TAC;
5589   GEN_TAC;
5590   LEFT_TAC  "x''";
5591   GEN_TAC;
5592   RIGHT_TAC "y''";
5593   DISCH_THEN_REWRITE ;
5594   RIGHT_TAC "y''";
5595   DISCH_ALL_TAC;
5596   USE 9 GSYM;
5597   REWR 8;
5598   ASM_REWRITE_TAC[];
5599   KILL 9;
5600   TSPEC `FST x` 2;
5601   REWR 2;
5602   TSPEC `FST x` 3;
5603   REWR 3;
5604   USE 3 (REWRITE_RULE[BIJ;SURJ]);
5605   ASM_MESON_TAC[];
5606   REWRITE_TAC[HAS_SIZE];
5607   DISCH_TAC;
5608   (* r9 *)
5609   TYPE_THEN `FINITE B /\ FINITE {j | j <| m}` SUBGOAL_TAC;
5610   ASM_REWRITE_TAC[FINITE_NUMSEG_LT];
5611   ASM_MESON_TAC[HAS_SIZE];
5612   DISCH_TAC;
5613   COPY 6;
5614   USE 6 (MATCH_MP   (INR FINITE_PRODUCT));
5615   REWR 6;
5616   COPY 7;
5617   USE 7 (MATCH_MP (INR CARD_PRODUCT));
5618   SUBCONJ_TAC;
5619   JOIN  6 5;
5620   USE 5 (MATCH_MP FINITE_BIJ2);
5621   ASM_REWRITE_TAC[];
5622   DISCH_TAC;
5623   JOIN 9 5;
5624   USE 5 (MATCH_MP BIJ_CARD);
5625   REWR 7;
5626   ASM_REWRITE_TAC[CARD_NUMSEG_LT];
5627   USE 0 (REWRITE_RULE[HAS_SIZE]);
5628   ASM_REWRITE_TAC[];
5629   ARITH_TAC;
5630   ]);;
5631   (* }}} *)
5632
5633 (* sets *)
5634 let even_card_even = prove_by_refinement(
5635   `!X (Y:A->bool). (FINITE X) /\ (FINITE Y) /\ (X INTER Y = EMPTY) ==>
5636     ((EVEN (CARD X) <=> EVEN (CARD Y)) <=> (EVEN (CARD (X UNION Y))))`,
5637   (* {{{ proof *)
5638   [
5639   DISCH_ALL_TAC;
5640   ASM_SIMP_TAC [CARD_UNION];
5641   REWRITE_TAC[EVEN_ADD];
5642   ]);;
5643   (* }}} *)
5644
5645
5646 (*
5647   terminal edge: (endpoint G m) /\ (closure top2 e (pointI m))
5648   produce bij-MAP from terminal edges to endpoints (of P SUBSET G)
5649   2-1 MAP from  terminal edges to segments.
5650   Hence an EVEN number of endpoints.
5651
5652 *)
5653
5654
5655
5656 let terminal_edge = jordan_def `terminal_edge G m =
5657     @e. (G e) /\ (closure top2 e (pointI m))`;;
5658
5659 let terminal_endpoint = prove_by_refinement(
5660   `!G m. (FINITE G) /\ (endpoint G m)  ==> ((G (terminal_edge G m)) /\
5661           (closure top2 (terminal_edge G m) (pointI m)) ) `,
5662   (* {{{ proof *)
5663   [
5664   DISCH_ALL_TAC;
5665   REWRITE_TAC[terminal_edge];
5666   SELECT_TAC;
5667   MESON_TAC[];
5668   ASM_MESON_TAC[endpoint_edge;EXISTS_UNIQUE_ALT];
5669   ]);;
5670   (* }}} *)
5671
5672 let terminal_unique = prove_by_refinement(
5673   `!G m e. (FINITE G) /\ (endpoint G m) ==>
5674        ( (G e) /\ (closure top2 e (pointI m)) <=> (e = terminal_edge G m))`,
5675   (* {{{ proof *)
5676   [
5677   DISCH_ALL_TAC;
5678   EQ_TAC;
5679   REWRITE_TAC[terminal_edge];
5680   SELECT_TAC;
5681   USE 1(REWRITE_RULE[endpoint]);
5682   ASM_MESON_TAC[num_closure1];
5683   ASM_MESON_TAC[terminal_endpoint];
5684   ASM_MESON_TAC[terminal_endpoint];
5685   ]);;
5686   (* }}} *)
5687
5688
5689 let segment_of_endpoint = prove_by_refinement(
5690   `!P e m. (P e) /\ (FINITE P) ==>
5691      (endpoint P m /\
5692          (segment_of P (terminal_edge P m) = segment_of P e)
5693         <=>
5694         endpoint (segment_of P e) m)`,
5695   (* {{{ proof *)
5696   [
5697   DISCH_ALL_TAC;
5698   TYPE_THEN `FINITE (segment_of P e)` SUBGOAL_TAC;
5699   IMATCH_MP_TAC  FINITE_SUBSET;
5700   ASM_MESON_TAC[segment_of_G];
5701   DISCH_TAC;
5702   EQ_TAC;
5703   DISCH_ALL_TAC;
5704   COPY 3;
5705   UND 5;
5706   REWRITE_TAC[endpoint];
5707   ASM_SIMP_TAC[num_closure1];
5708   DISCH_ALL_TAC;
5709   CHO 5;
5710   TYPE_THEN `e'` EXISTS_TAC;
5711   DISCH_ALL_TAC;
5712   EQ_TAC;
5713   USE 0 (MATCH_MP segment_of_G);
5714   ASM_MESON_TAC[ISUBSET];
5715   DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
5716   COPY 5;
5717   TSPEC `e'` 5;
5718   USE 5 (REWRITE_RULE[]);
5719   ASM_REWRITE_TAC[];
5720   UND 4;
5721   DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
5722   TSPEC `terminal_edge P m` 6;
5723   UND 4;
5724   ASM_SIMP_TAC[terminal_endpoint];
5725   REWRITE_TAC[segment_of_in];
5726   DISCH_TAC;
5727   (* se *)
5728   SUBCONJ_TAC;
5729   UND 3;
5730   REWRITE_TAC[endpoint];
5731   ASM_SIMP_TAC[num_closure1];
5732   DISCH_ALL_TAC;
5733   CHO 3;
5734   TYPE_THEN `e'` EXISTS_TAC;
5735   DISCH_ALL_TAC;
5736   EQ_TAC;
5737   TYPE_THEN `P e'' /\ closure top2 e'' (pointI m) ==> segment_of P e e''` SUBGOAL_TAC;
5738   DISCH_ALL_TAC;
5739   COPY 3;
5740   TSPEC `e'` 3;
5741   USE 3 (REWRITE_RULE []);
5742   TYPE_THEN `e'' = e'` ASM_CASES_TAC;
5743   ASM_MESON_TAC[];
5744   USE 0 (MATCH_MP inductive_segment);
5745   USE 0 (REWRITE_RULE[inductive_set]);
5746   UND 0;
5747   DISCH_ALL_TAC;
5748   TYPEL_THEN [`e'`;`e''`] (USE 9 o ISPECL);
5749   UND 9;
5750   DISCH_THEN IMATCH_MP_TAC ;
5751   ASM_REWRITE_TAC[adj;EMPTY_EXISTS;];
5752   TYPE_THEN `pointI m` EXISTS_TAC;
5753   REWRITE_TAC[INTER];
5754   ASM_REWRITE_TAC[];
5755   ASM_MESON_TAC[];
5756   DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
5757   ASM_MESON_TAC[segment_of_G;ISUBSET ];
5758   (* I'm getting lost in the thickets *)
5759   (* se2 *)
5760   DISCH_TAC;
5761   IMATCH_MP_TAC  (GSYM segment_of_eq);
5762   ASM_REWRITE_TAC[];
5763   COPY 4;
5764   COPY 3;
5765   UND 3;
5766   UND 4;
5767   REWRITE_TAC[endpoint];
5768   ASM_SIMP_TAC[num_closure1];
5769   DISCH_THEN CHOOSE_TAC;
5770   DISCH_THEN CHOOSE_TAC;
5771   (* *)
5772   COPY 3;
5773   TSPEC `e''` 3;
5774   TYPE_THEN `e' = e''` SUBGOAL_TAC;
5775   TSPEC `e''` 4;
5776   USE 4 (REWRITE_RULE[]);
5777   ASM_MESON_TAC[segment_of_G;ISUBSET ];
5778   DISCH_TAC;
5779   TSPEC `terminal_edge P m` 7;
5780   TYPE_THEN `e' = terminal_edge P m` SUBGOAL_TAC;
5781   ASM_MESON_TAC[terminal_endpoint];
5782   ASM_MESON_TAC[];
5783   ]);;
5784   (* }}} *)
5785
5786 let fibre2 = prove_by_refinement(
5787   `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==>
5788     (!S. ({ S | (?e. (P e) /\ (S = segment_of P e)) }  S) ==>
5789       ({m | (endpoint P m) /\ (segment_of P (terminal_edge P m) = S)}
5790               HAS_SIZE 2))`,
5791   (* {{{ proof *)
5792   [
5793   DISCH_ALL_TAC;
5794   REWRITE_TAC[];
5795   DISCH_ALL_TAC;
5796   CHO 3;
5797   ASM_REWRITE_TAC[];
5798   USE 3 (CONJUNCT1 );
5799   TYPE_THEN `psegment (segment_of P e)` SUBGOAL_TAC;
5800   REWRITE_TAC[psegment];
5801   CONJ_TAC;
5802   ASM_MESON_TAC[rectagon_subset;segment_of_G;segment_of_segment];
5803   PROOF_BY_CONTR_TAC;
5804   TYPE_THEN `segment_of P e = G` SUBGOAL_TAC;
5805   IMATCH_MP_TAC  rectagon_subset;
5806   REWR 4;
5807   ASM_REWRITE_TAC[];
5808   ASM_MESON_TAC[SUBSET_TRANS;segment_of_G];
5809   USE 3 (MATCH_MP segment_of_G);
5810   DISCH_TAC;
5811   REWR 3;
5812   JOIN 1 3;
5813   USE 1 (MATCH_MP SUBSET_ANTISYM);
5814   REWR 4;
5815   ASM_MESON_TAC[];
5816   DISCH_TAC;
5817   USE 4 (MATCH_MP endpoint_size2);
5818   TYPE_THEN `{m | endpoint P m /\ (segment_of P (terminal_edge P m) = segment_of P e)} = endpoint (segment_of P e)` SUBGOAL_TAC;
5819   IMATCH_MP_TAC  EQ_EXT;
5820   GEN_TAC ;
5821   REWRITE_TAC[];
5822   (* f2 *)
5823   IMATCH_MP_TAC  segment_of_endpoint;
5824   ASM_REWRITE_TAC[];
5825   IMATCH_MP_TAC  FINITE_SUBSET;
5826   ASM_MESON_TAC[segment];
5827   DISCH_THEN_REWRITE;
5828   ASM_MESON_TAC[];
5829   ]);;
5830   (* }}} *)
5831
5832 let endpoint_even = prove_by_refinement(
5833   `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==>
5834         (endpoint P HAS_SIZE 2 *|
5835            (CARD {S | (?e. (P e) /\ (S = segment_of P e))})  )`,
5836   (* {{{ proof *)
5837   [
5838   DISCH_ALL_TAC;
5839   TYPE_THEN  `f =  (segment_of P) o (terminal_edge P)` ABBREV_TAC;
5840   TYPE_THEN `B = { S | (?e. (P e) /\ (S = segment_of P e)) }` ABBREV_TAC;
5841   TYPE_THEN `f` (fun t-> IMATCH_MP_TAC   (ISPEC t fibre_card));
5842   TYPE_THEN `B` EXISTS_TAC;
5843   ASM_REWRITE_TAC[HAS_SIZE;IMAGE;SUBSET ; ];
5844   EXPAND_TAC "B";
5845   EXPAND_TAC "f";
5846   REWRITE_TAC[o_DEF ];
5847   SUBCONJ_TAC;
5848   TYPE_THEN `{S | ?e. P e /\ (S = segment_of P e)} = IMAGE (\x. (segment_of P x)) P` SUBGOAL_TAC;
5849   REWRITE_TAC[IMAGE];
5850   DISCH_THEN_REWRITE;
5851   IMATCH_MP_TAC  FINITE_IMAGE;
5852   IMATCH_MP_TAC  FINITE_SUBSET ;
5853   ASM_MESON_TAC[segment];
5854   DISCH_TAC;
5855   CONJ_TAC;
5856   NAME_CONFLICT_TAC;
5857   GEN_TAC;
5858   DISCH_THEN CHOOSE_TAC ;
5859   ASM_REWRITE_TAC[];
5860   TYPE_THEN `terminal_edge P x'` EXISTS_TAC;
5861   ASM_REWRITE_TAC[];
5862   TYPE_THEN `FINITE P` SUBGOAL_TAC;
5863   ASM_MESON_TAC[segment;FINITE_SUBSET];
5864   ASM_MESON_TAC[terminal_endpoint];
5865   (* ee *)
5866   REWRITE_TAC[GSYM HAS_SIZE];
5867   ASSUME_TAC fibre2;
5868   USE 6 (REWRITE_RULE[]);
5869   UND 6;
5870   DISCH_THEN IMATCH_MP_TAC ;
5871   ASM_MESON_TAC[];
5872   ]);;
5873   (* }}} *)
5874
5875 let num_closure0 = prove_by_refinement(
5876   `! G x.
5877      FINITE G ==> ((num_closure G x = 0) <=>
5878              (!e. (G e) ==> (~(closure top2 e x))))`,
5879   (* {{{ proof *)
5880   [
5881   DISCH_ALL_TAC;
5882   USE 0 (MATCH_MP num_closure_size);
5883   TSPEC `x` 0;
5884   EQ_TAC;
5885   DISCH_TAC;
5886   REWR 0;
5887   USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY ]);
5888   ASM_MESON_TAC[];
5889   DISCH_TAC;
5890   TYPE_THEN `{C | G C /\ closure top2 C x} = {}` SUBGOAL_TAC;
5891   PROOF_BY_CONTR_TAC;
5892   USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
5893   CHO 2;
5894   ASM_MESON_TAC[];
5895   DISCH_TAC;
5896   REWR 0;
5897   USE 0 (REWRITE_RULE[HAS_SIZE]);
5898   ASM_MESON_TAC[CARD_CLAUSES];
5899   ]);;
5900   (* }}} *)
5901
5902 let num_closure2 = prove_by_refinement(
5903   `!G x.
5904     FINITE G ==> ((num_closure G x = 2) <=>
5905            (?a b. (~(a = b)) /\
5906               ((!e. (G e /\ closure top2 e x) <=> (( e= a)\/ (e =b))))))`,
5907   (* {{{ proof *)
5908
5909   [
5910   DISCH_ALL_TAC;
5911   USE 0 (MATCH_MP num_closure_size);
5912   TSPEC `x` 0;
5913   EQ_TAC;
5914   DISCH_TAC;
5915   REWR 0;
5916   USE 0 (REWRITE_RULE[has_size2 ; ]);
5917   CHO 0;
5918   CHO 0;
5919   TYPE_THEN `a` EXISTS_TAC;
5920   TYPE_THEN `b` EXISTS_TAC;
5921   ASM_REWRITE_TAC[];
5922   DISCH_ALL_TAC;
5923   AND 0;
5924   TAPP `e` 2;
5925   USE 2(REWRITE_RULE[INSERT]);
5926   ASM_MESON_TAC[];
5927   DISCH_TAC;
5928   CHO 1;
5929   CHO 1;
5930   TYPE_THEN `X = {C | G C /\ closure top2 C x} ` ABBREV_TAC;
5931   TYPE_THEN `(?a b. (X = {a, b}) /\ ~(a = b))` SUBGOAL_TAC;
5932   TYPE_THEN `a` EXISTS_TAC;
5933   TYPE_THEN `b` EXISTS_TAC;
5934   ASM_REWRITE_TAC[];
5935   IMATCH_MP_TAC  EQ_EXT;
5936   GEN_TAC;
5937   REWRITE_TAC[INSERT];
5938   EXPAND_TAC "X";
5939   REWRITE_TAC[];
5940   ASM_MESON_TAC[];
5941   DISCH_TAC;
5942   USE 3 (REWRITE_RULE[GSYM has_size2]);
5943   RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
5944   ASM_MESON_TAC[];
5945   ]);;
5946
5947   (* }}} *)
5948
5949 let endpoint_subrectagon = prove_by_refinement(
5950   `!G P m. (rectagon G) /\ (P SUBSET G) ==>
5951         ((endpoint P m) <=>
5952         (?C C'. (P C) /\ (G C') /\ (~(P C')) /\ (~(C = C')) /\
5953            (closure top2 C (pointI m)) /\ (closure top2 C' (pointI m))))`,
5954   (* {{{ proof *)
5955   [
5956   DISCH_ALL_TAC;
5957   TYPE_THEN `FINITE G` SUBGOAL_TAC;
5958   ASM_MESON_TAC[rectagon];
5959   DISCH_TAC;
5960   TYPE_THEN `FINITE P` SUBGOAL_TAC;
5961   IMATCH_MP_TAC  FINITE_SUBSET;
5962   ASM_MESON_TAC[];
5963   DISCH_TAC;
5964   EQ_TAC;
5965   DISCH_TAC;
5966   TYPE_THEN `midpoint G m` SUBGOAL_TAC;
5967   REWRITE_TAC[midpoint];
5968   USE 0 (REWRITE_RULE[rectagon;INSERT]);
5969   UND 0;
5970   DISCH_ALL_TAC;
5971   TSPEC `m` 7;
5972   UND 7;
5973   DISCH_THEN DISJ_CASES_TAC;
5974   ASM_REWRITE_TAC[];
5975   USE 4 (REWRITE_RULE[endpoint]);
5976   JOIN 0 1;
5977   USE 0 (MATCH_MP num_closure_mono);
5978   ASM_MESON_TAC[ARITH_RULE `~(1 <=| 0)`];
5979   REWRITE_TAC[midpoint];
5980   TYPE_THEN `FINITE G` SUBGOAL_TAC;
5981   ASM_MESON_TAC[rectagon];
5982   DISCH_THEN (MP_TAC o (MATCH_MP num_closure_size));
5983   DISCH_ALL_TAC;
5984   TSPEC `pointI m` 6;
5985   REWR 6;
5986   USE 4 (REWRITE_RULE[endpoint]);
5987   UND 4;
5988   ASM_SIMP_TAC[num_closure1];
5989   DISCH_THEN CHOOSE_TAC;
5990   TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC;
5991   COPY 6;
5992   UND 8;
5993   REWRITE_TAC[has_size2];
5994   DISCH_THEN CHOOSE_TAC;
5995   CHO 8;
5996   TYPE_THEN `X a /\ X b /\ X e` SUBGOAL_TAC;
5997   CONJ_TAC;
5998   ASM_REWRITE_TAC[INSERT ];
5999   CONJ_TAC;
6000   ASM_REWRITE_TAC[INSERT];
6001   EXPAND_TAC "X";
6002   ASM_REWRITE_TAC[];
6003   TSPEC `e` 4;
6004   USE 4(REWRITE_RULE[]);
6005   ASM_REWRITE_TAC[];
6006   ASM_MESON_TAC[ISUBSET];
6007   DISCH_TAC;
6008   TYPE_THEN `P e /\ (closure top2 e (pointI m))` SUBGOAL_TAC;
6009   TSPEC `e` 4;
6010   ASM_MESON_TAC[];
6011   DISCH_TAC;
6012   TYPE_THEN `e` EXISTS_TAC;
6013   ASM_REWRITE_TAC[];
6014   TYPE_THEN `G a /\ closure top2 a (pointI m) /\ G b /\ closure top2 b (pointI m)` SUBGOAL_TAC;
6015   UND 9;
6016   EXPAND_TAC "X";
6017   ASM_REWRITE_TAC[];
6018   MESON_TAC[];
6019   DISCH_ALL_TAC;
6020   TYPE_THEN `(e =a) \/ (e = b)` SUBGOAL_TAC;
6021   ASM_MESON_TAC[two_exclusion];
6022   DISCH_THEN DISJ_CASES_TAC;
6023   TYPE_THEN `b` EXISTS_TAC;
6024   ASM_MESON_TAC[];
6025   TYPE_THEN `a` EXISTS_TAC;
6026   ASM_MESON_TAC[];
6027   DISCH_ALL_TAC;
6028   CHO 4;
6029   CHO 4;
6030   UND 4;
6031   DISCH_ALL_TAC;
6032   REWRITE_TAC[endpoint];
6033   UND 0;
6034   REWRITE_TAC[rectagon;INSERT ];
6035   DISCH_ALL_TAC;
6036   TSPEC `m` 12;
6037   UND 12;
6038   (* rg *)
6039   DISCH_THEN DISJ_CASES_TAC;
6040   USE 3 (MATCH_MP num_closure1);
6041   ASM_REWRITE_TAC[];
6042   USE 0 (MATCH_MP num_closure2);
6043   REWR 12;
6044   CHO 12;
6045   CHO 12;
6046   AND 12;
6047   TYPE_THEN `(C = a) \/ (C = b)` SUBGOAL_TAC;
6048   UND 12;
6049   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
6050   ASM_MESON_TAC[ISUBSET];
6051   DISCH_TAC;
6052   TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC;
6053   UND 12;
6054   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
6055   ASM_MESON_TAC[ISUBSET];
6056   DISCH_TAC;
6057   TYPE_THEN `C` EXISTS_TAC;
6058   DISCH_ALL_TAC;
6059   EQ_TAC;
6060   DISCH_ALL_TAC;
6061   TSPEC `e'` 12;
6062   REWR 12;
6063   TYPE_THEN `G e'` SUBGOAL_TAC;
6064   UND 17;
6065   UND 1;
6066   MESON_TAC[ISUBSET];
6067   DISCH_TAC;
6068   KILL 0;
6069   KILL 3;
6070   KILL 18;
6071   KILL 13;
6072   ASM_MESON_TAC[];
6073   KILL 0;
6074   KILL 3;
6075   KILL 13;
6076   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
6077   ASM_REWRITE_TAC[];
6078   (* rg2 *)
6079   USE 0(MATCH_MP num_closure0);
6080   REWR 12;
6081   ASM_MESON_TAC[];
6082   ]);;
6083   (* }}} *)
6084
6085 let part_below_finite = prove_by_refinement(
6086   `!G m. (FINITE G) ==> FINITE(part_below G m)`,
6087   (* {{{ proof *)
6088   [
6089   DISCH_ALL_TAC;
6090   IMATCH_MP_TAC  FINITE_SUBSET;
6091   TYPE_THEN `G` EXISTS_TAC;
6092   ASM_REWRITE_TAC[part_below;ISUBSET ];
6093   MESON_TAC[];
6094   ]);;
6095   (* }}} *)
6096
6097 let part_below_subset = prove_by_refinement(
6098   `!G m. (part_below G m) SUBSET G`,
6099   (* {{{ proof *)
6100   [
6101   REWRITE_TAC[part_below;ISUBSET];
6102   MESON_TAC[];
6103   ]);;
6104   (* }}} *)
6105
6106 let v_edge_cpoint = prove_by_refinement(
6107   `!m n. (closure top2 (v_edge m) (pointI n) <=>
6108           ((n = m) \/ (n = (FST m,SND m +: (&:1)))))`,
6109   (* {{{ proof *)
6110   [
6111   DISCH_ALL_TAC;
6112   REWRITE_TAC[v_edge_closure;vc_edge;UNION];
6113   REWRITE_TAC[v_edge_pointI;INR IN_SING ;plus_e12;pointI_inj];
6114   ]);;
6115   (* }}} *)
6116
6117 let h_edge_cpoint = prove_by_refinement(
6118   `!m n. (closure top2 (h_edge m) (pointI n) <=>
6119           ((n = m) \/ (n = (FST m +: (&:1),SND m ))))`,
6120   (* {{{ proof *)
6121   [
6122   DISCH_ALL_TAC;
6123   REWRITE_TAC[h_edge_closure;hc_edge;UNION];
6124   REWRITE_TAC[h_edge_pointI;INR IN_SING ;plus_e12;pointI_inj];
6125   ]);;
6126   (* }}} *)
6127
6128 let endpoint_lemma = prove_by_refinement(
6129   `!G m x.  (rectagon G) /\
6130       (endpoint (part_below G m) x)
6131        ==>
6132       (? C C' m'.
6133           ((C = v_edge m') \/ (C = h_edge m')) /\
6134           (edge C') /\
6135           (!e. G e /\ closure top2 e (pointI x) <=> (e = C) \/ (e = C')) /\
6136           (~(G = {})) /\
6137           (G SUBSET edge) /\
6138           (part_below G m C) /\
6139           (G C') /\
6140           (~part_below G m C') /\
6141           (~(C = C')) /\
6142           (closure top2 C (pointI x)) /\
6143           (closure top2 C' (pointI x)) /\
6144          (part_below G m SUBSET G) /\
6145          (endpoint (part_below G m) x))
6146           `,
6147   (* {{{ proof *)
6148   [
6149   DISCH_ALL_TAC;
6150   TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC;
6151   ASM_MESON_TAC[part_below_subset];
6152   DISCH_TAC ;
6153   COPY 2;
6154   COPY 1;
6155   UND 1;
6156   UND 3;
6157   UND 0;
6158   SIMP_TAC[endpoint_subrectagon];
6159   DISCH_TAC;
6160   DISCH_TAC;
6161   DISCH_THEN (CHOOSE_THEN MP_TAC);
6162   DISCH_THEN (CHOOSE_THEN MP_TAC);
6163   DISCH_ALL_TAC;
6164   USE 0 (REWRITE_RULE[rectagon;INSERT ]);
6165   UND 0;
6166   DISCH_ALL_TAC;
6167   TSPEC `x` 12;
6168   UND 12;
6169   DISCH_THEN DISJ_CASES_TAC;
6170   USE 0 (MATCH_MP num_closure2);
6171   REWR 12;
6172   CHO 12;
6173   CHO 12;
6174   KILL 0;
6175   AND 12;
6176   TYPE_THEN `(C = a) \/ (C = b)`  SUBGOAL_TAC;
6177  TSPEC `C` 0;
6178   UND 0;
6179   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
6180   ASM_MESON_TAC[ISUBSET];
6181   TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC;
6182   ASM_MESON_TAC[];
6183   DISCH_TAC;
6184   DISCH_TAC;
6185   TYPE_THEN `!e. G e /\ closure top2 e (pointI x) <=> ((e = C) \/ (e = C'))` SUBGOAL_TAC;
6186   DISCH_ALL_TAC;
6187   TSPEC `e` 0;
6188   ASM_REWRITE_TAC[];
6189   UND 15;
6190   UND 14;
6191   UND 12;
6192   UND 7;
6193   MESON_TAC[];
6194   DISCH_TAC;
6195   KILL 15;
6196   KILL 14;
6197   KILL 0;
6198   KILL 12;
6199   KILL 13;
6200   TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
6201   ASM_MESON_TAC[ISUBSET;];
6202   DISCH_ALL_TAC;
6203   USE 0 (REWRITE_RULE[edge]);
6204   UND 0;
6205   DISCH_THEN CHOOSE_TAC;
6206   TYPE_THEN `C` EXISTS_TAC;
6207   TYPE_THEN `C'` EXISTS_TAC;
6208   TYPE_THEN `m'` EXISTS_TAC;
6209   ASM_REWRITE_TAC[];
6210   (* snd case *)
6211   USE 0 (MATCH_MP num_closure0);
6212   REWR 12;
6213   PROOF_BY_CONTR_TAC;
6214   UND 12;
6215   UND 5;
6216   UND 9;
6217   MESON_TAC[];
6218   ]);;
6219   (* }}} *)
6220
6221 let endpoint_lemma_small_fst = prove_by_refinement(
6222   `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
6223        (FST m <=: FST x +: &:1) `,
6224   (* {{{ proof *)
6225
6226   [
6227   REP_GEN_TAC;
6228   DISCH_TAC;
6229   COPY 0;
6230   USE 0 (MATCH_MP endpoint_lemma);
6231   CHO 0;
6232   CHO 0;
6233   CHO 0;
6234   UND 0;
6235   DISCH_ALL_TAC;
6236   REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
6237   DISCH_ALL_TAC;
6238   (* setup complete *)
6239   UND 0;
6240   DISCH_THEN DISJ_CASES_TAC;
6241   REWR 6;
6242   USE 6 (REWRITE_RULE[part_below_v]);
6243   REWR 10;
6244   USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6245   TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
6246   ASM_MESON_TAC[];
6247   DISCH_TAC;
6248   REWR 14;
6249   AND 6;
6250   AND 6;
6251   REWR 14;
6252   UND 14;
6253   INT_ARITH_TAC;
6254   (* 2nd case *)
6255   REWR 6;
6256   USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
6257   REWR 10;
6258   USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6259   TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC;
6260   ASM_MESON_TAC[];
6261   TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC;
6262   ASM_MESON_TAC[];
6263   UND 14;
6264   INT_ARITH_TAC;
6265   ]);;
6266
6267   (* }}} *)
6268
6269 (* identical proof to endpoint_lemma_small_fst *)
6270 let endpoint_lemma_big_fst = prove_by_refinement(
6271   `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
6272        (FST x <=: FST m +: &:1) `,
6273   (* {{{ proof *)
6274
6275   [
6276   REP_GEN_TAC;
6277   DISCH_TAC;
6278   COPY 0;
6279   USE 0 (MATCH_MP endpoint_lemma);
6280   CHO 0;
6281   CHO 0;
6282   CHO 0;
6283   UND 0;
6284   DISCH_ALL_TAC;
6285   REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
6286   DISCH_ALL_TAC;
6287   (* setup complete *)
6288   UND 0;
6289   DISCH_THEN DISJ_CASES_TAC;
6290   REWR 6;
6291   USE 6 (REWRITE_RULE[part_below_v]);
6292   REWR 10;
6293   USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6294   TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
6295   ASM_MESON_TAC[];
6296   DISCH_TAC;
6297   REWR 14;
6298   AND 6;
6299   AND 6;
6300   REWR 14;
6301   UND 14;
6302   INT_ARITH_TAC;
6303   (* 2nd case *)
6304   REWR 6;
6305   USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
6306   REWR 10;
6307   USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6308   TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC;
6309   ASM_MESON_TAC[];
6310   TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC;
6311   ASM_MESON_TAC[];
6312   UND 14;
6313   INT_ARITH_TAC;
6314   ]);;
6315
6316   (* }}} *)
6317
6318 let endpoint_lemma_big_snd = prove_by_refinement(
6319   `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
6320        (SND  x <=: SND  m +: &:1) `,
6321   (* {{{ proof *)
6322
6323   [
6324   REP_GEN_TAC;
6325   DISCH_TAC;
6326   COPY 0;
6327   USE 0 (MATCH_MP endpoint_lemma);
6328   CHO 0;
6329   CHO 0;
6330   CHO 0;
6331   UND 0;
6332   DISCH_ALL_TAC;
6333   REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
6334   DISCH_ALL_TAC;
6335   (* setup complete *)
6336   UND 0;
6337   DISCH_THEN DISJ_CASES_TAC;
6338   REWR 6;
6339   USE 6 (REWRITE_RULE[part_below_v]);
6340   REWR 10;
6341   USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6342   TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC;
6343   ASM_MESON_TAC[];
6344   UND 14;
6345   AND 6;
6346   AND 6;
6347   UND 6;
6348   INT_ARITH_TAC;
6349   (* 2nd case *)
6350   REWR 6;
6351   USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
6352   REWR 10;
6353   USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6354   TYPE_THEN `SND x = SND m'` SUBGOAL_TAC;
6355   ASM_MESON_TAC[];
6356   TYPE_THEN `(SND m' <=: SND m)` SUBGOAL_TAC;
6357   ASM_MESON_TAC[];
6358   UND 14;
6359   INT_ARITH_TAC;
6360   ]);;
6361
6362   (* }}} *)
6363
6364 let endpoint_lemma_mid_fst = prove_by_refinement(
6365   `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
6366        (FST x = FST m) ==> (SND  x = SND  m +: &:1) `,
6367   (* {{{ proof *)
6368
6369   [
6370   REP_GEN_TAC;
6371   DISCH_TAC;
6372   COPY 0;
6373   USE 0 (MATCH_MP endpoint_lemma);
6374   CHO 0;
6375   CHO 0;
6376   CHO 0;
6377   UND 0;
6378   DISCH_ALL_TAC;
6379   (* setup complete *)
6380   UND 2;
6381   DISCH_THEN DISJ_CASES_TAC;
6382   REWR 7;
6383   USE 7 (REWRITE_RULE[part_below_v]);
6384   REWR 11;
6385   USE 11 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6386   TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC;
6387   ASM_MESON_TAC[];
6388   AND 7;
6389   AND 7;
6390   UND 7;
6391   USE 3 (REWRITE_RULE[edge]);
6392   CHO 3;
6393   UND 3;
6394   DISCH_THEN DISJ_CASES_TAC;
6395   REWR 9;
6396   USE 7 (REWRITE_RULE[part_below_v]);
6397   REWR 8;
6398   REWR 7;
6399   REWR 12;
6400   USE 9 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6401   TYPE_THEN `(FST m'' = FST m) /\ (FST x = FST m'')` SUBGOAL_TAC;
6402   ASM_MESON_TAC[];
6403   DISCH_TAC;
6404   REWR 9;
6405   REWR 7;
6406   UND 7;
6407   UND 9;
6408   INT_ARITH_TAC;
6409   (* 2nd case *)
6410   REWR 12;
6411   USE 7 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6412   REWR 8;
6413   REWR 9;
6414   USE 9 (REWRITE_RULE[left ;set_lower;part_below_h]);
6415   REWR 9;
6416   TYPE_THEN `(FST x = FST m') ` SUBGOAL_TAC;
6417   ASM_MESON_TAC[];
6418   DISCH_TAC;
6419   REWR 7;
6420   DISCH_ALL_TAC;
6421   REWR 7;
6422   KILL 12;
6423   REWR 7;
6424   KILL  11;
6425   (* try *)
6426   UND 7;
6427   UND 17;
6428   UND 18;
6429   UND 9;
6430   INT_ARITH_TAC;
6431   (* 3rd case *)
6432   (* 3c *)
6433   REWR 11;
6434   USE 11(REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6435   USE 3(REWRITE_RULE[edge]);
6436   CHO 3;
6437   UND 3;
6438   DISCH_THEN DISJ_CASES_TAC;
6439   REWR 9;
6440   USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
6441   REWR 8;
6442   REWR 9;
6443   UND 9;
6444   UND 11;
6445   UND 0;
6446   REWR 12;
6447   USE 0(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6448   UND 0;
6449   USE 1 (MATCH_MP endpoint_lemma_big_snd );
6450   UND 0;
6451   INT_ARITH_TAC;
6452   (* LAST case ,3d *)
6453   TYPE_THEN `G (h_edge m')` SUBGOAL_TAC;
6454   ASM_MESON_TAC[ISUBSET];
6455   DISCH_TAC;
6456   REWR 12;
6457   USE 12 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6458   TYPE_THEN `SND x = SND m''` SUBGOAL_TAC;
6459   ASM_MESON_TAC[];
6460   DISCH_TAC;
6461   REWR 12;
6462   REWR 7;
6463    USE 7(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
6464   REWR 7;
6465   TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC;
6466   ASM_MESON_TAC[];
6467   DISCH_TAC;
6468   UND 7;
6469   COPY 17;
6470   UND 7;
6471   DISCH_THEN_REWRITE;
6472   DISCH_TAC;
6473   REWR 9;
6474    USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
6475   REWR 8;
6476   REWR 9;
6477   TYPE_THEN `SND x = SND m'` SUBGOAL_TAC;
6478   ASM_MESON_TAC[];
6479   DISCH_TAC;
6480   UND 11;
6481   COPY 18;
6482   UND 11;
6483   DISCH_THEN_REWRITE;
6484   DISCH_TAC;
6485   TYPE_THEN `(FST m'' = FST m) \/ (FST m'' = FST m -: &:1)` SUBGOAL_TAC;
6486   UND 11;
6487   UND 7;
6488   UND 12;
6489   INT_ARITH_TAC;
6490   DISCH_TAC;
6491   TYPE_THEN `~(SND m'' <=: SND m)` SUBGOAL_TAC;
6492   UND 19;
6493   UND 9;
6494   INT_ARITH_TAC;
6495   UND 16;
6496   UND 18;
6497   UND 17;
6498   INT_ARITH_TAC;
6499   ]);;
6500
6501   (* }}} *)
6502
6503 let endpoint_lemma_upper_left = prove_by_refinement(
6504   `!G m . (rectagon G) ==>
6505        ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`,
6506   (* {{{ proof *)
6507
6508   [
6509   (* needs to be rewritten, template only *)
6510   REP_GEN_TAC;
6511   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;
6512   ASM_MESON_TAC[];
6513   DISCH_THEN IMATCH_MP_TAC ;
6514   GEN_TAC;
6515   DISCH_TAC;
6516   USE 0 (MATCH_MP endpoint_lemma);
6517   CHO 0;
6518   CHO 0;
6519   CHO 0;
6520   UND 0;
6521   DISCH_ALL_TAC;
6522   UND 1;
6523   DISCH_THEN DISJ_CASES_TAC;
6524   REWR 6;
6525   USE 6 (REWRITE_RULE[part_below_v]);
6526   REWR 10;
6527   USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6528   TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC;
6529   ASM_MESON_TAC[];
6530   TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
6531   ASM_MESON_TAC[];
6532   INT_ARITH_TAC;
6533   (* 2nd case *)
6534   REWR 6;
6535   USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
6536   REWR 10;
6537   USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6538   TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
6539   ASM_MESON_TAC[];
6540   INT_ARITH_TAC;
6541   ]);;
6542
6543   (* }}} *)
6544
6545 let endpoint_lemma_upper_left = prove_by_refinement(
6546   `!G m . (rectagon G) ==>
6547        ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`,
6548   (* {{{ proof *)
6549
6550   [
6551   (* needs to be rewritten, template only *)
6552   REP_GEN_TAC;
6553   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;
6554   ASM_MESON_TAC[];
6555   DISCH_THEN IMATCH_MP_TAC ;
6556   GEN_TAC;
6557   DISCH_TAC;
6558   USE 0 (MATCH_MP endpoint_lemma);
6559   CHO 0;
6560   CHO 0;
6561   CHO 0;
6562   UND 0;
6563   DISCH_ALL_TAC;
6564   UND 1;
6565   DISCH_THEN DISJ_CASES_TAC;
6566   REWR 6;
6567   USE 6 (REWRITE_RULE[part_below_v]);
6568   REWR 10;
6569   USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6570   TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC;
6571   ASM_MESON_TAC[];
6572   TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
6573   ASM_MESON_TAC[];
6574   INT_ARITH_TAC;
6575   (* 2nd case *)
6576   REWR 6;
6577   USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
6578   REWR 10;
6579   USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6580   TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
6581   ASM_MESON_TAC[];
6582   INT_ARITH_TAC;
6583   ]);;
6584
6585   (* }}} *)
6586
6587 let endpoint_lemma_upper_right = prove_by_refinement(
6588   `!G m . (rectagon G) ==>
6589        ~(endpoint (part_below G m) (FST m +: &:1, SND m +: &:1))`,
6590   (* {{{ proof *)
6591
6592   [
6593   (* needs to be rewritten, template only *)
6594   REP_GEN_TAC;
6595   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;
6596   ASM_MESON_TAC[];
6597   DISCH_THEN IMATCH_MP_TAC ;
6598   GEN_TAC;
6599   DISCH_TAC;
6600   USE 0 (MATCH_MP endpoint_lemma);
6601   CHO 0;
6602   CHO 0;
6603   CHO 0;
6604   UND 0;
6605   DISCH_ALL_TAC;
6606   UND 1;
6607   DISCH_THEN DISJ_CASES_TAC;
6608   REWR 6;
6609   USE 6 (REWRITE_RULE[part_below_v]);
6610   REWR 10;
6611   USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6612   TYPE_THEN `FST m +: &:1 = FST m'` SUBGOAL_TAC;
6613   ASM_MESON_TAC[];
6614   TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
6615   ASM_MESON_TAC[];
6616   INT_ARITH_TAC;
6617   (* 2nd case *)
6618   REWR 6;
6619   USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
6620   REWR 10;
6621   USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
6622   TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
6623   ASM_MESON_TAC[];
6624   INT_ARITH_TAC;
6625   ]);;
6626
6627   (* }}} *)
6628
6629 let endpoint_lemma_summary = prove_by_refinement(
6630   `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
6631     ((FST x = FST m -: &:1) /\ (SND x <=: SND  m)) \/
6632     ((FST x = FST m +: &:1) /\ (SND x <=: SND m)) \/
6633     ((FST x = FST m) /\ (SND x = SND m +: &:1 )) `,
6634   (* {{{ proof *)
6635   [
6636   (* USE int -arith to show cases of fst x, then for each give *)
6637   REP_GEN_TAC;
6638   DISCH_TAC;
6639   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;
6640   INT_ARITH_TAC;
6641   REP_CASES_TAC ;
6642   USE 0 (MATCH_MP endpoint_lemma_small_fst);
6643   PROOF_BY_CONTR_TAC;
6644   UND 0;
6645   UND 1;
6646   INT_ARITH_TAC;
6647   DISJ1_TAC;
6648   ASM_REWRITE_TAC[];
6649   COPY 0;
6650   USE 0 (MATCH_MP endpoint_lemma_big_snd);
6651   IMATCH_MP_TAC  (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`);
6652   ASM_REWRITE_TAC[];
6653   PROOF_BY_CONTR_TAC;
6654   REWR 3;
6655   TYPE_THEN `x = (FST m -: &:1, SND m + &:1)` SUBGOAL_TAC;
6656   ASM_REWRITE_TAC[PAIR_SPLIT];
6657   DISCH_TAC;
6658   REWR 2;
6659   ASM_MESON_TAC[endpoint_lemma_upper_left];
6660   USE 0 (MATCH_MP endpoint_lemma_mid_fst);
6661   ASM_MESON_TAC[];
6662   DISJ2_TAC;
6663   DISJ1_TAC ;
6664   ASM_REWRITE_TAC[];
6665   COPY 0;
6666   USE 0 (MATCH_MP endpoint_lemma_big_snd);
6667   IMATCH_MP_TAC  (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`);
6668   ASM_REWRITE_TAC[];
6669   PROOF_BY_CONTR_TAC;
6670   REWR 3;
6671   TYPE_THEN `x = (FST m +: &:1, SND m + &:1)` SUBGOAL_TAC;
6672   ASM_REWRITE_TAC[PAIR_SPLIT];
6673   DISCH_TAC;
6674   REWR 2;
6675   ASM_MESON_TAC[endpoint_lemma_upper_right];
6676   USE 0 (MATCH_MP endpoint_lemma_big_fst);
6677   PROOF_BY_CONTR_TAC;
6678   UND 0;
6679   UND 1;
6680   INT_ARITH_TAC;
6681   ]);;
6682   (* }}} *)
6683
6684 let terminal_case1 = prove_by_refinement(
6685   `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
6686       (closure top2 (h_edge n) (pointI x)) /\ (set_lower G m n ) ==>
6687       (x = right  n)`,
6688   (* {{{ proof *)
6689   [
6690   REWRITE_TAC[h_edge_cpoint; set_lower];
6691   DISCH_ALL_TAC;
6692   USE 2 (REWRITE_RULE[PAIR_SPLIT]);
6693   UND 2;
6694   DISCH_THEN DISJ_CASES_TAC;
6695   TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
6696   ASM_MESON_TAC[];
6697   DISCH_TAC;
6698   JOIN 0 1;
6699   USE 0 (MATCH_MP endpoint_lemma_mid_fst);
6700   REWR 0;
6701   UND 0;
6702   UND 2;
6703   UND 5;
6704   INT_ARITH_TAC;
6705   TYPE_THEN `FST x = FST m +: &:1` SUBGOAL_TAC;
6706   ASM_MESON_TAC[];
6707   REWRITE_TAC[PAIR_SPLIT;right  ];
6708   ASM_MESON_TAC[];
6709   ]);;
6710   (* }}} *)
6711
6712 let terminal_case2 = prove_by_refinement(
6713   `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
6714       (closure top2 (h_edge n) (pointI x)) /\
6715           (set_lower G (left  m) n ) ==>
6716       (x =  n)`,
6717   (* {{{ proof *)
6718   [
6719   REWRITE_TAC[h_edge_cpoint; set_lower ];
6720   DISCH_ALL_TAC;
6721   USE 2 (REWRITE_RULE[PAIR_SPLIT]);
6722   UND 2;
6723   DISCH_THEN DISJ_CASES_TAC;
6724   ASM_REWRITE_TAC[PAIR_SPLIT];
6725   TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
6726   UND 2;
6727   UND 4;
6728   REWRITE_TAC[left ];
6729   INT_ARITH_TAC ;
6730   DISCH_TAC;
6731   JOIN 0 1;
6732   USE 0 (MATCH_MP endpoint_lemma_mid_fst);
6733   AND 2;
6734   UND 2;
6735   REWR 0;
6736   DISCH_TAC;
6737   UND 5;
6738   UND 0;
6739   REWRITE_TAC[left  ];
6740   INT_ARITH_TAC;
6741   ]);;
6742   (* }}} *)
6743
6744 let terminal_case_v = prove_by_refinement(
6745   `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
6746       (closure top2 (v_edge n) (pointI x)) /\
6747           (part_below G m (v_edge n)) ==>
6748       (x = up m) /\ (m =n)`,
6749   (* {{{ proof *)
6750   [
6751   REWRITE_TAC[part_below_v; v_edge_cpoint;];
6752   DISCH_ALL_TAC;
6753   JOIN 0 1;
6754   USE 2 (REWRITE_RULE[PAIR_SPLIT]);
6755   REWR 1;
6756   TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
6757   ASM_MESON_TAC[];
6758   DISCH_TAC;
6759   REWR 1;
6760   REWRITE_TAC[PAIR_SPLIT; up ;];
6761   ASM_REWRITE_TAC[];
6762   USE 0 (MATCH_MP endpoint_lemma_mid_fst);
6763   REWR 0;
6764   ASM_REWRITE_TAC[];
6765   UND 0;
6766   UND 1;
6767   UND 5;
6768   INT_ARITH_TAC;
6769   ]);;
6770   (* }}} *)
6771
6772 let inj_terminal = prove_by_refinement(
6773   `!G m. (rectagon G) ==>
6774      (INJ (terminal_edge (part_below G m))
6775          (endpoint (part_below G m)) UNIV)`,
6776   (* {{{ proof *)
6777   [
6778   DISCH_ALL_TAC;
6779   TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC ;
6780   ASM_MESON_TAC[part_below_finite;rectagon];
6781   DISCH_TAC;
6782   REWRITE_TAC[INJ];
6783   DISCH_ALL_TAC;
6784   TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC;
6785   TYPE_THEN `closure top2 e (pointI x) /\ closure top2 e (pointI y)` SUBGOAL_TAC;
6786   ASM_MESON_TAC[terminal_endpoint];
6787   DISCH_ALL_TAC;
6788   TYPE_THEN `(part_below G m) e` SUBGOAL_TAC;
6789   ASM_MESON_TAC[terminal_endpoint];
6790   DISCH_TAC;
6791   TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC;
6792   REWRITE_TAC[part_below;ISUBSET];
6793   MESON_TAC[];
6794   DISCH_TAC;
6795   TYPE_THEN `edge e` SUBGOAL_TAC;
6796   ASM_MESON_TAC[ISUBSET;rectagon];
6797   REWRITE_TAC[edge];
6798   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
6799   TYPE_THEN `(x = up m) /\ (y = up m)` SUBGOAL_TAC;
6800   ASM_MESON_TAC[terminal_case_v];
6801   MESON_TAC[];
6802   (* h-case *)
6803   UND 4;
6804   REWR 8;
6805   USE 4 (REWRITE_RULE[part_below_h ;]);
6806   DISCH_TAC;
6807   UND 4;
6808   DISCH_THEN DISJ_CASES_TAC;
6809   TYPE_THEN `(x = right  m') /\ (y = right m')` SUBGOAL_TAC  ;
6810   ASM_MESON_TAC[terminal_case1];
6811   MESON_TAC[];
6812   TYPE_THEN `( x= m' ) /\ (y = m') ` SUBGOAL_TAC;
6813   ASM_MESON_TAC[terminal_case2];
6814   MESON_TAC[];
6815   ]);;
6816   (* }}} *)
6817
6818 (* now start on surjectivity results *)
6819
6820 let endpoint_criterion = prove_by_refinement(
6821   `!G m e. (FINITE G) /\
6822        (!e'. (G e' /\ (closure top2 e' (pointI m))) = (e = e')) ==>
6823      (endpoint G m) /\ (e = terminal_edge G m)`,
6824   (* {{{ proof *)
6825   [
6826   DISCH_ALL_TAC;
6827   SUBCONJ_TAC;
6828   REWRITE_TAC[endpoint;];
6829   ASM_SIMP_TAC[num_closure1];
6830   ASM_MESON_TAC[];
6831   DISCH_TAC;
6832   ASM_MESON_TAC[terminal_unique];
6833   ]);;
6834   (* }}} *)
6835
6836 let target_set = jordan_def `target_set G m =
6837     { e | (?n. (e = h_edge n) /\ (set_lower G m n)) \/
6838           (?n. (e = h_edge n) /\ (set_lower G (left m) n)) \/
6839           ((e = v_edge m) /\ G e)}`;;
6840
6841 let target_set_subset = prove_by_refinement(
6842   `!G m. target_set G m SUBSET G`,
6843   (* {{{ proof *)
6844   [
6845   REWRITE_TAC[ISUBSET;target_set;set_lower];
6846   ASM_MESON_TAC[];
6847   ]);;
6848   (* }}} *)
6849
6850 let target_edge = prove_by_refinement(
6851   `!G m. target_set G m SUBSET edge`,
6852   (* {{{ proof *)
6853   [
6854   REWRITE_TAC[target_set;edge;ISUBSET ];
6855   ASM_MESON_TAC[];
6856   ]);;
6857   (* }}} *)
6858
6859 let target_h = prove_by_refinement(
6860   `!G m n. target_set G m (h_edge n) <=>
6861          (set_lower G m n) \/ (set_lower G (left  m) n)`,
6862   (* {{{ proof *)
6863   [
6864   DISCH_ALL_TAC;
6865   REWRITE_TAC[target_set;h_edge_inj; hv_edgeV2;];
6866   ASM_MESON_TAC[];
6867   ]);;
6868   (* }}} *)
6869
6870 let target_v = prove_by_refinement(
6871   `!G m n. target_set G m (v_edge n) <=>
6872         (n = m) /\ G (v_edge n)`,
6873   (* {{{ proof *)
6874   [
6875   DISCH_ALL_TAC;
6876   REWRITE_TAC[target_set;hv_edgeV2;v_edge_inj;];
6877   ]);;
6878   (* }}} *)
6879
6880 let part_below_subset = prove_by_refinement(
6881   `!G m. (part_below G m SUBSET G)`,
6882   (* {{{ proof *)
6883   [
6884   REWRITE_TAC[part_below;ISUBSET];
6885   MESON_TAC[];
6886   ]);;
6887   (* }}} *)
6888
6889 let part_below_finite = prove_by_refinement(
6890   `!G m. (FINITE G ==> FINITE (part_below G m))`,
6891   (* {{{ proof *)
6892   [
6893   DISCH_ALL_TAC;
6894   IMATCH_MP_TAC  FINITE_SUBSET;
6895   TYPE_THEN `G` EXISTS_TAC;
6896   ASM_REWRITE_TAC[part_below_subset];
6897   ]);;
6898   (* }}} *)
6899
6900 let terminal_edge_image = prove_by_refinement(
6901   `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
6902       (target_set G m (terminal_edge (part_below G m) x))`,
6903   (* {{{ proof *)
6904   [
6905   DISCH_ALL_TAC;
6906   TYPE_THEN `FINITE G` SUBGOAL_TAC;
6907   ASM_MESON_TAC[rectagon];
6908   DISCH_TAC;
6909   COPY 2;
6910   USE 2 ( MATCH_MP part_below_finite);
6911   TSPEC `m` 2;
6912   REWRITE_TAC[target_set];
6913   TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC;
6914   TYPE_THEN `(part_below G m e) /\ (closure top2 e (pointI x))` SUBGOAL_TAC;
6915   ASM_MESON_TAC[terminal_endpoint];
6916   DISCH_ALL_TAC;
6917   TYPE_THEN `edge e` SUBGOAL_TAC;
6918   ASM_MESON_TAC[part_below_subset;ISUBSET;rectagon];
6919   REWRITE_TAC[edge];
6920   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
6921   ASM_REWRITE_TAC[hv_edgeV2;v_edge_inj];
6922   REWR 5;
6923   USE 5 (REWRITE_RULE[part_below_v]);
6924   ASM_REWRITE_TAC[PAIR_SPLIT ];
6925   REWR 6;
6926   USE 6 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
6927   TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
6928   ASM_MESON_TAC[];
6929   DISCH_TAC;
6930   REWR 6;
6931   TYPE_THEN `SND x = SND m +: &:1` SUBGOAL_TAC;
6932   ASM_MESON_TAC[endpoint_lemma_mid_fst];
6933   UND 6;
6934   AND 5;
6935   AND 5;
6936   UND 5;
6937   INT_ARITH_TAC;
6938   (* H edge *)
6939   ASM_REWRITE_TAC[hv_edgeV2;h_edge_inj;];
6940   REWR 5;
6941   USE 5(REWRITE_RULE[part_below_h ]);
6942   ASM_MESON_TAC[];
6943   ]);;
6944   (* }}} *)
6945
6946 let terminal_edge_surj = prove_by_refinement(
6947   `!G m e. (rectagon G) /\ (target_set G m e) ==>
6948        (?x. (endpoint (part_below G m) x) /\
6949           (e = terminal_edge (part_below G m) x))`,
6950   (* {{{ proof *)
6951   [
6952   DISCH_ALL_TAC;
6953   TYPE_THEN `FINITE G` SUBGOAL_TAC;
6954   ASM_MESON_TAC[rectagon];
6955   DISCH_TAC;
6956   TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC;
6957   ASM_MESON_TAC[part_below_finite];
6958   DISCH_TAC;
6959   TYPE_THEN `(part_below G m) SUBSET G` SUBGOAL_TAC;
6960   ASM_MESON_TAC[part_below_subset];
6961   DISCH_TAC;
6962   TYPE_THEN `edge e` SUBGOAL_TAC;
6963   ASM_MESON_TAC[target_edge;ISUBSET];
6964   REWRITE_TAC[edge];
6965   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
6966   REWR 1;
6967   USE 1(REWRITE_RULE[target_v]);
6968   AND 1;
6969   REWR 1;
6970   REWR 5;
6971   KILL 6;
6972   TYPE_THEN `up m` EXISTS_TAC;
6973   IMATCH_MP_TAC  endpoint_criterion;
6974   ASM_REWRITE_TAC[];
6975   GEN_TAC;
6976   EQ_TAC;
6977   DISCH_ALL_TAC;
6978   TYPE_THEN `edge e'` SUBGOAL_TAC;
6979   ASM_MESON_TAC[ISUBSET;rectagon];
6980   REWRITE_TAC[edge];
6981   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
6982   REWR 6;
6983   USE 6 (REWRITE_RULE[part_below_v]);
6984   ASM_REWRITE_TAC [v_edge_inj;PAIR_SPLIT];
6985   REWR 7;
6986   USE 7(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT;up;]);
6987   AND 6;
6988   AND 6;
6989   UND 6;
6990   UND 7;
6991   INT_ARITH_TAC;
6992   REWR 6;
6993   USE 6 (REWRITE_RULE[part_below_h;set_lower;left  ;]);
6994   TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC;
6995   ASM_MESON_TAC[];
6996   DISCH_TAC;
6997   REWR 7;
6998   USE 7(REWRITE_RULE[h_edge_cpoint; up; PAIR_SPLIT ]);
6999   UND 7;
7000   UND 9;
7001   INT_ARITH_TAC;
7002   DISCH_TAC;
7003   EXPAND_TAC "e'";
7004   KILL 6;
7005   ASM_REWRITE_TAC [part_below_v;v_edge_cpoint;up];
7006   INT_ARITH_TAC;
7007   (* half-on-proof , hedge *)
7008   (* hop *)
7009   REWR 1;
7010   USE 1(REWRITE_RULE[target_h]);
7011   UND 1;
7012   DISCH_THEN (DISJ_CASES_TAC); (* split LEFT and RIGHT H *)
7013   TYPE_THEN `right  m'` EXISTS_TAC;
7014   IMATCH_MP_TAC  endpoint_criterion;
7015   ASM_REWRITE_TAC[];
7016   GEN_TAC;
7017   EQ_TAC;
7018   DISCH_ALL_TAC;
7019   TYPE_THEN `edge e'` SUBGOAL_TAC;
7020   ASM_MESON_TAC[ISUBSET;rectagon];
7021   REWRITE_TAC[edge];
7022   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); (* snd H or v *)
7023   REWR 6;
7024   USE 6 (REWRITE_RULE[part_below_v]);
7025   REWR 7;
7026   USE 7(REWRITE_RULE[v_edge_cpoint;right  ;PAIR_SPLIT; ]);
7027   REWRITE_TAC[h_edge_inj;hv_edgeV2;];
7028   USE 1 (REWRITE_RULE[set_lower]);
7029   ASM_MESON_TAC[INT_ARITH `~(x +: &:1 = x)`];
7030   ASM_REWRITE_TAC [h_edge_inj;PAIR_SPLIT ];  (* snd H *)
7031   KILL 5;
7032   UND 8;
7033   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE [t]));
7034   RULE_ASSUM_TAC (REWRITE_RULE[part_below_h;h_edge_cpoint;PAIR_SPLIT;right  ]);
7035   UND 6;
7036   DISCH_THEN DISJ_CASES_TAC;
7037   RULE_ASSUM_TAC (REWRITE_RULE[set_lower]);
7038   ASM_MESON_TAC[];
7039   RULE_ASSUM_TAC (REWRITE_RULE[set_lower;left  ]);
7040   AND 5;
7041   AND 5;
7042   PROOF_BY_CONTR_TAC;
7043   UND 8;
7044   UND 7;
7045   UND 1;
7046   INT_ARITH_TAC;
7047   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
7048   REWRITE_TAC[part_below_h;h_edge_cpoint;right  ];
7049   ASM_REWRITE_TAC[];
7050   KILL 5;
7051   (* finally LEFT case: now everything needs to have an endpoint *)
7052   (* hop3*)
7053   USE 1 (REWRITE_RULE[set_lower;left  ]);
7054   TYPE_THEN `  m'` EXISTS_TAC ; (* was left  m *)
7055   IMATCH_MP_TAC  endpoint_criterion;
7056   ASM_REWRITE_TAC[];
7057   GEN_TAC;
7058   EQ_TAC;
7059   DISCH_ALL_TAC;
7060   TYPE_THEN `edge e'` SUBGOAL_TAC;
7061   ASM_MESON_TAC[rectagon;ISUBSET];
7062   REWRITE_TAC[edge];
7063   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
7064   ASM_REWRITE_TAC[];
7065   UND 7;
7066   DISCH_THEN  (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
7067   RULE_ASSUM_TAC  (REWRITE_RULE[part_below_v;v_edge_cpoint;left  ;PAIR_SPLIT ;]);
7068   UND 5;
7069   UND 6;
7070   UND 1;
7071   INT_ARITH_TAC;
7072   (* now H *)
7073   ASM_REWRITE_TAC[];
7074   UND 7;
7075   DISCH_THEN  (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
7076   RULE_ASSUM_TAC  (REWRITE_RULE[part_below_h;h_edge_cpoint;left  ;PAIR_SPLIT ;]);
7077   UND 5;
7078   DISCH_THEN DISJ_CASES_TAC;
7079   USE 5(REWRITE_RULE[set_lower]);
7080   UND 5;
7081   UND 6;
7082   UND 1;
7083   INT_ARITH_TAC;
7084   (* hop2 *)
7085   USE 5 (REWRITE_RULE[set_lower]);
7086   REWRITE_TAC[h_edge_inj;PAIR_SPLIT;];
7087   UND 5;
7088   UND 6;
7089   UND 1;
7090   INT_ARITH_TAC;
7091   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
7092   ASM_REWRITE_TAC[part_below_h;h_edge_cpoint; set_lower; left  ];
7093   ]);;
7094   (* }}} *)
7095
7096 (* set *)
7097 let inj_subset = prove_by_refinement(
7098   `!t t' s (f:A->B). (INJ f s t') /\ (t SUBSET t') /\
7099          (IMAGE f s SUBSET t) ==> (INJ f s t)`,
7100   (* {{{ proof *)
7101   [
7102   REWRITE_TAC[INJ;IMAGE;SUBSET ];
7103   ASM_MESON_TAC[];
7104   ]);;
7105   (* }}} *)
7106
7107 let terminal_edge_bij = prove_by_refinement(
7108   `!G m. (rectagon G) ==>
7109      (BIJ (terminal_edge (part_below G m))
7110          (endpoint (part_below G m)) (target_set G m))`,
7111   (* {{{ proof *)
7112   [
7113   DISCH_ALL_TAC;
7114   REWRITE_TAC[BIJ];
7115   SUBCONJ_TAC;
7116   IMATCH_MP_TAC  inj_subset;
7117   TYPE_THEN `UNIV:((num->real)->bool)->bool` EXISTS_TAC;
7118   ASM_SIMP_TAC[inj_terminal];
7119   REWRITE_TAC[IMAGE;SUBSET];
7120   ASM_MESON_TAC[terminal_edge_image];
7121   REWRITE_TAC[INJ;SURJ];
7122   DISCH_ALL_TAC;
7123   ASM_REWRITE_TAC[];
7124   ASM_MESON_TAC[terminal_edge_surj];
7125   ]);;
7126   (* }}} *)
7127
7128 let target_set_finite = prove_by_refinement(
7129   `!G m. (FINITE  G) ==> (FINITE (target_set G m))`,
7130   (* {{{ proof *)
7131   [
7132   DISCH_ALL_TAC;
7133   IMATCH_MP_TAC  FINITE_SUBSET;
7134   TYPE_THEN `G` EXISTS_TAC;
7135   ASM_MESON_TAC[target_set_subset];
7136   ]);;
7137   (* }}} *)
7138
7139 let rectagon_endpoint0 = prove_by_refinement(
7140   `!G. (rectagon G) ==> ((endpoint G) HAS_SIZE 0)`,
7141   (* {{{ proof *)
7142   [
7143   DISCH_ALL_TAC;
7144   TYPE_THEN `endpoint G = {}` SUBGOAL_TAC;
7145   REWRITE_TAC[EQ_EMPTY];
7146   ASM_MESON_TAC[rectagon_endpoint];
7147   DISCH_THEN_REWRITE;
7148   ASM_MESON_TAC[HAS_SIZE_0];
7149   ]);;
7150   (* }}} *)
7151
7152 let target_set_even = prove_by_refinement(
7153   `!G m. (rectagon G) ==> (EVEN (CARD (target_set G m)))`,
7154   (* {{{ proof *)
7155   [
7156   DISCH_ALL_TAC;
7157   TYPE_THEN `CARD (endpoint(part_below G m)) = CARD (target_set G m)` SUBGOAL_TAC;
7158   IMATCH_MP_TAC  BIJ_CARD ;
7159   TYPE_THEN `terminal_edge (part_below G m)` EXISTS_TAC;
7160   ASM_SIMP_TAC[terminal_edge_bij];
7161   ASSUME_TAC terminal_edge_bij;
7162   TYPEL_THEN [`G`;`m`] (USE 1 o ISPECL);
7163   REWR 1;
7164   ASSUME_TAC target_set_finite;
7165   TYPEL_THEN [`G`;`m`] (USE 2 o ISPECL);
7166   ASM_MESON_TAC[FINITE_BIJ2;rectagon];
7167   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
7168   TYPE_THEN `rectagon (part_below G m)` ASM_CASES_TAC;
7169   TYPE_THEN `CARD (endpoint (part_below G m)) =0` SUBGOAL_TAC;
7170   ASM_MESON_TAC[HAS_SIZE;rectagon_endpoint0];
7171   MESON_TAC[EVEN];
7172   TYPE_THEN `P = part_below G m` ABBREV_TAC ;
7173   TYPE_THEN `segment G /\ (P SUBSET G) /\ ~(rectagon P)` SUBGOAL_TAC;
7174   ASM_SIMP_TAC[rectagon_segment];
7175   ASM_MESON_TAC[part_below_subset];
7176   DISCH_TAC;
7177   USE 3 (MATCH_MP endpoint_even );
7178   USE 3 (REWRITE_RULE[HAS_SIZE]);
7179   ASM_REWRITE_TAC[EVEN_DOUBLE];
7180   ]);;
7181   (* }}} *)
7182
7183 let bij_target_set = prove_by_refinement(
7184   `!G m. (rectagon G) /\ ~(G (v_edge m)) ==>
7185      (BIJ h_edge (set_lower G (left  m) UNION (set_lower G m))
7186            (target_set G m))`,
7187   (* {{{ proof *)
7188   [
7189   DISCH_ALL_TAC;
7190   REWRITE_TAC[BIJ];
7191   SUBCONJ_TAC;
7192   REWRITE_TAC[INJ];
7193   CONJ_TAC;
7194   REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; ];
7195   MESON_TAC[];
7196   REWRITE_TAC[h_edge_inj;];
7197   MESON_TAC[];
7198   REWRITE_TAC[INJ;SURJ];
7199   DISCH_ALL_TAC;
7200   ASM_REWRITE_TAC[];
7201   REWRITE_TAC[target_set;set_lower;UNION;];
7202   GEN_TAC;
7203   REP_CASES_TAC;
7204   CHO 4;
7205   UND 4;
7206   DISCH_ALL_TAC;
7207   ASM_MESON_TAC[];
7208   CHO 4;
7209   ASM_MESON_TAC[];
7210   ASM_MESON_TAC[];
7211   ]);;
7212   (* }}} *)
7213
7214 let bij_target_set_odd = prove_by_refinement(
7215   `!G m. (rectagon G) /\ (G (v_edge m)) ==>
7216      (BIJ h_edge (set_lower G (left  m) UNION
7217              (set_lower G m) )
7218            (target_set G m DELETE (v_edge m)))`,
7219   (* {{{ proof *)
7220   [
7221   DISCH_ALL_TAC;
7222   REWRITE_TAC[BIJ];
7223   SUBCONJ_TAC;
7224   REWRITE_TAC[INJ];
7225   CONJ_TAC;
7226   REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; DELETE ];
7227   MESON_TAC[];
7228   REWRITE_TAC[h_edge_inj;];
7229   MESON_TAC[];
7230   REWRITE_TAC[INJ;SURJ];
7231   DISCH_ALL_TAC;
7232   ASM_REWRITE_TAC[];
7233   REWRITE_TAC[target_set;set_lower;UNION;DELETE ];
7234   GEN_TAC;
7235   DISCH_TAC;
7236   AND  4;
7237   REWR 5;
7238   UND 5;
7239   REP_CASES_TAC;
7240   CHO 5;
7241   UND 5;
7242   DISCH_ALL_TAC;
7243   ASM_MESON_TAC[];
7244   CHO 5;
7245   ASM_MESON_TAC[];
7246   ]);;
7247   (* }}} *)
7248
7249 let target_set_odd = prove_by_refinement(
7250   `!G m. (rectagon G) /\ (G (v_edge m)) ==>
7251          ~(EVEN(CARD (target_set G m DELETE (v_edge m))))`,
7252   (* {{{ proof *)
7253   [
7254   REWRITE_TAC[GSYM EVEN];
7255   DISCH_ALL_TAC;
7256   TYPE_THEN `FINITE (target_set G m)` SUBGOAL_TAC;
7257   ASM_MESON_TAC[target_set_finite;rectagon];
7258   DISCH_TAC;
7259   TYPE_THEN `target_set G m (v_edge m)` SUBGOAL_TAC;
7260   ASM_REWRITE_TAC [target_v];
7261   DISCH_TAC;
7262   TYPE_THEN `SUC (CARD (target_set G m DELETE (v_edge m))) = CARD (target_set G m )` SUBGOAL_TAC;
7263   IMATCH_MP_TAC  CARD_SUC_DELETE;
7264   ASM_REWRITE_TAC[];
7265   DISCH_THEN_REWRITE;
7266   ASM_MESON_TAC[target_set_even];
7267   ]);;
7268   (* }}} *)
7269
7270 let squ_left_even = prove_by_refinement(
7271   `!G m. (rectagon G) /\ ~(G (v_edge m)) ==>
7272      ((even_cell G (squ (left m)) = even_cell G(squ m)))`,
7273   (* {{{ proof *)
7274   [
7275   DISCH_ALL_TAC;
7276   TYPE_THEN `FINITE G` SUBGOAL_TAC;
7277   ASM_MESON_TAC[rectagon];
7278   DISCH_TAC;
7279   REWRITE_TAC[even_cell_squ;num_lower_set];
7280   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;
7281   IMATCH_MP_TAC  even_card_even;
7282   ASM_SIMP_TAC[finite_set_lower];
7283   REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ];
7284   MESON_TAC[INT_ARITH `~(z = z -: &:1)`];
7285   DISCH_THEN_REWRITE;
7286   TYPE_THEN `BIJ h_edge (set_lower G (left  m) UNION (set_lower G m)) (target_set G m) ` SUBGOAL_TAC;
7287   ASM_MESON_TAC[bij_target_set];
7288   DISCH_TAC;
7289   TYPE_THEN `CARD (set_lower G (left  m) UNION (set_lower G m)) = CARD (target_set G m)` SUBGOAL_TAC;
7290   IMATCH_MP_TAC  BIJ_CARD ;
7291   TYPE_THEN `h_edge` EXISTS_TAC;
7292   ASM_REWRITE_TAC[];
7293   REWRITE_TAC[FINITE_UNION];
7294   ASM_MESON_TAC[finite_set_lower];
7295   DISCH_THEN_REWRITE;
7296   ASM_MESON_TAC[target_set_even];
7297   ]);;
7298   (* }}} *)
7299
7300 let squ_left_odd = prove_by_refinement(
7301   `!G m. (rectagon G) /\ (G (v_edge m)) ==>
7302      (~(even_cell G (squ (left m)) = even_cell G(squ m)))`,
7303   (* {{{ proof *)
7304   [
7305   DISCH_ALL_TAC;
7306   TYPE_THEN `FINITE G` SUBGOAL_TAC;
7307   ASM_MESON_TAC[rectagon];
7308   DISCH_TAC;
7309   UND 0;
7310   REWRITE_TAC[even_cell_squ;num_lower_set];
7311   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;
7312   IMATCH_MP_TAC  even_card_even;
7313   ASM_SIMP_TAC[finite_set_lower];
7314   REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ];
7315   MESON_TAC[INT_ARITH `~(z = z -: &:1)`];
7316   DISCH_THEN_REWRITE;
7317   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;
7318   ASM_MESON_TAC[bij_target_set_odd];
7319   DISCH_TAC;
7320   TYPE_THEN `CARD (set_lower G (left  m) UNION (set_lower G m)) = CARD (target_set G m DELETE (v_edge m))` SUBGOAL_TAC;
7321   IMATCH_MP_TAC  BIJ_CARD ;
7322   TYPE_THEN `h_edge` EXISTS_TAC;
7323   ASM_REWRITE_TAC[];
7324   REWRITE_TAC[FINITE_UNION];
7325   ASM_MESON_TAC[finite_set_lower];
7326   DISCH_THEN_REWRITE;
7327   ASM_MESON_TAC[target_set_odd];
7328   ]);;
7329   (* }}} *)
7330
7331 let squ_left_par = prove_by_refinement(
7332   `!G m. (rectagon G) ==>
7333        (((even_cell G (squ (left m)) = even_cell G(squ m))) <=>
7334             ~(G (v_edge m)))`,
7335   (* {{{ proof *)
7336   [
7337   ASM_MESON_TAC[squ_left_even;squ_left_odd];
7338   ]);;
7339   (* }}} *)
7340
7341 (* ------------------------------------------------------------------ *)
7342 (* SECTION E *)
7343 (* ------------------------------------------------------------------ *)
7344
7345
7346 let rectangle = jordan_def `rectangle p q =
7347   {Z | ?u v. (Z = point(u,v)) /\
7348     (real_of_int (FST p ) <. u) /\ (u <. (real_of_int (FST q ))) /\
7349     (real_of_int (SND p ) <. v) /\ (v <. (real_of_int (SND q))) }`;;
7350
7351 let rectangle_inter = prove_by_refinement(
7352   `!p q. rectangle p q =
7353       {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER
7354       {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER
7355      {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST q)} INTER
7356     {z | ?r. (z = point r) /\ (SND  r ) <. real_of_int(SND  q)}  `,
7357   (* {{{ proof *)
7358
7359   [
7360   DISCH_ALL_TAC;
7361   IMATCH_MP_TAC  EQ_EXT;
7362   REWRITE_TAC[rectangle;INTER];
7363   GEN_TAC;
7364   EQ_TAC;
7365   DISCH_TAC;
7366   CHO 0;
7367   CHO 0;
7368   ASM_REWRITE_TAC[point_inj];
7369   CONV_TAC (dropq_conv "r");
7370   ASM_REWRITE_TAC[];
7371   CONV_TAC (dropq_conv "r");
7372   ASM_REWRITE_TAC[];
7373   CONV_TAC (dropq_conv "r'");
7374   CONV_TAC (dropq_conv "r");
7375   ASM_REWRITE_TAC[];
7376   DISCH_ALL_TAC;
7377   CHO 0;
7378   REWR 1;
7379   USE 1 (REWRITE_RULE[point_inj]);
7380   USE 1(CONV_RULE (dropq_conv "r'"));
7381   REWR 2;
7382   USE 2(REWRITE_RULE[point_inj]);
7383   USE 2(CONV_RULE (dropq_conv "r'"));
7384   REWR 3;
7385   USE 3(REWRITE_RULE[point_inj]);
7386   USE 3(CONV_RULE (dropq_conv "r'"));
7387   REWRITE_TAC[point_inj;PAIR_SPLIT];
7388   CONV_TAC (dropq_conv "u");
7389   CONV_TAC (dropq_conv "v");
7390   ASM_MESON_TAC[];
7391   ]);;
7392
7393   (* }}} *)
7394
7395 let rectangle_open = prove_by_refinement(
7396   `!p q. top2 (rectangle p q)`,
7397   (* {{{ proof *)
7398   [
7399   REWRITE_TAC[rectangle_inter];
7400   ASSUME_TAC top2_top;
7401   DISCH_ALL_TAC;
7402   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]);
7403   ]);;
7404   (* }}} *)
7405
7406 let rectangle_convex = prove_by_refinement(
7407   `!p q. convex (rectangle p q)`,
7408   (* {{{ proof *)
7409   [
7410   REP_GEN_TAC;
7411   REWRITE_TAC[rectangle_inter];
7412   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]);
7413   ]);;
7414   (* }}} *)
7415
7416 let rectangle_squ = prove_by_refinement(
7417   `!p. squ p = rectangle p (FST p +: &:1,SND p +: &:1)`,
7418   (* {{{ proof *)
7419   [
7420   REWRITE_TAC[squ;rectangle];
7421   ]);;
7422   (* }}} *)
7423
7424 let squ_inter = prove_by_refinement(
7425   `!p. squ p =
7426    {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER
7427       {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER
7428      {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST p +: &:1) } INTER
7429     {z | ?r. (z = point r) /\ (SND  r ) <. real_of_int(SND p +: &:1) }`,
7430   (* {{{ proof *)
7431   [
7432   REWRITE_TAC[rectangle_squ;rectangle_inter];
7433   ]);;
7434   (* }}} *)
7435
7436 (* set *)
7437 let subset3_absorb = prove_by_refinement(
7438   `!(A:A->bool) B C. (B SUBSET C) ==> (B INTER A = B INTER C INTER A)`,
7439   (* {{{ proof *)
7440   [
7441   DISCH_ALL_TAC;
7442   REWRITE_TAC[INTER_ACI];
7443   AP_TERM_TAC;
7444   ASM_MESON_TAC[SUBSET_INTER_ABSORPTION];
7445   ]);;
7446   (* }}} *)
7447
7448 let rectangle_lemma1 = prove_by_refinement(
7449   `!p. squ(down p) =
7450      (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1))
7451     INTER {z | ?r. (z = point r) /\ (SND  r <. real_of_int(SND  p))}`,
7452   (* {{{ proof *)
7453   [
7454   DISCH_ALL_TAC;
7455   REWRITE_TAC[squ_inter;rectangle_inter;down];
7456   REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
7457   REWRITE_TAC[INTER_ACI];
7458   AP_TERM_TAC;
7459   AP_TERM_TAC;
7460   AP_TERM_TAC;
7461   IMATCH_MP_TAC  EQ_EXT;
7462   GEN_TAC;
7463   REWRITE_TAC[INTER;int_suc ;];
7464   EQ_TAC;
7465   DISCH_ALL_TAC;
7466   CHO 0;
7467   ASSUME_TAC (REAL_ARITH `!u. u <. u + &.1`);
7468   CONJ_TAC;
7469   TYPE_THEN `r` EXISTS_TAC;
7470   ASM_MESON_TAC[REAL_LT_TRANS ];
7471   ASM_MESON_TAC[];
7472   MESON_TAC[];
7473   ]);;
7474   (* }}} *)
7475
7476
7477 let rectangle_lemma2 = prove_by_refinement(
7478   `!p. squ(p) =
7479      (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1))
7480     INTER {z | ?r. (z = point r) /\ ( real_of_int(SND  p) <. SND  r)}`,
7481   (* {{{ proof *)
7482   [
7483   DISCH_ALL_TAC;
7484   REWRITE_TAC[squ_inter;rectangle_inter;down];
7485   REWRITE_TAC[INTER_ACI];
7486   AP_TERM_TAC;
7487   TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}` ABBREV_TAC ;
7488   TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND p -: &:1) < SND r}` ABBREV_TAC ;
7489   REWRITE_TAC[INTER_ACI];
7490   IMATCH_MP_TAC  subset3_absorb;
7491   EXPAND_TAC "B";
7492   EXPAND_TAC "C";
7493   REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th];
7494   ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`];
7495   ]);;
7496   (* }}} *)
7497
7498 let rectangle_lemma3 = prove_by_refinement(
7499   `!q. h_edge q =
7500     (rectangle (FST q , SND q -: &:1) (FST q +: &:1 , SND q +: &:1))
7501     INTER {z | ?r. (z = point r) /\ ( SND  r = real_of_int(SND  q))}`,
7502   (* {{{ proof *)
7503   [
7504   DISCH_ALL_TAC;
7505   REWRITE_TAC[h_edge_inter;rectangle_inter;];
7506   TYPE_THEN `B = {z | ?p. (z = point p) /\ (SND p = real_of_int (SND q))}` ABBREV_TAC ;
7507   TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ;
7508   TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
7509   REWRITE_TAC[INTER_ACI];
7510   TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
7511   REWRITE_TAC[INTER_ACI];
7512   DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
7513   IMATCH_MP_TAC subset3_absorb;
7514   REWRITE_TAC[SUBSET_INTER];
7515   EXPAND_TAC "B";
7516   EXPAND_TAC "C";
7517   EXPAND_TAC "D";
7518   REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;];
7519   ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`];
7520   ]);;
7521   (* }}} *)
7522
7523 let rectangle_h = prove_by_refinement(
7524   `!p. rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1) =
7525      ((squ (down p)) UNION (h_edge p) UNION  (squ p) )`,
7526   (* {{{ proof *)
7527   [
7528   GEN_TAC;
7529   REWRITE_TAC[rectangle_lemma1;rectangle_lemma2;rectangle_lemma3];
7530   REWRITE_TAC[GSYM UNION_OVER_INTER];
7531   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;
7532   IMATCH_MP_TAC  EQ_EXT;
7533   GEN_TAC;
7534   REWRITE_TAC[UNION];
7535   ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`];
7536   DISCH_THEN_REWRITE;
7537   TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1) SUBSET  {z | ?r. z = point r}` SUBGOAL_TAC;
7538   REWRITE_TAC[rectangle;SUBSET ];
7539   ASM_MESON_TAC[];
7540   REWRITE_TAC [SUBSET_INTER_ABSORPTION;];
7541   DISCH_THEN_REWRITE;
7542   ]);;
7543   (* }}} *)
7544
7545 let rectangle_lemma4 = prove_by_refinement(
7546   `!p. squ(left   p) =
7547      (rectangle (FST p -: &:1 , SND p)(FST p +: &:1 , SND p +: &:1))
7548     INTER {z | ?r. (z = point r) /\ (FST   r <. real_of_int(FST  p))}`,
7549   (* {{{ proof *)
7550   [
7551   DISCH_ALL_TAC;
7552   REWRITE_TAC[squ_inter;rectangle_inter;left  ];
7553   REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
7554   REWRITE_TAC[INTER_ACI];
7555   AP_TERM_TAC;
7556   AP_TERM_TAC;
7557   TYPE_THEN `B = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC  ;
7558   TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)}` ABBREV_TAC ;
7559   REWRITE_TAC[INTER_ACI];
7560   IMATCH_MP_TAC  subset3_absorb;
7561   EXPAND_TAC "B";
7562   EXPAND_TAC "C";
7563   REWRITE_TAC[SUBSET;int_suc];
7564   ASM_MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &.1`];
7565   ]);;
7566   (* }}} *)
7567
7568 let rectangle_lemma5 = prove_by_refinement(
7569   `!p. squ(p) =
7570      (rectangle (FST p -: &:1 , SND p) (FST p +: &:1 , SND p +: &:1))
7571     INTER {z | ?r. (z = point r) /\ ( real_of_int(FST   p) <. FST   r)}`,
7572   (* {{{ proof *)
7573   [
7574   DISCH_ALL_TAC;
7575   REWRITE_TAC[squ_inter;rectangle_inter;];
7576 TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r} ` ABBREV_TAC ;
7577   TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
7578   REWRITE_TAC[INTER_ACI];
7579   IMATCH_MP_TAC  subset3_absorb;
7580   EXPAND_TAC "B";
7581   EXPAND_TAC "C";
7582   REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th];
7583   ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`];
7584   ]);;
7585   (* }}} *)
7586
7587 let rectangle_lemma6 = prove_by_refinement(
7588   `!q. v_edge q =
7589     (rectangle (FST q -: &:1 , SND q) (FST q +: &:1 , SND q +: &:1))
7590     INTER {z | ?r. (z = point r) /\ ( FST   r = real_of_int(FST   q))}`,
7591   (* {{{ proof *)
7592   [
7593   DISCH_ALL_TAC;
7594   REWRITE_TAC[v_edge_inter;rectangle_inter;];
7595   REWRITE_TAC[INTER_ACI];
7596   TYPE_THEN `B = {z | ?p. (z = point p) /\ (FST  p = real_of_int (FST  q))}` ABBREV_TAC ;
7597   TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST q -: &:1) < FST r}` ABBREV_TAC ;
7598   TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST q +: &:1)}` ABBREV_TAC ;
7599   REWRITE_TAC[INTER_ACI];
7600   TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
7601   REWRITE_TAC[INTER_ACI];
7602   DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
7603   IMATCH_MP_TAC subset3_absorb;
7604   REWRITE_TAC[SUBSET_INTER];
7605   EXPAND_TAC "B";
7606   EXPAND_TAC "C";
7607   EXPAND_TAC "D";
7608   REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;];
7609   ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`];
7610   ]);;
7611   (* }}} *)
7612
7613 let rectangle_v = prove_by_refinement(
7614   `!p. rectangle (FST p -: &:1 , SND p ) (FST p +: &:1 , SND p +: &:1) =
7615      ((squ (left p)) UNION (v_edge p) UNION  (squ p) )`,
7616   (* {{{ proof *)
7617   [
7618   GEN_TAC;
7619   REWRITE_TAC[rectangle_lemma4;rectangle_lemma5;rectangle_lemma6];
7620   REWRITE_TAC[GSYM UNION_OVER_INTER];
7621   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;
7622   IMATCH_MP_TAC  EQ_EXT;
7623   GEN_TAC;
7624   REWRITE_TAC[UNION];
7625   ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`];
7626   DISCH_THEN_REWRITE;
7627   TYPE_THEN `rectangle (FST p -: &:1 ,SND p) (FST p +: &:1,SND p +: &:1) SUBSET  {z | ?r. z = point r}` SUBGOAL_TAC;
7628   REWRITE_TAC[rectangle;SUBSET ];
7629   ASM_MESON_TAC[];
7630   REWRITE_TAC [SUBSET_INTER_ABSORPTION;];
7631   DISCH_THEN_REWRITE;
7632   ]);;
7633   (* }}} *)
7634
7635 let long_v = jordan_def `long_v p =
7636   {z | (?r. (z = point r) /\ (FST r = real_of_int (FST p)) /\
7637        (real_of_int(SND  p) - &1 <. SND r) /\
7638        (SND r <. real_of_int(SND p) + &1) )}`;;
7639
7640 let long_v_inter = prove_by_refinement(
7641   `!p. long_v p =
7642     {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} INTER
7643       {z | ?r. (z = point r) /\ (real_of_int(SND p -: &:1) <. SND r)} INTER
7644      {z | ?r. (z = point r) /\ (SND  r  <. real_of_int(SND  p +: &:1))} `,
7645   (* {{{ proof *)
7646
7647   [
7648   GEN_TAC;
7649   IMATCH_MP_TAC  EQ_EXT ;
7650   REWRITE_TAC[long_v;INTER;int_add_th;int_sub_th;int_of_num_th];
7651   GEN_TAC;
7652   EQ_TAC;
7653   DISCH_THEN CHOOSE_TAC;
7654   ASM_MESON_TAC[];
7655   DISCH_ALL_TAC;
7656   CHO 0;
7657   REWR 1;
7658   REWR 2;
7659   RULE_ASSUM_TAC  (REWRITE_RULE[point_inj]);
7660   USE 2(CONV_RULE (dropq_conv "r'"));
7661   USE 1(CONV_RULE (dropq_conv "r'"));
7662   ASM_MESON_TAC[];
7663   ]);;
7664
7665   (* }}} *)
7666
7667 let long_v_lemma1 = prove_by_refinement(
7668   `!q. v_edge (down q) =
7669      long_v q INTER
7670          {z | ?r. (z = point r) /\ (SND  r  <. real_of_int(SND  q))}`,
7671   (* {{{ proof *)
7672   [
7673   REWRITE_TAC[v_edge_inter;long_v_inter;down ];
7674   REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
7675   GEN_TAC;
7676   TYPE_THEN `B = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q)}` ABBREV_TAC ;
7677   TYPE_THEN `C = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
7678   alpha_tac;
7679   REWRITE_TAC[INTER_ACI];
7680   IMATCH_MP_TAC  subset3_absorb;
7681   EXPAND_TAC "B";
7682   EXPAND_TAC "C";
7683   REWRITE_TAC[SUBSET;int_add_th;int_of_num_th];
7684   MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &1`];
7685   ]);;
7686   (* }}} *)
7687
7688 let long_v_lemma2 = prove_by_refinement(
7689   `!q. v_edge q =
7690      long_v q INTER
7691          {z | ?r. (z = point r) /\ (real_of_int(SND  q) <. SND  r  )}`,
7692   (* {{{ proof *)
7693   [
7694   REWRITE_TAC[v_edge_inter;long_v_inter;down;int_suc;int_sub_th;int_of_num_th ];
7695   GEN_TAC;
7696   TYPE_THEN `B = {z | ?r. (z = point r) /\  real_of_int (SND q) < SND r}` ABBREV_TAC ;
7697   TYPE_THEN `C = {z | ?r. (z = point r) /\  real_of_int (SND q) - &1 < SND r}` ABBREV_TAC ;
7698   alpha_tac;
7699   REWRITE_TAC[INTER_ACI];
7700   IMATCH_MP_TAC  subset3_absorb;
7701   EXPAND_TAC "B";
7702   EXPAND_TAC "C";
7703   REWRITE_TAC[SUBSET;int_add_th;int_of_num_th];
7704   MESON_TAC[REAL_ARITH `x <. y ==> x - &1 <. y`];
7705   ]);;
7706   (* }}} *)
7707
7708 let pointI_inter = prove_by_refinement(
7709   `!q. {(pointI q)} =
7710         {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))} INTER
7711         {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}`,
7712   (* {{{ proof *)
7713   [
7714   DISCH_ALL_TAC;
7715   IMATCH_MP_TAC  EQ_EXT;
7716   REWRITE_TAC[INTER;INR IN_SING;pointI ];
7717   GEN_TAC;
7718   EQ_TAC;
7719   DISCH_THEN_REWRITE;
7720   REWRITE_TAC[point_inj];
7721   CONV_TAC (dropq_conv "r");
7722   CONV_TAC (dropq_conv "r'");
7723   DISCH_ALL_TAC;
7724   CHO 0;
7725   REWR 1;
7726   USE 1(REWRITE_RULE[point_inj]);
7727   USE 1(CONV_RULE (dropq_conv "r'"));
7728   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;];
7729   ]);;
7730   (* }}} *)
7731
7732 let long_v_lemma3 = prove_by_refinement(
7733   `!q. {(pointI q)} = long_v q INTER
7734        { z | ?r. (z = point r) /\ (real_of_int(SND q) = SND r)}`,
7735   (* {{{ proof *)
7736   [
7737   REWRITE_TAC[pointI_inter;long_v_inter];
7738   GEN_TAC;
7739   alpha_tac;
7740   TYPE_THEN `A = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))}` ABBREV_TAC ;
7741   TYPE_THEN `B = {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}` ABBREV_TAC ;
7742   TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ;
7743   TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
7744   REWRITE_TAC[INTER_ACI];
7745   AP_TERM_TAC;
7746   ONCE_REWRITE_TAC [EQ_SYM_EQ];
7747   REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
7748   EXPAND_TAC "B";
7749   EXPAND_TAC "C";
7750   EXPAND_TAC "D";
7751   REWRITE_TAC[SUBSET;INTER;int_sub_th;int_of_num_th;int_add_th];
7752   ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &1 <. y /\ x <. y + &1)`];
7753   ]);;
7754   (* }}} *)
7755
7756 let long_v_union = prove_by_refinement(
7757   `!p. long_v p =
7758       (v_edge (down p)) UNION {(pointI p)} UNION (v_edge p)`,
7759   (* {{{ proof *)
7760   [
7761   GEN_TAC;
7762   REWRITE_TAC[long_v_lemma1;long_v_lemma2;long_v_lemma3];
7763   REWRITE_TAC[GSYM UNION_OVER_INTER];
7764   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;
7765   IMATCH_MP_TAC  EQ_EXT  ;
7766   GEN_TAC;
7767   REWRITE_TAC[UNION;];
7768   EQ_TAC;
7769   MESON_TAC[];
7770   DISCH_THEN CHOOSE_TAC;
7771   ASM_REWRITE_TAC[point_inj];
7772   CONV_TAC (dropq_conv "r'");
7773   REAL_ARITH_TAC;
7774   DISCH_THEN_REWRITE;
7775   ONCE_REWRITE_TAC[EQ_SYM_EQ];
7776   REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;];
7777   REWRITE_TAC[long_v;SUBSET];
7778   MESON_TAC[];
7779   ]);;
7780   (* }}} *)
7781
7782 let two_two_lemma1 = prove_by_refinement(
7783   `!p. rectangle(FST p - &:1 , SND p - &:1) (FST p , SND p + &:1) =
7784   rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
7785      INTER
7786   {z | (?r. (z = point r) /\ (FST r <. real_of_int(FST p)))}`,
7787   (* {{{ proof *)
7788   [
7789   GEN_TAC;
7790   REWRITE_TAC[rectangle_inter];
7791   alpha_tac;
7792   TYPE_THEN `B  = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC  ;
7793   TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ;
7794   REWRITE_TAC[INTER_ACI];
7795   IMATCH_MP_TAC  subset3_absorb;
7796   EXPAND_TAC "B";
7797   EXPAND_TAC "C";
7798   REWRITE_TAC[SUBSET;int_suc;];
7799   MESON_TAC[REAL_ARITH `x <. y ==> x < y + &1`];
7800   ]);;
7801   (* }}} *)
7802
7803 let two_two_lemma2 = prove_by_refinement(
7804   `!p. rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1) =
7805   rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
7806   INTER
7807   {z | (?r. (z = point r) /\ ( real_of_int(FST p) <. FST r ))}`,
7808   (* {{{ proof *)
7809   [
7810   GEN_TAC;
7811   REWRITE_TAC[rectangle_inter];
7812   alpha_tac;
7813   TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}` ABBREV_TAC ;
7814   TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
7815   REWRITE_TAC[INTER_ACI];
7816   IMATCH_MP_TAC  subset3_absorb;
7817   EXPAND_TAC "B";
7818   EXPAND_TAC "C";
7819   REWRITE_TAC[SUBSET;int_sub_th;int_add_th;int_of_num_th;];
7820   ASM_MESON_TAC[REAL_ARITH `x < y ==> (x - &1 <. y)`];
7821   ]);;
7822   (* }}} *)
7823
7824 let two_two_lemma3 = prove_by_refinement(
7825   `!p. long_v p =
7826   rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
7827   INTER
7828     {z | (?r. (z = point r) /\ (  FST r =  real_of_int(FST p)  ))}`,
7829   (* {{{ proof *)
7830   [
7831   GEN_TAC;
7832   REWRITE_TAC[long_v_inter;rectangle_inter];
7833   alpha_tac;
7834   TYPE_THEN `B = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} ` ABBREV_TAC ;
7835   TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
7836   TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ;
7837   REWRITE_TAC[INTER_ACI];
7838   TYPE_THEN `!A. (B INTER C INTER D INTER A) = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
7839   REWRITE_TAC[INTER_ACI];
7840   DISCH_THEN (fun t-> PURE_REWRITE_TAC[t]);
7841   IMATCH_MP_TAC  subset3_absorb;
7842   EXPAND_TAC "B";
7843   EXPAND_TAC "C";
7844   EXPAND_TAC "D";
7845   REWRITE_TAC[SUBSET;INTER;int_sub_th;int_add_th;int_of_num_th];
7846   GEN_TAC;
7847   DISCH_THEN (CHOOSE_THEN MP_TAC);
7848   ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &.1 <. y /\ x <. y+ &1)`];
7849   ]);;
7850   (* }}} *)
7851
7852 let two_two_union = prove_by_refinement(
7853   `!p. rectangle (FST p -: &:1 , SND p -: &:1)
7854      (FST p +: &:1 , SND p + &:1) =
7855    rectangle(FST p - &:1 , SND p - &:1) (FST p  , SND p + &:1) UNION
7856    long_v p UNION
7857    rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1)`,
7858   (* {{{ proof *)
7859   [
7860   REWRITE_TAC[two_two_lemma1;two_two_lemma2;two_two_lemma3];
7861   REWRITE_TAC[GSYM UNION_OVER_INTER];
7862   GEN_TAC;
7863   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;
7864   IMATCH_MP_TAC  EQ_EXT;
7865   GEN_TAC;
7866   REWRITE_TAC[UNION];
7867   EQ_TAC;
7868   DISCH_THEN (CHOOSE_THEN MP_TAC);
7869   DISCH_THEN_REWRITE;
7870   REWRITE_TAC [point_inj];
7871   CONV_TAC (dropq_conv "r'");
7872   REAL_ARITH_TAC;
7873   MESON_TAC[];
7874   DISCH_TAC;
7875   USE 0 SYM;
7876   ASM_REWRITE_TAC[];
7877   ONCE_REWRITE_TAC [EQ_SYM_EQ];
7878   REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
7879   REWRITE_TAC[rectangle;SUBSET];
7880   MESON_TAC[];
7881   ]);;
7882   (* }}} *)
7883
7884 let two_two_nine = prove_by_refinement(
7885   `!p. rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) =
7886    squ (FST p -: &:1,SND p -: &:1) UNION squ (FST p -: &:1,SND p ) UNION
7887    squ (FST p,SND p -: &:1) UNION squ p UNION
7888    h_edge (left  p) UNION h_edge  p UNION
7889    v_edge (down p) UNION v_edge p UNION {(pointI p)}`,
7890   (* {{{ proof *)
7891   [
7892   GEN_TAC;
7893   REWRITE_TAC[two_two_union;rectangle_h;rectangle_v];
7894   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;
7895   REWRITE_TAC[left ;INT_ARITH `x -: &:1 +: &:1 = x`];
7896   DISCH_THEN_REWRITE;
7897   REWRITE_TAC[rectangle_h];
7898   REWRITE_TAC[left ;down; long_v_union];
7899   REWRITE_TAC[UNION_ACI];
7900   ]);;
7901   (* }}} *)
7902
7903
7904 (* ------------------------------------------------------------------ *)
7905
7906 let curve_cell = jordan_def `curve_cell G = G UNION
7907    {z | (?n. (z = {(pointI n)}) /\ (closure top2 (UNIONS G) (pointI n)))}`;;
7908
7909 let curve_cell_cell = prove_by_refinement(
7910   `!G. (G SUBSET edge) ==> (curve_cell G SUBSET cell)`,
7911   (* {{{ proof *)
7912   [
7913   REWRITE_TAC[SUBSET;edge;curve_cell;cell;UNION ];
7914   DISCH_ALL_TAC;
7915   DISCH_ALL_TAC;
7916   UND 1;
7917   DISCH_THEN DISJ_CASES_TAC;
7918   TSPEC `x` 0;
7919   REWR 0;
7920   CHO 0;
7921   ASM_MESON_TAC[];
7922   ASM_MESON_TAC[];
7923   ]);;
7924   (* }}} *)
7925
7926 let curve_cell_point = prove_by_refinement(
7927   `!G n. (FINITE G) /\ (G SUBSET edge) ==> (curve_cell G {(pointI n)} <=>
7928            (?e. (G e /\ (closure top2 e (pointI n)))))`,
7929   (* {{{ proof *)
7930   [
7931   REWRITE_TAC[curve_cell;UNION ;edge;SUBSET ];
7932   DISCH_ALL_TAC;
7933   EQ_TAC;
7934   DISCH_THEN DISJ_CASES_TAC;
7935   TSPEC `{(pointI n)}` 1;
7936   USE 1(GSYM);
7937   USE 1(REWRITE_RULE[eq_sing;v_edge_pointI;h_edge_pointI;]);
7938   ASM_MESON_TAC[];
7939   USE 2 (REWRITE_RULE[eq_sing;INR IN_SING ;pointI_inj]);
7940   USE 2(CONV_RULE (dropq_conv "n'"));
7941   ASSUME_TAC top2_top;
7942   UND 2;
7943   ASM_SIMP_TAC[closure_unions];
7944   REWRITE_TAC[IMAGE;INR IN_UNIONS ];
7945   DISCH_THEN CHOOSE_TAC;
7946   AND 2;
7947   CHO 4;
7948   ASM_MESON_TAC[];
7949   DISCH_THEN CHOOSE_TAC;
7950   DISJ2_TAC;
7951   REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;];
7952   CONV_TAC (dropq_conv "n'") ;
7953   TYPE_THEN `closure top2 e SUBSET closure top2 (UNIONS G)` SUBGOAL_TAC;
7954   IMATCH_MP_TAC  subset_of_closure;
7955   REWRITE_TAC[top2_top];
7956   IMATCH_MP_TAC  sub_union;
7957   ASM_REWRITE_TAC[];
7958   REWRITE_TAC[SUBSET];
7959   ASM_MESON_TAC[];
7960   ]);;
7961   (* }}} *)
7962
7963 let curve_cell_h = prove_by_refinement(
7964   `!G n. (segment G) ==> (curve_cell G (h_edge n) = G (h_edge n))`,
7965   (* {{{ proof *)
7966   [
7967   DISCH_ALL_TAC;
7968   REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI];
7969   ]);;
7970   (* }}} *)
7971
7972 let curve_cell_v = prove_by_refinement(
7973   `!G n. (segment G) ==> (curve_cell G (v_edge n) = G (v_edge n))`,
7974   (* {{{ proof *)
7975   [
7976   DISCH_ALL_TAC;
7977   REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI];
7978   ]);;
7979   (* }}} *)
7980
7981 let curve_cell_in = prove_by_refinement(
7982   `!C G . (G SUBSET edge) /\ (curve_cell G C) ==>
7983     (?n. (C = {(pointI n)}) \/ (C = h_edge n) \/ (C = v_edge n))`,
7984   (* {{{ proof *)
7985   [
7986   REWRITE_TAC[curve_cell;UNION ;SUBSET; edge ];
7987   DISCH_ALL_TAC;
7988   UND 1;
7989   DISCH_THEN DISJ_CASES_TAC;
7990   ASM_MESON_TAC[];
7991   ASM_MESON_TAC[];
7992   ]);;
7993   (* }}} *)
7994
7995 let curve_cell_subset = prove_by_refinement(
7996   `!G. (G SUBSET (curve_cell G))`,
7997   (* {{{ proof *)
7998   [
7999   REWRITE_TAC[SUBSET;curve_cell;UNION ];
8000   MESON_TAC[];
8001   ]);;
8002   (* }}} *)
8003
8004 let curve_closure = prove_by_refinement(
8005   `!G. (segment G) ==>
8006     (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`,
8007   (* {{{ proof *)
8008   [
8009   DISCH_ALL_TAC;
8010   TYPE_THEN `FINITE G` SUBGOAL_TAC;
8011   ASM_MESON_TAC[segment];
8012   DISCH_TAC ;
8013   ASSUME_TAC top2_top;
8014   (* ASM_SIMP_TAC[closure_unions]; *)
8015   TYPE_THEN `G SUBSET edge ` SUBGOAL_TAC;
8016   ASM_MESON_TAC[segment];
8017   DISCH_TAC;
8018   IMATCH_MP_TAC  SUBSET_ANTISYM;
8019   CONJ_TAC;
8020   ASM_SIMP_TAC[closure_unions];
8021   REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ];
8022   DISCH_ALL_TAC;
8023   CHO 4;
8024   AND 4;
8025   CHO 5;
8026   TYPE_THEN `edge x'` SUBGOAL_TAC;
8027   ASM_MESON_TAC[segment;ISUBSET];
8028   REWRITE_TAC[edge];
8029   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
8030   REWR 5;
8031   REWR 4;
8032   COPY 4;
8033   USE 4(REWRITE_RULE[v_edge_closure;vc_edge;UNION ;INR IN_SING ]);
8034   UND 4;
8035   REP_CASES_TAC;
8036   TYPE_THEN `v_edge m` EXISTS_TAC;
8037   ASM_SIMP_TAC [curve_cell_v];
8038   TYPE_THEN `{(pointI m)}` EXISTS_TAC;
8039
8040   ASM_SIMP_TAC [curve_cell_point];
8041   REWRITE_TAC[INR IN_SING];
8042   ASM_MESON_TAC[];
8043   USE 4(REWRITE_RULE[plus_e12]);
8044   TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC;
8045
8046   ASM_SIMP_TAC [curve_cell_point];
8047   REWRITE_TAC[INR IN_SING];
8048   ASM_MESON_TAC[];
8049   (* dt2 , down to 2 goals *)
8050   REWR 5;
8051   REWR 4;
8052   COPY 4;
8053   USE 4 (REWRITE_RULE[h_edge_closure;hc_edge;UNION;INR IN_SING]);
8054   UND 4;
8055   REP_CASES_TAC;
8056   TYPE_THEN `h_edge m` EXISTS_TAC;
8057   ASM_SIMP_TAC[curve_cell_h];
8058   TYPE_THEN `{(pointI m)}` EXISTS_TAC;
8059   ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
8060   ASM_MESON_TAC[];
8061   USE 4(REWRITE_RULE[plus_e12]);
8062   TYPE_THEN `{x}` EXISTS_TAC;
8063   ASM_REWRITE_TAC[INR IN_SING];
8064   ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
8065   ASM_MESON_TAC[];
8066   (* dt1 *)
8067   REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset];
8068   ASM_SIMP_TAC[closure_unions];
8069   CONJ_TAC;
8070   REWRITE_TAC[SUBSET;IMAGE;UNIONS];
8071   DISCH_ALL_TAC;
8072   CONV_TAC (dropq_conv "u");
8073   NAME_CONFLICT_TAC;
8074   CHO 4;
8075   TYPE_THEN `u` EXISTS_TAC;
8076   ASM_REWRITE_TAC[];
8077   ASM_MESON_TAC[subset_closure;ISUBSET ];
8078   (* // *)
8079   TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ;
8080   REWRITE_TAC[UNIONS;SUBSET ];
8081   CONV_TAC (dropq_conv "u");
8082   REWRITE_TAC[INR IN_SING];
8083   MESON_TAC[];
8084   ]);;
8085   (* }}} *)
8086
8087 (* logic *)
8088 let not_not = prove_by_refinement(
8089   `!x y. (~x = ~y) <=> (x = y)`,
8090   (* {{{ proof *)
8091   [
8092   MESON_TAC[];
8093   ]);;
8094   (* }}} *)
8095
8096 let not_eq = prove_by_refinement(
8097   `!x y. (~x = y) <=> (x = ~y)`,
8098   (* {{{ proof *)
8099   [
8100   MESON_TAC[];
8101   ]);;
8102   (* }}} *)
8103
8104 let cell_inter = prove_by_refinement(
8105   `!C D. (cell C) /\ (D SUBSET cell) ==>
8106          ((C INTER (UNIONS D) = EMPTY) <=> ~(D C))`,
8107   (* {{{ proof *)
8108
8109   [
8110   REWRITE_TAC[INTER;IN_UNIONS;SUBSET;EQ_EMPTY  ];
8111   DISCH_ALL_TAC;
8112   RIGHT_TAC  "x";
8113   REWRITE_TAC[not_not ];
8114   EQ_TAC;
8115   DISCH_THEN CHOOSE_TAC;
8116   AND 2;
8117   CHO 2;
8118   TYPE_THEN `t = C` SUBGOAL_TAC;
8119   IMATCH_MP_TAC  cell_partition;
8120   REWRITE_TAC[EMPTY_EXISTS;INTER ];
8121   ASM_MESON_TAC[];
8122   ASM_MESON_TAC[];
8123   DISCH_TAC;
8124   USE 0(MATCH_MP cell_nonempty);
8125   USE 0(REWRITE_RULE[EMPTY_EXISTS]);
8126   CHO 0;
8127   ASM_MESON_TAC[];
8128   ]);;
8129
8130   (* }}} *)
8131
8132 let curve_cell_h_inter = prove_by_refinement(
8133   `!G m. (segment G) ==>
8134      (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
8135          (~(G (h_edge m))))`,
8136   (* {{{ proof *)
8137   [
8138   DISCH_ALL_TAC;
8139   ASM_SIMP_TAC[GSYM curve_cell_h];
8140   IMATCH_MP_TAC  cell_inter;
8141   ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
8142   ASM_MESON_TAC[segment;curve_cell_cell];
8143   ]);;
8144   (* }}} *)
8145
8146 let curve_cell_v_inter = prove_by_refinement(
8147   `!G m. (segment G) ==>
8148      (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
8149          (~(G (v_edge m))))`,
8150   (* {{{ proof *)
8151   [
8152   DISCH_ALL_TAC;
8153   ASM_SIMP_TAC[GSYM curve_cell_v];
8154   IMATCH_MP_TAC  cell_inter;
8155   ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
8156   ASM_MESON_TAC[segment;curve_cell_cell];
8157   ]);;
8158   (* }}} *)
8159
8160 let curve_cell_squ = prove_by_refinement(
8161   `!G m. (segment G) ==> ~curve_cell G (squ m)`,
8162   (* {{{ proof *)
8163   [
8164     REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment];
8165   REWRITE_TAC[SUBSET; edge];
8166   DISCH_ALL_TAC;
8167   TSPEC `squ m` 3;
8168   USE 3(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;]);
8169   ASM_MESON_TAC[];
8170   ]);;
8171   (* }}} *)
8172
8173 let curve_cell_squ_inter = prove_by_refinement(
8174   `!G m. (segment G) ==>
8175      (((squ m) INTER (UNIONS (curve_cell G)) = {}))`,
8176   (* {{{ proof *)
8177   [
8178   DISCH_ALL_TAC;
8179   TYPE_THEN `cell (squ m)` SUBGOAL_TAC;
8180   REWRITE_TAC[cell_rules];
8181   DISCH_TAC;
8182   TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC;
8183   ASM_MESON_TAC[curve_cell_cell;segment];
8184   DISCH_TAC;
8185   ASM_SIMP_TAC [cell_inter];
8186   ASM_MESON_TAC [curve_cell_squ];
8187   ]);;
8188   (* }}} *)
8189
8190 let curve_point_unions = prove_by_refinement(
8191   `!G m. (segment G) ==>
8192      (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`,
8193   (* {{{ proof *)
8194   [
8195   DISCH_ALL_TAC;
8196   TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC;
8197   REWRITE_TAC[REWRITE_RULE[not_eq] single_inter];
8198   DISCH_THEN_REWRITE;
8199   REWRITE_TAC [not_eq];
8200   IMATCH_MP_TAC  cell_inter;
8201   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
8202   ASM_MESON_TAC[segment];
8203   DISCH_TAC;
8204   ASM_MESON_TAC[cell_rules;curve_cell_cell];
8205   ]);;
8206   (* }}} *)
8207
8208 let curve_cell_not_point = prove_by_refinement(
8209   `!G m. (segment G) ==> ((curve_cell G {(pointI m)} <=>
8210      ~(num_closure G (pointI m) = 0)))`,
8211   (* {{{ proof *)
8212   [
8213   DISCH_ALL_TAC;
8214   TYPE_THEN `FINITE G /\ (G SUBSET edge)` SUBGOAL_TAC;
8215   ASM_MESON_TAC[segment];
8216   DISCH_TAC;
8217   ASM_SIMP_TAC[curve_cell_point;num_closure0];
8218   ASM_MESON_TAC[];
8219   ]);;
8220   (* }}} *)
8221
8222 (* ------------------------------------------------------------------ *)
8223
8224 let par_cell = jordan_def `par_cell eps G C <=>
8225   ((?m. (C = {(pointI m)}) /\ (eps = EVEN (num_lower G m))) \/
8226          (?m. (C = h_edge m) /\ (eps = EVEN (num_lower G m))) \/
8227          (?m. (C = v_edge m) /\ (eps = EVEN (num_lower G m))) \/
8228          (?m. (C = squ m) /\ (eps= EVEN (num_lower G m)))) /\
8229    (C INTER (UNIONS (curve_cell G)) = EMPTY )`;;
8230
8231 let par_cell_curve_disj = prove_by_refinement(
8232   `!G C eps. (par_cell eps G C) ==>
8233           (C INTER (UNIONS (curve_cell G)) = EMPTY )`,
8234   (* {{{ proof *)
8235   [
8236  REWRITE_TAC[par_cell];
8237   DISCH_ALL_TAC;
8238   ASM_REWRITE_TAC[];
8239   ]);;
8240   (* }}} *)
8241
8242 let par_cell_cell = prove_by_refinement(
8243   `!G eps.  (par_cell eps G SUBSET cell)`,
8244   (* {{{ proof *)
8245   [
8246   REWRITE_TAC[SUBSET;par_cell;even_cell];
8247   DISCH_ALL_TAC;
8248   ASM_MESON_TAC[cell_rules];
8249   ]);;
8250   (* }}} *)
8251
8252 let par_cell_h = prove_by_refinement(
8253   `!G m eps. (segment G) ==> ((par_cell eps G (h_edge m) <=>
8254       (~(G (h_edge m))) /\ (eps = EVEN (num_lower G m))))`,
8255   (* {{{ proof *)
8256   [
8257   DISCH_ALL_TAC;
8258   REWRITE_TAC[par_cell;eq_sing;h_edge_inj;hv_edgeV2;h_edge_pointI;];
8259   REWRITE_TAC[square_h_edgeV2];
8260   ASM_SIMP_TAC[curve_cell_h_inter];
8261   CONV_TAC (dropq_conv "m'");
8262   MESON_TAC[];
8263   ]);;
8264   (* }}} *)
8265
8266 let par_cell_v = prove_by_refinement(
8267   `!G m eps. (segment G) ==> ((par_cell eps G (v_edge m) <=>
8268       (~(G (v_edge m))) /\ (eps = EVEN (num_lower G m))))`,
8269   (* {{{ proof *)
8270   [
8271   DISCH_ALL_TAC;
8272   REWRITE_TAC[par_cell;eq_sing;v_edge_inj;hv_edgeV2;v_edge_pointI;];
8273   REWRITE_TAC[square_v_edgeV2];
8274   ASM_SIMP_TAC[curve_cell_v_inter];
8275   CONV_TAC (dropq_conv "m'");
8276   MESON_TAC[];
8277   ]);;
8278   (* }}} *)
8279
8280 let par_cell_squ = prove_by_refinement(
8281   `!G m eps. (segment G) ==> ((par_cell eps G (squ m) <=>
8282        (eps = EVEN (num_lower G m))))`,
8283   (* {{{ proof *)
8284   [
8285   DISCH_ALL_TAC;
8286   REWRITE_TAC[par_cell;eq_sing;square_h_edgeV2;square_v_edgeV2;squ_inj];
8287   ASM_SIMP_TAC[curve_cell_squ_inter];
8288   REWRITE_TAC[square_pointI];
8289   CONV_TAC (dropq_conv "m'");
8290   ]);;
8291   (* }}} *)
8292
8293 let par_cell_point = prove_by_refinement(
8294   `!G m eps. (segment G) ==> ((par_cell eps G {(pointI m)} <=>
8295       ((num_closure G (pointI m) = 0) /\
8296           (eps = EVEN (num_lower G m)))))`,
8297   (* {{{ proof *)
8298   [
8299   DISCH_ALL_TAC;
8300   REWRITE_TAC[par_cell;eq_sing;INR IN_SING;point_inj;];
8301   SUBGOAL_TAC  `!u x. ({(pointI u)} = x) <=> (x = {(pointI u)})` ;
8302   ASM_MESON_TAC[];
8303   DISCH_THEN (fun t-> REWRITE_TAC[t]);
8304   REWRITE_TAC[eq_sing;INR IN_SING ;h_edge_pointI; v_edge_pointI; square_pointI;];
8305   REWRITE_TAC[pointI_inj; REWRITE_RULE[not_eq] single_inter];
8306   CONV_TAC (dropq_conv "m'");
8307   ASM_SIMP_TAC [curve_point_unions;curve_cell_not_point];
8308   MESON_TAC[];
8309   ]);;
8310   (* }}} *)
8311
8312 let eq_sing_sym = prove_by_refinement(
8313   `!X (y:A). ({y} = X) <=> X y /\ (!u. X u ==> (u = y))`,
8314   (* {{{ proof *)
8315   [
8316   ASM_MESON_TAC[eq_sing];
8317   ]);;
8318   (* }}} *)
8319
8320 let par_cell_disjoint = prove_by_refinement(
8321   `!G eps. (par_cell eps G INTER par_cell (~eps) G = EMPTY)`,
8322   (* {{{ proof *)
8323   [
8324   REWRITE_TAC[EQ_EMPTY;INTER ];
8325   REP_GEN_TAC;
8326   REWRITE_TAC[par_cell];
8327   REPEAT (REPEAT (LEFT_TAC "m") THEN (GEN_TAC));
8328   REPEAT (LEFT_TAC "m");
8329   REPEAT (REPEAT (LEFT_TAC "m'") THEN  (GEN_TAC ));
8330   REPEAT (LEFT_TAC ("m'"));
8331   REPEAT (REPEAT (LEFT_TAC "m''") THEN  (GEN_TAC ));
8332   REPEAT (LEFT_TAC ("m''"));
8333   LEFT_TAC "m'''" THEN GEN_TAC;
8334   LEFT_TAC "m''''" THEN GEN_TAC;
8335   LEFT_TAC "m'''''" THEN GEN_TAC;
8336   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
8337   REWRITE_TAC[DE_MORGAN_THM];
8338   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[]);
8339   ]);;
8340   (* }}} *)
8341
8342 let par_cell_nonempty = prove_by_refinement(
8343   `!G eps. (rectagon G) ==> ~(par_cell eps G = EMPTY)`,
8344   (* {{{ proof *)
8345   [
8346   DISCH_ALL_TAC;
8347   COPY 1;
8348   USE 1 (MATCH_MP rectagon_h_edge);
8349   CHO 1;
8350   TYPE_THEN `FINITE G` SUBGOAL_TAC;
8351   ASM_MESON_TAC[rectagon];
8352   DISCH_TAC ;
8353   USE 3(MATCH_MP squ_down);
8354   TSPEC `m` 3;
8355   USE 3 (REWRITE_RULE[set_lower_n]);
8356   UND 3;
8357   ASM_REWRITE_TAC[even_cell_squ;];
8358   PROOF_BY_CONTR_TAC;
8359   UND 0;
8360   REWRITE_TAC[EMPTY_EXISTS];
8361   TYPE_THEN `segment G` SUBGOAL_TAC;
8362   ASM_MESON_TAC[rectagon_segment];
8363   DISCH_TAC ;
8364   TYPE_THEN `eps = EVEN (num_lower G m)` ASM_CASES_TAC;
8365   TYPE_THEN `squ m` EXISTS_TAC;
8366   ASM_SIMP_TAC [par_cell_squ];
8367   TYPE_THEN `squ (down m)` EXISTS_TAC;
8368   ASM_SIMP_TAC[par_cell_squ];
8369   ASM_MESON_TAC[];
8370   ]);;
8371   (* }}} *)
8372
8373 let par_cell_unions_nonempty = prove_by_refinement(
8374   `!G eps. (rectagon G) ==> ~(UNIONS (par_cell eps G) = EMPTY)`,
8375   (* {{{ proof *)
8376   [
8377   REP_GEN_TAC;
8378   REWRITE_TAC[UNIONS;EMPTY_EXISTS ];
8379   NAME_CONFLICT_TAC;
8380   DISCH_TAC ;
8381   USE 0 (MATCH_MP par_cell_nonempty);
8382   TSPEC `eps` 0;
8383   USE 0 (REWRITE_RULE[EMPTY_EXISTS]);
8384   CHO 0;
8385  LEFT_TAC "u'";
8386   TYPE_THEN `u` EXISTS_TAC;
8387   ASM_REWRITE_TAC[];
8388   TYPE_THEN `cell u` SUBGOAL_TAC;
8389   ASM_MESON_TAC[par_cell_cell;ISUBSET ];
8390   DISCH_THEN (fun t-> MP_TAC (MATCH_MP cell_nonempty t));
8391   REWRITE_TAC[EMPTY_EXISTS];
8392   ]);;
8393   (* }}} *)
8394
8395 let ctop = jordan_def `ctop G =
8396    induced_top top2 (euclid 2 DIFF (UNIONS (curve_cell G)))`;;
8397
8398 let top2_unions = prove_by_refinement(
8399   `UNIONS (top2) = (euclid 2)`,
8400   (* {{{ proof *)
8401   [
8402   REWRITE_TAC [top2];
8403   ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
8404   ]);;
8405   (* }}} *)
8406
8407 let curve_closed = prove_by_refinement(
8408   `!G. (segment G) ==> (closed_ top2 (UNIONS (curve_cell G)))`,
8409   (* {{{ proof *)
8410   [
8411   DISCH_ALL_TAC;
8412   ASM_SIMP_TAC[GSYM curve_closure];
8413   IMATCH_MP_TAC  closure_closed;
8414   REWRITE_TAC[top2_top];
8415   IMATCH_MP_TAC  UNIONS_SUBSET;
8416   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
8417   ASM_MESON_TAC[segment];
8418   REWRITE_TAC[SUBSET;top2_unions;edge;  ];
8419   DISCH_ALL_TAC;
8420   DISCH_ALL_TAC;
8421   TSPEC `A` 1;
8422   REWR 1;
8423   CHO 1;
8424   ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid];
8425   ]);;
8426   (* }}} *)
8427
8428 let ctop_unions = prove_by_refinement(
8429   `!G. UNIONS (ctop G) = (euclid 2 DIFF (UNIONS (curve_cell G)))`,
8430   (* {{{ proof *)
8431   [
8432   GEN_TAC;
8433   REWRITE_TAC[ctop];
8434   REWRITE_TAC[induced_top_support];
8435   REWRITE_TAC[top2_unions];
8436   REWRITE_TAC[INTER;DIFF;];
8437   IMATCH_MP_TAC  EQ_EXT;
8438   REWRITE_TAC[];
8439   ASM_MESON_TAC[];
8440   ]);;
8441   (* }}} *)
8442
8443 let par_cell_partition = prove_by_refinement(
8444   `!G eps. (segment G) ==>
8445   ((UNIONS (par_cell eps G) UNION (UNIONS (par_cell (~eps) G))) =
8446     (UNIONS (ctop G))) `,
8447   (* {{{ proof *)
8448   [
8449   DISCH_ALL_TAC;
8450   IMATCH_MP_TAC  SUBSET_ANTISYM ;
8451   CONJ_TAC;
8452   REWRITE_TAC[union_subset];
8453   TYPE_THEN `eps` (fun t-> SPEC_TAC (t,t));
8454   RIGHT_TAC "eps";
8455   SUBCONJ_TAC;
8456   GEN_TAC;
8457   IMATCH_MP_TAC  UNIONS_SUBSET;
8458   REWRITE_TAC[ctop_unions;DIFF_SUBSET ];
8459   DISCH_ALL_TAC;
8460   COPY 1;
8461   USE 2(MATCH_MP par_cell_curve_disj);
8462   ASM_REWRITE_TAC[];
8463   IMATCH_MP_TAC  cell_euclid;
8464   ASM_MESON_TAC[par_cell_cell ;ISUBSET ];
8465   DISCH_TAC ;
8466   GEN_TAC;
8467   TSPEC `~eps` 1;
8468   ASM_REWRITE_TAC[];
8469   REWRITE_TAC[ctop_unions;SUBSET ;DIFF ; UNION ; UNIONS ];
8470   DISCH_ALL_TAC;
8471   USE 1(MATCH_MP point_onto);
8472   CHO 1;
8473   ASSUME_TAC cell_unions;
8474   TSPEC `p` 3;
8475   USE 3 (REWRITE_RULE[UNIONS]);
8476   CHO 3;
8477   USE 3 (REWRITE_RULE[cell]);
8478   AND 3;
8479   CHO 4;
8480   UND 4;
8481   REP_CASES_TAC;
8482   NAME_CONFLICT_TAC;
8483   ASM_REWRITE_TAC[];
8484   REWR 3;
8485   USE 3(REWRITE_RULE[INR IN_SING;pointI;point_inj ;]);
8486   ASM_REWRITE_TAC[GSYM pointI];
8487   LEFT_TAC "u'";
8488   TYPE_THEN `{(pointI p')}` EXISTS_TAC;
8489   ASM_SIMP_TAC[par_cell_point];
8490   REWRITE_TAC[INR IN_SING];
8491   LEFT 2 "u";
8492   TSPEC `{(pointI p')}` 2;
8493   REWR 2;
8494   USE 2(REWRITE_RULE[GSYM pointI;INR IN_SING ]);
8495   UND 2;
8496   ASM_SIMP_TAC [curve_cell_not_point];
8497   MESON_TAC[];
8498   (* case 2 *)
8499   LEFT_TAC "u";
8500   TYPE_THEN `h_edge p'` EXISTS_TAC ;
8501   ASM_SIMP_TAC [par_cell_h];
8502   LEFT 2 "u";
8503   REWR 3;
8504   ASM_REWRITE_TAC[];
8505   PROOF_BY_CONTR_TAC;
8506   TYPE_THEN `(G (h_edge p'))` SUBGOAL_TAC;
8507   ASM_MESON_TAC[];
8508   DISCH_TAC ;
8509   TSPEC `h_edge p'` 2;
8510   ASM_MESON_TAC[curve_cell_h];
8511   (* case 3 *)
8512   LEFT_TAC "u";
8513   TYPE_THEN `v_edge p'` EXISTS_TAC ;
8514   ASM_SIMP_TAC [par_cell_v];
8515   LEFT 2 "u";
8516   REWR 3;
8517   ASM_REWRITE_TAC[];
8518   PROOF_BY_CONTR_TAC;
8519   TYPE_THEN `(G (v_edge p'))` SUBGOAL_TAC;
8520   ASM_MESON_TAC[];
8521   DISCH_TAC ;
8522   TSPEC `v_edge p'` 2;
8523   ASM_MESON_TAC[curve_cell_v];
8524   (* case 4 *)
8525   LEFT_TAC "u";
8526   TYPE_THEN `squ p'` EXISTS_TAC ;
8527   ASM_SIMP_TAC [par_cell_squ];
8528   LEFT 2 "u";
8529   REWR 3;
8530   ASM_REWRITE_TAC[];
8531   MESON_TAC[];
8532   ]);;
8533   (* }}} *)
8534
8535 (* ------------------------------------------------------------------ *)
8536 (*  openness of par_cell *)
8537 (* ------------------------------------------------------------------ *)
8538
8539 let par_cell_h_squ = prove_by_refinement(
8540   `!G m eps. (segment G) /\ (par_cell eps G (h_edge m)) ==>
8541      (par_cell eps G (squ m) /\ par_cell eps G (squ (down m)))`,
8542   (* {{{ proof *)
8543   [
8544   DISCH_ALL_TAC;
8545   UND 1;
8546   ASM_SIMP_TAC [par_cell_h;par_cell_squ];
8547   DISCH_ALL_TAC;
8548   TYPE_THEN `FINITE G` SUBGOAL_TAC;
8549   ASM_MESON_TAC[segment];
8550   DISCH_TAC ;
8551   ONCE_REWRITE_TAC [EQ_SYM_EQ];
8552   ASM_SIMP_TAC[num_lower_down];
8553   ASM_MESON_TAC[set_lower_n];
8554   ]);;
8555   (* }}} *)
8556
8557 let par_cell_v_squ = prove_by_refinement(
8558   `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==>
8559      (par_cell eps G (squ m) /\ par_cell eps G (squ (left m)))`,
8560   (* {{{ proof *)
8561
8562   [
8563   DISCH_ALL_TAC;
8564   UND 1;
8565   TYPE_THEN `segment G` SUBGOAL_TAC;
8566   ASM_MESON_TAC[rectagon_segment];
8567   ASM_SIMP_TAC [par_cell_v;par_cell_squ];
8568   DISCH_ALL_TAC;
8569   ONCE_REWRITE_TAC [EQ_SYM_EQ];
8570   ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par];
8571   ]);;
8572
8573   (* }}} *)
8574
8575 (* move up *)
8576 let segment_finite = prove_by_refinement(
8577   `!G. (segment G) ==> (FINITE G)`,
8578   (* {{{ proof *)
8579   [
8580   ASM_MESON_TAC[segment];
8581   ]);;
8582   (* }}} *)
8583
8584 let num_closure0_edge = prove_by_refinement(
8585   `!G m. (FINITE G) /\ (num_closure G (pointI m) = 0) ==>
8586     ~G (v_edge m) /\ ~G (v_edge (down m)) /\
8587           ~G (h_edge m) /\ ~G(h_edge (left  m))`,
8588   (* {{{ proof *)
8589
8590   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
8591   [
8592   DISCH_ALL_TAC;
8593   UND 1;
8594   ASM_SIMP_TAC[num_closure0];
8595   DISCH_TAC;
8596   REWRITE_TAC[GSYM DE_MORGAN_THM];
8597   PURE_REWRITE_TAC [GSYM IMP_CLAUSES];
8598   REP_CASES_TAC;
8599   TSPEC `v_edge m` 1;
8600   JOIN 1 2;
8601   USE 1(rule);
8602   ASM_MESON_TAC[];
8603   TSPEC `v_edge (down m)` 1;
8604   JOIN 2 1;
8605   USE 1(rule);
8606   ASM_MESON_TAC[];
8607   TSPEC `h_edge ( m)` 1;
8608   JOIN 1 2;
8609   USE 1(rule);
8610   ASM_MESON_TAC[];
8611   TSPEC `h_edge (left  m)` 1;
8612   JOIN 1 2;
8613   USE 1(rule);
8614   ASM_MESON_TAC[];
8615   ]);;
8616   (* }}} *)
8617
8618 let par_cell_point_h = prove_by_refinement(
8619   `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
8620      (par_cell eps G (h_edge m) /\ par_cell eps G (h_edge (left m)))`,
8621   (* {{{ proof *)
8622   [
8623   DISCH_ALL_TAC;
8624   UND 1;
8625   TYPE_THEN `segment G` SUBGOAL_TAC;
8626   ASM_MESON_TAC[rectagon_segment];
8627   ASM_SIMP_TAC [par_cell_h;par_cell_point];
8628   DISCH_ALL_TAC;
8629   ONCE_REWRITE_TAC [EQ_SYM_EQ];
8630   ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par];
8631   UND 1;
8632   TYPE_THEN `FINITE G` SUBGOAL_TAC;
8633   ASM_MESON_TAC[segment_finite];
8634   ASM_MESON_TAC[num_closure0_edge];
8635   ]);;
8636   (* }}} *)
8637
8638 let par_cell_point_v = prove_by_refinement(
8639   `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
8640      (par_cell eps G (v_edge m) /\ par_cell eps G (v_edge (down m)))`,
8641   (* {{{ proof *)
8642   [
8643   DISCH_ALL_TAC;
8644   UND 1;
8645   TYPE_THEN `segment G` SUBGOAL_TAC;
8646   ASM_MESON_TAC[rectagon_segment];
8647   ASM_SIMP_TAC [par_cell_v;par_cell_point];
8648   DISCH_ALL_TAC;
8649   ONCE_REWRITE_TAC [EQ_SYM_EQ];
8650   TYPE_THEN `FINITE G` SUBGOAL_TAC;
8651   ASM_MESON_TAC[segment_finite];
8652   ASM_SIMP_TAC[num_lower_down];
8653   REWRITE_TAC [set_lower_n];
8654   ASM_MESON_TAC[num_closure0_edge];
8655   ]);;
8656   (* }}} *)
8657
8658 let par_cell_point_rectangle = prove_by_refinement(
8659   `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
8660      (rectangle (FST m -: &:1,SND m -: &:1) (FST m +: &:1,SND m +: &:1)
8661        SUBSET (UNIONS (par_cell eps G)))`,
8662   (* {{{ proof *)
8663   [
8664   DISCH_ALL_TAC;
8665   TYPE_THEN `segment G` SUBGOAL_TAC;
8666   ASM_SIMP_TAC[rectagon_segment];
8667   DISCH_TAC;
8668   REWRITE_TAC[two_two_union;union_subset];
8669   CONJ_TAC;
8670   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;
8671   REWRITE_TAC[left ;INT_ARITH ` x -: &:1 +: &:1 =x`];
8672   DISCH_THEN_REWRITE;
8673   REWRITE_TAC[rectangle_h;union_subset ];
8674   TYPE_THEN `par_cell eps G (h_edge (left  m))` SUBGOAL_TAC;
8675   ASM_MESON_TAC[par_cell_point_h];
8676   ASM_MESON_TAC[sub_union;par_cell_h_squ];
8677   CONJ_TAC;
8678   REWRITE_TAC[long_v_union;union_subset;];
8679   ASM_MESON_TAC[sub_union; par_cell_point_v;];
8680   REWRITE_TAC[rectangle_h;union_subset ];
8681   TYPE_THEN `par_cell eps G (h_edge (  m))` SUBGOAL_TAC;
8682   ASM_MESON_TAC[par_cell_point_h];
8683   ASM_MESON_TAC[sub_union;par_cell_h_squ];
8684   ]);;
8685   (* }}} *)
8686
8687 let par_cell_h_rectangle = prove_by_refinement(
8688   `!G m eps. (rectagon G) /\ (par_cell eps G (h_edge m)) ==>
8689      (rectangle (FST m ,SND m -: &:1) (FST m +: &:1,SND m +: &:1)
8690        SUBSET (UNIONS (par_cell eps G)))`,
8691   (* {{{ proof *)
8692   [
8693   DISCH_ALL_TAC;
8694   TYPE_THEN `segment G` SUBGOAL_TAC;
8695   ASM_SIMP_TAC[rectagon_segment];
8696   DISCH_TAC;
8697   REWRITE_TAC[rectangle_h;union_subset ];
8698   ASM_MESON_TAC[sub_union;par_cell_h_squ];
8699   ]);;
8700   (* }}} *)
8701
8702 let par_cell_v_rectangle = prove_by_refinement(
8703   `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==>
8704      (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1)
8705        SUBSET (UNIONS (par_cell eps G)))`,
8706   (* {{{ proof *)
8707   [
8708   DISCH_ALL_TAC;
8709   TYPE_THEN `segment G` SUBGOAL_TAC;
8710   ASM_SIMP_TAC[rectagon_segment];
8711   DISCH_TAC;
8712   REWRITE_TAC[rectangle_v;union_subset ];
8713   ASM_MESON_TAC[sub_union;par_cell_v_squ];
8714   ]);;
8715   (* }}} *)
8716
8717 let par_cell_squ_rectangle = prove_by_refinement(
8718   `!G m eps. (rectagon G) /\ (par_cell eps G (squ m)) ==>
8719      (rectangle (FST m  ,SND m ) (FST m +: &:1,SND m +: &:1)
8720        SUBSET (UNIONS (par_cell eps G)))`,
8721   (* {{{ proof *)
8722   [
8723   DISCH_ALL_TAC;
8724   REWRITE_TAC[GSYM rectangle_squ];
8725   IMATCH_MP_TAC  sub_union;
8726   ASM_REWRITE_TAC[];
8727   ]);;
8728   (* }}} *)
8729
8730 let par_cell_point_in_rectangle = prove_by_refinement(
8731   `!m. (rectangle (FST m -: &:1,SND m -: &:1)
8732             (FST m +: &:1,SND m +: &:1) (pointI m))`,
8733   (* {{{ proof *)
8734   [
8735   GEN_TAC;
8736   REWRITE_TAC[two_two_union;UNION ;long_v_union ; INR IN_SING ;];
8737   ]);;
8738   (* }}} *)
8739
8740 let par_cell_h_in_rectangle = prove_by_refinement(
8741   `!m. (h_edge m SUBSET
8742      (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)))`,
8743   (* {{{ proof *)
8744   [
8745   GEN_TAC;
8746   REWRITE_TAC[rectangle_h; UNION ; ISUBSET; INR IN_SING ;];
8747   MESON_TAC[];
8748   ]);;
8749   (* }}} *)
8750
8751 let par_cell_v_in_rectangle = prove_by_refinement(
8752   `!m. (v_edge m SUBSET
8753      (rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)))`,
8754   (* {{{ proof *)
8755   [
8756   GEN_TAC;
8757   REWRITE_TAC[rectangle_v; UNION ; ISUBSET; INR IN_SING ;];
8758   MESON_TAC[];
8759   ]);;
8760   (* }}} *)
8761
8762 let ctop_top = prove_by_refinement(
8763   `!G. topology_ (ctop G)`,
8764   (* {{{ proof *)
8765   [
8766   GEN_TAC;
8767   REWRITE_TAC[ctop];
8768   IMATCH_MP_TAC induced_top_top;
8769   REWRITE_TAC[top2_top];
8770   ]);;
8771   (* }}} *)
8772
8773 let ctop_open = prove_by_refinement(
8774   `!G B eps. (segment G) /\ (B SUBSET UNIONS (par_cell eps G)) /\
8775       (top2 B) ==> (ctop G B)`,
8776   (* {{{ proof *)
8777   [
8778   DISCH_ALL_TAC;
8779   REWRITE_TAC[ctop;induced_top;IMAGE];
8780   TYPE_THEN `B` EXISTS_TAC;
8781   ASM_REWRITE_TAC[];
8782   ONCE_REWRITE_TAC [EQ_SYM_EQ];
8783   REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;GSYM ctop_unions];
8784   ASM_SIMP_TAC[GSYM par_cell_partition];
8785   REWRITE_TAC[UNION;ISUBSET ];
8786   ASM_MESON_TAC[ISUBSET];
8787   ]);;
8788   (* }}} *)
8789
8790 let par_cell_open = prove_by_refinement(
8791   `!G eps. (rectagon G) ==> (ctop G (UNIONS (par_cell eps G )))`,
8792   (* {{{ proof *)
8793   [
8794   DISCH_ALL_TAC;
8795   TYPE_THEN `segment G` SUBGOAL_TAC;
8796   ASM_MESON_TAC[rectagon_segment];
8797   DISCH_TAC;
8798   ASSUME_TAC ctop_top;
8799   TSPEC `G` 2;
8800   USE 2(MATCH_MP open_nbd);
8801   UND 2;
8802   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]) ;
8803   GEN_TAC;
8804   RIGHT_TAC "B";
8805   DISCH_TAC;
8806   USE 2(REWRITE_RULE[UNIONS]);
8807   CHO 2;
8808   TYPE_THEN `?p. (u = {(pointI p)}) \/ (u = h_edge p) \/ (u = v_edge p) \/ (u = squ p)` SUBGOAL_TAC;
8809   AND 2;
8810   USE 3 (MATCH_MP (REWRITE_RULE[ISUBSET ]par_cell_cell));
8811   USE 3(REWRITE_RULE[cell]);
8812   ASM_REWRITE_TAC[];
8813   DISCH_THEN (CHOOSE_THEN MP_TAC );
8814   ASSUME_TAC rectangle_open;
8815   REP_CASES_TAC ;
8816   (* 1st case *)
8817   REWR 2;
8818   USE 2(REWRITE_RULE[INR IN_SING]);
8819   ASM_REWRITE_TAC[];
8820   TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
8821   REWRITE_TAC[par_cell_point_in_rectangle];
8822   SUBCONJ_TAC;
8823   ASM_SIMP_TAC[par_cell_point_rectangle];
8824   ASM_MESON_TAC[ctop_open];
8825   (* 2nd case *)
8826   REWR 2;
8827   TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
8828   ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_h_in_rectangle];
8829   SUBCONJ_TAC;
8830   ASM_SIMP_TAC[par_cell_h_rectangle];
8831   ASM_MESON_TAC[ctop_open];
8832   (* 3rd case *)
8833   REWR 2;
8834   TYPE_THEN `rectangle (FST p -: &:1,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
8835   ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_v_in_rectangle];
8836   SUBCONJ_TAC;
8837   ASM_SIMP_TAC[par_cell_v_rectangle];
8838   ASM_MESON_TAC[ctop_open];
8839   (* 4th case *)
8840   REWR 2;
8841   TYPE_THEN `rectangle (FST p,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
8842   ASSUME_TAC rectangle_squ;
8843   TSPEC `p` 5;
8844   SUBCONJ_TAC;
8845   ASM_SIMP_TAC[par_cell_squ_rectangle];
8846   DISCH_TAC;
8847   CONJ_TAC;
8848   ASM_MESON_TAC[PAIR];
8849   ASM_MESON_TAC[ctop_open];
8850   ]);;
8851   (* }}} *)
8852
8853 (* ------------------------------------------------------------------ *)
8854 (* start on connected components of ctop G *)
8855 (* ------------------------------------------------------------------ *)
8856
8857 (* move *)
8858 let connected_empty = prove_by_refinement(
8859   `!(U:(A->bool)->bool). connected U EMPTY `,
8860   (* {{{ proof *)
8861   [
8862   REWRITE_TAC[connected];
8863   ]);;
8864   (* }}} *)
8865
8866 let par_cell_union_disjoint = prove_by_refinement(
8867   `!G eps. (UNIONS (par_cell eps G) INTER (UNIONS (par_cell (~eps) G)) =
8868               EMPTY )`,
8869   (* {{{ proof *)
8870
8871   [
8872   REWRITE_TAC[INTER;EQ_EMPTY ;UNIONS;];
8873   DISCH_ALL_TAC;
8874   AND 0;
8875   CHO 0;
8876   CHO 1;
8877   TYPE_THEN `cell u /\ cell u'` SUBGOAL_TAC;
8878   ASM_MESON_TAC[par_cell_cell;ISUBSET];
8879   DISCH_TAC;
8880   TYPE_THEN `u = u'` SUBGOAL_TAC;
8881   IMATCH_MP_TAC  cell_partition;
8882   REWRITE_TAC[EMPTY_EXISTS;INTER ];
8883   ASM_MESON_TAC[];
8884   DISCH_TAC;
8885   ASSUME_TAC par_cell_disjoint;
8886   USE 4(REWRITE_RULE[INTER;EQ_EMPTY]);
8887   TYPEL_THEN[`G`;`eps`;`u`] (USE 4 o ISPECL);
8888   USE 3 (GSYM);
8889   REWR 1;
8890   ASM_MESON_TAC[];
8891   ]);;
8892
8893   (* }}} *)
8894
8895 let par_cell_comp = prove_by_refinement(
8896   `!G eps x. (rectagon G) ==>
8897          (component  (ctop G) x SUBSET (UNIONS (par_cell eps G))) \/
8898             (component (ctop G) x SUBSET (UNIONS (par_cell (~eps) G)))`,
8899   (* {{{ proof *)
8900
8901   [
8902   DISCH_ALL_TAC;
8903   TYPE_THEN `component  (ctop G) x SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
8904   REWRITE_TAC[component_DEF ;SUBSET ;connected ];
8905   MESON_TAC[];
8906   TYPE_THEN `segment G` SUBGOAL_TAC;
8907   ASM_MESON_TAC [rectagon_segment];
8908   DISCH_TAC;
8909   ASM_SIMP_TAC[GSYM par_cell_partition];
8910   DISCH_TAC;
8911   PROOF_BY_CONTR_TAC;
8912   USE 3 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
8913   AND 3;
8914   LEFT 3 "x'";
8915   CHO 3;
8916   LEFT 4 "x'";
8917   CHO 4;
8918   TYPE_THEN `component  (ctop G) x x'' /\ component  (ctop G) x x' ` SUBGOAL_TAC;
8919   ASM_MESON_TAC[];
8920   DISCH_TAC;
8921   TYPE_THEN `component  (ctop G) x' x'' ` SUBGOAL_TAC;
8922   ASM_MESON_TAC[component_symm;component_trans];
8923   DISCH_TAC;
8924   USE 6(REWRITE_RULE[component_DEF]);
8925   CHO 6;
8926   USE 6(REWRITE_RULE[connected]);
8927   AND 6;
8928   AND 6;
8929   AND 7;
8930   TYPE_THEN `A = UNIONS (par_cell eps G)` ABBREV_TAC ;
8931   TYPE_THEN `B = UNIONS (par_cell (~eps) G)` ABBREV_TAC ;
8932   TYPEL_THEN [`A`;`B`] (USE 7 o ISPECL);
8933   UND 7;
8934   REWRITE_TAC[];
8935   TYPE_THEN `ctop G A /\ ctop G B` SUBGOAL_TAC;
8936   ASM_MESON_TAC[par_cell_open];
8937   DISCH_THEN_REWRITE;
8938   TYPE_THEN `Z SUBSET (A UNION B)` SUBGOAL_TAC;
8939   ASM_MESON_TAC[par_cell_partition];
8940   DISCH_THEN_REWRITE;
8941   TYPE_THEN `A INTER B = EMPTY` SUBGOAL_TAC;
8942   EXPAND_TAC "A";
8943   EXPAND_TAC "B";
8944   ASM_MESON_TAC[par_cell_union_disjoint;INTER_ACI;];
8945   DISCH_THEN_REWRITE;
8946   ASM_MESON_TAC[ISUBSET];
8947   ]);;
8948
8949   (* }}} *)
8950
8951 (* move *)
8952 let connected_component = prove_by_refinement(
8953   `!U Z (x:A). (connected U Z) /\ (Z x) ==> (Z SUBSET (component U x)) `,
8954   (* {{{ proof *)
8955   [
8956   REWRITE_TAC[component_DEF  ;SUBSET ];
8957   DISCH_ALL_TAC;
8958   DISCH_ALL_TAC;
8959   TYPE_THEN `Z` EXISTS_TAC;
8960   ASM_REWRITE_TAC[];
8961   ]);;
8962   (* }}} *)
8963
8964 let cont_mk_segment = prove_by_refinement(
8965   `!x y n. (euclid n x) /\ (euclid n y) ==>
8966     (continuous (joinf (\u. x)
8967         (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1))
8968           (&.0))
8969    (top_of_metric (UNIV,d_real)) (top_of_metric (euclid n,d_euclid)))`,
8970   (* {{{ proof *)
8971   [
8972   DISCH_ALL_TAC;
8973   IMATCH_MP_TAC  joinf_cont;
8974   CONJ_TAC;
8975   IMATCH_MP_TAC  const_continuous;
8976   IMATCH_MP_TAC  top_of_metric_top;
8977   REWRITE_TAC[metric_real];
8978   CONJ_TAC;
8979   IMATCH_MP_TAC  joinf_cont;
8980   CONJ_TAC;
8981   IMATCH_MP_TAC  continuous_lin_combo;
8982   ASM_REWRITE_TAC[];
8983   CONJ_TAC;
8984   IMATCH_MP_TAC  const_continuous;
8985   IMATCH_MP_TAC  top_of_metric_top;
8986   REWRITE_TAC[metric_real];
8987   BETA_TAC;
8988   REDUCE_TAC;
8989   REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_rzero ];
8990   REWRITE_TAC[joinf];
8991   REDUCE_TAC;
8992   REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero ];
8993   ]);;
8994   (* }}} *)
8995
8996 let mk_segment_image = prove_by_refinement(
8997   `!x y n. (euclid n x) /\ (euclid n y) ==> (?f.
8998      (continuous f
8999         (top_of_metric(UNIV,d_real))
9000         (top_of_metric (euclid n,d_euclid))) /\
9001      (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y))`,
9002   (* {{{ proof *)
9003   [
9004   DISCH_ALL_TAC;
9005   TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
9006   CONJ_TAC;
9007   IMATCH_MP_TAC  cont_mk_segment;
9008   ASM_REWRITE_TAC[];
9009   REWRITE_TAC[joinf;IMAGE ];
9010   REWRITE_TAC[mk_segment];
9011   IMATCH_MP_TAC  EQ_EXT;
9012   GEN_TAC;
9013   ASM_REWRITE_TAC[];
9014   EQ_TAC;
9015   DISCH_TAC;
9016   CHO 2;
9017   UND 2;
9018   COND_CASES_TAC;
9019   DISCH_ALL_TAC;
9020   JOIN 3 2;
9021   ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
9022   DISCH_ALL_TAC;
9023   UND 5;
9024   COND_CASES_TAC;
9025   DISCH_TAC;
9026   TYPE_THEN `&1 - x''` EXISTS_TAC;
9027   SUBCONJ_TAC;
9028   UND 5;
9029   REAL_ARITH_TAC ;
9030   DISCH_TAC;
9031   CONJ_TAC;
9032   UND 3;
9033   REAL_ARITH_TAC ;
9034   ONCE_REWRITE_TAC [euclid_add_comm];
9035   REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
9036   ASM_MESON_TAC[];
9037   DISCH_TAC;
9038   ASM_REWRITE_TAC[];
9039   TYPE_THEN `&0` EXISTS_TAC;
9040   CONJ_TAC;
9041   REAL_ARITH_TAC ;
9042   CONJ_TAC;
9043   REAL_ARITH_TAC ;
9044   REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
9045   (* 2nd half *)
9046   DISCH_TAC;
9047   CHO 2;
9048   TYPE_THEN `&1 - a` EXISTS_TAC ;
9049   ASM_REWRITE_TAC[];
9050   CONJ_TAC;
9051   AND 2;
9052   AND 2;
9053   UND 3;
9054   UND 4;
9055   REAL_ARITH_TAC ;
9056   COND_CASES_TAC;
9057   ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
9058   COND_CASES_TAC;
9059   REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
9060   ASM_MESON_TAC [euclid_add_comm];
9061   TYPE_THEN `a = &.0` SUBGOAL_TAC;
9062   UND 4;
9063   UND 3;
9064   AND 2;
9065   UND 3;
9066   REAL_ARITH_TAC ;
9067   DISCH_TAC;
9068   REWR 2;
9069   REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
9070   ]);;
9071   (* }}} *)
9072
9073 let euclid_n_convex = prove_by_refinement(
9074   `!n. (convex (euclid n))`,
9075   (* {{{ proof *)
9076   [
9077   GEN_TAC;
9078   REWRITE_TAC[convex;mk_segment;SUBSET ];
9079   DISCH_ALL_TAC;
9080   DISCH_ALL_TAC;
9081   CHO 2;
9082   ASM_REWRITE_TAC[];
9083   ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure];
9084   ]);;
9085   (* }}} *)
9086
9087 let connected_mk_segment = prove_by_refinement(
9088   `!x y n. (euclid n x) /\ (euclid n y) ==>
9089    (connected (top_of_metric(euclid n,d_euclid)) (mk_segment x y))`,
9090   (* {{{ proof *)
9091   [
9092   DISCH_ALL_TAC;
9093   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;
9094   IMATCH_MP_TAC  mk_segment_image;
9095   ASM_REWRITE_TAC[];
9096   DISCH_THEN CHOOSE_TAC;
9097   USE 2(GSYM);
9098   ASM_REWRITE_TAC[];
9099   IMATCH_MP_TAC  connect_image;
9100   TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC;
9101   ASM_REWRITE_TAC[];
9102   CONJ_TAC;
9103   USE 2(GSYM);
9104   ASM_REWRITE_TAC[];
9105   TYPE_THEN `UNIONS (top_of_metric (euclid n,d_euclid) ) = (euclid n)` SUBGOAL_TAC;
9106   ASM_MESON_TAC [top_of_metric_unions;metric_euclid];
9107   DISCH_THEN_REWRITE;
9108   ASM_MESON_TAC[convex;euclid_n_convex];
9109   MATCH_ACCEPT_TAC connect_real;
9110   ]);;
9111   (* }}} *)
9112
9113 let ctop_open = prove_by_refinement(
9114   `!G A. (top2 A /\ (A SUBSET (UNIONS (ctop G))) ==> ctop G A)`,
9115   (* {{{ proof *)
9116   [
9117   DISCH_ALL_TAC;
9118   REWRITE_TAC[ctop;induced_top;IMAGE ];
9119   TYPE_THEN `A` EXISTS_TAC;
9120   ASM_REWRITE_TAC[];
9121   ONCE_REWRITE_TAC[EQ_SYM_EQ];
9122   REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
9123   REWRITE_TAC[GSYM ctop_unions];
9124   ASM_REWRITE_TAC[];
9125   ]);;
9126   (* }}} *)
9127
9128 let ctop_top2 = prove_by_refinement(
9129   `!G A. (segment G /\ ctop G A ==> top2 A)`,
9130   (* {{{ proof *)
9131   [
9132   REWRITE_TAC[ctop;induced_top;IMAGE ;];
9133   DISCH_ALL_TAC;
9134   TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ;
9135   TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC;
9136   EXPAND_TAC "U";
9137   ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
9138   CHO 1;
9139   DISCH_TAC;
9140   ASM_REWRITE_TAC[];
9141   IMATCH_MP_TAC  top_inter;
9142   ASM_REWRITE_TAC[top2_top;];
9143   ASM_SIMP_TAC[GSYM curve_closure;top2];
9144   IMATCH_MP_TAC  (REWRITE_RULE[open_DEF] closed_open);
9145   IMATCH_MP_TAC  closure_closed;
9146   CONJ_TAC;
9147   EXPAND_TAC "U";
9148   ASM_MESON_TAC[top_of_metric_top;metric_euclid];
9149   USE 3(GSYM);
9150   ASM_REWRITE_TAC[];
9151   IMATCH_MP_TAC  UNIONS_SUBSET;
9152   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
9153   ASM_MESON_TAC[segment];
9154   REWRITE_TAC[edge;ISUBSET;];
9155   DISCH_ALL_TAC;
9156   DISCH_ALL_TAC;
9157   TSPEC `A'` 4;
9158   REWR 4;
9159   CHO 4;
9160   UND 4;
9161   DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] ;
9162   MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] v_edge_euclid);
9163   MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] h_edge_euclid);
9164   ]);;
9165   (* }}} *)
9166
9167 let mk_segment_sym_lemma = prove_by_refinement(
9168   `!x y z. (mk_segment x y z ==> mk_segment y x z)`,
9169   (* {{{ proof *)
9170   [
9171   REWRITE_TAC[mk_segment];
9172   DISCH_ALL_TAC;
9173   CHO 0;
9174   TYPE_THEN `&1 - a` EXISTS_TAC;
9175   CONJ_TAC;
9176   ASM_MESON_TAC[REAL_ARITH `a <= &1 ==> &0 <= &1 - a`];
9177   CONJ_TAC;
9178   ASM_MESON_TAC[REAL_ARITH `&0 <= a ==> &1 - a <= &1`];
9179   ONCE_REWRITE_TAC[euclid_add_comm];
9180   ASM_REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
9181   ]);;
9182   (* }}} *)
9183
9184 let mk_segment_sym = prove_by_refinement(
9185   `!x y. (mk_segment x y = mk_segment y x)`,
9186   (* {{{ proof *)
9187   [
9188   DISCH_ALL_TAC;
9189   IMATCH_MP_TAC  EQ_EXT;
9190   GEN_TAC;
9191   EQ_TAC THEN ASM_MESON_TAC[mk_segment_sym_lemma];
9192   ]);;
9193   (* }}} *)
9194
9195 let mk_segment_end = prove_by_refinement(
9196   `!x y. (mk_segment x y x /\ mk_segment x y y)`,
9197   (* {{{ proof *)
9198   [
9199   RIGHT_TAC "y";
9200   RIGHT_TAC "x";
9201   SUBCONJ_TAC;
9202   DISCH_ALL_TAC;
9203   REWRITE_TAC[mk_segment];
9204   TYPE_THEN `&1` EXISTS_TAC;
9205   REDUCE_TAC;
9206   CONJ_TAC;
9207   ARITH_TAC;
9208   REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
9209   DISCH_TAC;
9210   ONCE_REWRITE_TAC[mk_segment_sym];
9211   ASM_MESON_TAC[];
9212   ]);;
9213   (* }}} *)
9214
9215 let convex_connected = prove_by_refinement(
9216   `!G Z. (segment G /\ convex Z) /\ (Z SUBSET (UNIONS (ctop G))) ==>
9217             (connected (ctop G) Z)`,
9218   (* {{{ proof *)
9219   [
9220   DISCH_ALL_TAC;
9221   REWRITE_TAC[connected];
9222   DISCH_ALL_TAC;
9223   ASM_REWRITE_TAC[];
9224   DISCH_ALL_TAC;
9225   PROOF_BY_CONTR_TAC;
9226   USE 7 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
9227   AND 7;
9228   LEFT 7 "x";
9229   CHO 7;
9230   LEFT 8 "x";
9231   CHO 8;
9232   TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC;
9233   ASM_MESON_TAC[];
9234   DISCH_TAC;
9235   TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC;
9236   USE 1(REWRITE_RULE[convex]);
9237   ASM_MESON_TAC[ISUBSET];
9238   DISCH_TAC;
9239   TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC;
9240   IMATCH_MP_TAC  connected_mk_segment;
9241   USE 2(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]);
9242   ASM_MESON_TAC[];
9243   REWRITE_TAC[connected];
9244   DISCH_ALL_TAC;
9245   AND 11;
9246   TYPEL_THEN [`A`;`B`] (USE 11 o ISPECL);
9247   REWR 11;
9248   TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC;
9249   REWRITE_TAC[GSYM top2];
9250   ASM_MESON_TAC[ctop_top2;top2];
9251   DISCH_TAC;
9252   UND 11;
9253   ASM_REWRITE_TAC[];
9254   REWRITE_TAC[DE_MORGAN_THM;ISUBSET;];
9255   CONJ_TAC;
9256   LEFT_TAC "x''";
9257   TYPE_THEN `x'` EXISTS_TAC;
9258   REWRITE_TAC[mk_segment_end];
9259   ASM_MESON_TAC[];
9260   LEFT_TAC "x''";
9261   TYPE_THEN `x` EXISTS_TAC;
9262   REWRITE_TAC[mk_segment_end];
9263   ASM_MESON_TAC[];
9264   ]);;
9265   (* }}} *)
9266
9267 let component_replace = prove_by_refinement(
9268   `!U (x:A) y. component  U x y ==> (component  U x = component  U y)`,
9269   (* {{{ proof *)
9270
9271   [
9272   DISCH_ALL_TAC;
9273   IMATCH_MP_TAC  EQ_EXT;
9274   DISCH_ALL_TAC;
9275   EQ_TAC;
9276   DISCH_ALL_TAC;
9277   USE 0(MATCH_MP component_symm);
9278   ASM_MESON_TAC[component_trans];
9279   ASM_MESON_TAC[component_trans;component_symm];
9280   ]);;
9281
9282   (* }}} *)
9283
9284 let convex_component = prove_by_refinement(
9285   `!G Z x. (segment G /\ convex Z /\ (Z SUBSET (UNIONS (ctop G))) /\
9286      (~(Z INTER (component  (ctop G) x ) = EMPTY))  ==>
9287         (Z SUBSET (component  (ctop G) x)))  `,
9288   (* {{{ proof *)
9289   [
9290   DISCH_ALL_TAC;
9291   TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC;
9292   ASM_SIMP_TAC[convex_connected];
9293   DISCH_TAC;
9294   USE 3(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
9295   CHO 3;
9296   AND 3;
9297   USE 3(MATCH_MP component_replace);
9298   ASM_REWRITE_TAC[];
9299   IMATCH_MP_TAC  connected_component;
9300   ASM_REWRITE_TAC[];
9301   ]);;
9302   (* }}} *)
9303
9304 let cell_convex = prove_by_refinement(
9305   `!C.  (cell C) ==> (convex C)`,
9306   (* {{{ proof *)
9307   [
9308   REWRITE_TAC[cell];
9309   GEN_TAC;
9310   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];
9311
9312   ]);;
9313   (* }}} *)
9314
9315 (* ------------------------------------------------------------------ *)
9316
9317 let cell_of = jordan_def `cell_of C = { A | (cell A) /\ (A SUBSET C) }`;;
9318
9319 let unions_cell_of = prove_by_refinement(
9320   `!G x. (segment G ==>
9321      (UNIONS (cell_of (component  (ctop G) x)) =
9322            component  (ctop G) x))`,
9323   (* {{{ proof *)
9324   [
9325   DISCH_ALL_TAC;
9326   IMATCH_MP_TAC  SUBSET_ANTISYM;
9327   REWRITE_TAC[UNIONS;SUBSET;cell_of];
9328   CONJ_TAC;
9329   DISCH_ALL_TAC;
9330   CHO 1;
9331   AND 1;
9332   ASM_MESON_TAC[];
9333   DISCH_ALL_TAC;
9334   TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC;
9335   UND 1;
9336   REWRITE_TAC[component_DEF   ;connected;SUBSET ;ctop_unions;DIFF ];
9337   DISCH_THEN CHOOSE_TAC;
9338   ASM_MESON_TAC[];
9339   DISCH_TAC;
9340   USE 2 (MATCH_MP point_onto);
9341   CHO 2;
9342   REWR 1;
9343   ASM_REWRITE_TAC[];
9344   ASSUME_TAC cell_unions;
9345   TSPEC `p` 3;
9346   USE 3 (REWRITE_RULE[UNIONS]);
9347   CHO 3;
9348   TYPE_THEN `u` EXISTS_TAC;
9349   TYPE_THEN `u SUBSET (component  (ctop G) x) ==> (!x'. u x' ==> component  (ctop G) x x')` SUBGOAL_TAC;
9350   REWRITE_TAC[ISUBSET];
9351   ASM_REWRITE_TAC[];
9352   DISCH_THEN IMATCH_MP_TAC ;
9353   IMATCH_MP_TAC  convex_component ;
9354   ASM_REWRITE_TAC[EMPTY_EXISTS];
9355   CONJ_TAC;
9356   ASM_MESON_TAC[cell_convex];
9357   CONJ_TAC;
9358   REWRITE_TAC[ctop_unions];
9359   REWRITE_TAC[DIFF;SUBSET ];
9360   DISCH_ALL_TAC;
9361   CONJ_TAC;
9362   AND 3;
9363   UND 5;
9364   UND 4;
9365   ASM_MESON_TAC[cell_euclid;ISUBSET];
9366   REWRITE_TAC[UNIONS];
9367   LEFT_TAC  "u";
9368   GEN_TAC;
9369   DISCH_ALL_TAC;
9370   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
9371   ASM_MESON_TAC[segment];
9372   DISCH_TAC;
9373   USE 6 (MATCH_MP   curve_cell_cell);
9374   USE 6 (REWRITE_RULE[ISUBSET]);
9375   TSPEC `u'` 6;
9376   REWR 6;
9377   TYPE_THEN `u = u'` SUBGOAL_TAC;
9378   IMATCH_MP_TAC  cell_partition;
9379   REWRITE_TAC[EMPTY_EXISTS;INTER];
9380   ASM_MESON_TAC[];
9381   DISCH_TAC;
9382   USE 1 (REWRITE_RULE[component_DEF;connected;SUBSET ]);
9383   TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC;
9384   ASM_MESON_TAC[];
9385   REWRITE_TAC[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ];
9386   DISJ2_TAC ;
9387   ASM_MESON_TAC[];
9388   NAME_CONFLICT_TAC;
9389   TYPE_THEN `point p` EXISTS_TAC;
9390   ASM_REWRITE_TAC [INTER];
9391   ]);;
9392   (* }}} *)
9393
9394
9395
9396
9397 (* ------------------------------------------------------------------ *)
9398 (* SECTION F *)
9399 (* ------------------------------------------------------------------ *)
9400
9401 (* ------------------------------------------------------------------ *)
9402 (* num_abs_of_int *)
9403 (* ------------------------------------------------------------------ *)
9404
9405 let num_abs_of_int_exists = prove_by_refinement(
9406   `!m. ?i. &i = abs  (real_of_int(m))`,
9407   (* {{{ proof *)
9408   [
9409   GEN_TAC;
9410   REWRITE_TAC[GSYM int_abs_th];
9411   ASSUME_TAC dest_int_rep;
9412   TSPEC `||: m` 0;
9413   CHO 0;
9414   TYPE_THEN `n` EXISTS_TAC;
9415   UND 0;
9416   DISCH_THEN DISJ_CASES_TAC;
9417   ASM_REWRITE_TAC[];
9418   WITH 0 (REWRITE_RULE[int_abs_th]);
9419   TYPE_THEN `&0 <= abs  (real_of_int m)` SUBGOAL_TAC;
9420   REWRITE_TAC[REAL_ABS_POS];
9421   TYPE_THEN `abs  (real_of_int m) <= &.0` SUBGOAL_TAC;
9422   ASM_REWRITE_TAC[];
9423   REDUCE_TAC ;
9424   ASM_REWRITE_TAC[];
9425   REAL_ARITH_TAC ;
9426   ]);;
9427   (* }}} *)
9428
9429 let num_abs_of_int_select = new_definition
9430      `num_abs_of_int m = @i. (&i = abs  (real_of_int m))`;;
9431
9432 let num_abs_of_int_th = prove_by_refinement(
9433   `!m. &(num_abs_of_int m) = abs  (real_of_int m)`,
9434   (* {{{ proof *)
9435   [
9436   GEN_TAC;
9437   REWRITE_TAC[num_abs_of_int_select];
9438   SELECT_TAC;
9439   ASM_REWRITE_TAC[];
9440   ASM_MESON_TAC[num_abs_of_int_exists];
9441   ]);;
9442   (* }}} *)
9443
9444 let num_abs_of_int_mul = prove_by_refinement(
9445   `!m n. (num_abs_of_int (m * n) = num_abs_of_int m * num_abs_of_int n)`,
9446   (* {{{ proof *)
9447   [
9448   REWRITE_TAC[GSYM REAL_OF_NUM_EQ;GSYM REAL_MUL;num_abs_of_int_th;int_mul_th;ABS_MUL;];
9449   ]);;
9450   (* }}} *)
9451
9452 let num_abs_of_int_num = prove_by_refinement(
9453   `!n. (num_abs_of_int (&: n) = n)`,
9454   (* {{{ proof *)
9455   [
9456   REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_of_num_th;REAL_ABS_NUM;];
9457   ]);;
9458   (* }}} *)
9459
9460 let num_abs_of_int_triangle = prove_by_refinement(
9461   `!n m. num_abs_of_int (m + n) <=|
9462            num_abs_of_int(m) +| num_abs_of_int n`,
9463   (* {{{ proof *)
9464   [
9465   REP_GEN_TAC;
9466   REWRITE_TAC[GSYM REAL_OF_NUM_LE;num_abs_of_int_th;int_add_th;GSYM REAL_OF_NUM_ADD;ABS_TRIANGLE;];
9467   ]);;
9468   (* }}} *)
9469
9470 let num_abs_of_int0 = prove_by_refinement(
9471   `!m. (num_abs_of_int m = 0) <=> (m = &:0)`,
9472   (* {{{ proof *)
9473   [
9474   GEN_TAC;
9475   REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;REAL_ABS_ZERO;];
9476   REWRITE_TAC[int_eq;];
9477   REWRITE_TAC[int_of_num_th;];
9478   ]);;
9479   (* }}} *)
9480
9481 let num_abs_of_int_neg = prove_by_refinement(
9482   `!m. (num_abs_of_int (--: m) = num_abs_of_int m)`,
9483   (* {{{ proof *)
9484   [
9485   GEN_TAC;
9486   REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_neg_th;REAL_ABS_NEG;];
9487   ]);;
9488   (* }}} *)
9489
9490 let num_abs_of_int_suc = prove_by_refinement(
9491   `!m. (&:0 <=: m) ==>
9492      (SUC (num_abs_of_int m) = num_abs_of_int (m +: &:1))`,
9493   (* {{{ proof *)
9494   [
9495   REWRITE_TAC[int_le;int_of_num_th;];
9496   DISCH_ALL_TAC;
9497   REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc];
9498   UND 0;
9499   REAL_ARITH_TAC;
9500   ]);;
9501   (* }}} *)
9502
9503 let num_abs_of_int_pre = prove_by_refinement(
9504   `!m. (m <=: &:0) ==>
9505      (SUC (num_abs_of_int m) = num_abs_of_int (m -: &:1))`,
9506   (* {{{ proof *)
9507   [
9508   REWRITE_TAC[int_le;int_of_num_th;];
9509   DISCH_ALL_TAC;
9510   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;];
9511   UND 0;
9512   REAL_ARITH_TAC;
9513   ]);;
9514   (* }}} *)
9515
9516 (* ------------------------------------------------------------------ *)
9517 (* closure of squares *)
9518 (* ------------------------------------------------------------------ *)
9519
9520 let right_left = prove_by_refinement(
9521   `!m. (right  (left  m) = m) /\ (left  (right  m) = m) /\
9522     (up (down m) = m) /\ (down (up m) = m) /\
9523     (up (right  m) = right  (up m)) /\ (up (left  m) = left  (up m)) /\
9524     (down (right  m) = right  (down m)) /\
9525     (down (left  m) = (left  (down m)))`,
9526   (* {{{ proof *)
9527   [
9528   REWRITE_TAC[right ;left ;up;down;PAIR_SPLIT];
9529   INT_ARITH_TAC;
9530   ]);;
9531   (* }}} *)
9532
9533 let squc = jordan_def `squc p = {Z | ?u v.
9534                   (Z = point (u,v)) /\
9535                   real_of_int (FST p) <= u /\
9536                   u <= real_of_int (FST p +: &:1) /\
9537                   real_of_int (SND p) <= v /\
9538                   v <= real_of_int (SND p +: &:1)}`;;
9539
9540 let squc_inter = prove_by_refinement(
9541   `!p. squc p =
9542    {z | ?r. (z = point r) /\ real_of_int (FST p) <= FST r} INTER
9543          {z | ?r. (z = point r) /\ real_of_int (SND p) <= SND r} INTER
9544          {z | ?r. (z = point r) /\ FST r <= real_of_int (FST p +: &:1)} INTER
9545          {z | ?r. (z = point r) /\ SND r <= real_of_int (SND p +: &:1)}`,
9546   (* {{{ proof *)
9547
9548   [
9549   REWRITE_TAC[squc];
9550   GEN_TAC;
9551   IMATCH_MP_TAC  EQ_EXT;
9552   GEN_TAC;
9553   REWRITE_TAC[INTER];
9554   EQ_TAC;
9555   DISCH_TAC;
9556   CHO 0;
9557   CHO 0;
9558   ASM_REWRITE_TAC[point_inj;];
9559   CONV_TAC (dropq_conv "r");
9560   ASM_REWRITE_TAC[];
9561   CONV_TAC (dropq_conv "r");
9562   ASM_REWRITE_TAC[];
9563   CONV_TAC (dropq_conv "r'");
9564   ASM_REWRITE_TAC[];
9565   CONV_TAC (dropq_conv "r");
9566   ASM_REWRITE_TAC[];
9567   DISCH_ALL_TAC;
9568   CHO 0;
9569   AND 0;
9570   REWR 1;
9571   REWRITE_TAC[point_inj;PAIR_SPLIT ;];
9572   CONV_TAC (dropq_conv "u");
9573   CONV_TAC (dropq_conv "v");
9574   USE 1 (REWRITE_RULE[point_inj;]);
9575   USE 1 (CONV_RULE (dropq_conv "r'"));
9576   REWR 2;
9577   USE 2 (REWRITE_RULE[point_inj;]);
9578   USE 2 (CONV_RULE (dropq_conv "r'"));
9579   REWR 3;
9580   USE 3 (REWRITE_RULE[point_inj;]);
9581   USE 3 (CONV_RULE (dropq_conv "r'"));
9582   ASM_REWRITE_TAC[];
9583   ]);;
9584
9585   (* }}} *)
9586
9587 let squc_closed = prove_by_refinement(
9588   `!p. closed_ (top2) (squc p)`,
9589   (* {{{ proof *)
9590   [
9591   GEN_TAC;
9592   ASSUME_TAC top2_top;
9593   REWRITE_TAC[squc_inter];
9594   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];
9595   ]);;
9596   (* }}} *)
9597
9598 let squ_subset_sqc = prove_by_refinement(
9599   `!p. (squ p SUBSET (squc p))`,
9600   (* {{{ proof *)
9601   [
9602   GEN_TAC;
9603   REWRITE_TAC[SUBSET;squ;squc];
9604   GEN_TAC;
9605   DISCH_ALL_TAC;
9606   CHO 0;
9607   CHO 0;
9608   TYPE_THEN `u` EXISTS_TAC;
9609   TYPE_THEN `v` EXISTS_TAC;
9610   ASM_MESON_TAC[REAL_ARITH `x < y ==> x <=. y`];
9611   ]);;
9612   (* }}} *)
9613
9614 let squc_union_lemma1 = prove_by_refinement(
9615   `!p. squc p INTER
9616      {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} =
9617    {(pointI p)} UNION (v_edge p) UNION {(pointI (up p))}`,
9618   (* {{{ proof *)
9619   [
9620   GEN_TAC;
9621   IMATCH_MP_TAC  EQ_EXT;
9622   GEN_TAC;
9623   REWRITE_TAC[squc;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;];
9624   EQ_TAC;
9625   DISCH_ALL_TAC;
9626   CHO 0;
9627   CHO 0;
9628   REWR 1;
9629   USE 1(REWRITE_RULE[point_inj]);
9630   USE 1(CONV_RULE (dropq_conv "r"));
9631   UND 0;
9632   DISCH_ALL_TAC;
9633   UND 4;
9634   UND 5;
9635   REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`];
9636   KILL 2;
9637   KILL 3;
9638   KILL 0;
9639   USE 1 (GSYM);
9640   ASM_REWRITE_TAC[];
9641   KILL 0;
9642   REP_CASES_TAC;
9643   ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`];
9644   EXPAND_TAC "v";
9645   REWRITE_TAC[pointI;int_suc;];
9646   ASM_REWRITE_TAC[pointI];
9647   REWRITE_TAC[v_edge];
9648   DISJ2_TAC ;
9649   DISJ1_TAC ;
9650   REWRITE_TAC[point_inj; PAIR_SPLIT];
9651   CONV_TAC (dropq_conv "u");
9652   CONV_TAC (dropq_conv "v'");
9653   ASM_REWRITE_TAC[];
9654   ASM_REWRITE_TAC[int_suc];
9655   REP_CASES_TAC;
9656   ASM_REWRITE_TAC[pointI;point_inj;];
9657   CONJ_TAC;
9658   REWRITE_TAC[PAIR_SPLIT];
9659   CONV_TAC (dropq_conv "u");
9660   CONV_TAC (dropq_conv "v");
9661   REAL_ARITH_TAC ;
9662   CONV_TAC (dropq_conv "r");
9663   USE 0 (REWRITE_RULE[v_edge]);
9664   CHO 0;
9665   CHO 0;
9666   ASM_REWRITE_TAC[];
9667   REWRITE_TAC[point_inj];
9668   CONJ_TAC;
9669   REWRITE_TAC[PAIR_SPLIT];
9670   CONV_TAC (dropq_conv "u");
9671   CONV_TAC (dropq_conv "v'");
9672   AND  0;
9673   UND 0;
9674   REWRITE_TAC[int_suc];
9675   REAL_ARITH_TAC ;
9676   CONV_TAC (dropq_conv "r");
9677   (* LAST *)
9678   ASM_REWRITE_TAC[pointI;point_inj;];
9679   CONJ_TAC;
9680   REWRITE_TAC[PAIR_SPLIT];
9681   CONV_TAC (dropq_conv "u");
9682   CONV_TAC (dropq_conv "v");
9683   REWRITE_TAC[int_suc];
9684   REAL_ARITH_TAC ;
9685   CONV_TAC (dropq_conv "r");
9686   ]);;
9687   (* }}} *)
9688
9689 let squc_union_lemma2 = prove_by_refinement(
9690   `!p. squc p INTER
9691      {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} =
9692    {(pointI (right  p))} UNION (v_edge (right  p)) UNION
9693      {(pointI (up (right  p)))}`,
9694   (* {{{ proof *)
9695   [
9696   GEN_TAC;
9697   IMATCH_MP_TAC  EQ_EXT;
9698   GEN_TAC;
9699   REWRITE_TAC[squc;right  ;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;];
9700   EQ_TAC;
9701   DISCH_ALL_TAC;
9702   CHO 0;
9703   CHO 0;
9704   REWR 1;
9705   USE 1(REWRITE_RULE[point_inj]);
9706   USE 1(CONV_RULE (dropq_conv "r"));
9707   UND 0;
9708   DISCH_ALL_TAC;
9709   UND 4;
9710   UND 5;
9711   REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`];
9712   KILL 2;
9713   KILL 3;
9714   KILL 0;
9715   USE 1 (GSYM);
9716   ASM_REWRITE_TAC[];
9717   KILL 0;
9718   REP_CASES_TAC;
9719   ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`];
9720   EXPAND_TAC "v";
9721   REWRITE_TAC[pointI;int_suc;];
9722   (* 3 LEFT *)
9723   ASM_REWRITE_TAC[pointI;int_suc;];
9724   (* 2 LEFT *)
9725   REWRITE_TAC[v_edge];
9726   DISJ2_TAC ;
9727   DISJ1_TAC ;
9728   REWRITE_TAC[point_inj; PAIR_SPLIT];
9729   CONV_TAC (dropq_conv "u");
9730   REWRITE_TAC[int_suc];
9731   CONV_TAC (dropq_conv "v'");
9732   ASM_REWRITE_TAC[];
9733   (* second half  *)
9734   ASM_REWRITE_TAC[int_suc];
9735   REP_CASES_TAC;
9736   ASM_REWRITE_TAC[pointI;point_inj;];
9737   CONJ_TAC;
9738   REWRITE_TAC[PAIR_SPLIT];
9739   CONV_TAC (dropq_conv "u");
9740   CONV_TAC (dropq_conv "v");
9741   ASM_REWRITE_TAC[int_suc];
9742   REAL_ARITH_TAC ;
9743   CONV_TAC (dropq_conv "r");
9744   REWRITE_TAC[int_suc];
9745   (* 2 LEFT *)
9746   USE 0 (REWRITE_RULE[v_edge]);
9747   CHO 0;
9748   CHO 0;
9749   ASM_REWRITE_TAC[];
9750   REWRITE_TAC[point_inj];
9751   CONJ_TAC;
9752   REWRITE_TAC[PAIR_SPLIT];
9753   CONV_TAC (dropq_conv "u");
9754   CONV_TAC (dropq_conv "v'");
9755   AND  0;
9756   UND 0;
9757   REWRITE_TAC[int_suc];
9758   REAL_ARITH_TAC ;
9759   CONV_TAC (dropq_conv "r");
9760   REWRITE_TAC[int_suc];
9761   (* LAST *)
9762   ASM_REWRITE_TAC[pointI;point_inj;];
9763   CONJ_TAC;
9764   REWRITE_TAC[PAIR_SPLIT];
9765   CONV_TAC (dropq_conv "u");
9766   CONV_TAC (dropq_conv "v");
9767   REWRITE_TAC[int_suc];
9768   REAL_ARITH_TAC ;
9769   CONV_TAC (dropq_conv "r");
9770   REWRITE_TAC[int_suc];
9771   ]);;
9772   (* }}} *)
9773
9774 let squc_union_lemma3 = prove_by_refinement(
9775   `!p. squc p INTER
9776     {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\
9777        (real_of_int(FST p) <. FST r) } =
9778     (h_edge p) UNION squ p UNION (h_edge (up p))`,
9779   (* {{{ proof *)
9780   [
9781   GEN_TAC;
9782   IMATCH_MP_TAC  EQ_EXT;
9783   GEN_TAC;
9784   REWRITE_TAC[INTER;squc;UNION;];
9785   EQ_TAC;
9786   DISCH_ALL_TAC;
9787   CHO 0;
9788   CHO 0;
9789   REWR 1;
9790   USE 1 (REWRITE_RULE[point_inj]);
9791   USE 1 (CONV_RULE (dropq_conv "r"));
9792   AND 0;
9793   UND 0;
9794   DISCH_ALL_TAC;
9795   KILL  0;
9796   KILL  3;
9797   UND 4;
9798   UND 5;
9799   REWRITE_TAC[REAL_ARITH `(x <= y) <=> (y = x) \/ (x <. y)`;int_suc];
9800   REP_CASES_TAC;
9801   ASM_MESON_TAC[REAL_ARITH `~(v = v + &1)`];
9802   EXPAND_TAC "v";
9803   REWRITE_TAC[up;h_edge];
9804   DISJ2_TAC;
9805   DISJ2_TAC;
9806   REWRITE_TAC[point_inj;];
9807   REWRITE_TAC[PAIR_SPLIT];
9808   CONV_TAC (dropq_conv "u'");
9809   CONV_TAC (dropq_conv "v");
9810   ASM_REWRITE_TAC[int_suc];
9811   (* 3 to go *)
9812   ASM_REWRITE_TAC[];
9813   DISJ1_TAC;
9814   REWRITE_TAC[h_edge;point_inj;PAIR_SPLIT];
9815   CONV_TAC (dropq_conv "u'");
9816   CONV_TAC (dropq_conv "v");
9817   ASM_REWRITE_TAC[int_suc];
9818   (* 2 to go *)
9819   DISJ2_TAC;
9820   DISJ1_TAC;
9821   REWRITE_TAC[squ;point_inj;PAIR_SPLIT];
9822   CONV_TAC (dropq_conv "u'");
9823   CONV_TAC (dropq_conv "v'");
9824   ASM_REWRITE_TAC[int_suc];
9825   (* 2nd half *)
9826   DISCH_TAC;
9827   TYPE_THEN `?q. x = point q` ASM_CASES_TAC;
9828   CHO 1;
9829   ASM_REWRITE_TAC[point_inj];
9830   CONJ_TAC;
9831   REWRITE_TAC[PAIR_SPLIT];
9832   CONV_TAC (dropq_conv "u");
9833   CONV_TAC (dropq_conv "v");
9834   REWR 0;
9835   UND 0;
9836   REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;];
9837   REP_CASES_TAC;
9838   USE 0 (CONV_RULE (dropq_conv "u"));
9839   USE 0 (CONV_RULE (dropq_conv "v"));
9840   UND 0;
9841   REAL_ARITH_TAC ;
9842   USE 0 (CONV_RULE (dropq_conv "u"));
9843   USE 0 (CONV_RULE (dropq_conv "v"));
9844   UND 0;
9845   REAL_ARITH_TAC ;
9846   USE 0 (CONV_RULE (dropq_conv "u"));
9847   USE 0 (CONV_RULE (dropq_conv "v"));
9848   UND 0;
9849   REAL_ARITH_TAC ;
9850   CONV_TAC (dropq_conv "r");
9851   REWR 0;
9852   UND 0;
9853   REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;];
9854   REP_CASES_TAC;
9855   USE 0 (CONV_RULE (dropq_conv "u"));
9856   USE 0 (CONV_RULE (dropq_conv "v"));
9857   UND 0;
9858   REAL_ARITH_TAC ;
9859   USE 0 (CONV_RULE (dropq_conv "u"));
9860   USE 0 (CONV_RULE (dropq_conv "v"));
9861   UND 0;
9862   REAL_ARITH_TAC ;
9863   USE 0 (CONV_RULE (dropq_conv "u"));
9864   USE 0 (CONV_RULE (dropq_conv "v"));
9865   UND 0;
9866   REAL_ARITH_TAC ;
9867   (* 1 goal LEFT *)
9868   PROOF_BY_CONTR_TAC;
9869   KILL 2;
9870   UND 1;
9871   REWRITE_TAC[];
9872   IMATCH_MP_TAC  point_onto;
9873   ASM_MESON_TAC[h_edge_euclid;squ_euclid;v_edge_euclid;ISUBSET ];
9874   ]);;
9875   (* }}} *)
9876
9877 let squc_lemma4 = prove_by_refinement(
9878   `!p. squc p SUBSET
9879     {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION
9880      {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION
9881       {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\
9882        (real_of_int(FST p) <. FST r) } `,
9883   (* {{{ proof *)
9884   [
9885   REWRITE_TAC[SUBSET;UNION ;squc ];
9886   DISCH_ALL_TAC;
9887   CHO 0;
9888   CHO 0;
9889   ASM_REWRITE_TAC[point_inj ;];
9890   LEFT_TAC "r";
9891   CONV_TAC (dropq_conv "r");
9892   UND 0;
9893   DISCH_ALL_TAC;
9894   UND 1;
9895   UND 2;
9896   ASM_REWRITE_TAC[int_suc];
9897   REAL_ARITH_TAC ;
9898   ]);;
9899   (* }}} *)
9900
9901 let squc_union = prove_by_refinement(
9902   `!p. squc p = {(pointI p)} UNION {(pointI (right  p))} UNION
9903        {(pointI (up p))} UNION {(pointI (up (right   p)))} UNION
9904        (h_edge p) UNION (h_edge (up p)) UNION
9905        (v_edge p) UNION (v_edge (right  p)) UNION
9906        (squ p)`,
9907   (* {{{ proof *)
9908   [
9909   GEN_TAC;
9910   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;
9911   ONCE_REWRITE_TAC[EQ_SYM_EQ];
9912   REWRITE_TAC  [GSYM SUBSET_INTER_ABSORPTION];
9913   MATCH_ACCEPT_TAC squc_lemma4;
9914   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
9915   REWRITE_TAC[UNION_OVER_INTER];
9916   REWRITE_TAC[squc_union_lemma1;squc_union_lemma2;squc_union_lemma3];
9917   REWRITE_TAC[UNION_ACI];
9918   ]);;
9919   (* }}} *)
9920
9921 let squ_closure_h = prove_by_refinement(
9922   `!p. (h_edge p) SUBSET (closure top2 (squ p))`,
9923   (* {{{ proof *)
9924   [
9925   REWRITE_TAC[SUBSET;];
9926   DISCH_ALL_TAC;
9927   ASM_REWRITE_TAC[top2];
9928   IMATCH_MP_TAC  closure_segment;
9929   ASM_REWRITE_TAC[squ_euclid];
9930   TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
9931   IMATCH_MP_TAC  point_onto;
9932   ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid];
9933   DISCH_TAC;
9934   CHO 1;
9935   REWR 0;
9936   KILL 1;
9937   TYPE_THEN `point (FST q, SND q + &1)` EXISTS_TAC;
9938   REWRITE_TAC[point_scale;point_add;];
9939   UND 0;
9940   TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
9941   REWRITE_TAC[];
9942   DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
9943   PURE_REWRITE_TAC[point_add;point_scale];
9944   REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;];
9945   DISCH_ALL_TAC;
9946   USE 0 (CONV_RULE (dropq_conv "u"));
9947   USE 0 (CONV_RULE (dropq_conv "v"));
9948   DISCH_ALL_TAC;
9949   CONV_TAC (dropq_conv "u");
9950   CONV_TAC (dropq_conv "v");
9951   UND 0;
9952   REWRITE_TAC[int_suc];
9953   ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
9954   ASM_REWRITE_TAC[];
9955   REDUCE_TAC;
9956   ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`);
9957   ASM_REWRITE_TAC[];
9958   REDUCE_TAC;
9959   UND 1;
9960   UND 2;
9961   REDUCE_TAC ;
9962   REAL_ARITH_TAC;
9963   ]);;
9964   (* }}} *)
9965
9966 let squ_closure_up_h = prove_by_refinement(
9967   `!p. (h_edge (up   p)) SUBSET (closure top2 (squ p))`,
9968   (* {{{ proof *)
9969   [
9970   REWRITE_TAC[SUBSET;up  ];
9971   DISCH_ALL_TAC;
9972   ASM_REWRITE_TAC[top2];
9973   IMATCH_MP_TAC  closure_segment;
9974   ASM_REWRITE_TAC[squ_euclid];
9975   TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
9976   IMATCH_MP_TAC  point_onto;
9977   ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid];
9978   DISCH_TAC;
9979   CHO 1;
9980   REWR 0;
9981   KILL 1;
9982   TYPE_THEN `point (FST q , SND q - &1)` EXISTS_TAC;
9983   REWRITE_TAC[point_scale;point_add;];
9984   UND 0;
9985   TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
9986   REWRITE_TAC[];
9987   DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
9988   PURE_REWRITE_TAC[point_add;point_scale];
9989   REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;];
9990   DISCH_ALL_TAC;
9991   USE 0 (CONV_RULE (dropq_conv "u"));
9992   USE 0 (CONV_RULE (dropq_conv "v"));
9993   DISCH_ALL_TAC;
9994   CONV_TAC (dropq_conv "u");
9995   CONV_TAC (dropq_conv "v");
9996   UND 0;
9997   REWRITE_TAC[int_suc];
9998   ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
9999   ASM_REWRITE_TAC[];
10000   REDUCE_TAC;
10001   ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`);
10002   ASM_REWRITE_TAC[];
10003   REDUCE_TAC;
10004   UND 1;
10005   UND 2;
10006   REDUCE_TAC ;
10007   REAL_ARITH_TAC;
10008   ]);;
10009   (* }}} *)
10010
10011 let squ_closure_down_h = prove_by_refinement(
10012   `!p. (h_edge p SUBSET (closure top2 (squ (down p))))`,
10013   (* {{{ proof *)
10014
10015   [
10016   GEN_TAC;
10017   ASSUME_TAC squ_closure_up_h ;
10018   TSPEC `down p` 0;
10019   USE 0 (REWRITE_RULE [right_left]);
10020   ASM_REWRITE_TAC[];
10021   ]);;
10022
10023   (* }}} *)
10024
10025 let squ_closure_v = prove_by_refinement(
10026   `!p. (v_edge p) SUBSET (closure top2 (squ p))`,
10027   (* {{{ proof *)
10028   [
10029   REWRITE_TAC[SUBSET;];
10030   DISCH_ALL_TAC;
10031   ASM_REWRITE_TAC[top2];
10032   IMATCH_MP_TAC  closure_segment;
10033   ASM_REWRITE_TAC[squ_euclid];
10034   TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
10035   IMATCH_MP_TAC  point_onto;
10036   ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid];
10037   DISCH_TAC;
10038   CHO 1;
10039   REWR 0;
10040   KILL 1;
10041   TYPE_THEN `point (FST q + &1, SND q )` EXISTS_TAC;
10042   REWRITE_TAC[point_scale;point_add;];
10043   UND 0;
10044   TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
10045   REWRITE_TAC[];
10046   DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
10047   PURE_REWRITE_TAC[point_add;point_scale];
10048   REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;];
10049   DISCH_ALL_TAC;
10050   USE 0 (CONV_RULE (dropq_conv "u"));
10051   USE 0 (CONV_RULE (dropq_conv "v"));
10052   DISCH_ALL_TAC;
10053   CONV_TAC (dropq_conv "u");
10054   CONV_TAC (dropq_conv "v");
10055   UND 0;
10056   REWRITE_TAC[int_suc];
10057   ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
10058   ASM_REWRITE_TAC[];
10059   REDUCE_TAC;
10060   ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`);
10061   ASM_REWRITE_TAC[];
10062   REDUCE_TAC;
10063   UND 1;
10064   UND 2;
10065   REDUCE_TAC ;
10066   REAL_ARITH_TAC;
10067   ]);;
10068   (* }}} *)
10069
10070 let squ_closure_right_v = prove_by_refinement(
10071   `!p. (v_edge (right     p)) SUBSET (closure top2 (squ p))`,
10072   (* {{{ proof *)
10073   [
10074   REWRITE_TAC[SUBSET;right    ];
10075   DISCH_ALL_TAC;
10076   ASM_REWRITE_TAC[top2];
10077   IMATCH_MP_TAC  closure_segment;
10078   ASM_REWRITE_TAC[squ_euclid];
10079   TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
10080   IMATCH_MP_TAC  point_onto;
10081   ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid];
10082   DISCH_TAC;
10083   CHO 1;
10084   REWR 0;
10085   KILL 1;
10086   TYPE_THEN `point (FST q - &1 , SND q )` EXISTS_TAC;
10087   REWRITE_TAC[point_scale;point_add;];
10088   UND 0;
10089   TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
10090   REWRITE_TAC[];
10091   DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
10092   PURE_REWRITE_TAC[point_add;point_scale];
10093   REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;];
10094   DISCH_ALL_TAC;
10095   USE 0 (CONV_RULE (dropq_conv "u"));
10096   USE 0 (CONV_RULE (dropq_conv "v"));
10097   DISCH_ALL_TAC;
10098   CONV_TAC (dropq_conv "u");
10099   CONV_TAC (dropq_conv "v");
10100   UND 0;
10101   REWRITE_TAC[int_suc];
10102   ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
10103   ASM_REWRITE_TAC[];
10104   REDUCE_TAC;
10105   ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`);
10106   ASM_REWRITE_TAC[];
10107   REDUCE_TAC;
10108   UND 1;
10109   UND 2;
10110   REDUCE_TAC ;
10111   REAL_ARITH_TAC;
10112   ]);;
10113   (* }}} *)
10114
10115 let squ_closure_left_v  = prove_by_refinement(
10116   `!p. (v_edge p SUBSET (closure top2 (squ (left  p))))`,
10117   (* {{{ proof *)
10118   [
10119   GEN_TAC;
10120   ASSUME_TAC squ_closure_right_v;
10121   TSPEC `left  p` 0;
10122   USE 0 (REWRITE_RULE[right_left]);
10123   ASM_REWRITE_TAC[];
10124   ]);;
10125   (* }}} *)
10126
10127 let squ_closure_hc = prove_by_refinement(
10128   `!p. (hc_edge p) SUBSET (closure top2 (squ p))`,
10129   (* {{{ proof *)
10130
10131   [
10132   DISCH_ALL_TAC;
10133   REWRITE_TAC[GSYM h_edge_closure];
10134   IMATCH_MP_TAC  closure_subset;
10135   ASSUME_TAC top2_top;
10136   ASM_REWRITE_TAC[squ_closure_h];
10137   IMATCH_MP_TAC  closure_closed;
10138   ASM_REWRITE_TAC[top2_unions;squ_euclid];
10139   ]);;
10140
10141   (* }}} *)
10142
10143 let squ_closure_up_hc = prove_by_refinement(
10144   `!p. (hc_edge (up p)) SUBSET (closure top2 (squ p))`,
10145   (* {{{ proof *)
10146   [
10147   DISCH_ALL_TAC;
10148   REWRITE_TAC[GSYM h_edge_closure];
10149   IMATCH_MP_TAC  closure_subset;
10150   ASSUME_TAC top2_top;
10151   ASM_REWRITE_TAC[squ_closure_up_h];
10152   IMATCH_MP_TAC  closure_closed;
10153   ASM_REWRITE_TAC[top2_unions;squ_euclid];
10154   ]);;
10155   (* }}} *)
10156
10157 let squ_closure_vc = prove_by_refinement(
10158   `!p. (vc_edge p) SUBSET (closure top2 (squ p))`,
10159   (* {{{ proof *)
10160   [
10161   DISCH_ALL_TAC;
10162   REWRITE_TAC[GSYM v_edge_closure];
10163   IMATCH_MP_TAC  closure_subset;
10164   ASSUME_TAC top2_top;
10165   ASM_REWRITE_TAC[squ_closure_v];
10166   IMATCH_MP_TAC  closure_closed;
10167   ASM_REWRITE_TAC[top2_unions;squ_euclid];
10168   ]);;
10169   (* }}} *)
10170
10171 let squ_closure = prove_by_refinement(
10172   `!p. (closure top2 (squ p)) = (squc p)`,
10173   (* {{{ proof *)
10174
10175   [
10176   DISCH_ALL_TAC;
10177   ASSUME_TAC top2_top;
10178   IMATCH_MP_TAC  SUBSET_ANTISYM;
10179   CONJ_TAC;
10180   IMATCH_MP_TAC  closure_subset;
10181   ASM_REWRITE_TAC[squc_closed];
10182   REWRITE_TAC[squc_union];
10183   REWRITE_TAC[SUBSET;UNION];
10184   ASM_MESON_TAC[];
10185   REWRITE_TAC[squc_union];
10186   REWRITE_TAC[union_subset];
10187   ASSUME_TAC squ_closure_hc;
10188   TSPEC `p` 1;
10189   ASSUME_TAC squ_closure_up_hc;
10190   TSPEC `p` 2;
10191   USE 1 (REWRITE_RULE[hc_edge;plus_e12;union_subset]);
10192   USE 2 (REWRITE_RULE[hc_edge;plus_e12;up;union_subset]);
10193   ASM_REWRITE_TAC [up;right;squ_closure_v;REWRITE_RULE[right  ] squ_closure_right_v  ];
10194   ASM_SIMP_TAC[subset_closure];
10195   ]);;
10196
10197   (* }}} *)
10198
10199 (* ------------------------------------------------------------------ *)
10200 (* adj_edge *)
10201 (* ------------------------------------------------------------------ *)
10202
10203
10204 let adj_edge = jordan_def `adj_edge x y <=> (~(x = y)) /\
10205   (?e. (edge e) /\
10206    (e SUBSET (closure top2 x)) /\ (e SUBSET (closure top2 y)))`;;
10207
10208 let adj_edge_sym = prove_by_refinement(
10209   `!x y. (adj_edge x y = adj_edge y x)`,
10210   (* {{{ proof *)
10211   [
10212   REWRITE_TAC[adj_edge];
10213   MESON_TAC[];
10214   ]);;
10215   (* }}} *)
10216
10217 let adj_edge_left = prove_by_refinement(
10218   `!m. (adj_edge (squ m) (squ (left  m)))`,
10219   (* {{{ proof *)
10220   [
10221   DISCH_ALL_TAC;
10222   REWRITE_TAC[adj_edge];
10223   REWRITE_TAC[squ_closure;squ_inj;];
10224   CONJ_TAC;
10225   REWRITE_TAC[left ;PAIR_SPLIT;];
10226   INT_ARITH_TAC;
10227   TYPE_THEN `v_edge m` EXISTS_TAC;
10228   REWRITE_TAC[edge;v_edge_inj;];
10229   CONV_TAC (dropq_conv "m'");
10230   REWRITE_TAC[squc_union; SUBSET;UNION ;];
10231   REWRITE_TAC[right_left];
10232   ASM_MESON_TAC[];
10233   ]);;
10234   (* }}} *)
10235
10236 let adj_edge_right = prove_by_refinement(
10237   `!m. (adj_edge (squ m) (squ (right    m)))`,
10238   (* {{{ proof *)
10239   [
10240   DISCH_ALL_TAC;
10241   REWRITE_TAC[adj_edge];
10242   REWRITE_TAC[squ_closure;squ_inj;];
10243   CONJ_TAC;
10244   REWRITE_TAC[right   ;PAIR_SPLIT;];
10245   INT_ARITH_TAC;
10246   TYPE_THEN `v_edge (right  m)` EXISTS_TAC;
10247   REWRITE_TAC[edge;v_edge_inj;];
10248   CONV_TAC (dropq_conv "m'");
10249   REWRITE_TAC[squc_union; SUBSET;UNION ;];
10250   ASM_MESON_TAC[];
10251   ]);;
10252   (* }}} *)
10253
10254 let adj_edge_down = prove_by_refinement(
10255   `!m. (adj_edge (squ m) (squ (down  m)))`,
10256   (* {{{ proof *)
10257   [
10258   DISCH_ALL_TAC;
10259   REWRITE_TAC[adj_edge];
10260   REWRITE_TAC[squ_closure;squ_inj;];
10261   CONJ_TAC;
10262   REWRITE_TAC[down ;PAIR_SPLIT;];
10263   INT_ARITH_TAC;
10264   TYPE_THEN `h_edge m` EXISTS_TAC;
10265   REWRITE_TAC[edge;h_edge_inj;];
10266   CONV_TAC (dropq_conv "m'");
10267   REWRITE_TAC[squc_union; SUBSET;UNION ;];
10268   REWRITE_TAC[right_left];
10269   ASM_MESON_TAC[];
10270   ]);;
10271   (* }}} *)
10272
10273 let adj_edge_right = prove_by_refinement(
10274   `!m. (adj_edge (squ m) (squ (up    m)))`,
10275   (* {{{ proof *)
10276   [
10277   DISCH_ALL_TAC;
10278   REWRITE_TAC[adj_edge];
10279   REWRITE_TAC[squ_closure;squ_inj;];
10280   CONJ_TAC;
10281   REWRITE_TAC[up   ;PAIR_SPLIT;];
10282   INT_ARITH_TAC;
10283   TYPE_THEN `h_edge (up  m)` EXISTS_TAC;
10284   REWRITE_TAC[edge;h_edge_inj;];
10285   CONV_TAC (dropq_conv "m'");
10286   REWRITE_TAC[squc_union; SUBSET;UNION ;];
10287   ASM_MESON_TAC[];
10288   ]);;
10289   (* }}} *)
10290
10291 (* ------------------------------------------------------------------ *)
10292 (* components  *)
10293 (* ------------------------------------------------------------------ *)
10294
10295 let rectangle_euclid = prove_by_refinement(
10296   `!p q. (rectangle p q SUBSET (euclid 2))`,
10297   (* {{{ proof *)
10298   [
10299   REWRITE_TAC[rectangle;SUBSET ;];
10300   DISCH_ALL_TAC;
10301   CHO 0;
10302   CHO 0;
10303   ASM_REWRITE_TAC[euclid_point];
10304   ]);;
10305   (* }}} *)
10306
10307 let component_unions = prove_by_refinement(
10308   `!U (x:A). (component  U x SUBSET (UNIONS U))`,
10309   (* {{{ proof *)
10310   [
10311   REWRITE_TAC[SUBSET; component_DEF; connected ;];
10312   ASM_MESON_TAC[];
10313   ]);;
10314   (* }}} *)
10315
10316 let comp_h_rect = prove_by_refinement(
10317   `!G m x. (segment G /\
10318      (h_edge m SUBSET component  (ctop G) x)) ==>
10319    (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1)
10320        SUBSET component  (ctop G) x)`,
10321   (* {{{ proof *)
10322   [
10323   DISCH_ALL_TAC;
10324   IMATCH_MP_TAC   convex_component;
10325   ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
10326   CONJ_TAC;
10327   REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
10328   REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
10329   DISCH_ALL_TAC;
10330   AND 2;
10331   TYPE_THEN `~(squ (down m) x') /\ ~(squ m x')` SUBGOAL_TAC;
10332   USE 0(MATCH_MP curve_cell_squ_inter);
10333   COPY 0;
10334   TSPEC `m` 0;
10335   TSPEC `down m` 4;
10336   UND 4;
10337   UND 0;
10338   REWRITE_TAC [EQ_EMPTY; INTER];
10339   ASM_MESON_TAC[];
10340   DISCH_ALL_TAC;
10341   REWR 3;
10342   TYPE_THEN `h_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
10343   IMATCH_MP_TAC  SUBSET_TRANS;
10344   TYPE_THEN `component  (ctop G) x` EXISTS_TAC;
10345   ASM_REWRITE_TAC[component_unions];
10346   REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; h_edge_euclid; INTER;];
10347   ASM_MESON_TAC[];
10348   REWRITE_TAC[rectangle_h; EMPTY_EXISTS; UNION ; INTER;];
10349   USE 1 (REWRITE_RULE[SUBSET]);
10350   TYPE_THEN `~(h_edge m = EMPTY)` SUBGOAL_TAC ;
10351   IMATCH_MP_TAC  cell_nonempty;
10352   REWRITE_TAC[cell_rules];
10353   REWRITE_TAC[EMPTY_EXISTS];
10354   DISCH_TAC;
10355   CHO 2;
10356   TYPE_THEN `u` EXISTS_TAC;
10357   ASM_MESON_TAC[];
10358   ]);;
10359   (* }}} *)
10360
10361 let comp_v_rect = prove_by_refinement(
10362   `!G m x. (segment G /\
10363      (v_edge m SUBSET component  (ctop G) x)) ==>
10364    (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1)
10365        SUBSET component  (ctop G) x)`,
10366   (* {{{ proof *)
10367   [
10368   DISCH_ALL_TAC;
10369   IMATCH_MP_TAC   convex_component;
10370   ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
10371   CONJ_TAC;
10372   REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
10373   REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
10374   DISCH_ALL_TAC;
10375   AND 2;
10376   TYPE_THEN `~(squ (left   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
10377   USE 0(MATCH_MP curve_cell_squ_inter);
10378   COPY 0;
10379   TSPEC `m` 0;
10380   TSPEC `left   m` 4;
10381   UND 4;
10382   UND 0;
10383   REWRITE_TAC [EQ_EMPTY; INTER];
10384   ASM_MESON_TAC[];
10385   DISCH_ALL_TAC;
10386   REWR 3;
10387   TYPE_THEN `v_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
10388   IMATCH_MP_TAC  SUBSET_TRANS;
10389   TYPE_THEN `component  (ctop G) x` EXISTS_TAC;
10390   ASM_REWRITE_TAC[component_unions];
10391   REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; v_edge_euclid; INTER;];
10392   ASM_MESON_TAC[];
10393   REWRITE_TAC[rectangle_v; EMPTY_EXISTS; UNION ; INTER;];
10394   USE 1 (REWRITE_RULE[SUBSET]);
10395   TYPE_THEN `~(v_edge m = EMPTY)` SUBGOAL_TAC ;
10396   IMATCH_MP_TAC  cell_nonempty;
10397   REWRITE_TAC[cell_rules];
10398   REWRITE_TAC[EMPTY_EXISTS];
10399   DISCH_TAC;
10400   CHO 2;
10401   TYPE_THEN `u` EXISTS_TAC;
10402   ASM_MESON_TAC[];
10403   ]);;
10404   (* }}} *)
10405
10406 let long_v_convex = prove_by_refinement(
10407   `!p. (convex (long_v p))`,
10408   (* {{{ proof *)
10409   [
10410   REWRITE_TAC[long_v_inter];
10411   GEN_TAC;
10412   IMATCH_MP_TAC  convex_inter;
10413   REWRITE_TAC[line2D_F_convex];
10414   IMATCH_MP_TAC  convex_inter;
10415   REWRITE_TAC[open_half_plane2D_LTS_convex;open_half_plane2D_SLT_convex];
10416   ]);;
10417   (* }}} *)
10418
10419 let long_v_euclid = prove_by_refinement(
10420   `!p. (long_v p SUBSET (euclid 2))`,
10421   (* {{{ proof *)
10422   [
10423   REWRITE_TAC[long_v_union;union_subset;v_edge_euclid;single_subset;pointI;euclid_point];
10424   ]);;
10425   (* }}} *)
10426
10427 let comp_pointI_long = prove_by_refinement(
10428   `!G m x. (segment G /\ component  (ctop G) x (pointI m)) ==>
10429    (long_v m SUBSET component  (ctop G) x)`,
10430   (* {{{ proof *)
10431   [
10432   DISCH_ALL_TAC;
10433   IMATCH_MP_TAC  convex_component;
10434   ASM_REWRITE_TAC[long_v_convex;ctop_unions;DIFF_SUBSET;long_v_euclid];
10435   CONJ_TAC;
10436   REWRITE_TAC[long_v_union;EQ_EMPTY;UNION;INTER];
10437   GEN_TAC;
10438   TYPE_THEN `UNIONS (ctop G) (pointI m)` SUBGOAL_TAC;
10439   ASSUME_TAC (ISPEC `(ctop G)` component_unions);
10440   ASM_MESON_TAC[ISUBSET];
10441   REWRITE_TAC[ctop_unions;DIFF ;];
10442   DISCH_ALL_TAC;
10443   AND 2;
10444   TYPE_THEN `~(curve_cell G {(pointI m)})` SUBGOAL_TAC;
10445   USE 4(REWRITE_RULE[UNIONS]);
10446   LEFT 4 "u";
10447   TSPEC `{(pointI m)}` 4;
10448   USE 4(REWRITE_RULE [INR IN_SING;]);
10449   ASM_REWRITE_TAC[];
10450   ASM_SIMP_TAC[curve_cell_not_point;];
10451   TYPE_THEN `FINITE G` SUBGOAL_TAC;
10452   ASM_SIMP_TAC[segment_finite];
10453   ASM_SIMP_TAC[num_closure0];
10454   DISCH_TAC;
10455   UND 5;
10456   REP_CASES_TAC; (* cases *)
10457   TYPE_THEN `~(v_edge (down m) INTER  UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC;
10458   REWRITE_TAC[EMPTY_EXISTS;INTER ];
10459   ASM_MESON_TAC[];
10460   ASM_SIMP_TAC[curve_cell_v_inter];
10461   DISCH_ALL_TAC;
10462   TSPEC `v_edge (down m)` 5;
10463   UND 5;
10464   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`;];
10465   (* next case *)
10466   USE 7 (REWRITE_RULE[INR IN_SING]);
10467   ASM_MESON_TAC[];
10468   TYPE_THEN `~(v_edge (m) INTER  UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC;
10469   REWRITE_TAC[EMPTY_EXISTS;INTER ];
10470   ASM_MESON_TAC[];
10471   ASM_SIMP_TAC[curve_cell_v_inter];
10472   DISCH_ALL_TAC;
10473   TSPEC `v_edge (m)` 5;
10474   UND 5;
10475   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`;];
10476   (* LAST *)
10477   REWRITE_TAC[long_v_union;EMPTY_EXISTS;];
10478   TYPE_THEN `(pointI m)` EXISTS_TAC;
10479   ASM_REWRITE_TAC[INTER;UNION;INR IN_SING;];
10480   ]);;
10481   (* }}} *)
10482
10483 let comp_h_squ = prove_by_refinement(
10484   `!G x m. (segment G /\ (h_edge m SUBSET (component  (ctop G) x)) ==>
10485      (squ m SUBSET (component  (ctop G ) x)))`,
10486   (* {{{ proof *)
10487   [
10488   DISCH_ALL_TAC;
10489   TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
10490   IMATCH_MP_TAC comp_h_rect;
10491   ASM_REWRITE_TAC[];
10492   DISCH_TAC;
10493   IMATCH_MP_TAC  SUBSET_TRANS;
10494   TYPE_THEN `rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC;
10495   ASM_REWRITE_TAC[];
10496   REWRITE_TAC[rectangle_h];
10497   REWRITE_TAC[SUBSET;UNION];
10498   MESON_TAC[];
10499   ]);;
10500   (* }}} *)
10501
10502 let comp_v_squ = prove_by_refinement(
10503   `!G x m. (segment G /\ (v_edge m SUBSET (component  (ctop G) x)) ==>
10504      (squ m SUBSET (component  (ctop G ) x)))`,
10505   (* {{{ proof *)
10506   [
10507   DISCH_ALL_TAC;
10508   TYPE_THEN `(rectangle (FST m -: &:1 , SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
10509   IMATCH_MP_TAC comp_v_rect;
10510   ASM_REWRITE_TAC[];
10511   DISCH_TAC;
10512   IMATCH_MP_TAC  SUBSET_TRANS;
10513   TYPE_THEN `rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC;
10514   ASM_REWRITE_TAC[];
10515   REWRITE_TAC[rectangle_v];
10516   REWRITE_TAC[SUBSET;UNION];
10517   MESON_TAC[];
10518   ]);;
10519   (* }}} *)
10520
10521 let comp_p_squ = prove_by_refinement(
10522   `!G x m. (segment G /\ (component  (ctop G) x (pointI m))) ==>
10523      (squ m SUBSET (component  (ctop G ) x))`,
10524   (* {{{ proof *)
10525   [
10526   DISCH_ALL_TAC;
10527   TYPE_THEN `long_v m SUBSET component  (ctop G) x` SUBGOAL_TAC;
10528   IMATCH_MP_TAC comp_pointI_long;
10529   ASM_REWRITE_TAC[];
10530   REWRITE_TAC[long_v_union];
10531   REWRITE_TAC[union_subset];
10532   DISCH_ALL_TAC;
10533   IMATCH_MP_TAC  comp_v_squ;
10534   ASM_REWRITE_TAC[];
10535   ]);;
10536   (* }}} *)
10537
10538 let comp_squ = prove_by_refinement(
10539   `!G x. (segment G /\ (~(component  (ctop G) x = EMPTY)) ==>
10540      (?m. (squ m SUBSET (component  (ctop G ) x))))`,
10541   (* {{{ proof *)
10542   [
10543   DISCH_ALL_TAC;
10544   COPY 0;
10545   USE 0 (MATCH_MP unions_cell_of);
10546   TSPEC `x` 0;
10547   USE 0 (SYM);
10548   USE 1 (REWRITE_RULE[EMPTY_EXISTS]);
10549   CHO 1;
10550   UND 0;
10551   DISCH_THEN (fun t-> USE 1 (ONCE_REWRITE_RULE[t]));
10552   USE 0 (REWRITE_RULE[cell_of;UNIONS]);
10553   CHO 0;
10554   UND 0;
10555   DISCH_ALL_TAC;
10556   USE 0 (REWRITE_RULE[cell]);
10557   CHO 0;
10558   UND 0;
10559   REP_CASES_TAC;
10560   REWR 1;
10561   USE 1 (REWRITE_RULE[single_subset]);
10562   ASM_MESON_TAC[comp_p_squ];
10563   ASM_MESON_TAC[comp_h_squ];
10564   ASM_MESON_TAC[comp_v_squ];
10565   ASM_MESON_TAC[];
10566   ]);;
10567   (* }}} *)
10568
10569 let comp_squ_left_rect_v = prove_by_refinement(
10570   `!G m x. (segment G /\ ~(G (v_edge (  m))) /\
10571     (squ m SUBSET component (ctop G) x) ==>
10572    (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1) SUBSET
10573  component (ctop G) x))`,
10574   (* {{{ proof *)
10575   [
10576   DISCH_ALL_TAC;
10577   UND 1;
10578   ASM_SIMP_TAC[GSYM curve_cell_v];
10579   DISCH_TAC;
10580   (*  *)
10581   IMATCH_MP_TAC   convex_component;
10582   ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
10583   CONJ_TAC;
10584   REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
10585   REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
10586   DISCH_ALL_TAC;
10587   AND 3;
10588   TYPE_THEN `~(squ (left   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
10589   USE 0(MATCH_MP curve_cell_squ_inter);
10590   COPY 0;
10591   TSPEC `m` 0;
10592   TSPEC `left   m` 5;
10593   UND 5;
10594   UND 0;
10595   REWRITE_TAC [EQ_EMPTY; INTER];
10596   ASM_MESON_TAC[];
10597   DISCH_ALL_TAC;
10598   REWR 4;
10599   USE 3 (REWRITE_RULE[UNIONS;]);
10600   CHO 3;
10601   TYPE_THEN `cell u` SUBGOAL_TAC;
10602   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
10603   ASM_MESON_TAC[segment];
10604   ASM_MESON_TAC[ISUBSET; curve_cell_cell];
10605   DISCH_TAC;
10606   TYPE_THEN `u = v_edge m ` SUBGOAL_TAC;
10607   IMATCH_MP_TAC  cell_partition;
10608   ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
10609   ASM_MESON_TAC[];
10610   ASM_MESON_TAC[];
10611   REWRITE_TAC[rectangle_v;EMPTY_EXISTS;];
10612   TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
10613   ASM_MESON_TAC[cell_nonempty;cell_rules];
10614   REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
10615   USE 2(REWRITE_RULE[ISUBSET]);
10616   ASM_MESON_TAC[];
10617   ]);;
10618   (* }}} *)
10619
10620 let comp_squ_left_rect = prove_by_refinement(
10621   `!G m x. (segment G /\
10622     (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
10623          (squ p SUBSET (component  (ctop G) x))))) /\
10624      (squ m SUBSET component  (ctop G) x)) ==>
10625    (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1)
10626        SUBSET component  (ctop G) x)`,
10627   (* {{{ proof *)
10628   [
10629   DISCH_ALL_TAC;
10630   LEFT 1 "p";
10631   TSPEC `m` 1;
10632   LEFT 1 "e";
10633   TSPEC `v_edge m` 1;
10634   REWR 1;
10635   USE 1(REWRITE_RULE[squ_closure_v]);
10636   IMATCH_MP_TAC  comp_squ_left_rect_v;
10637   ASM_REWRITE_TAC[];
10638   ]);;
10639   (* }}} *)
10640
10641 let comp_squ_right_rect_v = prove_by_refinement(
10642   `!G m x. (segment G /\ ~(G (v_edge (right  m))) /\
10643     (squ m SUBSET component (ctop G) x) ==>
10644    (rectangle (FST m,SND m ) (FST m +: &:2,SND m +: &:1) SUBSET
10645  component (ctop G) x))`,
10646   (* {{{ proof *)
10647   [
10648   DISCH_ALL_TAC;
10649   UND 1;
10650   ASM_SIMP_TAC[GSYM curve_cell_v];
10651   DISCH_TAC;
10652   (*  *)
10653   IMATCH_MP_TAC   convex_component;
10654   ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
10655   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;
10656   REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
10657   DISCH_THEN_REWRITE;
10658   CONJ_TAC;
10659   REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
10660   REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
10661   DISCH_ALL_TAC;
10662   AND 3;
10663   USE 4 (REWRITE_RULE[right_left]);
10664   TYPE_THEN `~(squ  m x') /\ ~(squ (right  m) x')` SUBGOAL_TAC;
10665   USE 0(MATCH_MP curve_cell_squ_inter);
10666   COPY 0;
10667   TSPEC `m` 0;
10668   TSPEC `right   m` 5;
10669   UND 5;
10670   UND 0;
10671   REWRITE_TAC [EQ_EMPTY; INTER];
10672   ASM_MESON_TAC[];
10673   DISCH_ALL_TAC;
10674   REWR 4;
10675   USE 3 (REWRITE_RULE[UNIONS;]);
10676   CHO 3;
10677   TYPE_THEN `cell u` SUBGOAL_TAC;
10678   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
10679   ASM_MESON_TAC[segment];
10680   ASM_MESON_TAC[ISUBSET; curve_cell_cell];
10681   DISCH_TAC;
10682   TYPE_THEN `u = v_edge (right  m) ` SUBGOAL_TAC;
10683   IMATCH_MP_TAC  cell_partition;
10684   ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
10685   ASM_MESON_TAC[];
10686   ASM_MESON_TAC[];
10687   REWRITE_TAC[rectangle_v;EMPTY_EXISTS;];
10688   REWRITE_TAC[right_left];
10689   TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
10690   ASM_MESON_TAC[cell_nonempty;cell_rules];
10691   REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
10692   USE 2(REWRITE_RULE[ISUBSET]);
10693   ASM_MESON_TAC[];
10694   ]);;
10695   (* }}} *)
10696
10697 let comp_squ_right_rect = prove_by_refinement(
10698   `!G m x. (segment G /\
10699     (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
10700          (squ p SUBSET (component  (ctop G) x))))) /\
10701      (squ m SUBSET component  (ctop G) x)) ==>
10702    (rectangle (FST m , SND m ) (FST m +: &:2,SND m +: &:1)
10703        SUBSET component  (ctop G) x)`,
10704   (* {{{ proof *)
10705   [
10706   DISCH_ALL_TAC;
10707   LEFT 1 "p";
10708   TSPEC `m` 1;
10709   LEFT 1 "e";
10710   TSPEC `v_edge (right  m)` 1;
10711   REWR 1;
10712   USE 1(REWRITE_RULE[squ_closure_right_v]);
10713   IMATCH_MP_TAC  comp_squ_right_rect_v;
10714   ASM_REWRITE_TAC[];
10715   ]);;
10716   (* }}} *)
10717
10718 let comp_squ_down_rect_h = prove_by_refinement(
10719   `!G m x. (segment G /\ ~(G (h_edge m)) /\
10720     (squ m SUBSET component (ctop G) x) ==>
10721    (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET
10722  component (ctop G) x))`,
10723   (* {{{ proof *)
10724   [
10725   DISCH_ALL_TAC;
10726   UND 1;
10727   ASM_SIMP_TAC[GSYM curve_cell_h];
10728   DISCH_TAC;
10729   (*  *)
10730   IMATCH_MP_TAC   convex_component;
10731   ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
10732   CONJ_TAC;
10733   REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
10734   REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
10735   DISCH_ALL_TAC;
10736   AND 3;
10737   TYPE_THEN `~(squ (down   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
10738   USE 0(MATCH_MP curve_cell_squ_inter);
10739   COPY 0;
10740   TSPEC `m` 0;
10741   TSPEC `down   m` 5;
10742   UND 5;
10743   UND 0;
10744   REWRITE_TAC [EQ_EMPTY; INTER];
10745   ASM_MESON_TAC[];
10746   DISCH_ALL_TAC;
10747   REWR 4;
10748   USE 3 (REWRITE_RULE[UNIONS;]);
10749   CHO 3;
10750   TYPE_THEN `cell u` SUBGOAL_TAC;
10751   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
10752   ASM_MESON_TAC[segment];
10753   ASM_MESON_TAC[ISUBSET; curve_cell_cell];
10754   DISCH_TAC;
10755   TYPE_THEN `u = h_edge m ` SUBGOAL_TAC;
10756   IMATCH_MP_TAC  cell_partition;
10757   ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
10758   ASM_MESON_TAC[];
10759   ASM_MESON_TAC[];
10760   REWRITE_TAC[rectangle_h;EMPTY_EXISTS;];
10761   TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
10762   ASM_MESON_TAC[cell_nonempty;cell_rules];
10763   REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
10764   USE 2(REWRITE_RULE[ISUBSET]);
10765   ASM_MESON_TAC[];
10766   ]);;
10767   (* }}} *)
10768
10769 let comp_squ_down_rect = prove_by_refinement(
10770   `!G m x. (segment G /\
10771     (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
10772          (squ p SUBSET (component  (ctop G) x))))) /\
10773      (squ m SUBSET component  (ctop G) x)) ==>
10774    (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1)
10775        SUBSET component  (ctop G) x)`,
10776   (* {{{ proof *)
10777
10778   [
10779   DISCH_ALL_TAC;
10780   LEFT 1 "p";
10781   TSPEC `m` 1;
10782   LEFT 1 "e";
10783   TSPEC `h_edge m` 1;
10784   REWR 1;
10785   USE 1(REWRITE_RULE[squ_closure_h]);
10786   ASM_MESON_TAC[comp_squ_down_rect_h];
10787   ]);;
10788
10789   (* }}} *)
10790
10791 let comp_squ_up_rect_h = prove_by_refinement(
10792   `!G m x. (segment G /\ ~(G (h_edge (up m))) /\
10793     (squ m SUBSET component (ctop G) x) ==>
10794    (rectangle (FST m,SND m ) (FST m +: &:1,SND m +: &:2) SUBSET
10795  component (ctop G) x))`,
10796   (* {{{ proof *)
10797   [
10798   DISCH_ALL_TAC;
10799   UND 1;
10800   ASM_SIMP_TAC[GSYM curve_cell_h];
10801   DISCH_TAC;
10802   (*  *)
10803   IMATCH_MP_TAC   convex_component;
10804   ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
10805   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;
10806   REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
10807   DISCH_THEN_REWRITE;
10808   CONJ_TAC;
10809   REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
10810   REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
10811   DISCH_ALL_TAC;
10812   AND 3;
10813   USE 4 (REWRITE_RULE[right_left]);
10814   TYPE_THEN `~(squ  m x') /\ ~(squ (up  m) x')` SUBGOAL_TAC;
10815   USE 0(MATCH_MP curve_cell_squ_inter);
10816   COPY 0;
10817   TSPEC `m` 0;
10818   TSPEC `up   m` 5;
10819   UND 5;
10820   UND 0;
10821   REWRITE_TAC [EQ_EMPTY; INTER];
10822   ASM_MESON_TAC[];
10823   DISCH_ALL_TAC;
10824   REWR 4;
10825   USE 3 (REWRITE_RULE[UNIONS;]);
10826   CHO 3;
10827   TYPE_THEN `cell u` SUBGOAL_TAC;
10828   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
10829   ASM_MESON_TAC[segment];
10830   ASM_MESON_TAC[ISUBSET; curve_cell_cell];
10831   DISCH_TAC;
10832   TYPE_THEN `u = h_edge (up  m) ` SUBGOAL_TAC;
10833   IMATCH_MP_TAC  cell_partition;
10834   ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
10835   ASM_MESON_TAC[];
10836   ASM_MESON_TAC[];
10837   REWRITE_TAC[rectangle_h;EMPTY_EXISTS;];
10838   REWRITE_TAC[right_left];
10839   TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
10840   ASM_MESON_TAC[cell_nonempty;cell_rules];
10841   REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
10842   USE 2(REWRITE_RULE[ISUBSET]);
10843   ASM_MESON_TAC[];
10844   ]);;
10845   (* }}} *)
10846
10847 let comp_squ_up_rect = prove_by_refinement(
10848   `!G m x. (segment G /\
10849     (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
10850          (squ p SUBSET (component  (ctop G) x))))) /\
10851      (squ m SUBSET component  (ctop G) x)) ==>
10852    (rectangle (FST m , SND m ) (FST m +: &:1,SND m +: &:2)
10853        SUBSET component  (ctop G) x)`,
10854   (* {{{ proof *)
10855   [
10856   DISCH_ALL_TAC;
10857   LEFT 1 "p";
10858   TSPEC `m` 1;
10859   LEFT 1 "e";
10860   TSPEC `h_edge (up  m)` 1;
10861   REWR 1;
10862   USE 1(REWRITE_RULE[squ_closure_up_h]);
10863   IMATCH_MP_TAC  comp_squ_up_rect_h;
10864   ASM_REWRITE_TAC[];
10865   ]);;
10866   (* }}} *)
10867
10868 let comp_squ_right_left = prove_by_refinement(
10869   `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G) x))  /\
10870     (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
10871          (squ p SUBSET (component  (ctop G) x)))))) ==>
10872      (squ (left    m) SUBSET (component  (ctop G) x))  /\
10873     (squ (right      m) SUBSET (component  (ctop G) x))  /\
10874     (squ (up  m) SUBSET (component  (ctop G) x))  /\
10875    (squ (down  m) SUBSET (component  (ctop G) x))`,
10876   (* {{{ proof *)
10877   [
10878   DISCH_ALL_TAC;
10879   JOIN 2 1;
10880   JOIN 0 1;
10881   WITH 0 (MATCH_MP comp_squ_up_rect);
10882   WITH 0 (MATCH_MP comp_squ_down_rect);
10883   WITH 0 (MATCH_MP comp_squ_left_rect);
10884   WITH 0 (MATCH_MP comp_squ_right_rect);
10885   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;
10886   REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
10887   DISCH_THEN (fun t-> USE 1 (REWRITE_RULE[t]));
10888   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;
10889   REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
10890   DISCH_THEN (fun t-> USE 4 (REWRITE_RULE[t]));
10891   RULE_ASSUM_TAC (REWRITE_RULE[rectangle_h;rectangle_v;union_subset;right_left ]);
10892   ASM_REWRITE_TAC[];
10893   ]);;
10894   (* }}} *)
10895
10896 (* move *)
10897 let suc_sum = prove_by_refinement(
10898   `!j a b. (SUC j = a+ b) ==> (?k. (SUC k = a) \/ (SUC k = b))`,
10899   (* {{{ proof *)
10900   [
10901   DISCH_ALL_TAC;
10902   PROOF_BY_CONTR_TAC;
10903   LEFT 1 "k";
10904   USE 1(REWRITE_RULE[DE_MORGAN_THM]);
10905   TYPE_THEN `a = 0 ` SUBGOAL_TAC;
10906   PROOF_BY_CONTR_TAC;
10907   ASM_MESON_TAC[num_CASES];
10908   TYPE_THEN `b = 0` SUBGOAL_TAC;
10909   ASM_MESON_TAC[num_CASES];
10910   UND 0;
10911   ARITH_TAC;
10912   ]);;
10913   (* }}} *)
10914
10915 let squ_induct = prove_by_refinement(
10916   `!j m n. ?p.
10917     ((SUC j) = (num_abs_of_int (FST m -: FST n) +
10918              num_abs_of_int (SND  m -: SND  n))) ==>
10919     ((j = (num_abs_of_int (FST p -: FST n) +
10920              num_abs_of_int (SND  p -: SND  n))) /\
10921      ((p = left  m) \/ (p = right  m) \/ (p = up m) \/ (p = down m))) `,
10922   (* {{{ proof *)
10923   [
10924   DISCH_ALL_TAC;
10925   RIGHT_TAC "p";
10926   DISCH_TAC;
10927   WITH  0 (MATCH_MP suc_sum);
10928   CHO 1;
10929   UND 1;
10930   DISCH_THEN DISJ_CASES_TAC;
10931   TYPE_THEN `~(num_abs_of_int (FST m -: FST n) = 0)` SUBGOAL_TAC;
10932   UND 1;
10933   ARITH_TAC;
10934   REWRITE_TAC[num_abs_of_int0];
10935   DISCH_TAC;
10936   TYPE_THEN `FST m <: FST n \/ FST n <: FST m` SUBGOAL_TAC;
10937   UND 2;
10938   INT_ARITH_TAC;
10939   DISCH_THEN DISJ_CASES_TAC;
10940   TYPE_THEN `right  m` EXISTS_TAC;
10941   ASM_REWRITE_TAC[];
10942   REWRITE_TAC[right ];
10943   ONCE_REWRITE_TAC[GSYM SUC_INJ];
10944   REWRITE_TAC[GSYM ADD];
10945   TYPE_THEN `(FST m +: &:1) -: FST n <=: &:0` SUBGOAL_TAC;
10946   UND 3;
10947   INT_ARITH_TAC;
10948   ASM_SIMP_TAC[num_abs_of_int_pre];
10949   TYPE_THEN `(FST m +: &:1) -: FST n -: &:1 = FST m -: FST n` SUBGOAL_TAC;
10950   INT_ARITH_TAC;
10951   DISCH_THEN_REWRITE;
10952   (* next *)
10953   TYPE_THEN `left    m` EXISTS_TAC;
10954   ASM_REWRITE_TAC[];
10955   REWRITE_TAC[left   ];
10956   ONCE_REWRITE_TAC[GSYM SUC_INJ];
10957   REWRITE_TAC[GSYM ADD];
10958   TYPE_THEN `&:0 <=: (FST m -: &:1) -: FST n ` SUBGOAL_TAC;
10959   UND 3;
10960   INT_ARITH_TAC;
10961   ASM_SIMP_TAC[num_abs_of_int_suc];
10962   TYPE_THEN `(FST m -: &:1 -: FST n +: &:1) = FST m -: FST n` SUBGOAL_TAC;
10963   INT_ARITH_TAC;
10964   DISCH_THEN_REWRITE;
10965   (* next *)
10966   TYPE_THEN `~(num_abs_of_int (SND  m -: SND  n) = 0)` SUBGOAL_TAC;
10967   UND 1;
10968   ARITH_TAC;
10969   REWRITE_TAC[num_abs_of_int0];
10970   DISCH_TAC;
10971   TYPE_THEN `SND  m <: SND  n \/ SND  n <: SND  m` SUBGOAL_TAC;
10972   UND 2;
10973   INT_ARITH_TAC;
10974   DISCH_THEN DISJ_CASES_TAC;
10975   (* next *)
10976   TYPE_THEN `up    m` EXISTS_TAC;
10977   ASM_REWRITE_TAC[];
10978   REWRITE_TAC[up  ];
10979   ONCE_REWRITE_TAC[GSYM SUC_INJ];
10980   REWRITE_TAC[GSYM ADD_SUC];
10981   TYPE_THEN `(SND  m +: &:1) -: SND  n <=: &:0` SUBGOAL_TAC;
10982   UND 3;
10983   INT_ARITH_TAC;
10984   ASM_SIMP_TAC[num_abs_of_int_pre];
10985   TYPE_THEN `((SND  m +: &:1) -: SND  n -: &:1) = SND  m -: SND  n` SUBGOAL_TAC;
10986   INT_ARITH_TAC;
10987   DISCH_THEN_REWRITE;
10988   (* final *)
10989   TYPE_THEN `down    m` EXISTS_TAC;
10990   ASM_REWRITE_TAC[];
10991   REWRITE_TAC[down   ];
10992   ONCE_REWRITE_TAC[GSYM SUC_INJ];
10993   REWRITE_TAC[GSYM ADD_SUC];
10994   TYPE_THEN `&:0 <=: (SND  m -: &:1) -: SND  n ` SUBGOAL_TAC;
10995   UND 3;
10996   INT_ARITH_TAC;
10997   ASM_SIMP_TAC[num_abs_of_int_suc];
10998   TYPE_THEN `(SND  m -: &:1 -: SND  n +: &:1) = SND  m -: SND  n` SUBGOAL_TAC;
10999   INT_ARITH_TAC;
11000   DISCH_THEN_REWRITE;
11001   ]);;
11002   (* }}} *)
11003
11004 let comp_squ_fill = prove_by_refinement(
11005   `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G ) x)) /\
11006   (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
11007          (squ p SUBSET (component  (ctop G) x)))))) ==>
11008   (!n. (squ n SUBSET (component  (ctop G) x)))
11009   `,
11010   (* {{{ proof *)
11011   [
11012   DISCH_ALL_TAC;
11013   GEN_TAC;
11014   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;
11015   DISCH_ALL_TAC;
11016   ASM_MESON_TAC[];
11017   DISCH_THEN IMATCH_MP_TAC ;
11018   INDUCT_TAC;
11019   ONCE_REWRITE_TAC [EQ_SYM_EQ];
11020   REWRITE_TAC[ADD_EQ_0;num_abs_of_int0];
11021   GEN_TAC;
11022   DISCH_TAC;
11023   TYPE_THEN `n = m` SUBGOAL_TAC;
11024   UND 3;
11025   REWRITE_TAC[PAIR_SPLIT];
11026   INT_ARITH_TAC;
11027   ASM_MESON_TAC[];
11028   DISCH_ALL_TAC;
11029   USE 4 (MATCH_MP (CONV_RULE (quant_right_CONV "p") squ_induct));
11030   CHO 4;
11031   TSPEC `p` 3;
11032   REWR 3;
11033   AND 4;
11034   TYPE_THEN `(n = left p) \/ (n = right p) \/ (n = up p) \/ (n = down p)` SUBGOAL_TAC;
11035   UND 4;
11036   REP_CASES_TAC THEN (ASM_REWRITE_TAC[right_left]);
11037   KILL 4;
11038   KILL 5;
11039   KILL 1;
11040   JOIN  3 2;
11041   JOIN 0 1;
11042   USE 0 (MATCH_MP comp_squ_right_left);
11043   ASM_MESON_TAC[];
11044   ]);;
11045   (* }}} *)
11046
11047 let comp_squ_adj = prove_by_refinement(
11048   `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G ) x))) ==>
11049      (?p e. (G e /\ e SUBSET closure top2 (squ p) /\
11050          (squ p SUBSET (component  (ctop G) x))))`,
11051   (* {{{ proof *)
11052
11053   [
11054   DISCH_ALL_TAC;
11055   PROOF_BY_CONTR_TAC;
11056   TYPE_THEN `(!n. (squ n SUBSET (component  (ctop G) x)))` SUBGOAL_TAC;
11057   ASM_MESON_TAC[comp_squ_fill];
11058   DISCH_TAC;
11059   TYPE_THEN `?e. (G e /\ (edge e))` SUBGOAL_TAC;
11060   USE 0 (REWRITE_RULE [segment;EMPTY_EXISTS;SUBSET;]);
11061   ASM_MESON_TAC[];
11062   DISCH_TAC;
11063   UND 2;
11064   REWRITE_TAC[];
11065   LEFT_TAC "e";
11066   CHO 4;
11067   TYPE_THEN `e` EXISTS_TAC;
11068   ASM_REWRITE_TAC[];
11069   AND 2;
11070   USE 2(REWRITE_RULE[edge]);
11071   CHO 2;
11072   UND 2;
11073   DISCH_THEN DISJ_CASES_TAC;
11074   ASM_REWRITE_TAC[];
11075   TYPE_THEN `m'` EXISTS_TAC;
11076   ASM_REWRITE_TAC[squ_closure_v;squ_closure_h];
11077   ASM_MESON_TAC[squ_closure_v;squ_closure_h];
11078   ]);;
11079
11080   (* }}} *)
11081
11082 (* ------------------------------------------------------------------ *)
11083
11084
11085 let along_seg = jordan_def `along_seg G e x <=> G e /\
11086      (?p. (e SUBSET closure top2 (squ p) /\
11087           squ p SUBSET (component  (ctop G) x) ))`;;
11088
11089 let along_lemma1 = prove_by_refinement(
11090   `!G m x.  (segment G /\ (squ m SUBSET component  (ctop G) x) /\
11091      (G (v_edge m)) /\ (G (h_edge m))) ==>
11092    (?p. (h_edge m) SUBSET closure top2 (squ p) /\
11093        (squ p SUBSET (component  (ctop G) x)))`,
11094   (* {{{ proof *)
11095
11096   [
11097   DISCH_ALL_TAC;
11098   TYPE_THEN `m` EXISTS_TAC;
11099   ASM_MESON_TAC[squ_closure_h];
11100   ]);;
11101
11102   (* }}} *)
11103
11104 let midpoint_exclusion = prove_by_refinement(
11105   `!G m e e' e''. (segment G /\ G e /\ G e' /\ G e'' /\ (~(e = e')) /\
11106     (closure top2 e (pointI m)) /\ (closure top2 e' (pointI m)) /\
11107     (closure top2 e'' (pointI m))   ==> ((e'' = e) \/ (e'' = e')))
11108     `,
11109   (* {{{ proof *)
11110   [
11111   DISCH_ALL_TAC;
11112   USE 0 (REWRITE_RULE[segment;INSERT; ]);
11113   UND 0;
11114   DISCH_ALL_TAC;
11115   TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC;
11116   TSPEC `m` 10;
11117   UND 10;
11118   REP_CASES_TAC;
11119   ASM_REWRITE_TAC[];
11120   UND 10;
11121   USE 0 (MATCH_MP num_closure1);
11122   ASM_REWRITE_TAC[];
11123   DISCH_TAC;
11124   CHO 10;
11125   COPY 10;
11126   TSPEC `e` 12;
11127   TSPEC `e'` 10;
11128   ASM_MESON_TAC[];
11129   USE 0 (MATCH_MP num_closure0);
11130   TSPEC `pointI m` 0;
11131   REWR 0;
11132   TSPEC `e` 0;
11133   ASM_MESON_TAC[];
11134   DISCH_TAC;
11135   USE 0 (MATCH_MP num_closure_size);
11136   TSPEC `pointI m` 0;
11137   REWR 0;
11138   TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ;
11139   TYPE_THEN `X e /\ X e' /\ X e''` SUBGOAL_TAC;
11140   EXPAND_TAC "X";
11141   ASM_REWRITE_TAC[];
11142   UND 0;
11143   UND 4;
11144   MESON_TAC[two_exclusion];
11145   ]);;
11146   (* }}} *)
11147
11148 (* indexed to here *)
11149 let along_lemma2 = prove_by_refinement(
11150   `!G m. (segment G /\ G (v_edge m) /\ G (v_edge (down m)) ==>
11151      ~(G (h_edge m)))`,
11152   (* {{{ proof *)
11153   [
11154   DISCH_ALL_TAC;
11155   TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = v_edge (down m))` SUBGOAL_TAC;
11156   IMATCH_MP_TAC  midpoint_exclusion;
11157   TYPE_THEN `G` EXISTS_TAC;
11158   TYPE_THEN `m` EXISTS_TAC;
11159   ASM_REWRITE_TAC[v_edge_inj;down;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;];
11160   INT_ARITH_TAC ;
11161   REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2];
11162   ]);;
11163   (* }}} *)
11164
11165 let along_lemma3 = prove_by_refinement(
11166   `!G m. (segment G /\ G (v_edge m) /\ G(h_edge (left  m)) ==>
11167      ~(G (h_edge m)) /\ ~(G (v_edge (down m))))`,
11168   (* {{{ proof *)
11169   [
11170   DISCH_ALL_TAC;
11171   CONJ_TAC;
11172   PROOF_BY_CONTR_TAC;
11173   USE 3(REWRITE_RULE[]);
11174   TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = h_edge (left  m))` SUBGOAL_TAC;
11175   IMATCH_MP_TAC  midpoint_exclusion;
11176   TYPE_THEN `G` EXISTS_TAC;
11177   TYPE_THEN `m` EXISTS_TAC;
11178   ASM_REWRITE_TAC[v_edge_inj;left;v_edge_cpoint;GSYM hv_edgeV2;h_edge_cpoint;PAIR_SPLIT;];
11179   INT_ARITH_TAC ;
11180   REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2;left ;h_edge_inj;PAIR_SPLIT;];
11181   INT_ARITH_TAC;
11182   PROOF_BY_CONTR_TAC;
11183   USE 3(REWRITE_RULE[]);
11184   TYPE_THEN `(h_edge (left  m) = v_edge m) \/ (h_edge (left  m) = v_edge (down m))` SUBGOAL_TAC;
11185   IMATCH_MP_TAC  midpoint_exclusion;
11186   TYPE_THEN `G` EXISTS_TAC;
11187   TYPE_THEN `m` EXISTS_TAC;
11188   ASM_REWRITE_TAC[v_edge_inj;down;left ;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;];
11189   INT_ARITH_TAC ;
11190   REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2];
11191   ]);;
11192   (* }}} *)
11193
11194 let along_lemma4 = prove_by_refinement(
11195   `!G m x.  (segment G /\ (squ m SUBSET component  (ctop G) x) /\
11196      (G (v_edge m)) /\ (G (v_edge (down m)))) ==>
11197    (?p. (v_edge (down m)) SUBSET closure top2 (squ p) /\
11198        (squ p SUBSET (component  (ctop G) x)))`,
11199   (* {{{ proof *)
11200   [
11201   DISCH_ALL_TAC;
11202   TYPE_THEN `down m` EXISTS_TAC;
11203   CONJ_TAC;
11204   ASM_MESON_TAC[squ_closure_v];
11205   TYPE_THEN `~(G (h_edge m))` SUBGOAL_TAC;
11206   ASM_MESON_TAC[along_lemma2];
11207   DISCH_TAC;
11208   TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC ;
11209   IMATCH_MP_TAC  comp_squ_down_rect_h;
11210   ASM_REWRITE_TAC[];
11211   REWRITE_TAC[rectangle_h; union_subset];
11212   MESON_TAC [];
11213   ]);;
11214   (* }}} *)
11215
11216 let along_lemma5 = prove_by_refinement(
11217   `!G m x. (segment G /\ (squ m SUBSET component  (ctop G) x) /\
11218      (G (v_edge m)) /\ (G (h_edge (left   m)))) ==>
11219    (?p. (h_edge (left   m)) SUBSET closure top2 (squ p) /\
11220        (squ p SUBSET (component  (ctop G) x)))`,
11221   (* {{{ proof *)
11222   [
11223   DISCH_ALL_TAC;
11224   TYPE_THEN `left  (down m)` EXISTS_TAC;
11225   CONJ_TAC;
11226   REWRITE_TAC[GSYM right_left];
11227   ASM_MESON_TAC[squ_closure_down_h];
11228   TYPE_THEN ` ~(G (h_edge m)) /\ ~(G (v_edge (down m)))` SUBGOAL_TAC;
11229   IMATCH_MP_TAC  along_lemma3;
11230   ASM_REWRITE_TAC[];
11231   DISCH_ALL_TAC;
11232   TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC ;
11233   IMATCH_MP_TAC  comp_squ_down_rect_h;
11234   ASM_REWRITE_TAC[];
11235   REWRITE_TAC[rectangle_h; union_subset];
11236   DISCH_ALL_TAC;
11237   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;
11238   IMATCH_MP_TAC  comp_squ_left_rect_v;
11239   ASM_REWRITE_TAC[];
11240   REWRITE_TAC[rectangle_v;union_subset;];
11241   DISCH_ALL_TAC;
11242   ASM_REWRITE_TAC[];
11243   ]);;
11244   (* }}} *)
11245
11246 let along_lemma6 = prove_by_refinement(
11247   `!G m x e. (segment G /\ (squ m SUBSET component  (ctop G) x) /\
11248      (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==>
11249    (?p. e SUBSET closure top2 (squ p) /\
11250        (squ p SUBSET (component  (ctop G) x))))`,
11251   (* {{{ proof *)
11252   [
11253   DISCH_ALL_TAC;
11254   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC ;
11255   ASM_MESON_TAC[segment];
11256   DISCH_TAC;
11257   TYPE_THEN `edge e` SUBGOAL_TAC;
11258   ASM_MESON_TAC[ISUBSET;];
11259   REWRITE_TAC[edge];
11260   DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
11261   REWR 4;
11262   USE 4 (REWRITE_RULE[v_edge_cpoint]);
11263   UND 4;
11264   DISCH_TAC;
11265   TYPE_THEN `(m' = m) \/ (m' = (down m))` SUBGOAL_TAC;
11266   UND 4;
11267   REWRITE_TAC[down;PAIR_SPLIT];
11268   INT_ARITH_TAC ;
11269   KILL 4;
11270   DISCH_THEN DISJ_CASES_TAC;
11271   TYPE_THEN `m` EXISTS_TAC;
11272   ASM_REWRITE_TAC[squ_closure_v];
11273   ASM_REWRITE_TAC[];
11274   IMATCH_MP_TAC  along_lemma4;
11275   ASM_REWRITE_TAC[];
11276   ASM_MESON_TAC[];
11277   ASM_REWRITE_TAC[];
11278   REWR 4;
11279   USE 4(REWRITE_RULE[h_edge_cpoint]);
11280   TYPE_THEN `(m' = m) \/ (m' = (left  m))` SUBGOAL_TAC;
11281   UND 4;
11282   REWRITE_TAC[left;PAIR_SPLIT];
11283   INT_ARITH_TAC ;
11284   KILL 4;
11285   DISCH_THEN DISJ_CASES_TAC;
11286   ASM_REWRITE_TAC[];
11287   IMATCH_MP_TAC  along_lemma1;
11288   ASM_REWRITE_TAC[];
11289   ASM_MESON_TAC[];
11290   ASM_REWRITE_TAC[];
11291   IMATCH_MP_TAC  along_lemma5;
11292   ASM_REWRITE_TAC[];
11293   ASM_MESON_TAC[];
11294   ]);;
11295   (* }}} *)
11296
11297 (* ------------------------------------------------------------------ *)
11298
11299 let reflAf = jordan_def
11300    `reflAf r (x:num->real) = point(&2 * (real_of_int r) - x 0, x 1)`;;
11301
11302 let reflAi = jordan_def
11303    `reflAi r (x:int#int) = ((&:2 *: r) -: FST x,SND x)`;;
11304
11305 let reflBf = jordan_def
11306    `reflBf r (x:num->real) = point( x 0 , &2 * (real_of_int r) - x 1)`;;
11307
11308 let reflBi = jordan_def
11309    `reflBi r (x:int#int) = (FST x, (&:2 *: r) -: SND x)`;;
11310
11311 let reflCf = jordan_def
11312    `reflCf  (x:num->real) = point (x 1, x 0)`;;
11313
11314 let reflCi = jordan_def
11315    `reflCi  (x:int#int) = (SND  x, FST  x)`;;
11316
11317 let reflAf_inv = prove_by_refinement(
11318   `!r m.  (reflAf r (reflAf r (point m)) = (point m))`,
11319   (* {{{ proof *)
11320
11321   [
11322   REP_GEN_TAC;
11323   REWRITE_TAC[reflAf;coord01;PAIR_SPLIT ;point_inj ;];
11324   REAL_ARITH_TAC ;
11325   ]);;
11326
11327   (* }}} *)
11328
11329 let reflBf_inv = prove_by_refinement(
11330   `!r m.  (reflBf r (reflBf r (point m)) = (point m))`,
11331   (* {{{ proof *)
11332   [
11333   REP_GEN_TAC;
11334   REWRITE_TAC[reflBf;coord01;PAIR_SPLIT ;point_inj ;];
11335   REAL_ARITH_TAC ;
11336   ]);;
11337   (* }}} *)
11338
11339 let reflCf_inv = prove_by_refinement(
11340   `!m.  (reflCf  (reflCf  (point m)) = (point m))`,
11341   (* {{{ proof *)
11342   [
11343   REP_GEN_TAC;
11344   REWRITE_TAC[reflCf;coord01;PAIR_SPLIT ;point_inj ;];
11345   ]);;
11346   (* }}} *)
11347
11348 let reflAi_inv = prove_by_refinement(
11349   `!r x.  (reflAi r (reflAi r x) = x)`,
11350   (* {{{ proof *)
11351   [
11352   REWRITE_TAC[reflAi;PAIR_SPLIT;];
11353   INT_ARITH_TAC;
11354   ]);;
11355   (* }}} *)
11356
11357 let reflBi_inv = prove_by_refinement(
11358   `!r x.  (reflBi r (reflBi r x) = x)`,
11359   (* {{{ proof *)
11360   [
11361   REWRITE_TAC[reflBi;PAIR_SPLIT;];
11362   INT_ARITH_TAC;
11363   ]);;
11364   (* }}} *)
11365
11366 let reflCi_inv = prove_by_refinement(
11367   `!x.  (reflCi  (reflCi  x) = x)`,
11368   (* {{{ proof *)
11369   [
11370   REWRITE_TAC[reflCi;PAIR_SPLIT;];
11371   ]);;
11372   (* }}} *)
11373
11374 let invo_BIJ = prove_by_refinement(
11375   `!f. (!m . (f (f (point m)) = (point m))) /\
11376         (!x. (euclid 2 (f x))) ==>
11377              (BIJ f (euclid 2) (euclid 2))`,
11378   (* {{{ proof *)
11379   [
11380   DISCH_ALL_TAC;
11381   REWRITE_TAC[BIJ;INJ;SURJ;];
11382   SUBCONJ_TAC;
11383   CONJ_TAC;
11384   DISCH_ALL_TAC;
11385   ASM_REWRITE_TAC[];
11386   DISCH_ALL_TAC;
11387   USE 2 (MATCH_MP (point_onto));
11388   USE 3 (MATCH_MP (point_onto));
11389   CHO 2;
11390   CHO 3;
11391   REWR 4;
11392   TYPE_THEN `f` (USE 4 o AP_TERM );
11393   REWR 4;
11394   DISCH_ALL_TAC;
11395   ASM_REWRITE_TAC[];
11396   DISCH_ALL_TAC;
11397   USE 4(MATCH_MP point_onto);
11398   CHO 4;
11399   ASM_REWRITE_TAC[];
11400   TYPE_THEN ` f (point p)` EXISTS_TAC ;
11401   ASM_REWRITE_TAC[];
11402   ]);;
11403   (* }}} *)
11404
11405 let reflA_BIJ = prove_by_refinement(
11406   `!r. (BIJ (reflAf r) (euclid 2) (euclid 2))`,
11407   (* {{{ proof *)
11408   [
11409   GEN_TAC;
11410   IMATCH_MP_TAC  invo_BIJ;
11411   REWRITE_TAC[reflAf_inv];
11412   REWRITE_TAC[reflAf;euclid_point;];
11413   ]);;
11414   (* }}} *)
11415
11416 let reflB_BIJ = prove_by_refinement(
11417   `!r. (BIJ (reflBf r) (euclid 2) (euclid 2))`,
11418   (* {{{ proof *)
11419   [
11420   GEN_TAC;
11421   IMATCH_MP_TAC  invo_BIJ;
11422   REWRITE_TAC[reflBf_inv];
11423   REWRITE_TAC[reflBf;euclid_point;];
11424   ]);;
11425   (* }}} *)
11426
11427 let reflC_BIJ = prove_by_refinement(
11428   `(BIJ (reflCf ) (euclid 2) (euclid 2))`,
11429   (* {{{ proof *)
11430   [
11431   IMATCH_MP_TAC  invo_BIJ;
11432   REWRITE_TAC[reflCf_inv];
11433   REWRITE_TAC[reflCf;euclid_point;];
11434   ]);;
11435   (* }}} *)
11436
11437 let invo_homeo = prove_by_refinement(
11438   `!U (f:A->A). (continuous f U U) /\ (BIJ f (UNIONS U) (UNIONS U)) /\
11439     (!x. (UNIONS U x ==> (f (f x ) = x))) ==> (homeomorphism f U U)`,
11440   (* {{{ proof *)
11441
11442   [
11443   DISCH_ALL_TAC;
11444   IMATCH_MP_TAC  bicont_homeomorphism;
11445   ASM_REWRITE_TAC[];
11446   TYPE_THEN `!x. (UNIONS U x) ==> (INV f (UNIONS U) (UNIONS U) x = f x)` SUBGOAL_TAC;
11447   DISCH_ALL_TAC;
11448   TYPE_THEN `UNIONS U (f x)` SUBGOAL_TAC;
11449   UND 1;
11450   REWRITE_TAC[BIJ;SURJ];
11451   ASM_MESON_TAC[];
11452   DISCH_TAC;
11453   ASM_SIMP_TAC [(INR INVERSE_XY)];
11454   DISCH_ALL_TAC;
11455   UND 0;
11456   REWRITE_TAC[continuous];
11457   DISCH_ALL_TAC;
11458   DISCH_ALL_TAC;
11459   TSPEC `v` 0;
11460   REWR 0;
11461   UND 0;
11462   REWRITE_TAC[preimage];
11463   TYPE_THEN `{x | UNIONS U x /\ v (INV f (UNIONS U) (UNIONS U) x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC;
11464   IMATCH_MP_TAC  EQ_EXT;
11465   GEN_TAC;
11466   REWRITE_TAC[];
11467   IMATCH_MP_TAC  (TAUT `(C ==> (A <=> B)) ==> ( C /\ A <=> C /\ B)`);
11468   DISCH_TAC;
11469   ASM_MESON_TAC[];
11470   DISCH_THEN_REWRITE;
11471   ]);;
11472
11473   (* }}} *)
11474
11475 let d_euclid_point = prove_by_refinement(
11476   `!r s. (d_euclid (point r) (point s) =
11477        sqrt ((FST r - FST s) pow 2 + ((SND r - SND s) pow 2)))`,
11478   (* {{{ proof *)
11479   [
11480   DISCH_ALL_TAC;
11481   TYPE_THEN `euclid 2 (point r) /\ euclid 2 (point s)` SUBGOAL_TAC;
11482   REWRITE_TAC[euclid_point];
11483   DISCH_TAC ;
11484   USE 0(MATCH_MP d_euclid_n);
11485   ASM_REWRITE_TAC[];
11486   AP_TERM_TAC;
11487   REWRITE_TAC[ARITH_RULE `2 = SUC 1`];
11488   REWRITE_TAC[sum_DEF];
11489   REDUCE_TAC;
11490   REWRITE_TAC[ARITH_RULE `1 = SUC 0`];
11491   REWRITE_TAC[sum_DEF];
11492   REDUCE_TAC;
11493   REWRITE_TAC[ARITH_RULE `(SUC 0  =1) /\ (SUC (SUC 0) = 2)`];
11494   REWRITE_TAC[coord01];
11495   REWRITE_TAC[POW_2];
11496   ]);;
11497   (* }}} *)
11498
11499 let reflA_cont = prove_by_refinement(
11500   `!r. continuous (reflAf r) top2 top2`,
11501   (* {{{ proof *)
11502   [
11503   REWRITE_TAC[top2];
11504   GEN_TAC;
11505   TYPE_THEN `(IMAGE (reflAf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
11506   REWRITE_TAC[IMAGE;SUBSET];
11507   ASM_SIMP_TAC[metric_euclid];
11508   CONV_TAC (dropq_conv "x");
11509   REWRITE_TAC[reflAf;euclid_point];
11510   DISCH_TAC;
11511   ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
11512   DISCH_ALL_TAC;
11513   TYPE_THEN `epsilon` EXISTS_TAC;
11514   DISCH_ALL_TAC;
11515   ASM_REWRITE_TAC[];
11516   DISCH_ALL_TAC;
11517   USE 2(MATCH_MP point_onto);
11518   CHO 2;
11519   USE 3(MATCH_MP point_onto);
11520   CHO 3;
11521   UND 4;
11522   ASM_REWRITE_TAC[reflAf;d_euclid_point;coord01;];
11523   TYPE_THEN `(&2 * real_of_int r - FST p - (&2 * real_of_int r - FST p'))  = --. (FST p - FST p') ` SUBGOAL_TAC;
11524   REAL_ARITH_TAC ;
11525   DISCH_THEN_REWRITE;
11526   ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS];
11527   REWRITE_TAC[ABS_NEG];
11528   ]);;
11529   (* }}} *)
11530
11531 let reflB_cont = prove_by_refinement(
11532   `!r. continuous (reflBf r) top2 top2`,
11533   (* {{{ proof *)
11534   [
11535   REWRITE_TAC[top2];
11536   GEN_TAC;
11537   TYPE_THEN `(IMAGE (reflBf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
11538   REWRITE_TAC[IMAGE;SUBSET];
11539   ASM_SIMP_TAC[metric_euclid];
11540   CONV_TAC (dropq_conv "x");
11541   REWRITE_TAC[reflBf;euclid_point];
11542   DISCH_TAC;
11543   ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
11544   DISCH_ALL_TAC;
11545   TYPE_THEN `epsilon` EXISTS_TAC;
11546   DISCH_ALL_TAC;
11547   ASM_REWRITE_TAC[];
11548   DISCH_ALL_TAC;
11549   USE 2(MATCH_MP point_onto);
11550   CHO 2;
11551   USE 3(MATCH_MP point_onto);
11552   CHO 3;
11553   UND 4;
11554   ASM_REWRITE_TAC[reflBf;d_euclid_point;coord01;];
11555   TYPE_THEN `(&2 * real_of_int r - SND  p - (&2 * real_of_int r - SND  p'))  = --. (SND  p - SND  p') ` SUBGOAL_TAC;
11556   REAL_ARITH_TAC ;
11557   DISCH_THEN_REWRITE;
11558   ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS];
11559   REWRITE_TAC[ABS_NEG];
11560   ]);;
11561   (* }}} *)
11562
11563 let reflC_cont = prove_by_refinement(
11564   ` continuous (reflCf) top2 top2`,
11565   (* {{{ proof *)
11566   [
11567   REWRITE_TAC[top2];
11568   TYPE_THEN `(IMAGE (reflCf) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
11569   REWRITE_TAC[IMAGE;SUBSET];
11570   ASM_SIMP_TAC[metric_euclid];
11571   CONV_TAC (dropq_conv "x");
11572   REWRITE_TAC[reflCf;euclid_point];
11573   DISCH_TAC;
11574   ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
11575   DISCH_ALL_TAC;
11576   TYPE_THEN `epsilon` EXISTS_TAC;
11577   DISCH_ALL_TAC;
11578   ASM_REWRITE_TAC[];
11579   DISCH_ALL_TAC;
11580   USE 2(MATCH_MP point_onto);
11581   CHO 2;
11582   USE 3(MATCH_MP point_onto);
11583   CHO 3;
11584   UND 4;
11585   ASM_REWRITE_TAC[reflCf;d_euclid_point;coord01;];
11586   REWRITE_TAC[REAL_ADD_AC];
11587   ]);;
11588   (* }}} *)
11589
11590 let reflA_homeo = prove_by_refinement(
11591   `!r. (homeomorphism (reflAf r) top2 top2)`,
11592   (* {{{ proof *)
11593   [
11594   GEN_TAC;
11595   ASSUME_TAC reflA_BIJ;
11596   ASSUME_TAC top2_unions;
11597   IMATCH_MP_TAC  invo_homeo;
11598   REWRITE_TAC[reflA_cont];
11599   ASM_REWRITE_TAC[];
11600   DISCH_ALL_TAC;
11601   USE 2(MATCH_MP   point_onto);
11602   CHO 2;
11603   ASM_REWRITE_TAC[reflAf_inv];
11604   ]);;
11605   (* }}} *)
11606
11607 let reflB_homeo = prove_by_refinement(
11608   `!r. (homeomorphism (reflBf r) top2 top2)`,
11609   (* {{{ proof *)
11610   [
11611   GEN_TAC;
11612   ASSUME_TAC reflB_BIJ;
11613   ASSUME_TAC top2_unions;
11614   IMATCH_MP_TAC  invo_homeo;
11615   REWRITE_TAC[reflB_cont];
11616   ASM_REWRITE_TAC[];
11617   DISCH_ALL_TAC;
11618   USE 2(MATCH_MP   point_onto);
11619   CHO 2;
11620   ASM_REWRITE_TAC[reflBf_inv];
11621   ]);;
11622   (* }}} *)
11623
11624 let reflC_homeo = prove_by_refinement(
11625   ` (homeomorphism (reflCf ) top2 top2)`,
11626   (* {{{ proof *)
11627   [
11628   ASSUME_TAC reflC_BIJ;
11629   ASSUME_TAC top2_unions;
11630   IMATCH_MP_TAC  invo_homeo;
11631   REWRITE_TAC[reflC_cont];
11632   ASM_REWRITE_TAC[];
11633   DISCH_ALL_TAC;
11634   USE 2(MATCH_MP   point_onto);
11635   CHO 2;
11636   ASM_REWRITE_TAC[reflCf_inv];
11637   ]);;
11638   (* }}} *)
11639
11640 let IMAGE2 = new_definition
11641    `IMAGE2 (f:A->B) U = IMAGE (IMAGE (f:A->B)) U`;;
11642
11643 let reflA_h_edge = prove_by_refinement(
11644   `!m r.  IMAGE (reflAf r) (h_edge m) = h_edge (left  (reflAi r m))`,
11645   (* {{{ proof *)
11646   [
11647   REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left  ;];
11648   DISCH_ALL_TAC;
11649   IMATCH_MP_TAC  EQ_EXT;
11650   REWRITE_TAC[h_edge];
11651   DISCH_ALL_TAC;
11652   CONV_TAC (dropq_conv "x'");
11653   CONV_TAC (dropq_conv "v");
11654   REWRITE_TAC[coord01];
11655   EQ_TAC;
11656   DISCH_THEN CHOOSE_TAC;
11657   TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
11658   ASM_REWRITE_TAC[];
11659   UND 0;
11660   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
11661   DISCH_ALL_TAC;
11662   UND 0;
11663   UND 1;
11664   REAL_ARITH_TAC;
11665   DISCH_THEN CHOOSE_TAC;
11666   TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
11667   ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
11668   UND 0;
11669   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
11670   DISCH_ALL_TAC;
11671   UND 2;
11672   UND 1;
11673   REAL_ARITH_TAC;
11674   ]);;
11675   (* }}} *)
11676
11677 let reflA_v_edge = prove_by_refinement(
11678   `!m r.  IMAGE (reflAf r) (v_edge m) = v_edge (  (reflAi r m))`,
11679   (* {{{ proof *)
11680   [
11681   REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left  ;];
11682   DISCH_ALL_TAC;
11683   IMATCH_MP_TAC  EQ_EXT;
11684   REWRITE_TAC[v_edge];
11685   DISCH_ALL_TAC;
11686   CONV_TAC (dropq_conv "x'");
11687   CONV_TAC (dropq_conv "u");
11688   REWRITE_TAC[coord01];
11689   REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;];
11690   MESON_TAC[];
11691   ]);;
11692   (* }}} *)
11693
11694 let reflA_edge = prove_by_refinement(
11695   `!r e. (edge e ==> edge (IMAGE (reflAf r) e))`,
11696   (* {{{ proof *)
11697   [
11698   REWRITE_TAC[edge];
11699   DISCH_ALL_TAC;
11700   CHO 0;
11701   UND 0;
11702   DISCH_THEN DISJ_CASES_TAC;
11703   ASM_REWRITE_TAC[];
11704   MESON_TAC[reflA_v_edge];
11705   ASM_REWRITE_TAC[];
11706   MESON_TAC[reflA_h_edge];
11707   ]);;
11708   (* }}} *)
11709
11710 let reflB_v_edge = prove_by_refinement(
11711   `!m r.  IMAGE (reflBf r) (v_edge m) = v_edge (down  (reflBi r m))`,
11712   (* {{{ proof *)
11713   [
11714   REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down  ;];
11715   DISCH_ALL_TAC;
11716   IMATCH_MP_TAC  EQ_EXT;
11717   REWRITE_TAC[v_edge];
11718   DISCH_ALL_TAC;
11719   CONV_TAC (dropq_conv "x'");
11720   CONV_TAC (dropq_conv "u");
11721   REWRITE_TAC[coord01];
11722   EQ_TAC;
11723   DISCH_THEN CHOOSE_TAC;
11724   TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
11725   ASM_REWRITE_TAC[];
11726   UND 0;
11727   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
11728   DISCH_ALL_TAC;
11729   UND 0;
11730   UND 1;
11731   REAL_ARITH_TAC;
11732   DISCH_THEN CHOOSE_TAC;
11733   TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
11734   ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
11735   UND 0;
11736   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
11737   DISCH_ALL_TAC;
11738   UND 2;
11739   UND 1;
11740   REAL_ARITH_TAC;
11741   ]);;
11742   (* }}} *)
11743
11744 let reflB_h_edge = prove_by_refinement(
11745   `!m r.  IMAGE (reflBf r) (h_edge m) = h_edge (  (reflBi r m))`,
11746   (* {{{ proof *)
11747   [
11748   REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down  ;];
11749   DISCH_ALL_TAC;
11750   IMATCH_MP_TAC  EQ_EXT;
11751   REWRITE_TAC[h_edge];
11752   DISCH_ALL_TAC;
11753   CONV_TAC (dropq_conv "x'");
11754   CONV_TAC (dropq_conv "v");
11755   REWRITE_TAC[coord01];
11756   REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;];
11757   MESON_TAC[];
11758   ]);;
11759   (* }}} *)
11760
11761 let reflB_edge = prove_by_refinement(
11762   `!r e. (edge e ==> edge (IMAGE (reflBf r) e))`,
11763   (* {{{ proof *)
11764   [
11765   REWRITE_TAC[edge];
11766   DISCH_ALL_TAC;
11767   CHO 0;
11768   UND 0;
11769   DISCH_THEN DISJ_CASES_TAC;
11770   ASM_REWRITE_TAC[];
11771   MESON_TAC[reflB_v_edge];
11772   ASM_REWRITE_TAC[];
11773   MESON_TAC[reflB_h_edge];
11774   ]);;
11775   (* }}} *)
11776
11777 let reflC_vh_edge = prove_by_refinement(
11778   `!m .  IMAGE (reflCf) (v_edge m) = h_edge ( (reflCi m))`,
11779   (* {{{ proof *)
11780   [
11781   REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down  ;];
11782   DISCH_ALL_TAC;
11783   IMATCH_MP_TAC  EQ_EXT;
11784   REWRITE_TAC[v_edge;h_edge];
11785   DISCH_ALL_TAC;
11786   CONV_TAC (dropq_conv "x'");
11787   CONV_TAC (dropq_conv "u");
11788   CONV_TAC (dropq_conv "v");
11789   REWRITE_TAC[coord01];
11790   ASM_MESON_TAC[];
11791   ]);;
11792   (* }}} *)
11793
11794 let reflC_hv_edge = prove_by_refinement(
11795   `!m .  IMAGE (reflCf) (h_edge m) = v_edge ( (reflCi m))`,
11796   (* {{{ proof *)
11797   [
11798   REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down  ;];
11799   DISCH_ALL_TAC;
11800   IMATCH_MP_TAC  EQ_EXT;
11801   REWRITE_TAC[v_edge;h_edge];
11802   DISCH_ALL_TAC;
11803   CONV_TAC (dropq_conv "x'");
11804   CONV_TAC (dropq_conv "u");
11805   CONV_TAC (dropq_conv "v");
11806   REWRITE_TAC[coord01];
11807   ASM_MESON_TAC[];
11808   ]);;
11809   (* }}} *)
11810
11811 let reflC_edge = prove_by_refinement(
11812   `!e. (edge e ==> edge (IMAGE (reflCf ) e))`,
11813   (* {{{ proof *)
11814   [
11815   REWRITE_TAC[edge];
11816   DISCH_ALL_TAC;
11817   CHO 0;
11818   UND 0;
11819   DISCH_THEN DISJ_CASES_TAC;
11820   ASM_REWRITE_TAC[];
11821   MESON_TAC[reflC_vh_edge];
11822   ASM_REWRITE_TAC[];
11823   MESON_TAC[reflC_hv_edge];
11824   ]);;
11825   (* }}} *)
11826
11827 let homeo_bij = prove_by_refinement(
11828   `!(f:A->B) U V. (homeomorphism f U V) ==> (BIJ (IMAGE f) U V)`,
11829   (* {{{ proof *)
11830   [
11831   REWRITE_TAC[BIJ;homeomorphism;continuous;preimage;];
11832   DISCH_ALL_TAC;
11833   SUBCONJ_TAC;
11834   REWRITE_TAC[INJ];
11835   ASM_REWRITE_TAC[IMAGE;];
11836   DISCH_ALL_TAC;
11837   TAPP `u:B` 6;
11838   USE 6 (REWRITE_RULE[]);
11839   USE 6(CONV_RULE NAME_CONFLICT_CONV);
11840   IMATCH_MP_TAC  EQ_EXT;
11841   USE 6 (GEN `u:B`);
11842   GEN_TAC;
11843   COPY 6;
11844   EQ_TAC;
11845   DISCH_TAC;
11846   TSPEC `f x'` 7;
11847   TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC;
11848   TYPE_THEN `x'` EXISTS_TAC;
11849   ASM_REWRITE_TAC[];
11850   DISCH_TAC;
11851   UND 7;
11852   KILL 6;
11853   ASM_REWRITE_TAC[];
11854   DISCH_TAC;
11855   CHO 6;
11856   CHO 9;
11857   TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC;
11858   REWRITE_TAC[UNIONS;];
11859   ASM_MESON_TAC[];
11860   DISCH_TAC;
11861   TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC;
11862   REWRITE_TAC[UNIONS;];
11863   ASM_MESON_TAC[];
11864   DISCH_TAC;
11865   TYPE_THEN `x' = x'''` SUBGOAL_TAC;
11866   USE 0(REWRITE_RULE[INJ]);
11867   ASM_MESON_TAC[];
11868   DISCH_TAC;
11869   TYPE_THEN `x' = x''` SUBGOAL_TAC;
11870   USE 0(REWRITE_RULE[INJ]);
11871   ASM_MESON_TAC[];
11872   DISCH_TAC;
11873   ASM_MESON_TAC[];
11874   (* mm *)
11875   DISCH_TAC;
11876   TSPEC `f x'` 7;
11877   TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC;
11878   TYPE_THEN `x'` EXISTS_TAC;
11879   ASM_REWRITE_TAC[];
11880   DISCH_TAC;
11881   UND 7;
11882   KILL 6;
11883   ASM_REWRITE_TAC[];
11884   DISCH_TAC;
11885   CHO 6;
11886   CHO 9;
11887   TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC;
11888   REWRITE_TAC[UNIONS;];
11889   ASM_MESON_TAC[];
11890   DISCH_TAC;
11891   TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC;
11892   REWRITE_TAC[UNIONS;];
11893   ASM_MESON_TAC[];
11894   DISCH_TAC;
11895   TYPE_THEN `x' = x'''` SUBGOAL_TAC;
11896   USE 0(REWRITE_RULE[INJ]);
11897   ASM_MESON_TAC[];
11898   DISCH_TAC;
11899   TYPE_THEN `x' = x''` SUBGOAL_TAC;
11900   USE 0(REWRITE_RULE[INJ]);
11901   ASM_MESON_TAC[];
11902   DISCH_TAC;
11903   ASM_MESON_TAC[];
11904   REWRITE_TAC[INJ;SURJ];
11905   DISCH_ALL_TAC;
11906   ASM_REWRITE_TAC[];
11907   DISCH_ALL_TAC;
11908   TYPE_THEN `{z | UNIONS U z /\ x (f z)}` EXISTS_TAC;
11909   CONJ_TAC;
11910   UND 2;
11911   DISCH_THEN IMATCH_MP_TAC ;
11912   ASM_REWRITE_TAC[];
11913   IMATCH_MP_TAC  SUBSET_ANTISYM;
11914   CONJ_TAC;
11915   REWRITE_TAC[IMAGE;SUBSET ;];
11916   NAME_CONFLICT_TAC;
11917   CONV_TAC (dropq_conv "x''");
11918   MESON_TAC[];
11919   REWRITE_TAC[SUBSET;IMAGE];
11920   DISCH_ALL_TAC;
11921   NAME_CONFLICT_TAC;
11922   UND 1;
11923   REWRITE_TAC[SURJ];
11924   DISCH_ALL_TAC;
11925   TSPEC `x'` 8;
11926   TYPE_THEN `UNIONS V x'` SUBGOAL_TAC;
11927   REWRITE_TAC[UNIONS;];
11928   ASM_MESON_TAC[];
11929   DISCH_TAC;
11930   REWR 8;
11931   CHO 8;
11932   ASM_MESON_TAC[];
11933   ]);;
11934   (* }}} *)
11935
11936 let homeo_unions = prove_by_refinement(
11937   `!(f:A->B) U V. (homeomorphism f U V) ==>
11938       (IMAGE f (UNIONS U) = (UNIONS V))`,
11939   (* {{{ proof *)
11940   [
11941   REWRITE_TAC[homeomorphism;BIJ;SURJ;IMAGE;];
11942   DISCH_ALL_TAC;
11943   IMATCH_MP_TAC  EQ_EXT;
11944   REWRITE_TAC[];
11945   GEN_TAC;
11946   NAME_CONFLICT_TAC;
11947   EQ_TAC;
11948   DISCH_ALL_TAC;
11949   CHO 5;
11950   ASM_MESON_TAC[];
11951   DISCH_TAC;
11952   TSPEC `x` 2;
11953   ASM_MESON_TAC[];
11954   ]);;
11955   (* }}} *)
11956
11957 let homeo_closed = prove_by_refinement(
11958   `!(f:A->B) U V A. (homeomorphism f U V /\ (A SUBSET (UNIONS U)) ==>
11959     (closed_ V (IMAGE f A) = closed_ U A))`,
11960   (* {{{ proof *)
11961   [
11962   DISCH_ALL_TAC;
11963    TYPE_THEN `BIJ f (UNIONS U) (UNIONS V)` SUBGOAL_TAC;
11964   ASM_MESON_TAC[homeomorphism];
11965   DISCH_TAC;
11966   USE 2(MATCH_MP DIFF_SURJ);
11967   TSPEC `A` 2;
11968   REWR 2;
11969   ASM_REWRITE_TAC[closed;open_DEF];
11970   EQ_TAC;
11971   DISCH_ALL_TAC;
11972   USE 0(REWRITE_RULE[homeomorphism;continuous]);
11973   UND 0;
11974   DISCH_ALL_TAC;
11975   USE 2 SYM;
11976   REWR 4;
11977   TSPEC `IMAGE f (UNIONS U DIFF A)` 5;
11978   REWR 5;
11979   TYPE_THEN `preimage (UNIONS U) f (IMAGE f (UNIONS U DIFF A)) = UNIONS U DIFF A` SUBGOAL_TAC;
11980   IMATCH_MP_TAC  EQ_EXT ;
11981   GEN_TAC;
11982   REWRITE_TAC[INR in_preimage;IMAGE;DIFF;];
11983   USE 0(REWRITE_RULE[BIJ;INJ]);
11984   EQ_TAC;
11985   DISCH_ALL_TAC;
11986   CHO 8;
11987   ASM_MESON_TAC[];
11988   MESON_TAC[];
11989   DISCH_TAC;
11990   ASM_MESON_TAC[];
11991   DISCH_TAC;
11992   CONJ_TAC;
11993   USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]);
11994   REWRITE_TAC[IMAGE;SUBSET];
11995   GEN_TAC;
11996   NAME_CONFLICT_TAC;
11997   UND 1;
11998   REWRITE_TAC[SUBSET];
11999   ASM_MESON_TAC[];
12000   USE 0(REWRITE_RULE[homeomorphism]);
12001   ASM_MESON_TAC[];
12002   ]);;
12003   (* }}} *)
12004
12005
12006 (* ------------------------------------------------------------------ *)
12007 (* SECTION G *)
12008 (* ------------------------------------------------------------------ *)
12009
12010
12011 let IMAGE_INTERS = prove_by_refinement(
12012   `!(f:A->B) A X . (INJ f X UNIV) /\ (UNIONS A SUBSET X) /\
12013      ~(A = EMPTY) ==>
12014    ((IMAGE f) (INTERS A) = (INTERS (IMAGE2 f A)))`,
12015   (* {{{ proof *)
12016
12017   [
12018   DISCH_ALL_TAC;
12019   REWRITE_TAC[IMAGE2;INTERS;IMAGE;];
12020   IMATCH_MP_TAC  EQ_EXT;
12021   GEN_TAC;
12022   REWRITE_TAC[];
12023   NAME_CONFLICT_TAC;
12024   EQ_TAC;
12025   DISCH_ALL_TAC;
12026   CHO 3;
12027   AND 3;
12028   ASM_REWRITE_TAC[];
12029   DISCH_ALL_TAC;
12030   CHO 5;
12031   AND 5;
12032   ASM_REWRITE_TAC[];
12033   NAME_CONFLICT_TAC;
12034   TYPE_THEN `x'` EXISTS_TAC;
12035   ASM_MESON_TAC[];
12036   DISCH_ALL_TAC;
12037   USE 3 (CONV_RULE (dropq_conv "u'"));
12038   USE 3 (CONV_RULE (dropq_conv "y'"));
12039   USE 2(REWRITE_RULE[EMPTY_EXISTS]);
12040   CHO 2;
12041   COPY 3;
12042   TSPEC `u` 3;
12043   CHO 3;
12044   REWR 3;
12045   TYPE_THEN `x'` EXISTS_TAC;
12046   ASM_REWRITE_TAC[];
12047   DISCH_ALL_TAC;
12048   USE 0(REWRITE_RULE[INJ]);
12049   TSPEC `u'` 4;
12050   CHO 4;
12051   REWR 4;
12052   TYPEL_THEN [`x'`;`x''`] (USE 0 o ISPECL);
12053   USE 1(REWRITE_RULE[UNIONS;ISUBSET]);
12054   ASM_MESON_TAC[];
12055   ]);;
12056
12057   (* }}} *)
12058
12059 let homeo_closure = prove_by_refinement(
12060   `!(f:A->B) U V A. (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) /\
12061      (topology_ U)  ==>
12062      (IMAGE f (closure U A) = closure V (IMAGE f A))`,
12063   (* {{{ proof *)
12064
12065   [
12066   DISCH_ALL_TAC;
12067   REWRITE_TAC[closure];
12068   TYPE_THEN `INJ f (UNIONS U) (UNIV)` SUBGOAL_TAC;
12069   USE 0(REWRITE_RULE[homeomorphism;BIJ;INJ;]);
12070   ASM_REWRITE_TAC[INJ];
12071   DISCH_TAC;
12072   TYPE_THEN `C = {B | closed_ U B /\ A SUBSET B}` ABBREV_TAC ;
12073   TYPE_THEN `(UNIONS C SUBSET UNIONS U)` SUBGOAL_TAC;
12074   REWRITE_TAC[SUBSET;];
12075   EXPAND_TAC "C";
12076   REWRITE_TAC[closed];
12077   TYPE_THEN `X = UNIONS U` ABBREV_TAC ;
12078   REWRITE_TAC[UNIONS];
12079   MESON_TAC[ISUBSET];
12080   DISCH_TAC;
12081   TYPE_THEN `~(C = EMPTY)` SUBGOAL_TAC;
12082   REWRITE_TAC[EMPTY_EXISTS];
12083   TYPE_THEN `UNIONS U` EXISTS_TAC;
12084   EXPAND_TAC "C";
12085   ASM_REWRITE_TAC[closed; ISUBSET; DIFF_EQ_EMPTY;];
12086   ASM_SIMP_TAC[INR open_EMPTY];
12087   DISCH_TAC;
12088   JOIN 5 6;
12089   JOIN 3 5;
12090   USE 3 (MATCH_MP IMAGE_INTERS);
12091   ASM_REWRITE_TAC[];
12092   AP_TERM_TAC;
12093   REWRITE_TAC[IMAGE2];
12094   EXPAND_TAC "C";
12095   IMATCH_MP_TAC  EQ_EXT;
12096   GEN_TAC;
12097   TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
12098   REWRITE_TAC[IMAGE];
12099   NAME_CONFLICT_TAC;
12100   EQ_TAC;
12101   DISCH_THEN CHOOSE_TAC;
12102   ASM_REWRITE_TAC[];
12103   EXPAND_TAC "g";
12104   KILL 5;
12105   TYPE_THEN `x' SUBSET (UNIONS U)` SUBGOAL_TAC;
12106   USE 6(REWRITE_RULE[closed]);
12107   ASM_REWRITE_TAC[];
12108   ASM_SIMP_TAC[homeo_closed];
12109   DISCH_TAC;
12110   REWRITE_TAC[ISUBSET;IMAGE];
12111   NAME_CONFLICT_TAC;
12112   ASM_MESON_TAC[ISUBSET];
12113   DISCH_ALL_TAC;
12114   TYPE_THEN `preimage (UNIONS U) f x` EXISTS_TAC;
12115   TYPE_THEN `x = g (preimage (UNIONS U) f x)` SUBGOAL_TAC;
12116   REWRITE_TAC[preimage];
12117   EXPAND_TAC "g";
12118   IMATCH_MP_TAC  EQ_EXT;
12119   GEN_TAC;
12120   EQ_TAC;
12121   DISCH_TAC;
12122   REWRITE_TAC[IMAGE];
12123   NAME_CONFLICT_TAC;
12124   USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]);
12125   UND 0;
12126   DISCH_ALL_TAC;
12127   TSPEC `x'` 10;
12128   TYPE_THEN `UNIONS V x'` SUBGOAL_TAC;
12129   USE 6(REWRITE_RULE[closed]);
12130   ASM_MESON_TAC[ISUBSET];
12131   DISCH_TAC;
12132   REWR 10;
12133   ASM_MESON_TAC[];
12134   REWRITE_TAC[IMAGE];
12135   DISCH_THEN CHOOSE_TAC;
12136   ASM_REWRITE_TAC[];
12137   DISCH_TAC;
12138   USE 8 (SYM);
12139   ONCE_ASM_REWRITE_TAC[];
12140   REWRITE_TAC[];
12141   CONJ_TAC;
12142   TYPE_THEN `preimage (UNIONS U) f x SUBSET (UNIONS U)` SUBGOAL_TAC;
12143   REWRITE_TAC[preimage;SUBSET;];
12144   MESON_TAC[];
12145   ASM_SIMP_TAC[GSYM homeo_closed];
12146   REWRITE_TAC[preimage;SUBSET];
12147   DISCH_ALL_TAC;
12148   CONJ_TAC;
12149   ASM_MESON_TAC[ISUBSET];
12150   UND 7;
12151   EXPAND_TAC "g";
12152   REWRITE_TAC[IMAGE;ISUBSET;];
12153   UND 9;
12154   MESON_TAC[];
12155   ]);;
12156
12157   (* }}} *)
12158
12159 let INJ_IMAGE = prove_by_refinement(
12160   `!(f :A->B) A B X . (A SUBSET X) /\ (B SUBSET X) /\
12161      (INJ f X UNIV) ==> ((IMAGE f A = IMAGE f B) <=> (A = B))`,
12162   (* {{{ proof *)
12163   [
12164   REP_BASIC_TAC;
12165   EQ_TAC;
12166   DISCH_TAC;
12167   IMATCH_MP_TAC  SUBSET_ANTISYM;
12168   RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
12169   TAPP `y:B` 3;
12170   RULE_ASSUM_TAC  (REWRITE_RULE[]);
12171   USE 3(GEN `y:B`);
12172   REWRITE_TAC[SUBSET];
12173   PROOF_BY_CONTR_TAC;
12174   USE 4(REWRITE_RULE [DE_MORGAN_THM]);
12175   FIRST_ASSUM (DISJ_CASES_TAC);
12176
12177   LEFT  5 "x";
12178   REP_BASIC_TAC;
12179   TSPEC `f x ` 3;
12180   TYPE_THEN `A x` SUBGOAL_TAC;
12181   ASM_MESON_TAC[];
12182   DISCH_TAC;
12183   TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC;
12184   ASM_MESON_TAC[];
12185   DISCH_TAC;
12186   TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC;
12187   ASM_MESON_TAC[];
12188   DISCH_TAC;
12189   REP_BASIC_TAC;
12190   USE 0(REWRITE_RULE[BIJ;INJ]);
12191   TYPE_THEN `x = x'` SUBGOAL_TAC;
12192   ASM_MESON_TAC[ISUBSET];
12193   ASM_MESON_TAC[];
12194
12195   LEFT  5 "x";
12196   REP_BASIC_TAC;
12197   TSPEC `f x ` 3;
12198   TYPE_THEN `B x` SUBGOAL_TAC;
12199   ASM_MESON_TAC[];
12200   DISCH_TAC;
12201   TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC;
12202   ASM_MESON_TAC[];
12203   DISCH_TAC;
12204   TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC;
12205   ASM_MESON_TAC[];
12206   DISCH_TAC;
12207   REP_BASIC_TAC;
12208   USE 0(REWRITE_RULE[BIJ;INJ]);
12209   TYPE_THEN `x = x'` SUBGOAL_TAC;
12210   ASM_MESON_TAC[ISUBSET];
12211   ASM_MESON_TAC[];
12212   DISCH_THEN_REWRITE;
12213   ]);;
12214   (* }}} *)
12215
12216 let INJ_UNIV = prove_by_refinement(
12217   `!(f: A->B) X Y. (INJ f X Y) ==> (INJ f X UNIV)`,
12218   (* {{{ proof *)
12219   [
12220   REWRITE_TAC[INJ];
12221   REP_BASIC_TAC;
12222   ASM_MESON_TAC [];
12223   ]);;
12224   (* }}} *)
12225
12226 let homeo_adj = prove_by_refinement(
12227   `!f X Y.  (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\
12228        (Y SUBSET euclid 2)
12229        ==> (adj X Y ==> (adj (IMAGE f X) (IMAGE f Y)))`,
12230   (* {{{ proof *)
12231   [
12232   REWRITE_TAC[adj;INTER;EMPTY_EXISTS];
12233   REP_BASIC_TAC;
12234   ASSUME_TAC top2_top;
12235   ASSUME_TAC top2_unions;
12236   TYPE_THEN `X SUBSET (UNIONS top2) /\ Y SUBSET (UNIONS (top2))` SUBGOAL_TAC;
12237   ASM_REWRITE_TAC[];
12238   TYPE_THEN `closure top2 (IMAGE f X) = IMAGE f (closure top2 X)` SUBGOAL_TAC;
12239   ASM_MESON_TAC[GSYM homeo_closure];
12240   DISCH_THEN_REWRITE;
12241   TYPE_THEN `closure top2 (IMAGE f Y) = IMAGE f (closure top2 Y)` SUBGOAL_TAC;
12242   ASM_MESON_TAC[GSYM homeo_closure];
12243   DISCH_THEN_REWRITE;
12244   REP_BASIC_TAC;
12245   CONJ_TAC;
12246   PROOF_BY_CONTR_TAC;
12247   RULE_ASSUM_TAC  (REWRITE_RULE[]);
12248   UND 2;
12249   REWRITE_TAC[];
12250   UND 10;
12251   TYPE_THEN `INJ f (euclid 2) UNIV` SUBGOAL_TAC;
12252   IMATCH_MP_TAC  INJ_UNIV;
12253   RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ]);
12254   REP_BASIC_TAC;
12255   REWR 11;
12256   ASM_MESON_TAC[];
12257   REP_BASIC_TAC;
12258   ASM_MESON_TAC[INJ_IMAGE];
12259   (* done WITH both *)
12260   TYPE_THEN `f u` EXISTS_TAC;
12261   REWRITE_TAC[IMAGE];
12262   ASM_MESON_TAC[];
12263   (* converse *)
12264   ]);;
12265   (* }}} *)
12266
12267 let homeomorphism_inv = prove_by_refinement(
12268   `!(f:A->B) U V. homeomorphism f U V ==>
12269     (homeomorphism (INV f (UNIONS U) (UNIONS V)) V U)`,
12270   (* {{{ proof *)
12271   [
12272   REP_BASIC_TAC;
12273   REWRITE_TAC[homeomorphism];
12274   ASM_SIMP_TAC[INV_homeomorphism];
12275   USE 0(REWRITE_RULE [homeomorphism;continuous;]);
12276   REP_BASIC_TAC;
12277   ASM_SIMP_TAC[INVERSE_BIJ];
12278   REP_BASIC_TAC;
12279   TSPEC `A` 1;
12280   REWR 1;
12281   TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ;
12282   TYPE_THEN `BIJ g (UNIONS V) (UNIONS U)` SUBGOAL_TAC;
12283   EXPAND_TAC "g";
12284   IMATCH_MP_TAC  INVERSE_BIJ;
12285   ASM_REWRITE_TAC[];
12286   TYPE_THEN `!x'. (A x' ==> (f (g x') = x'))` SUBGOAL_TAC;
12287   REP_BASIC_TAC;
12288   TYPEL_THEN  [`f`;`UNIONS U`;`UNIONS V`] (fun t->  ASSUME_TAC (ISPECL  t (INR INVERSE_DEF)));
12289   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
12290   REWR 6;
12291   REP_BASIC_TAC;
12292   FIRST_ASSUM IMATCH_MP_TAC  ;
12293   REWRITE_TAC[UNIONS];
12294   ASM_MESON_TAC[];
12295   DISCH_TAC;
12296   DISCH_TAC;
12297   (* branch *)
12298   TYPE_THEN `(IMAGE g A) = preimage (UNIONS U) f A` SUBGOAL_TAC;
12299   REWRITE_TAC[IMAGE;preimage];
12300   IMATCH_MP_TAC  EQ_EXT;
12301   REP_BASIC_TAC;
12302   REWRITE_TAC[];
12303   NAME_CONFLICT_TAC;
12304   EQ_TAC;
12305   REP_BASIC_TAC;
12306   ASM_REWRITE_TAC[];
12307   ASM_SIMP_TAC[];
12308   EXPAND_TAC "g";
12309   USE 2(MATCH_MP   INVERSE_BIJ);
12310   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
12311   REP_BASIC_TAC;
12312   FIRST_ASSUM IMATCH_MP_TAC ;
12313   REWRITE_TAC [UNIONS];
12314   ASM_MESON_TAC[];
12315   REP_BASIC_TAC;
12316   TYPE_THEN `f x` EXISTS_TAC;
12317   ASM_REWRITE_TAC[];
12318   TYPE_THEN `f x = f (g (f x))` SUBGOAL_TAC;
12319   ASM_SIMP_TAC[];
12320   DISCH_TAC;
12321   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;INJ]);
12322   REP_BASIC_TAC;
12323   FIRST_ASSUM IMATCH_MP_TAC ;
12324   ASM_REWRITE_TAC[];
12325   USE 9 SYM;
12326   ASM_REWRITE_TAC[];
12327   TYPE_THEN `UNIONS V (f x)` SUBGOAL_TAC;
12328   FIRST_ASSUM IMATCH_MP_TAC ;
12329   ASM_REWRITE_TAC[];
12330   DISCH_TAC;
12331   FIRST_ASSUM IMATCH_MP_TAC ;
12332   ASM_REWRITE_TAC[];
12333   ASM_MESON_TAC[];
12334   ]);;
12335   (* }}} *)
12336
12337 let inv_comp_left = prove_by_refinement(
12338   `!(f:A->B) X Y x.  (BIJ f X Y /\ X x) ==> (INV f X Y (f x) = x)`,
12339   (* {{{ proof *)
12340   [
12341   REP_BASIC_TAC;
12342   TYPE_THEN `Y (f x)` SUBGOAL_TAC;
12343   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
12344   ASM_MESON_TAC[];
12345   ASM_MESON_TAC[INR INVERSE_XY];
12346   ]);;
12347   (* }}} *)
12348
12349 let inv_comp_right = prove_by_refinement(
12350   `!(f:A->B) X Y y. (BIJ f X Y /\ Y y) ==> (f (INV f X Y y) = y)`,
12351   (* {{{ proof *)
12352   [
12353   REP_BASIC_TAC;
12354   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
12355   ASM_MESON_TAC[INR INVERSE_DEF;];
12356   ]);;
12357   (* }}} *)
12358
12359 let image_inv_image = prove_by_refinement(
12360   `!(f:A->B) A X Y. (BIJ f X Y) /\ (A SUBSET X) ==>
12361     (IMAGE (INV f X Y) (IMAGE f A) = A)`,
12362   (* {{{ proof *)
12363   [
12364   REP_BASIC_TAC;
12365   REWRITE_TAC[IMAGE];
12366   IMATCH_MP_TAC  EQ_EXT;
12367   REP_BASIC_TAC;
12368   REWRITE_TAC[];
12369   NAME_CONFLICT_TAC;
12370   CONV_TAC (dropq_conv "x''");
12371   EQ_TAC;
12372   REP_BASIC_TAC;
12373   TYPE_THEN `x = x'` SUBGOAL_TAC;
12374   ASM_REWRITE_TAC[];
12375   ASM_MESON_TAC [inv_comp_left;ISUBSET;];
12376   ASM_MESON_TAC[];
12377   REP_BASIC_TAC;
12378   TYPE_THEN `x` EXISTS_TAC;
12379   ASM_REWRITE_TAC[];
12380   ONCE_REWRITE_TAC[EQ_SYM_EQ];
12381   IMATCH_MP_TAC  inv_comp_left;
12382   ASM_MESON_TAC[ISUBSET];
12383   ]);;
12384   (* }}} *)
12385
12386 let homeo_adj_eq = prove_by_refinement(
12387   `!f X Y. (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\
12388        (Y SUBSET euclid 2)
12389        ==> (adj X Y = (adj (IMAGE f X) (IMAGE f Y)))`,
12390   (* {{{ proof *)
12391   [
12392   REP_BASIC_TAC;
12393   EQ_TAC;
12394   ASM_MESON_TAC[homeo_adj];
12395   TYPEL_THEN  [`INV f (euclid 2) (euclid 2)`;`IMAGE f X`;`IMAGE f Y`] (fun t-> MP_TAC (ISPECL t homeo_adj));
12396   ASSUME_TAC top2_unions;
12397   TYPE_THEN `homeomorphism (INV f (euclid 2) (euclid 2)) top2 top2` SUBGOAL_TAC;
12398   ASM_MESON_TAC[homeomorphism_inv];
12399   DISCH_THEN_REWRITE;
12400   TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC;
12401   ASM_MESON_TAC[homeomorphism];
12402   DISCH_TAC;
12403   ASM_SIMP_TAC[image_inv_image];
12404   REP_BASIC_TAC;
12405   TYPE_THEN `IMAGE f X SUBSET euclid 2 /\ IMAGE f Y SUBSET euclid 2` SUBGOAL_TAC;
12406   REWRITE_TAC[IMAGE;SUBSET];
12407   NAME_CONFLICT_TAC;
12408   CONJ_TAC THEN (CONV_TAC (dropq_conv "x''")) THEN (RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]));
12409   ASM_MESON_TAC[ISUBSET];
12410   ASM_MESON_TAC[ISUBSET];
12411   DISCH_TAC;
12412   ASM_MESON_TAC[];
12413   ]);;
12414   (* }}} *)
12415
12416 let finite_num_closure = prove_by_refinement(
12417   `!G top (x:A). FINITE G ==> (FINITE {C | G C /\ closure top C x})`,
12418   (* {{{ proof *)
12419   [
12420   DISCH_ALL_TAC;
12421   IMATCH_MP_TAC FINITE_SUBSET;
12422   TYPE_THEN `G` EXISTS_TAC;
12423   ASM_REWRITE_TAC[SUBSET];
12424   ASM_MESON_TAC[];
12425   ]);;
12426   (* }}} *)
12427
12428 let image_powerset = prove_by_refinement(
12429   `!(f:A->B) X Y. (BIJ f X Y ==>
12430      (BIJ (IMAGE f) {z | z SUBSET X} { z | z SUBSET Y}))`,
12431   (* {{{ proof *)
12432   [
12433   REP_BASIC_TAC;
12434   REWRITE_TAC[BIJ];
12435   SUBCONJ_TAC;
12436   REWRITE_TAC[INJ];
12437   REP_BASIC_TAC;
12438   CONJ_TAC;
12439   REP_BASIC_TAC;
12440   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
12441   REP_BASIC_TAC ;
12442   REWRITE_TAC[IMAGE;SUBSET;];
12443   ASM_MESON_TAC[ISUBSET ;];
12444   REWRITE_TAC[IMAGE;SUBSET;];
12445   REP_BASIC_TAC;
12446   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;INJ]);
12447   REP_BASIC_TAC;
12448   IMATCH_MP_TAC  EQ_EXT;
12449   GEN_TAC;
12450
12451   TAPP `z:B` 1;
12452   USE 1(REWRITE_RULE[]);
12453   USE 1(GEN `z:B`);
12454   EQ_TAC;
12455   TSPEC `f x'` 1;
12456   REP_BASIC_TAC;
12457   UND 1;
12458   NAME_CONFLICT_TAC;
12459   TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC;
12460   ASM_MESON_TAC[];
12461   DISCH_THEN_REWRITE;
12462   REP_BASIC_TAC;
12463   TYPE_THEN `x' = x''` SUBGOAL_TAC;
12464   FIRST_ASSUM IMATCH_MP_TAC ;
12465   ASM_MESON_TAC[];
12466   ASM_MESON_TAC[];
12467   (* 2 *)
12468   TSPEC `f x'` 1;
12469   REP_BASIC_TAC;
12470   UND 1;
12471   NAME_CONFLICT_TAC;
12472   TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC;
12473   ASM_MESON_TAC[];
12474   DISCH_THEN_REWRITE;
12475   REP_BASIC_TAC;
12476   TYPE_THEN `x' = x''` SUBGOAL_TAC;
12477   FIRST_ASSUM IMATCH_MP_TAC ;
12478   ASM_MESON_TAC[];
12479   ASM_MESON_TAC[];
12480   REWRITE_TAC[INJ;SURJ];
12481   REP_BASIC_TAC;
12482   ASM_REWRITE_TAC[];
12483   REP_BASIC_TAC;
12484   TYPE_THEN `{z | X z /\ x (f z) }` EXISTS_TAC;
12485   SUBCONJ_TAC;
12486   REWRITE_TAC[SUBSET];
12487   MESON_TAC[];
12488   DISCH_TAC;
12489   REWRITE_TAC[IMAGE];
12490   IMATCH_MP_TAC  EQ_EXT ;
12491   REP_BASIC_TAC;
12492   REWRITE_TAC[];
12493   NAME_CONFLICT_TAC;
12494   EQ_TAC;
12495   REP_BASIC_TAC;
12496   ASM_REWRITE_TAC[];
12497   DISCH_TAC;
12498   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
12499   REP_BASIC_TAC;
12500   TSPEC `x'` 0;
12501   USE 3(REWRITE_RULE[SUBSET]);
12502   TSPEC  `x'` 3;
12503   REWR 3;
12504   REWR 0;
12505   REP_BASIC_TAC;
12506   TYPE_THEN `y` EXISTS_TAC;
12507   ASM_MESON_TAC[];
12508   ]);;
12509   (* }}} *)
12510
12511 let image_power_inj = prove_by_refinement(
12512   `!(f:A->B) X Y A B. (BIJ f X Y /\ A SUBSET X /\ B SUBSET X ==>
12513      ((IMAGE f A = IMAGE f B) <=> (A = B)))`,
12514   (* {{{ proof *)
12515   [
12516   REP_BASIC_TAC;
12517   TYPEL_THEN [`f`;`X`;`Y`]  (fun t -> ASSUME_TAC (ISPECL t image_powerset ));
12518   REWR 3;
12519   USE 3(REWRITE_RULE[BIJ;INJ;]);
12520   REP_BASIC_TAC;
12521   EQ_TAC;
12522   ASM_MESON_TAC[];
12523   DISCH_THEN_REWRITE;
12524   ]);;
12525   (* }}} *)
12526
12527 let image_power_surj = prove_by_refinement(
12528   `!(f:A->B) X Y B. (BIJ f X Y /\ B SUBSET Y ==>
12529     (?A. (A SUBSET X /\ (IMAGE f A = B))))`,
12530   (* {{{ proof *)
12531   [
12532   REP_BASIC_TAC;
12533   TYPEL_THEN [`f`;`X`;`Y`]  (fun t -> ASSUME_TAC (ISPECL t image_powerset ));
12534   REWR 2;
12535   USE 2(REWRITE_RULE[BIJ;SURJ]);
12536   REP_BASIC_TAC;
12537   ASM_MESON_TAC[];
12538   ]);;
12539   (* }}} *)
12540
12541 let segment_euclid = prove_by_refinement(
12542   `!G e. (segment G /\ G e) ==> (e SUBSET (euclid 2))`,
12543   (* {{{ proof *)
12544   [
12545   REP_BASIC_TAC;
12546   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
12547   REP_BASIC_TAC;
12548   USE 3(REWRITE_RULE[SUBSET]);
12549   TSPEC `e` 3;
12550   REWR 3;
12551   USE 3(REWRITE_RULE[edge]);
12552   REP_BASIC_TAC;
12553   ASM_MESON_TAC[h_edge_euclid;v_edge_euclid];
12554   ]);;
12555   (* }}} *)
12556
12557 let image_app = prove_by_refinement(
12558   `!(f:A->B) X Y x t. INJ f X Y /\ x SUBSET X /\ (X t) ==>
12559    (IMAGE f x (f t) = x t)`,
12560   (* {{{ proof *)
12561   [
12562   REWRITE_TAC[INJ;IMAGE;SUBSET ;];
12563   REP_BASIC_TAC;
12564   EQ_TAC;
12565   ASM_MESON_TAC[];
12566   ASM_MESON_TAC[];
12567   ]);;
12568   (* }}} *)
12569
12570 let homeo_num_closure = prove_by_refinement(
12571   `!G f m. (homeomorphism f top2 top2 /\ segment G) ==>
12572    (num_closure G (pointI m) =
12573            (num_closure (IMAGE2 f G) (f (pointI m))))`,
12574   (* {{{ proof *)
12575   [
12576   REP_BASIC_TAC;
12577   ASSUME_TAC top2_unions;
12578   ASSUME_TAC top2_top;
12579   TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC;
12580   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
12581   ASM_MESON_TAC [];
12582   DISCH_TAC;
12583   TYPE_THEN `G` (fun t-> ASSUME_TAC (ISPEC t segment_euclid));
12584   REWRITE_TAC[num_closure];
12585   IMATCH_MP_TAC  BIJ_CARD;
12586   TYPE_THEN `IMAGE f` EXISTS_TAC;
12587   CONJ_TAC;
12588   IMATCH_MP_TAC  finite_num_closure;
12589   ASM_MESON_TAC[segment_finite];
12590   REWRITE_TAC[BIJ];
12591   SUBCONJ_TAC;
12592   REWRITE_TAC[INJ];
12593   REP_BASIC_TAC;
12594   CONJ_TAC;
12595   REP_BASIC_TAC;
12596   REWRITE_TAC[IMAGE2];
12597   CONJ_TAC;
12598   REWRITE_TAC[IMAGE];
12599   TYPE_THEN `x` EXISTS_TAC;
12600   ASM_REWRITE_TAC[];
12601   TYPE_THEN `x SUBSET (UNIONS top2)` SUBGOAL_TAC;
12602   ASM_MESON_TAC[];
12603   DISCH_TAC;
12604   TYPE_THEN `IMAGE f (closure top2 x) = closure top2 (IMAGE f x)` SUBGOAL_TAC;
12605   ASM_MESON_TAC [homeo_closure];
12606   DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
12607   REWRITE_TAC[IMAGE];
12608   ASM_MESON_TAC[];
12609   REP_BASIC_TAC;
12610   TYPE_THEN `x SUBSET (euclid 2) /\ y SUBSET (euclid 2)` SUBGOAL_TAC;
12611   ASM_MESON_TAC[];
12612   DISCH_TAC;
12613   ASM_MESON_TAC[image_power_inj];
12614   REWRITE_TAC[INJ;SURJ];
12615   REP_BASIC_TAC;
12616   ASM_REWRITE_TAC[];
12617   REP_BASIC_TAC;
12618   RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2]);
12619   UND 9;
12620   TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
12621   REWRITE_TAC[IMAGE];
12622   EXPAND_TAC "g";
12623   REP_BASIC_TAC;
12624   TYPE_THEN `x'` EXISTS_TAC;
12625   ASM_REWRITE_TAC[];
12626   REWR 8;
12627   UND 8;
12628   TYPE_THEN `x' SUBSET (UNIONS top2)` SUBGOAL_TAC;
12629   ASM_MESON_TAC[];
12630   DISCH_TAC;
12631   TYPE_THEN `closure top2 (g x') = IMAGE f (closure top2 x')` SUBGOAL_TAC;
12632   ASM_MESON_TAC [GSYM homeo_closure];
12633   DISCH_THEN_REWRITE;
12634   (* m3 *)
12635   TYPE_THEN `INJ f (euclid 2) (euclid 2) /\ (closure top2 x' SUBSET (euclid 2)) /\ (euclid 2 (pointI m))` SUBGOAL_TAC;
12636   RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
12637    ASM_REWRITE_TAC[pointI;euclid_point];
12638   IMATCH_MP_TAC  c_edge_euclid;
12639   ASM_MESON_TAC[segment;ISUBSET];
12640   DISCH_TAC;
12641   USE 12 (MATCH_MP image_app);
12642   ASM_REWRITE_TAC[];
12643   ]);;
12644   (* }}} *)
12645
12646 (* ------------------------------------------------------------------ *)
12647 (* SECTION H *)
12648 (* ------------------------------------------------------------------ *)
12649
12650 let reflA_pointI = prove_by_refinement(
12651   `!r m. (reflAf r (pointI m) = pointI (reflAi r m))`,
12652   (* {{{ proof *)
12653   [
12654   REP_BASIC_TAC;
12655   REWRITE_TAC[reflAi;reflAf;pointI];
12656   REWRITE_TAC[point_inj;PAIR_SPLIT;];
12657   REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
12658   ]);;
12659   (* }}} *)
12660
12661 let reflB_pointI = prove_by_refinement(
12662   `!r m. (reflBf r (pointI m) = pointI (reflBi r m))`,
12663   (* {{{ proof *)
12664   [
12665   REP_BASIC_TAC;
12666   REWRITE_TAC[reflBi;reflBf;pointI];
12667   REWRITE_TAC[point_inj;PAIR_SPLIT;];
12668   REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
12669   ]);;
12670   (* }}} *)
12671
12672 let reflC_pointI = prove_by_refinement(
12673   `!m. (reflCf  (pointI m) = pointI (reflCi m))`,
12674   (* {{{ proof *)
12675   [
12676   REP_BASIC_TAC;
12677   REWRITE_TAC[reflCi;reflCf;pointI];
12678   REWRITE_TAC[point_inj;PAIR_SPLIT;];
12679   REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
12680   ]);;
12681   (* }}} *)
12682
12683 let edge_euclid2 = prove_by_refinement(
12684   `!e. (edge e ==> e SUBSET (euclid 2))`,
12685   (* {{{ proof *)
12686   [
12687   MESON_TAC [edge;h_edge_euclid;v_edge_euclid;];
12688   ]);;
12689   (* }}} *)
12690
12691 let reflA_segment = prove_by_refinement(
12692   `!G r. (segment G ==> (segment (IMAGE2 (reflAf r) G)))`,
12693   (* {{{ proof *)
12694   [
12695   REP_BASIC_TAC;
12696   REWRITE_TAC[segment];
12697   COPY 0;
12698   USE 0(REWRITE_RULE[segment]);
12699   REP_BASIC_TAC;
12700   TYPE_THEN `homeomorphism (reflAf r) top2 top2` SUBGOAL_TAC;
12701   REWRITE_TAC[reflA_homeo];
12702   DISCH_TAC;
12703   ASSUME_TAC top2_top;
12704   ASSUME_TAC top2_unions;
12705   TYPE_THEN `BIJ (reflAf r) (euclid 2) (euclid 2)` SUBGOAL_TAC;
12706   ASM_MESON_TAC[homeomorphism];
12707   DISCH_TAC;
12708   TYPE_THEN `INJ (IMAGE (reflAf r)) edge edge` SUBGOAL_TAC;
12709   REWRITE_TAC[INJ;reflA_edge;];
12710   REP_BASIC_TAC;
12711   TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
12712   ASM_MESON_TAC[edge_euclid2];
12713   DISCH_TAC;
12714   ASM_MESON_TAC[image_power_inj];
12715   DISCH_TAC;
12716   (* start cases *)
12717   SUBCONJ_TAC;
12718   REWRITE_TAC[IMAGE2];
12719   IMATCH_MP_TAC  FINITE_IMAGE;
12720   ASM_REWRITE_TAC[];
12721   DISCH_TAC;
12722   SUBCONJ_TAC;
12723   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
12724   REP_BASIC_TAC;
12725   RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
12726   TSPEC `IMAGE (reflAf r) u` 4;
12727   UND 4;
12728   REWRITE_TAC[];
12729   TYPE_THEN `IMAGE (IMAGE (reflAf r)) G (IMAGE (reflAf r) u) = G u` SUBGOAL_TAC;
12730   IMATCH_MP_TAC  image_app;
12731   EXISTS_TAC `edge`;
12732   EXISTS_TAC `edge`;
12733   ASM_REWRITE_TAC[];
12734   ASM_MESON_TAC[ISUBSET];
12735   ASM_MESON_TAC[];
12736   DISCH_TAC;
12737   (*
12738   ASM_MESON_TAC[image_power_inj];
12739   DISCH_TAC;
12740   ASM_REWRITE_TAC[];
12741   ASM_MESON_TAC[ISUBSET];
12742   ASM_MESON_TAC[];
12743   DISCH_TAC;
12744   *)
12745   SUBCONJ_TAC;
12746   REWRITE_TAC[IMAGE2;SUBSET];
12747   GEN_TAC;
12748   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
12749   REWRITE_TAC[];
12750   REP_BASIC_TAC;
12751   ASM_REWRITE_TAC[];
12752   IMATCH_MP_TAC  reflA_edge;
12753   ASM_MESON_TAC[ISUBSET;];
12754   DISCH_TAC;
12755   (* num closure clause *)
12756   CONJ_TAC;
12757   GEN_TAC;
12758   TYPE_THEN `pointI m = reflAf r (pointI (reflAi r m))` SUBGOAL_TAC;
12759   REWRITE_TAC[reflA_pointI;reflAi_inv];
12760   DISCH_THEN_REWRITE;
12761   TYPE_THEN `num_closure (IMAGE2 (reflAf r) G) (reflAf r (pointI (reflAi r m))) = num_closure G (pointI (reflAi r m))` SUBGOAL_TAC;
12762   IMATCH_MP_TAC  (GSYM homeo_num_closure);
12763   ASM_REWRITE_TAC[];
12764   DISCH_THEN_REWRITE;
12765   ASM_MESON_TAC[];
12766   (* inductive_set clause *)
12767   REP_BASIC_TAC;
12768   (* isc *)
12769   USE 16(REWRITE_RULE[IMAGE2]);
12770   USE 16 (MATCH_MP SUBSET_PREIMAGE);
12771   REP_BASIC_TAC;
12772   TSPEC `Z` 0;
12773   TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
12774   ASM_REWRITE_TAC[];
12775   CONJ_TAC;
12776   PROOF_BY_CONTR_TAC;
12777   RULE_ASSUM_TAC (REWRITE_RULE[]);
12778   REWR 16;
12779   RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
12780   ASM_MESON_TAC[];
12781   REP_BASIC_TAC;
12782   TYPE_THEN `D = IMAGE (reflAf r) C` ABBREV_TAC ;
12783   TYPE_THEN `D' = IMAGE (reflAf r) C'` ABBREV_TAC ;
12784   TSPEC `D` 14; (* *)
12785   TSPEC `D'` 14;
12786   TYPE_THEN `S D /\ IMAGE2 (reflAf r) G D' /\ adj D D'` SUBGOAL_TAC;
12787   SUBCONJ_TAC;
12788   ASM_REWRITE_TAC[];
12789   EXPAND_TAC "D";
12790   TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C) = Z C` SUBGOAL_TAC;
12791   IMATCH_MP_TAC  image_app;
12792   TYPE_THEN `edge` EXISTS_TAC;
12793   TYPE_THEN `edge` EXISTS_TAC;
12794   ASM_REWRITE_TAC[];
12795   SUBCONJ_TAC;
12796   IMATCH_MP_TAC  SUBSET_TRANS;
12797   TYPE_THEN `G` EXISTS_TAC;
12798   ASM_REWRITE_TAC[];
12799   REWRITE_TAC[SUBSET];
12800   DISCH_THEN IMATCH_MP_TAC ;
12801   ASM_REWRITE_TAC[];
12802   DISCH_THEN_REWRITE;
12803   ASM_REWRITE_TAC[];
12804   DISCH_TAC;
12805   (* fh1 *)
12806   SUBCONJ_TAC;
12807   EXPAND_TAC "D'";
12808   REWRITE_TAC[IMAGE2;IMAGE];
12809   NAME_CONFLICT_TAC;
12810   TYPE_THEN `C'` EXISTS_TAC;
12811   ASM_REWRITE_TAC[];
12812   DISCH_TAC;
12813   EXPAND_TAC "D";
12814   EXPAND_TAC "D'";
12815   TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
12816   ASM_MESON_TAC[ISUBSET;edge_euclid2];
12817   DISCH_TAC;
12818   TYPE_THEN `(adj C C' ==> adj (IMAGE (reflAf r) C) (IMAGE (reflAf r) C'))` SUBGOAL_TAC;
12819   IMATCH_MP_TAC  homeo_adj;
12820   ASM_REWRITE_TAC[];
12821   DISCH_THEN IMATCH_MP_TAC ;
12822   ASM_REWRITE_TAC[];
12823   DISCH_TAC;
12824   REWR 14;
12825   UND 14;
12826   EXPAND_TAC "D'";
12827   TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C') = Z C'` SUBGOAL_TAC;
12828   IMATCH_MP_TAC  image_app;
12829   TYPE_THEN `edge` EXISTS_TAC;
12830   TYPE_THEN `edge` EXISTS_TAC;
12831   ASM_REWRITE_TAC[];
12832   SUBCONJ_TAC;
12833   IMATCH_MP_TAC  SUBSET_TRANS;
12834   TYPE_THEN `G` EXISTS_TAC;
12835   ASM_REWRITE_TAC[];
12836   DISCH_TAC;
12837   UND 3;
12838   UND 19;
12839   ASM_MESON_TAC[ISUBSET];
12840   MESON_TAC[];
12841   DISCH_TAC;
12842   REWR 0;
12843   ASM_REWRITE_TAC[IMAGE2];
12844   ]);;
12845   (* }}} *)
12846
12847 let reflB_segment = prove_by_refinement(
12848   `!G r. (segment G ==> (segment (IMAGE2 (reflBf r) G)))`,
12849   (* {{{ proof *)
12850   [
12851   REP_BASIC_TAC;
12852   REWRITE_TAC[segment];
12853   COPY 0;
12854   USE 0(REWRITE_RULE[segment]);
12855   REP_BASIC_TAC;
12856   TYPE_THEN `homeomorphism (reflBf r) top2 top2` SUBGOAL_TAC;
12857   REWRITE_TAC[reflB_homeo];
12858   DISCH_TAC;
12859   ASSUME_TAC top2_top;
12860   ASSUME_TAC top2_unions;
12861   TYPE_THEN `BIJ (reflBf r) (euclid 2) (euclid 2)` SUBGOAL_TAC;
12862   ASM_MESON_TAC[homeomorphism];
12863   DISCH_TAC;
12864   TYPE_THEN `INJ (IMAGE (reflBf r)) edge edge` SUBGOAL_TAC;
12865   REWRITE_TAC[INJ;reflB_edge;];
12866   REP_BASIC_TAC;
12867   TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
12868   ASM_MESON_TAC[edge_euclid2];
12869   DISCH_TAC;
12870   ASM_MESON_TAC[image_power_inj];
12871   DISCH_TAC;
12872   (* start cases *)
12873   SUBCONJ_TAC;
12874   REWRITE_TAC[IMAGE2];
12875   IMATCH_MP_TAC  FINITE_IMAGE;
12876   ASM_REWRITE_TAC[];
12877   DISCH_TAC;
12878   SUBCONJ_TAC;
12879   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
12880   REP_BASIC_TAC;
12881   RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
12882   TSPEC `IMAGE (reflBf r) u` 4;
12883   UND 4;
12884   REWRITE_TAC[];
12885   TYPE_THEN `IMAGE (IMAGE (reflBf r)) G (IMAGE (reflBf r) u) = G u` SUBGOAL_TAC;
12886   IMATCH_MP_TAC  image_app;
12887   EXISTS_TAC `edge`;
12888   EXISTS_TAC `edge`;
12889   ASM_REWRITE_TAC[];
12890   ASM_MESON_TAC[ISUBSET];
12891   ASM_MESON_TAC[];
12892   DISCH_TAC;
12893   (*
12894   ASM_MESON_TAC[image_power_inj];
12895   DISCH_TAC;
12896   ASM_REWRITE_TAC[];
12897   ASM_MESON_TAC[ISUBSET];
12898   ASM_MESON_TAC[];
12899   DISCH_TAC;
12900   *)
12901   SUBCONJ_TAC;
12902   REWRITE_TAC[IMAGE2;SUBSET];
12903   GEN_TAC;
12904   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
12905   REWRITE_TAC[];
12906   REP_BASIC_TAC;
12907   ASM_REWRITE_TAC[];
12908   IMATCH_MP_TAC  reflB_edge;
12909   ASM_MESON_TAC[ISUBSET;];
12910   DISCH_TAC;
12911   (* num closure clause *)
12912   CONJ_TAC;
12913   GEN_TAC;
12914   TYPE_THEN `pointI m = reflBf r (pointI (reflBi r m))` SUBGOAL_TAC;
12915   REWRITE_TAC[reflB_pointI;reflBi_inv];
12916   DISCH_THEN_REWRITE;
12917   TYPE_THEN `num_closure (IMAGE2 (reflBf r) G) (reflBf r (pointI (reflBi r m))) = num_closure G (pointI (reflBi r m))` SUBGOAL_TAC;
12918   IMATCH_MP_TAC  (GSYM homeo_num_closure);
12919   ASM_REWRITE_TAC[];
12920   DISCH_THEN_REWRITE;
12921   ASM_MESON_TAC[];
12922   (* inductive_set clause *)
12923   REP_BASIC_TAC;
12924   (* isc *)
12925   USE 16(REWRITE_RULE[IMAGE2]);
12926   USE 16 (MATCH_MP SUBSET_PREIMAGE);
12927   REP_BASIC_TAC;
12928   TSPEC `Z` 0;
12929   TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
12930   ASM_REWRITE_TAC[];
12931   CONJ_TAC;
12932   PROOF_BY_CONTR_TAC;
12933   RULE_ASSUM_TAC (REWRITE_RULE[]);
12934   REWR 16;
12935   RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
12936   ASM_MESON_TAC[];
12937   REP_BASIC_TAC;
12938   TYPE_THEN `D = IMAGE (reflBf r) C` ABBREV_TAC ;
12939   TYPE_THEN `D' = IMAGE (reflBf r) C'` ABBREV_TAC ;
12940   TSPEC `D` 14; (* *)
12941   TSPEC `D'` 14;
12942   TYPE_THEN `S D /\ IMAGE2 (reflBf r) G D' /\ adj D D'` SUBGOAL_TAC;
12943   SUBCONJ_TAC;
12944   ASM_REWRITE_TAC[];
12945   EXPAND_TAC "D";
12946   TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C) = Z C` SUBGOAL_TAC;
12947   IMATCH_MP_TAC  image_app;
12948   TYPE_THEN `edge` EXISTS_TAC;
12949   TYPE_THEN `edge` EXISTS_TAC;
12950   ASM_REWRITE_TAC[];
12951   SUBCONJ_TAC;
12952   IMATCH_MP_TAC  SUBSET_TRANS;
12953   TYPE_THEN `G` EXISTS_TAC;
12954   ASM_REWRITE_TAC[];
12955   REWRITE_TAC[SUBSET];
12956   DISCH_THEN IMATCH_MP_TAC ;
12957   ASM_REWRITE_TAC[];
12958   DISCH_THEN_REWRITE;
12959   ASM_REWRITE_TAC[];
12960   DISCH_TAC;
12961   (* fh1 *)
12962   SUBCONJ_TAC;
12963   EXPAND_TAC "D'";
12964   REWRITE_TAC[IMAGE2;IMAGE];
12965   NAME_CONFLICT_TAC;
12966   TYPE_THEN `C'` EXISTS_TAC;
12967   ASM_REWRITE_TAC[];
12968   DISCH_TAC;
12969   EXPAND_TAC "D";
12970   EXPAND_TAC "D'";
12971   TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
12972   ASM_MESON_TAC[ISUBSET;edge_euclid2];
12973   DISCH_TAC;
12974   TYPE_THEN `(adj C C' ==> adj (IMAGE (reflBf r) C) (IMAGE (reflBf r) C'))` SUBGOAL_TAC;
12975   IMATCH_MP_TAC  homeo_adj;
12976   ASM_REWRITE_TAC[];
12977   DISCH_THEN IMATCH_MP_TAC ;
12978   ASM_REWRITE_TAC[];
12979   DISCH_TAC;
12980   REWR 14;
12981   UND 14;
12982   EXPAND_TAC "D'";
12983   TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C') = Z C'` SUBGOAL_TAC;
12984   IMATCH_MP_TAC  image_app;
12985   TYPE_THEN `edge` EXISTS_TAC;
12986   TYPE_THEN `edge` EXISTS_TAC;
12987   ASM_REWRITE_TAC[];
12988   SUBCONJ_TAC;
12989   IMATCH_MP_TAC  SUBSET_TRANS;
12990   TYPE_THEN `G` EXISTS_TAC;
12991   ASM_REWRITE_TAC[];
12992   DISCH_TAC;
12993   UND 3;
12994   UND 19;
12995   ASM_MESON_TAC[ISUBSET];
12996   MESON_TAC[];
12997   DISCH_TAC;
12998   REWR 0;
12999   ASM_REWRITE_TAC[IMAGE2];
13000   ]);;
13001   (* }}} *)
13002
13003 let reflC_segment = prove_by_refinement(
13004   `!G . (segment G ==> (segment (IMAGE2 (reflCf) G)))`,
13005   (* {{{ proof *)
13006
13007   [
13008   REP_BASIC_TAC;
13009   REWRITE_TAC[segment];
13010   COPY 0;
13011   USE 0(REWRITE_RULE[segment]);
13012   REP_BASIC_TAC;
13013   TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC;
13014   REWRITE_TAC[reflC_homeo];
13015   DISCH_TAC;
13016   ASSUME_TAC top2_top;
13017   ASSUME_TAC top2_unions;
13018   TYPE_THEN `BIJ (reflCf) (euclid 2) (euclid 2)` SUBGOAL_TAC;
13019   ASM_MESON_TAC[homeomorphism];
13020   DISCH_TAC;
13021   TYPE_THEN `INJ (IMAGE (reflCf)) edge edge` SUBGOAL_TAC;
13022   REWRITE_TAC[INJ;reflC_edge;];
13023   REP_BASIC_TAC;
13024   TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
13025   ASM_MESON_TAC[edge_euclid2];
13026   DISCH_TAC;
13027   ASM_MESON_TAC[image_power_inj];
13028   DISCH_TAC;
13029   (* start cases *)
13030   SUBCONJ_TAC;
13031   REWRITE_TAC[IMAGE2];
13032   IMATCH_MP_TAC  FINITE_IMAGE;
13033   ASM_REWRITE_TAC[];
13034   DISCH_TAC;
13035   SUBCONJ_TAC;
13036   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
13037   REP_BASIC_TAC;
13038   RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
13039   TSPEC `IMAGE (reflCf) u` 4;
13040   UND 4;
13041   REWRITE_TAC[];
13042   TYPE_THEN `IMAGE (IMAGE (reflCf)) G (IMAGE (reflCf) u) = G u` SUBGOAL_TAC;
13043   IMATCH_MP_TAC  image_app;
13044   EXISTS_TAC `edge`;
13045   EXISTS_TAC `edge`;
13046   ASM_REWRITE_TAC[];
13047   ASM_MESON_TAC[ISUBSET];
13048   ASM_MESON_TAC[];
13049   DISCH_TAC;
13050   (*
13051   ASM_MESON_TAC[image_power_inj];
13052   DISCH_TAC;
13053   ASM_REWRITE_TAC[];
13054   ASM_MESON_TAC[ISUBSET];
13055   ASM_MESON_TAC[];
13056   DISCH_TAC;
13057   *)
13058   SUBCONJ_TAC;
13059   REWRITE_TAC[IMAGE2;SUBSET];
13060   GEN_TAC;
13061   GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
13062   REWRITE_TAC[];
13063   REP_BASIC_TAC;
13064   ASM_REWRITE_TAC[];
13065   IMATCH_MP_TAC  reflC_edge;
13066   ASM_MESON_TAC[ISUBSET;];
13067   DISCH_TAC;
13068   (* num closure clause *)
13069   CONJ_TAC;
13070   GEN_TAC;
13071   TYPE_THEN `pointI m = reflCf (pointI (reflCi m))` SUBGOAL_TAC;
13072   REWRITE_TAC[reflC_pointI;reflCi_inv];
13073   DISCH_THEN_REWRITE;
13074   TYPE_THEN `num_closure (IMAGE2 (reflCf) G) (reflCf (pointI (reflCi m))) = num_closure G (pointI (reflCi m))` SUBGOAL_TAC;
13075   IMATCH_MP_TAC  (GSYM homeo_num_closure);
13076   ASM_REWRITE_TAC[];
13077   DISCH_THEN_REWRITE;
13078   ASM_MESON_TAC[];
13079   (* inductive_set clause *)
13080   REP_BASIC_TAC;
13081   (* isc *)
13082   USE 16(REWRITE_RULE[IMAGE2]);
13083   USE 16 (MATCH_MP SUBSET_PREIMAGE);
13084   REP_BASIC_TAC;
13085   TSPEC `Z` 0;
13086   TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
13087   ASM_REWRITE_TAC[];
13088   CONJ_TAC;
13089   PROOF_BY_CONTR_TAC;
13090   RULE_ASSUM_TAC (REWRITE_RULE[]);
13091   REWR 16;
13092   RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
13093   ASM_MESON_TAC[];
13094   REP_BASIC_TAC;
13095   TYPE_THEN `D = IMAGE (reflCf) C` ABBREV_TAC ;
13096   TYPE_THEN `D' = IMAGE (reflCf) C'` ABBREV_TAC ;
13097   TSPEC `D` 14; (* *)
13098   TSPEC `D'` 14;
13099   TYPE_THEN `S D /\ IMAGE2 (reflCf) G D' /\ adj D D'` SUBGOAL_TAC;
13100   SUBCONJ_TAC;
13101   ASM_REWRITE_TAC[];
13102   EXPAND_TAC "D";
13103   TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C) = Z C` SUBGOAL_TAC;
13104   IMATCH_MP_TAC  image_app;
13105   TYPE_THEN `edge` EXISTS_TAC;
13106   TYPE_THEN `edge` EXISTS_TAC;
13107   ASM_REWRITE_TAC[];
13108   SUBCONJ_TAC;
13109   IMATCH_MP_TAC  SUBSET_TRANS;
13110   TYPE_THEN `G` EXISTS_TAC;
13111   ASM_REWRITE_TAC[];
13112   REWRITE_TAC[SUBSET];
13113   DISCH_THEN IMATCH_MP_TAC ;
13114   ASM_REWRITE_TAC[];
13115   DISCH_THEN_REWRITE;
13116   ASM_REWRITE_TAC[];
13117   DISCH_TAC;
13118   (* fh1 *)
13119   SUBCONJ_TAC;
13120   EXPAND_TAC "D'";
13121   REWRITE_TAC[IMAGE2;IMAGE];
13122   NAME_CONFLICT_TAC;
13123   TYPE_THEN `C'` EXISTS_TAC;
13124   ASM_REWRITE_TAC[];
13125   DISCH_TAC;
13126   EXPAND_TAC "D";
13127   EXPAND_TAC "D'";
13128   TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
13129   ASM_MESON_TAC[ISUBSET;edge_euclid2];
13130   DISCH_TAC;
13131   TYPE_THEN `(adj C C' ==> adj (IMAGE (reflCf) C) (IMAGE (reflCf) C'))` SUBGOAL_TAC;
13132   IMATCH_MP_TAC  homeo_adj;
13133   ASM_REWRITE_TAC[];
13134   DISCH_THEN IMATCH_MP_TAC ;
13135   ASM_REWRITE_TAC[];
13136   DISCH_TAC;
13137   REWR 14;
13138   UND 14;
13139   EXPAND_TAC "D'";
13140   TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C') = Z C'` SUBGOAL_TAC;
13141   IMATCH_MP_TAC  image_app;
13142   TYPE_THEN `edge` EXISTS_TAC;
13143   TYPE_THEN `edge` EXISTS_TAC;
13144   ASM_REWRITE_TAC[];
13145   SUBCONJ_TAC;
13146   IMATCH_MP_TAC  SUBSET_TRANS;
13147   TYPE_THEN `G` EXISTS_TAC;
13148   ASM_REWRITE_TAC[];
13149   DISCH_TAC;
13150   UND 3;
13151   UND 19;
13152   ASM_MESON_TAC[ISUBSET];
13153   MESON_TAC[];
13154   DISCH_TAC;
13155   REWR 0;
13156   ASM_REWRITE_TAC[IMAGE2];
13157   ]);;
13158
13159   (* }}} *)
13160
13161 let point_x = prove_by_refinement(
13162   `!x m. (x = point m) <=> (euclid 2 x /\ (FST m = x 0) /\ (SND m = x 1))`,
13163   (* {{{ proof *)
13164   [
13165   REP_BASIC_TAC;
13166   EQ_TAC ;
13167   DISCH_THEN_REWRITE;
13168   REWRITE_TAC[coord01;euclid_point];
13169   REP_BASIC_TAC;
13170   USE 2 (MATCH_MP   point_onto );
13171   REP_BASIC_TAC;
13172   ASM_REWRITE_TAC[point_inj];
13173   REWRITE_TAC[PAIR_SPLIT];
13174   ASM_REWRITE_TAC[coord01];
13175   ]);;
13176   (* }}} *)
13177
13178 (* next IMAGE of square *)
13179
13180 let reflA_squ = prove_by_refinement(
13181   `!m r.  IMAGE (reflAf r) (squ m) = squ (left  (reflAi r m))`,
13182   (* {{{ proof *)
13183   [
13184   REWRITE_TAC[squ;reflAf;reflAi;IMAGE ;left  ;];
13185   DISCH_ALL_TAC;
13186   IMATCH_MP_TAC  EQ_EXT;
13187   REWRITE_TAC[];
13188   DISCH_ALL_TAC;
13189   CONV_TAC (dropq_conv "x'");
13190   REWRITE_TAC[coord01;];
13191   REWRITE_TAC[point_x];
13192   CONV_TAC (dropq_conv "v");
13193   EQ_TAC ;
13194   REP_BASIC_TAC;
13195   TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
13196   ASM_REWRITE_TAC[];
13197   UND 4;
13198   UND 5;
13199   USE 0 (GSYM );
13200   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
13201   REAL_ARITH_TAC;
13202   (* 2 *)
13203   REP_BASIC_TAC;
13204   TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
13205   ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
13206   UND 2;
13207   UND 3;
13208   USE 4 (GSYM);
13209   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
13210   REAL_ARITH_TAC;
13211   ]);;
13212   (* }}} *)
13213
13214 let reflB_squ = prove_by_refinement(
13215   `!m r.  IMAGE (reflBf r) (squ m) = squ (down  (reflBi r m))`,
13216   (* {{{ proof *)
13217   [
13218   REWRITE_TAC[squ;reflBf;reflBi;IMAGE ;down  ;];
13219   DISCH_ALL_TAC;
13220   IMATCH_MP_TAC  EQ_EXT;
13221   REWRITE_TAC[];
13222   DISCH_ALL_TAC;
13223   CONV_TAC (dropq_conv "x'");
13224   REWRITE_TAC[coord01;];
13225   REWRITE_TAC[point_x];
13226   CONV_TAC (dropq_conv "u");
13227   EQ_TAC ;
13228   REP_BASIC_TAC;
13229   TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
13230   ASM_REWRITE_TAC[];
13231   UND 2;
13232   UND 3;
13233   USE 0 (GSYM );
13234   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
13235   REAL_ARITH_TAC;
13236   (* 2 *)
13237   REP_BASIC_TAC;
13238   TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
13239   ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
13240   UND 0;
13241   UND 1;
13242   USE 4 (GSYM);
13243   ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
13244   REAL_ARITH_TAC;
13245   ]);;
13246   (* }}} *)
13247
13248 let reflC_squ = prove_by_refinement(
13249   `!m.  IMAGE (reflCf) (squ m) = squ (  (reflCi m))`,
13250   (* {{{ proof *)
13251   [
13252   REWRITE_TAC[squ;reflCf;reflCi;IMAGE ; ];
13253   DISCH_ALL_TAC;
13254   IMATCH_MP_TAC EQ_EXT;
13255   REWRITE_TAC[];
13256   DISCH_ALL_TAC;
13257   CONV_TAC (dropq_conv "x'");
13258   REWRITE_TAC[coord01;];
13259   REWRITE_TAC[point_x];
13260   CONV_TAC (dropq_conv "u");
13261   CONV_TAC (dropq_conv "v");
13262   MESON_TAC[];
13263   ]);;
13264   (* }}} *)
13265
13266 (* move to sets *)
13267 let powerset = jordan_def `powerset (X:A->bool) = { z | z SUBSET X }`;;
13268
13269 let image_sing = prove_by_refinement(
13270   `!(f:A -> B) x. (IMAGE f {x} = {(f x)})`,
13271   (* {{{ proof *)
13272   [
13273   REWRITE_TAC[IMAGE;INSERT];
13274   CONV_TAC (dropq_conv "x'");
13275   ]);;
13276   (* }}} *)
13277
13278 let image_unions = prove_by_refinement(
13279   `!(f:A->B)  U.
13280      (IMAGE f (UNIONS U) = UNIONS (IMAGE (IMAGE f) U))`,
13281   (* {{{ proof *)
13282   [
13283   DISCH_ALL_TAC;
13284   REWRITE_TAC[IMAGE;UNIONS;];
13285   IMATCH_MP_TAC  EQ_EXT;
13286   GEN_TAC;
13287   REWRITE_TAC[];
13288   EQ_TAC;
13289   REP_BASIC_TAC;
13290   CONV_TAC (dropq_conv "u");
13291   ASM_REWRITE_TAC[];
13292   NAME_CONFLICT_TAC;
13293   ASM_MESON_TAC[];
13294   REP_BASIC_TAC;
13295   NAME_CONFLICT_TAC;
13296   REWR 0;
13297   KILL 1;
13298   ASM_MESON_TAC[];
13299   ]);;
13300   (* }}} *)
13301
13302 (* move *)
13303 let segment_euclid = prove_by_refinement(
13304   `!G. (segment G) ==> (closure top2 (UNIONS G) SUBSET euclid 2)`,
13305   (* {{{ proof *)
13306   [
13307   REP_BASIC_TAC;
13308   IMATCH_MP_TAC  closure_subset;
13309   ASM_REWRITE_TAC[top2_top;GSYM top2_unions];
13310   CONJ_TAC;
13311   IMATCH_MP_TAC  closed_UNIV;
13312   REWRITE_TAC[top2_top];
13313   REWRITE_TAC[top2_unions;SUBSET;UNIONS;];
13314   REP_BASIC_TAC;
13315   TYPE_THEN `edge u` SUBGOAL_TAC;
13316   ASM_MESON_TAC[segment;ISUBSET];
13317   ASM_MESON_TAC[edge_euclid2;ISUBSET];
13318   ]);;
13319   (* }}} *)
13320
13321 let image_curve_cell_reflA  = prove_by_refinement(
13322   `!G r. (segment G) ==>
13323     (curve_cell (IMAGE2 (reflAf r) G) =
13324            IMAGE2 (reflAf r) (curve_cell G))`,
13325   (* {{{ proof *)
13326   [
13327   REP_BASIC_TAC;
13328   REWRITE_TAC[curve_cell];
13329   REWRITE_TAC[IMAGE2;IMAGE_UNION;];
13330   AP_TERM_TAC;
13331   IMATCH_MP_TAC  EQ_EXT;
13332   REP_BASIC_TAC;
13333   REWRITE_TAC[];
13334   TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
13335   REWRITE_TAC[SUBSET;UNIONS;];
13336   REP_BASIC_TAC;
13337   TYPE_THEN `edge u` SUBGOAL_TAC;
13338   ASM_MESON_TAC[segment;ISUBSET;];
13339   ASM_MESON_TAC[edge_euclid2;ISUBSET];
13340   DISCH_TAC;
13341   ASSUME_TAC top2_top;
13342   ASSUME_TAC top2_unions;
13343   (*  *)
13344   TYPE_THEN `UNIONS (IMAGE (IMAGE (reflAf r)) G) = IMAGE (reflAf r) (UNIONS G)` SUBGOAL_TAC;
13345   REWRITE_TAC[GSYM image_unions];
13346   DISCH_THEN_REWRITE ;
13347   (*  *)
13348   TYPE_THEN `closure top2 (IMAGE (reflAf r) (UNIONS G)) = IMAGE (reflAf r) (closure top2 (UNIONS G))` SUBGOAL_TAC;
13349   IMATCH_MP_TAC  (GSYM homeo_closure);
13350   ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;];
13351   DISCH_THEN_REWRITE;
13352   (*  *)
13353   TYPE_THEN `!n. IMAGE (reflAf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflAi r n))` SUBGOAL_TAC;
13354   REP_BASIC_TAC;
13355   TYPE_THEN  `n' = reflAi r n` ABBREV_TAC ;
13356   TYPE_THEN `pointI n = reflAf r (pointI n')` SUBGOAL_TAC;
13357   EXPAND_TAC "n'";
13358   KILL 4;
13359   ASM_REWRITE_TAC[reflA_pointI;reflAi_inv];
13360   DISCH_THEN_REWRITE;
13361   IMATCH_MP_TAC  image_app;
13362   TYPE_THEN `(euclid 2)` EXISTS_TAC;
13363  TYPE_THEN `(euclid 2)` EXISTS_TAC;
13364   REWRITE_TAC[pointI;euclid_point];
13365   ASSUME_TAC reflA_homeo;
13366   RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
13367   ASM_REWRITE_TAC[];
13368   IMATCH_MP_TAC  segment_euclid;
13369   ASM_REWRITE_TAC[];
13370   DISCH_THEN_REWRITE;
13371   (*  *)
13372   REWRITE_TAC[IMAGE;];
13373   CONV_TAC (dropq_conv "x'");
13374 (**** Modified by JRH to avoid GSPEC
13375   REWRITE_TAC[INR IN_SING;GSPEC;];
13376  ****)
13377   REWRITE_TAC[INR IN_SING; UNWIND_THM2];
13378   NAME_CONFLICT_TAC;
13379   CONV_TAC (dropq_conv "x'");
13380   CONV_TAC (dropq_conv "y'");
13381 (**** Removed by JRH
13382   REWRITE_TAC[GSPEC];
13383  ****)
13384   (*  *)
13385   EQ_TAC ;
13386   REP_BASIC_TAC;
13387   TYPE_THEN `reflAi r n'` EXISTS_TAC;
13388   ASM_REWRITE_TAC[];
13389   IMATCH_MP_TAC  EQ_EXT;
13390   REWRITE_TAC[INR IN_SING; reflA_pointI; reflAi_inv;];
13391 (*** Removed by JRH
13392   MESON_TAC[];
13393  ****)
13394   (*   *)
13395   REP_BASIC_TAC;
13396   TYPE_THEN `reflAi r n'` EXISTS_TAC;
13397   ASM_REWRITE_TAC[reflAi_inv;];
13398   IMATCH_MP_TAC  EQ_EXT;
13399   REWRITE_TAC[INR IN_SING;reflA_pointI;];
13400 (*** Removed by JRH
13401   MESON_TAC[];
13402  ****)
13403   ]);;
13404   (* }}} *)
13405
13406 let image_curve_cell_reflB  = prove_by_refinement(
13407   `!G r. (segment G) ==>
13408     (curve_cell (IMAGE2 (reflBf r) G) =
13409            IMAGE2 (reflBf r) (curve_cell G))`,
13410   (* {{{ proof *)
13411   [
13412   REP_BASIC_TAC;
13413   REWRITE_TAC[curve_cell];
13414   REWRITE_TAC[IMAGE2;IMAGE_UNION;];
13415   AP_TERM_TAC;
13416   IMATCH_MP_TAC  EQ_EXT;
13417   REP_BASIC_TAC;
13418   REWRITE_TAC[];
13419   TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
13420   REWRITE_TAC[SUBSET;UNIONS;];
13421   REP_BASIC_TAC;
13422   TYPE_THEN `edge u` SUBGOAL_TAC;
13423   ASM_MESON_TAC[segment;ISUBSET;];
13424   ASM_MESON_TAC[edge_euclid2;ISUBSET];
13425   DISCH_TAC;
13426   ASSUME_TAC top2_top;
13427   ASSUME_TAC top2_unions;
13428   (*  *)
13429   TYPE_THEN `UNIONS (IMAGE (IMAGE (reflBf r)) G) = IMAGE (reflBf r) (UNIONS G)` SUBGOAL_TAC;
13430   REWRITE_TAC[GSYM image_unions];
13431   DISCH_THEN_REWRITE ;
13432   (*  *)
13433   TYPE_THEN `closure top2 (IMAGE (reflBf r) (UNIONS G)) = IMAGE (reflBf r) (closure top2 (UNIONS G))` SUBGOAL_TAC;
13434   IMATCH_MP_TAC  (GSYM homeo_closure);
13435   ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;];
13436   DISCH_THEN_REWRITE;
13437   (*  *)
13438   TYPE_THEN `!n. IMAGE (reflBf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflBi r n))` SUBGOAL_TAC;
13439   REP_BASIC_TAC;
13440   TYPE_THEN  `n' = reflBi r n` ABBREV_TAC ;
13441   TYPE_THEN `pointI n = reflBf r (pointI n')` SUBGOAL_TAC;
13442   EXPAND_TAC "n'";
13443   KILL 4;
13444   ASM_REWRITE_TAC[reflB_pointI;reflBi_inv];
13445   DISCH_THEN_REWRITE;
13446   IMATCH_MP_TAC  image_app;
13447   TYPE_THEN `(euclid 2)` EXISTS_TAC;
13448  TYPE_THEN `(euclid 2)` EXISTS_TAC;
13449   REWRITE_TAC[pointI;euclid_point];
13450   ASSUME_TAC reflB_homeo;
13451   RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
13452   ASM_REWRITE_TAC[];
13453   IMATCH_MP_TAC  segment_euclid;
13454   ASM_REWRITE_TAC[];
13455   DISCH_THEN_REWRITE;
13456   (*  *)
13457   REWRITE_TAC[IMAGE;];
13458   CONV_TAC (dropq_conv "x'");
13459
13460 (*** JRH changed this line to avoid GSPEC
13461   REWRITE_TAC[INR IN_SING;GSPEC;];
13462  ***)
13463   REWRITE_TAC[INR IN_SING; UNWIND_THM2];
13464   NAME_CONFLICT_TAC;
13465   CONV_TAC (dropq_conv "x'");
13466   CONV_TAC (dropq_conv "y'");
13467 (*** JRH removed this to avoid GSPEC
13468   REWRITE_TAC[GSPEC];
13469  ***)
13470   (*  *)
13471   EQ_TAC ;
13472   REP_BASIC_TAC;
13473   TYPE_THEN `reflBi r n'` EXISTS_TAC;
13474   ASM_REWRITE_TAC[];
13475   IMATCH_MP_TAC  EQ_EXT;
13476   REWRITE_TAC[INR IN_SING; reflB_pointI; reflBi_inv;];
13477 (*** Removed by JRH
13478   MESON_TAC[];
13479  ****)
13480   (*   *)
13481   REP_BASIC_TAC;
13482   TYPE_THEN `reflBi r n'` EXISTS_TAC;
13483   ASM_REWRITE_TAC[reflBi_inv;];
13484   IMATCH_MP_TAC  EQ_EXT;
13485   REWRITE_TAC[INR IN_SING;reflB_pointI;];
13486 (*** Removed by JRH
13487   MESON_TAC[];
13488  ****)
13489   ]);;
13490   (* }}} *)
13491
13492 let image_curve_cell_reflC  = prove_by_refinement(
13493   `!G . (segment G) ==>
13494     (curve_cell (IMAGE2 (reflCf ) G) =
13495            IMAGE2 (reflCf) (curve_cell G))`,
13496   (* {{{ proof *)
13497   [
13498   REP_BASIC_TAC;
13499   REWRITE_TAC[curve_cell];
13500   REWRITE_TAC[IMAGE2;IMAGE_UNION;];
13501   AP_TERM_TAC;
13502   IMATCH_MP_TAC  EQ_EXT;
13503   REP_BASIC_TAC;
13504   REWRITE_TAC[];
13505   TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
13506   REWRITE_TAC[SUBSET;UNIONS;];
13507   REP_BASIC_TAC;
13508   TYPE_THEN `edge u` SUBGOAL_TAC;
13509   ASM_MESON_TAC[segment;ISUBSET;];
13510   ASM_MESON_TAC[edge_euclid2;ISUBSET];
13511   DISCH_TAC;
13512   ASSUME_TAC top2_top;
13513   ASSUME_TAC top2_unions;
13514   (*  *)
13515   TYPE_THEN `UNIONS (IMAGE (IMAGE (reflCf)) G) = IMAGE (reflCf) (UNIONS G)` SUBGOAL_TAC;
13516   REWRITE_TAC[GSYM image_unions];
13517   DISCH_THEN_REWRITE ;
13518   (*  *)
13519   TYPE_THEN `closure top2 (IMAGE (reflCf) (UNIONS G)) = IMAGE (reflCf) (closure top2 (UNIONS G))` SUBGOAL_TAC;
13520   IMATCH_MP_TAC  (GSYM homeo_closure);
13521   ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;];
13522   DISCH_THEN_REWRITE;
13523   (*  *)
13524   TYPE_THEN `!n. IMAGE (reflCf) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflCi n))` SUBGOAL_TAC;
13525   REP_BASIC_TAC;
13526   TYPE_THEN  `n' = reflCi n` ABBREV_TAC ;
13527   TYPE_THEN `pointI n = reflCf (pointI n')` SUBGOAL_TAC;
13528   EXPAND_TAC "n'";
13529   KILL 4;
13530   ASM_REWRITE_TAC[reflC_pointI;reflCi_inv];
13531   DISCH_THEN_REWRITE;
13532   IMATCH_MP_TAC  image_app;
13533   TYPE_THEN `(euclid 2)` EXISTS_TAC;
13534  TYPE_THEN `(euclid 2)` EXISTS_TAC;
13535   REWRITE_TAC[pointI;euclid_point];
13536   ASSUME_TAC reflC_homeo;
13537   RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
13538   ASM_REWRITE_TAC[];
13539   IMATCH_MP_TAC  segment_euclid;
13540   ASM_REWRITE_TAC[];
13541   DISCH_THEN_REWRITE;
13542   (*  *)
13543   REWRITE_TAC[IMAGE;];
13544   CONV_TAC (dropq_conv "x'");
13545 (*** This line changed by JRH to avoid GSPEC
13546   REWRITE_TAC[INR IN_SING;GSPEC;];
13547  ***)
13548   REWRITE_TAC[INR IN_SING; UNWIND_THM2];
13549   NAME_CONFLICT_TAC;
13550   CONV_TAC (dropq_conv "x'");
13551   CONV_TAC (dropq_conv "y'");
13552  (*** Removed by JRH to avoid GSPEC
13553   REWRITE_TAC[GSPEC];
13554  ***)
13555   (*  *)
13556   EQ_TAC ;
13557   REP_BASIC_TAC;
13558   TYPE_THEN `reflCi n'` EXISTS_TAC;
13559   ASM_REWRITE_TAC[];
13560   IMATCH_MP_TAC  EQ_EXT;
13561   REWRITE_TAC[INR IN_SING; reflC_pointI; reflCi_inv;];
13562 (*** Removed by JRH
13563   MESON_TAC[];
13564  ****)
13565   (*   *)
13566   REP_BASIC_TAC;
13567   TYPE_THEN `reflCi n'` EXISTS_TAC;
13568   ASM_REWRITE_TAC[reflCi_inv;];
13569   IMATCH_MP_TAC  EQ_EXT;
13570   REWRITE_TAC[INR IN_SING;reflC_pointI;];
13571 (*** Removed by JRH
13572   MESON_TAC[];
13573  ****)
13574   ]);;
13575   (* }}} *)
13576
13577 let inj_inter = prove_by_refinement(
13578   `!(f:A->B) X Y A B. (INJ f X Y) /\ (A SUBSET X) /\ (B SUBSET X) ==>
13579      (IMAGE f (A INTER B) = (IMAGE f A) INTER (IMAGE f B))`,
13580   (* {{{ proof *)
13581   [
13582   REP_BASIC_TAC;
13583   REWRITE_TAC[IMAGE;INTER ];
13584   IMATCH_MP_TAC  EQ_EXT;
13585   GEN_TAC;
13586   REWRITE_TAC[];
13587   NAME_CONFLICT_TAC;
13588   EQ_TAC;
13589   REP_BASIC_TAC;
13590   ASM_MESON_TAC[ISUBSET;];
13591   REP_BASIC_TAC;
13592   TYPE_THEN `x' = x''` SUBGOAL_TAC;
13593   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
13594   REP_BASIC_TAC;
13595   FIRST_ASSUM IMATCH_MP_TAC ;
13596   ASM_MESON_TAC[ISUBSET;];
13597   REP_BASIC_TAC;
13598   TYPE_THEN `x'` EXISTS_TAC;
13599   ASM_MESON_TAC[];
13600   ]);;
13601   (* }}} *)
13602
13603 let homeomorphism_induced_top = prove_by_refinement(
13604   `!(f:A->B) U V A.  (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) ==>
13605       (IMAGE2 f (induced_top U A) = induced_top V (IMAGE f A))`,
13606   (* {{{ proof *)
13607   [
13608   REP_BASIC_TAC;
13609   REWRITE_TAC[induced_top;];
13610   COPY 1;
13611   USE 1 (MATCH_MP homeo_bij);
13612   IMATCH_MP_TAC  EQ_EXT;
13613   GEN_TAC;
13614   REWRITE_TAC[IMAGE2];
13615   TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
13616   REWRITE_TAC[IMAGE];
13617   NAME_CONFLICT_TAC;
13618   CONV_TAC (dropq_conv "x''");
13619   (*  *)
13620   TYPE_THEN `!t. U t ==> (g (t INTER A)  = g t INTER g A)` SUBGOAL_TAC;
13621   REP_BASIC_TAC;
13622   EXPAND_TAC "g";
13623   IMATCH_MP_TAC  inj_inter;
13624   TYPE_THEN `(UNIONS U)` EXISTS_TAC;
13625   TYPE_THEN `(UNIONS V)` EXISTS_TAC;
13626   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]);
13627   ASM_REWRITE_TAC[];
13628   IMATCH_MP_TAC  sub_union;
13629   ASM_REWRITE_TAC[];
13630   DISCH_TAC;
13631   (*   *)
13632   EQ_TAC;
13633   REP_BASIC_TAC;
13634   TSPEC `x'` 4;
13635   REWR 4;
13636   ASM_REWRITE_TAC[];
13637   NAME_CONFLICT_TAC;
13638   TYPE_THEN `g x'` EXISTS_TAC;
13639   ASM_REWRITE_TAC[];
13640   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
13641   REP_BASIC_TAC;
13642   ASM_MESON_TAC[];
13643   (*  *)
13644   REP_BASIC_TAC;
13645   TYPE_THEN `?t. U t /\ (g t = x')` SUBGOAL_TAC;
13646   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
13647   REP_BASIC_TAC;
13648   ASM_MESON_TAC[];
13649   REP_BASIC_TAC;
13650   TYPE_THEN `t` EXISTS_TAC;
13651   ASM_REWRITE_TAC[];
13652   TSPEC `t` 4;
13653   REWR 4;
13654   ASM_REWRITE_TAC[];
13655   ]);;
13656   (* }}} *)
13657
13658 let ctop_reflA = prove_by_refinement(
13659   `!G r. (segment G) ==>
13660       (IMAGE2 (reflAf r) (ctop G) = ctop (IMAGE2 (reflAf r) G))`,
13661   (* {{{ proof *)
13662   [
13663   REP_BASIC_TAC;
13664   REWRITE_TAC[ctop];
13665   ASSUME_TAC reflA_homeo;
13666   TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
13667   REWRITE_TAC[top2_unions;DIFF;SUBSET;];
13668   MESON_TAC[];
13669   DISCH_TAC ;
13670   (*   *)
13671   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;
13672   IMATCH_MP_TAC  homeomorphism_induced_top;
13673   ASM_MESON_TAC[];
13674   DISCH_THEN_REWRITE;
13675   AP_TERM_TAC;
13676   TSPEC `r` 1;
13677   (*  *)
13678   TYPE_THEN `IMAGE (reflAf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflAf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
13679   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
13680   REP_BASIC_TAC;
13681   USE 4 (MATCH_MP DIFF_SURJ);
13682   FIRST_ASSUM IMATCH_MP_TAC ;
13683   REWRITE_TAC[UNIONS;SUBSET;];
13684   REP_BASIC_TAC;
13685   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
13686   ASM_MESON_TAC[segment];
13687   DISCH_TAC;
13688   TYPE_THEN `cell u` SUBGOAL_TAC;
13689   USE 7 (MATCH_MP curve_cell_cell);
13690   ASM_MESON_TAC[ISUBSET;];
13691   ASM_MESON_TAC[ISUBSET;cell_euclid];
13692   DISCH_THEN_REWRITE;
13693   AP_TERM_TAC;
13694   REWRITE_TAC[image_unions];
13695   AP_TERM_TAC;
13696   ASM_SIMP_TAC[image_curve_cell_reflA];
13697   REWRITE_TAC[IMAGE2];
13698   ]);;
13699   (* }}} *)
13700
13701 let ctop_reflB = prove_by_refinement(
13702   `!G r. (segment G) ==>
13703       (IMAGE2 (reflBf r) (ctop G) = ctop (IMAGE2 (reflBf r) G))`,
13704   (* {{{ proof *)
13705   [
13706   REP_BASIC_TAC;
13707   REWRITE_TAC[ctop];
13708   ASSUME_TAC reflB_homeo;
13709   TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
13710   REWRITE_TAC[top2_unions;DIFF;SUBSET;];
13711   MESON_TAC[];
13712   DISCH_TAC ;
13713   (*   *)
13714   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;
13715   IMATCH_MP_TAC  homeomorphism_induced_top;
13716   ASM_MESON_TAC[];
13717   DISCH_THEN_REWRITE;
13718   AP_TERM_TAC;
13719   TSPEC `r` 1;
13720   (*  *)
13721   TYPE_THEN `IMAGE (reflBf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflBf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
13722   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
13723   REP_BASIC_TAC;
13724   USE 4 (MATCH_MP DIFF_SURJ);
13725   FIRST_ASSUM IMATCH_MP_TAC ;
13726   REWRITE_TAC[UNIONS;SUBSET;];
13727   REP_BASIC_TAC;
13728   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
13729   ASM_MESON_TAC[segment];
13730   DISCH_TAC;
13731   TYPE_THEN `cell u` SUBGOAL_TAC;
13732   USE 7 (MATCH_MP curve_cell_cell);
13733   ASM_MESON_TAC[ISUBSET;];
13734   ASM_MESON_TAC[ISUBSET;cell_euclid];
13735   DISCH_THEN_REWRITE;
13736   AP_TERM_TAC;
13737   REWRITE_TAC[image_unions];
13738   AP_TERM_TAC;
13739   ASM_SIMP_TAC[image_curve_cell_reflB];
13740   REWRITE_TAC[IMAGE2];
13741   ]);;
13742   (* }}} *)
13743
13744 let ctop_reflC = prove_by_refinement(
13745   `!G . (segment G) ==>
13746       (IMAGE2 (reflCf) (ctop G) = ctop (IMAGE2 (reflCf) G))`,
13747   (* {{{ proof *)
13748   [
13749   REP_BASIC_TAC;
13750   REWRITE_TAC[ctop];
13751   ASSUME_TAC reflC_homeo;
13752   TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
13753   REWRITE_TAC[top2_unions;DIFF;SUBSET;];
13754   MESON_TAC[];
13755   DISCH_TAC ;
13756   (*   *)
13757   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;
13758   IMATCH_MP_TAC  homeomorphism_induced_top;
13759   ASM_MESON_TAC[];
13760   DISCH_THEN_REWRITE;
13761   AP_TERM_TAC;
13762   (*  *)
13763   TYPE_THEN `IMAGE (reflCf) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflCf) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
13764   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
13765   REP_BASIC_TAC;
13766   USE 4 (MATCH_MP DIFF_SURJ);
13767   FIRST_ASSUM IMATCH_MP_TAC ;
13768   REWRITE_TAC[UNIONS;SUBSET;];
13769   REP_BASIC_TAC;
13770   TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
13771   ASM_MESON_TAC[segment];
13772   DISCH_TAC;
13773   TYPE_THEN `cell u` SUBGOAL_TAC;
13774   USE 7 (MATCH_MP curve_cell_cell);
13775   ASM_MESON_TAC[ISUBSET;];
13776   ASM_MESON_TAC[ISUBSET;cell_euclid];
13777   DISCH_THEN_REWRITE;
13778   AP_TERM_TAC;
13779   REWRITE_TAC[image_unions];
13780   AP_TERM_TAC;
13781   ASM_SIMP_TAC[image_curve_cell_reflC];
13782   REWRITE_TAC[IMAGE2];
13783   ]);;
13784   (* }}} *)
13785
13786 let connected_homeo = prove_by_refinement(
13787   `!(f:A->B) U V Z. (homeomorphism f U V /\ (Z SUBSET UNIONS U) ==>
13788        (connected V (IMAGE f Z) = connected U Z))`,
13789   (* {{{ proof *)
13790   [
13791   REP_BASIC_TAC;
13792   TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ;
13793   TYPE_THEN `Z = IMAGE g (IMAGE f Z)` SUBGOAL_TAC;
13794   IMATCH_MP_TAC  EQ_EXT;
13795   GEN_TAC;
13796   REWRITE_TAC[IMAGE];
13797   EXPAND_TAC "g";
13798   NAME_CONFLICT_TAC;
13799   CONV_TAC (dropq_conv "x''");
13800   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
13801   REP_BASIC_TAC;
13802   TYPE_THEN `!x'. (UNIONS U x') ==> (INV f (UNIONS U) (UNIONS V) (f x') = x')` SUBGOAL_TAC;
13803   REP_BASIC_TAC;
13804   IMATCH_MP_TAC  inv_comp_left;
13805   ASM_REWRITE_TAC[];
13806   DISCH_TAC;
13807   (*  *)
13808   EQ_TAC;
13809   REP_BASIC_TAC;
13810   TYPE_THEN ` x` EXISTS_TAC;
13811   KILL 2;
13812   ASM_REWRITE_TAC[];
13813   ASM_MESON_TAC[ISUBSET;];
13814   REP_BASIC_TAC;
13815   TSPEC `x'` 5;
13816   TYPE_THEN `UNIONS U x'` SUBGOAL_TAC;
13817   ASM_MESON_TAC[ISUBSET];
13818   DISCH_TAC;
13819   REWR 5;
13820   ASM_REWRITE_TAC[];
13821   DISCH_TAC;
13822   EQ_TAC;
13823   REP_BASIC_TAC;
13824   UND 3;
13825   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
13826   IMATCH_MP_TAC  connect_image;
13827   TYPE_THEN `V` EXISTS_TAC;
13828   ASM_REWRITE_TAC[];
13829   CONJ_TAC;
13830   EXPAND_TAC "g";
13831   IMATCH_MP_TAC  INV_homeomorphism;
13832   ASM_REWRITE_TAC[];
13833   REWRITE_TAC[IMAGE;SUBSET;];
13834   REP_BASIC_TAC;
13835   UND 3;
13836   EXPAND_TAC "g";
13837   ASM_REWRITE_TAC[];
13838   DISCH_TAC;
13839   TYPE_THEN `UNIONS U x''` SUBGOAL_TAC;
13840   ASM_MESON_TAC[ISUBSET];
13841   DISCH_TAC;
13842   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
13843   TYPE_THEN `x = x''` SUBGOAL_TAC;
13844   ASM_MESON_TAC[inv_comp_left];
13845   ASM_MESON_TAC[];
13846   REP_BASIC_TAC;
13847   IMATCH_MP_TAC  connect_image;
13848   TYPE_THEN `U` EXISTS_TAC;
13849   ASM_REWRITE_TAC[];
13850   RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]);
13851   REP_BASIC_TAC;
13852   ASM_REWRITE_TAC[SUBSET;IMAGE;];
13853   NAME_CONFLICT_TAC;
13854   CONV_TAC (dropq_conv "x''");
13855   ASM_MESON_TAC[ISUBSET;];
13856   ]);;
13857   (* }}} *)
13858
13859 (* start here , Tues Jun 8 , 2004 *)
13860
13861 let component = prove_by_refinement(
13862   `!U (x:A) . (component  U x = {y | ?Z. connected U Z /\ Z x /\ Z y})`,
13863   (* {{{ proof *)
13864   [
13865   REP_BASIC_TAC;
13866   IMATCH_MP_TAC  EQ_EXT;
13867   REWRITE_TAC[component_DEF ;];
13868   ]);;
13869   (* }}} *)
13870
13871 let component_homeo = prove_by_refinement(
13872   `!(f:A->B) U V x. (homeomorphism f U V) /\ (UNIONS U x) ==>
13873      (IMAGE f (component U x) = (component  V (f x)))`,
13874   (* {{{ proof *)
13875   [
13876   REP_BASIC_TAC;
13877   REWRITE_TAC[component ;IMAGE ; ];
13878   IMATCH_MP_TAC  EQ_EXT ;
13879   REP_BASIC_TAC;
13880   REWRITE_TAC[];
13881   CONV_TAC (dropq_conv "x'");
13882   EQ_TAC;
13883   REP_BASIC_TAC;
13884   TYPE_THEN `IMAGE f Z` EXISTS_TAC;
13885   CONJ_TAC;
13886   TYPE_THEN `Z SUBSET UNIONS U` SUBGOAL_TAC;
13887   RULE_ASSUM_TAC  (REWRITE_RULE[connected]);
13888   ASM_REWRITE_TAC[];
13889   ASM_SIMP_TAC[connected_homeo];
13890   ASM_REWRITE_TAC[];
13891   REWRITE_TAC[IMAGE];
13892   ASM_MESON_TAC[];
13893   (*  *)
13894   REP_BASIC_TAC;
13895   (* *)
13896   TYPE_THEN `?A. A SUBSET (UNIONS U) /\ (IMAGE f A = Z)` SUBGOAL_TAC;
13897   IMATCH_MP_TAC  image_power_surj;
13898   TYPE_THEN `UNIONS V` EXISTS_TAC;
13899   ASM_MESON_TAC[connected;homeomorphism];
13900   REP_BASIC_TAC;
13901   TYPE_THEN `A` EXISTS_TAC;
13902   NAME_CONFLICT_TAC;
13903   WITH 5 (REWRITE_RULE[IMAGE]);
13904   USE 7 (GSYM);
13905   REWR 2;
13906   REP_BASIC_TAC;
13907   TYPE_THEN `x''` EXISTS_TAC;
13908   ASM_REWRITE_TAC[];
13909   REWR 3;
13910   REP_BASIC_TAC;
13911   TYPE_THEN ` x = x'''` SUBGOAL_TAC;
13912   RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]);
13913   REP_BASIC_TAC;
13914   FIRST_ASSUM IMATCH_MP_TAC  ;
13915   ASM_REWRITE_TAC[];
13916   ASM_MESON_TAC[ISUBSET];
13917   DISCH_THEN_REWRITE;
13918   ASM_REWRITE_TAC[];
13919   KILL 7;
13920   ASM_SIMP_TAC[GSYM connected_homeo];
13921   ]);;
13922   (* }}} *)
13923
13924 let bij_homeo = prove_by_refinement(
13925   `!(f:A->B) U V. (BIJ f (UNIONS U) (UNIONS V)) /\
13926     (BIJ (IMAGE f) U V) ==> (homeomorphism f U V)`,
13927   (* {{{ proof *)
13928   [
13929   REP_BASIC_TAC;
13930   REWRITE_TAC[homeomorphism;continuous;];
13931   ASM_REWRITE_TAC[preimage;];
13932   CONJ_TAC;
13933   REP_BASIC_TAC;
13934   COPY 1;
13935   UND 3;
13936   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ;SURJ]);
13937   REP_BASIC_TAC;
13938   TSPEC  `v` 1;
13939   REWR 1;
13940   REP_BASIC_TAC;
13941   EXPAND_TAC "v";
13942   TYPE_THEN `{x | UNIONS U x /\ IMAGE f y (f x)} = y` SUBGOAL_TAC;
13943   IMATCH_MP_TAC  EQ_EXT;
13944   REWRITE_TAC[];
13945   GEN_TAC;
13946   EQ_TAC;
13947   REP_BASIC_TAC;
13948   TYPE_THEN `IMAGE f y (f x) = y x` SUBGOAL_TAC;
13949   IMATCH_MP_TAC image_app ;
13950   TYPE_THEN `(UNIONS U)` EXISTS_TAC;
13951   TYPE_THEN `(UNIONS V)` EXISTS_TAC;
13952   RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
13953   ASM_REWRITE_TAC[];
13954   ASM_MESON_TAC[sub_union];
13955   ASM_MESON_TAC[];
13956   REP_BASIC_TAC;
13957   CONJ_TAC;
13958   ASM_MESON_TAC[sub_union;ISUBSET];
13959   REWRITE_TAC[IMAGE];
13960   ASM_MESON_TAC[];
13961   DISCH_THEN_REWRITE;
13962   ASM_REWRITE_TAC[];
13963   (* *)
13964   REP_BASIC_TAC;
13965   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
13966   REP_BASIC_TAC;
13967   ASM_MESON_TAC[];
13968   ]);;
13969   (* }}} *)
13970
13971 let homeomorphism_subset = prove_by_refinement(
13972   `!(f:A->B) U V C. (homeomorphism f U V) /\ (C SUBSET U) ==>
13973    (homeomorphism f C (IMAGE2 f C))`,
13974   (* {{{ proof *)
13975
13976   [
13977   REP_BASIC_TAC;
13978   IMATCH_MP_TAC  bij_homeo;
13979   SUBCONJ_TAC;
13980   TYPE_THEN `UNIONS C SUBSET UNIONS U` SUBGOAL_TAC;
13981   IMATCH_MP_TAC  UNIONS_UNIONS ;
13982   ASM_REWRITE_TAC[];
13983   DISCH_TAC;
13984   REWRITE_TAC[IMAGE2 ;GSYM  image_unions;];
13985   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]);
13986   REP_BASIC_TAC;
13987   REWRITE_TAC[BIJ];
13988   SUBCONJ_TAC;
13989   REWRITE_TAC[INJ];
13990     SUBCONJ_TAC;
13991   REP_BASIC_TAC;
13992   TYPE_THEN `IMAGE f (UNIONS C) (f x) = (UNIONS C) x` SUBGOAL_TAC;
13993   IMATCH_MP_TAC  (image_app);
13994   TYPE_THEN `(UNIONS U)` EXISTS_TAC;
13995   TYPE_THEN `(UNIONS V)` EXISTS_TAC;
13996   ASM_REWRITE_TAC[];
13997   ASM_MESON_TAC[ISUBSET];
13998   DISCH_THEN_REWRITE;
13999   ASM_REWRITE_TAC[];
14000   DISCH_TAC;
14001   REP_BASIC_TAC;
14002   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
14003   REP_BASIC_TAC;
14004   FIRST_ASSUM IMATCH_MP_TAC ;
14005   ASM_MESON_TAC [ISUBSET];
14006   REWRITE_TAC[INJ];
14007   REP_BASIC_TAC;
14008   REWRITE_TAC[SURJ];
14009   ASM_REWRITE_TAC[];
14010   REP_BASIC_TAC;
14011   RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
14012   ASM_MESON_TAC[];
14013   DISCH_TAC;
14014   REWRITE_TAC[BIJ];
14015   WITH_FIRST (MATCH_MP homeo_bij);
14016   SUBCONJ_TAC;
14017   REWRITE_TAC[INJ];
14018   CONJ_TAC;
14019   REP_BASIC_TAC;
14020   REWRITE_TAC[IMAGE2;];
14021   TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
14022   REWRITE_TAC[IMAGE];
14023   ASM_MESON_TAC[];
14024   REP_BASIC_TAC;
14025   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
14026   REP_BASIC_TAC;
14027   FIRST_ASSUM IMATCH_MP_TAC ;
14028   ASM_REWRITE_TAC[];
14029   ASM_MESON_TAC[ISUBSET];
14030   REWRITE_TAC[INJ;SURJ];
14031   REP_BASIC_TAC;
14032   ASM_REWRITE_TAC[];
14033   REP_BASIC_TAC;
14034   RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2]);
14035   TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
14036   UND 6;
14037   REWRITE_TAC[IMAGE];
14038   ASM_MESON_TAC[];
14039   ]);;
14040
14041   (* }}} *)
14042
14043 let component_reflA = prove_by_refinement(
14044   `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==>
14045     (IMAGE (reflAf r) (component  (ctop G) x) =
14046          (component  (ctop (IMAGE2 (reflAf r) G)) (reflAf r x)))`,
14047   (* {{{ proof *)
14048   [
14049   REP_BASIC_TAC;
14050   IMATCH_MP_TAC  component_homeo;
14051   ASM_REWRITE_TAC[];
14052   TYPE_THEN `ctop (IMAGE2 (reflAf r) G) = IMAGE2 (reflAf r) (ctop G)` SUBGOAL_TAC ;
14053   ASM_MESON_TAC[ctop_reflA];
14054   DISCH_THEN_REWRITE;
14055   IMATCH_MP_TAC  homeomorphism_subset;
14056   TYPE_THEN `top2` EXISTS_TAC;
14057   TYPE_THEN `top2` EXISTS_TAC;
14058   REWRITE_TAC[reflA_homeo];
14059   REWRITE_TAC[SUBSET];
14060   ASM_MESON_TAC[ctop_top2];
14061   ]);;
14062   (* }}} *)
14063
14064 let component_reflB = prove_by_refinement(
14065   `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==>
14066     (IMAGE (reflBf r) (component  (ctop G) x) =
14067          (component  (ctop (IMAGE2 (reflBf r) G)) (reflBf r x)))`,
14068   (* {{{ proof *)
14069   [
14070   REP_BASIC_TAC;
14071   IMATCH_MP_TAC  component_homeo;
14072   ASM_REWRITE_TAC[];
14073   TYPE_THEN `ctop (IMAGE2 (reflBf r) G) = IMAGE2 (reflBf r) (ctop G)` SUBGOAL_TAC ;
14074   ASM_MESON_TAC[ctop_reflB];
14075   DISCH_THEN_REWRITE;
14076   IMATCH_MP_TAC  homeomorphism_subset;
14077   TYPE_THEN `top2` EXISTS_TAC;
14078   TYPE_THEN `top2` EXISTS_TAC;
14079   REWRITE_TAC[reflB_homeo];
14080   REWRITE_TAC[SUBSET];
14081   ASM_MESON_TAC[ctop_top2];
14082   ]);;
14083   (* }}} *)
14084
14085 let component_reflC = prove_by_refinement(
14086   `!(f:A->B) G x. (segment G) /\ (UNIONS (ctop G) x) ==>
14087     (IMAGE (reflCf) (component  (ctop G) x) =
14088          (component  (ctop (IMAGE2 (reflCf) G)) (reflCf x)))`,
14089   (* {{{ proof *)
14090   [
14091   REP_BASIC_TAC;
14092   IMATCH_MP_TAC  component_homeo;
14093   ASM_REWRITE_TAC[];
14094   TYPE_THEN `ctop (IMAGE2 (reflCf) G) = IMAGE2 (reflCf) (ctop G)` SUBGOAL_TAC ;
14095   ASM_MESON_TAC[ctop_reflC];
14096   DISCH_THEN_REWRITE;
14097   IMATCH_MP_TAC  homeomorphism_subset;
14098   TYPE_THEN `top2` EXISTS_TAC;
14099   TYPE_THEN `top2` EXISTS_TAC;
14100   REWRITE_TAC[reflC_homeo];
14101   REWRITE_TAC[SUBSET];
14102   ASM_MESON_TAC[ctop_top2];
14103   ]);;
14104   (* }}} *)
14105
14106 let subset_union_inter = prove_by_refinement(
14107   `!(X:A->bool) A B. (X SUBSET (A UNION B)   ==>
14108       (~(X INTER A = EMPTY )) \/ (~(X INTER B = EMPTY)) \/ (X = EMPTY ))`,
14109   (* {{{ proof *)
14110   [
14111   (REWRITE_TAC [EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ; ]);
14112   MESON_TAC[];
14113   ]);;
14114   (* }}} *)
14115
14116 let squ_disj = prove_by_refinement(
14117   `!m n. ((squ m INTER squ n = {}) <=> ~(m = n))`,
14118   (* {{{ proof *)
14119   [
14120   DISCH_ALL_TAC;
14121     EQ_TAC;
14122   DISCH_ALL_TAC;
14123   REWR 1;
14124   RULE_ASSUM_TAC (REWRITE_RULE[INTER_IDEMPOT;]);
14125   ASM_MESON_TAC[cell_nonempty;cell_rules];
14126   DISCH_TAC;
14127   PROOF_BY_CONTR_TAC;
14128   TYPE_THEN `squ m = squ n` SUBGOAL_TAC;
14129   IMATCH_MP_TAC  cell_partition;
14130   ASM_MESON_TAC[cell_rules];
14131   ASM_REWRITE_TAC[squ_inj];
14132   ]);;
14133   (* }}} *)
14134
14135 (* move way up *)
14136 let cell_clauses = prove_by_refinement(
14137   `(!m. (~(v_edge m = EMPTY ) /\ ~(h_edge m = EMPTY )
14138        /\ ~(squ m = EMPTY ) /\ ~({(pointI m)} = EMPTY ))) /\
14139    (!m n. (v_edge m INTER {(pointI n)} = EMPTY ) /\
14140          ({(pointI n)} INTER v_edge m = EMPTY ) /\
14141   (h_edge m INTER {(pointI n)} = EMPTY ) /\
14142          ({(pointI n)} INTER h_edge m = EMPTY ) /\
14143   (squ m INTER {(pointI n)} = EMPTY ) /\
14144          ({(pointI n)} INTER squ m = EMPTY ) /\
14145        ((v_edge m INTER v_edge n  = EMPTY ) <=> ~(m = n) ) /\
14146    ((h_edge m INTER h_edge n  = EMPTY ) <=> ~(m = n) ) /\
14147   ((squ m INTER squ n  = EMPTY ) <=> ~(m = n) ) /\
14148   (squ m INTER h_edge n = EMPTY ) /\
14149          (h_edge n INTER squ m = EMPTY ) /\
14150   (squ m INTER v_edge n = EMPTY ) /\
14151         ( v_edge n INTER squ m = EMPTY ) /\
14152    (h_edge m INTER v_edge n = EMPTY ) /\
14153         ( v_edge n INTER h_edge m = EMPTY ) /\
14154    (({(pointI n)} INTER {(pointI m)} = EMPTY ) <=> ~(n = m)) /\
14155    (({(pointI n)} = {(pointI m)}  ) <=> (n = m)) /\
14156    ~(h_edge n = {(pointI m)}) /\
14157    ~(v_edge n = {(pointI m)}) /\
14158    ~(squ n = {(pointI m)}) /\
14159    ~( {(pointI m)} = h_edge n) /\
14160 ~( {(pointI m)} = v_edge n) /\
14161 ~( {(pointI m)} = squ n) /\
14162 ~(h_edge m = v_edge n) /\
14163 ((h_edge m = h_edge n) <=> (m = n)) /\
14164 ~(h_edge m = squ n) /\
14165 ~(v_edge m = h_edge n) /\
14166 ((v_edge m = v_edge n) <=> (m = n)) /\
14167 ~(v_edge m = squ n) /\
14168 ~(squ m = h_edge n) /\
14169 ((squ m = squ n) <=> (m = n)) /\
14170 ~(squ m = v_edge n) /\
14171 ~(squ m (pointI n)) /\
14172 ~(v_edge m (pointI n)) /\
14173 ~(h_edge m (pointI n)) /\
14174 ((pointI n = pointI m) <=> (n = m)))  `,
14175
14176   (* {{{ proof *)
14177   (let notrr = REWRITE_RULE[not_eq] in
14178   let interc = ONCE_REWRITE_RULE[INTER_COMM] in
14179   ([
14180   CONJ_TAC ;
14181   ASM_MESON_TAC[cell_nonempty;cell_rules];
14182   REP_BASIC_TAC;
14183   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];
14184   REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;];
14185   CONV_TAC (dropq_conv "u");
14186   ASM_MESON_TAC[pointI_inj];
14187   ])));;
14188   (* }}} *)
14189
14190 let inter_union = prove_by_refinement(
14191   `!X A (B:A->bool). ~(X INTER (A UNION B) = EMPTY) ==>
14192     ~(X INTER A = EMPTY) \/ ~(X INTER B = EMPTY)`,
14193   (* {{{ proof *)
14194   [
14195   REWRITE_TAC[INTER;UNION;EMPTY_EXISTS;];
14196   MESON_TAC[];
14197   ]);;
14198   (* }}} *)
14199
14200 let squc_v = prove_by_refinement(
14201   `!m n. (v_edge m SUBSET squc n) ==> (n = m) \/ (n = left  m)`,
14202   (* {{{ proof *)
14203   [
14204   REWRITE_TAC[squc_union;];
14205   REP_BASIC_TAC;
14206   USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
14207   REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
14208   FIRST_ASSUM DISJ_CASES_TAC;
14209   ASM_REWRITE_TAC[];
14210   KILL 0;
14211   USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
14212   ASM_REWRITE_TAC[right_left];
14213   (*   *)
14214   ]);;
14215   (* }}} *)
14216
14217 let squc_h = prove_by_refinement(
14218   `!m n. (h_edge m SUBSET squc n) ==> (n = m) \/ (n = down  m)`,
14219   (* {{{ proof *)
14220   [
14221   REWRITE_TAC[squc_union;];
14222   REP_BASIC_TAC;
14223   USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
14224   REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
14225   FIRST_ASSUM DISJ_CASES_TAC;
14226   ASM_REWRITE_TAC[];
14227   KILL 0;
14228   USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
14229   FIRST_ASSUM DISJ_CASES_TAC;
14230   ASM_REWRITE_TAC[right_left];
14231   KILL 0;
14232   REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
14233   ASM_MESON_TAC [];
14234   (*   *)
14235   ]);;
14236   (* }}} *)
14237
14238 let component_empty = prove_by_refinement(
14239   `!U (x:A). (topology_ U) ==> ((component  U x = EMPTY) = ~(UNIONS U x))`,
14240   (* {{{ proof *)
14241   [
14242   REP_BASIC_TAC;
14243   REWRITE_TAC[component ;EQ_EMPTY;];
14244   EQ_TAC;
14245   REP_BASIC_TAC;
14246   TSPEC `x` 2;
14247   ASM_MESON_TAC[connected_sing;INR IN_SING;];
14248   REP_BASIC_TAC;
14249   RULE_ASSUM_TAC (REWRITE_RULE[connected]);
14250   REP_BASIC_TAC;
14251   ASM_MESON_TAC[ISUBSET];
14252   ]);;
14253   (* }}} *)
14254
14255 let image_imp = prove_by_refinement(
14256   `!(f:A->B) X t. X t ==> (IMAGE f X) (f t)`,
14257   (* {{{ proof *)
14258   [
14259   REP_BASIC_TAC;
14260   REWRITE_TAC[IMAGE];
14261   ASM_MESON_TAC[];
14262   ]);;
14263   (* }}} *)
14264
14265 let image_inj = prove_by_refinement(
14266   `!(f:A->B) X A B. (INJ f X UNIV) /\ (A SUBSET X ) /\ (B SUBSET X) /\
14267      (IMAGE f A SUBSET IMAGE f B) ==> (A SUBSET B)`,
14268   (* {{{ proof *)
14269   [
14270   REWRITE_TAC[INJ;IMAGE;SUBSET;];
14271   REP_BASIC_TAC;
14272   ASM_MESON_TAC[];
14273   ]);;
14274   (* }}} *)
14275
14276 let closure_euclid = prove_by_refinement(
14277   `closure (top2) (euclid 2) = euclid 2`,
14278   (* {{{ proof *)
14279   [
14280   REWRITE_TAC[closure;top2];
14281   IMATCH_MP_TAC  SUBSET_ANTISYM;
14282   CONJ_TAC;
14283   IMATCH_MP_TAC  INTERS_SUBSET;
14284   REWRITE_TAC[SUBSET_REFL;];
14285   ASM_MESON_TAC[closed_UNIV;top_of_metric_top;metric_euclid;top_of_metric_unions;];
14286   REWRITE_TAC[INTERS;SUBSET];
14287   REP_BASIC_TAC;
14288   FIRST_ASSUM IMATCH_MP_TAC ;
14289   ASM_REWRITE_TAC[];
14290   ]);;
14291   (* }}} *)
14292
14293 let closure_euclid = prove_by_refinement(
14294   `!A. (A SUBSET (euclid 2) ==> (closure top2 A SUBSET (euclid 2)))`,
14295   (* {{{ proof *)
14296   [
14297   REP_BASIC_TAC;
14298   ONCE_REWRITE_TAC [GSYM closure_euclid];
14299   IMATCH_MP_TAC  subset_of_closure;
14300   ASM_REWRITE_TAC[top2_top];
14301   ]);;
14302   (* }}} *)
14303
14304 let along_lemma7 = prove_by_refinement(
14305   `!G m n x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
14306      (v_edge m SUBSET squc n) /\
14307      (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==>
14308    (?p. e SUBSET closure top2 (squ p) /\
14309        (squ p SUBSET (component  (ctop G) x))))`,
14310   (* {{{ proof *)
14311   [
14312   REP_BASIC_TAC;
14313   WITH_FIRST (MATCH_MP squc_v);
14314   FIRST_ASSUM (DISJ_CASES_TAC);
14315   REWR 3;
14316   IMATCH_MP_TAC  along_lemma6;
14317   TYPE_THEN `m` EXISTS_TAC;
14318   ASM_REWRITE_TAC[];
14319   REWR 4;
14320   (* 2nd side *)
14321   REWR 4;
14322   REWR 3;
14323   KILL 6;
14324   KILL 7;
14325   TYPE_THEN `e' = IMAGE (reflAf (&:0)) e ` ABBREV_TAC ;
14326   TYPE_THEN `G' = IMAGE2 (reflAf (&:0)) G` ABBREV_TAC ;
14327   TYPE_THEN `x' = reflAf (&:0) x` ABBREV_TAC ;
14328   TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
14329   TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
14330   USE 4(REWRITE_RULE[SUBSET]);
14331   TYPE_THEN `~(squ (left  m) = EMPTY)` SUBGOAL_TAC;
14332   ASM_MESON_TAC[cell_nonempty;cell_rules];
14333   REWRITE_TAC[EMPTY_EXISTS];
14334   REP_BASIC_TAC;
14335   TSPEC `u` 4;
14336   REWR 4;
14337   ASM_MESON_TAC[];
14338   TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
14339   ASM_MESON_TAC[ctop_top];
14340   ASM_SIMP_TAC [component_empty];
14341   DISCH_TAC;
14342   TYPE_THEN `component  (ctop G') x' = IMAGE (reflAf (&:0)) (component  (ctop G) x)` SUBGOAL_TAC;
14343   ASM_MESON_TAC[component_reflA;];
14344   DISCH_TAC;
14345   (*  *)
14346   TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
14347   IMATCH_MP_TAC  along_lemma6;
14348   TYPE_THEN `reflAi (&:0) m` EXISTS_TAC;
14349   (SUBCONJ_TAC);
14350   (* 1st claus *)
14351   EXPAND_TAC "G'";
14352   IMATCH_MP_TAC reflA_segment;
14353   ASM_REWRITE_TAC[];
14354   DISCH_TAC;
14355   CONJ_TAC;
14356   (* 2nd clause *)
14357   ASM_REWRITE_TAC[];
14358   (* goal 2c *)
14359   USE 4(MATCH_MP (ISPEC `reflAf (&:0)` IMAGE_SUBSET ));
14360   TYPE_THEN `squ(reflAi (&:0) m) = IMAGE (reflAf (&:0)) (squ (left  m))` SUBGOAL_TAC;
14361   REWRITE_TAC[reflA_squ];
14362   AP_TERM_TAC;
14363   REWRITE_TAC[reflAi;left ;PAIR_SPLIT; ];
14364   INT_ARITH_TAC;
14365   ASM_MESON_TAC[];
14366   (* 3 *)
14367   CONJ_TAC;
14368   REWRITE_TAC[GSYM reflA_v_edge];
14369   EXPAND_TAC "G'";
14370   REWRITE_TAC[IMAGE2];
14371   UND 2;
14372   (* goal 3c *)
14373   MESON_TAC[image_imp];
14374   (* <2> *)
14375   CONJ_TAC;
14376   EXPAND_TAC "G'";
14377   EXPAND_TAC "e'";
14378   REWRITE_TAC[IMAGE2];
14379   ASM_MESON_TAC[image_imp];
14380   EXPAND_TAC "e'";
14381   TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) e) = IMAGE (reflAf (&:0)) (closure top2 e)` SUBGOAL_TAC;
14382   IMATCH_MP_TAC  (GSYM homeo_closure);
14383   ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;];
14384   TYPE_THEN `edge e ` SUBGOAL_TAC;
14385   ASM_MESON_TAC[segment;ISUBSET];
14386   MESON_TAC[ISUBSET;edge_euclid2;];
14387   DISCH_THEN_REWRITE;
14388   REWRITE_TAC[GSYM reflA_pointI];
14389   IMATCH_MP_TAC  image_imp;
14390   ASM_REWRITE_TAC[];
14391   REP_BASIC_TAC;
14392   (* <1> *)
14393   TYPE_THEN `p = left  (reflAi (&:0) p')` ABBREV_TAC ;
14394   TYPE_THEN `squ p' = IMAGE (reflAf (&:0) ) (squ p)` SUBGOAL_TAC;
14395   ASM_REWRITE_TAC[reflA_squ;];
14396   AP_TERM_TAC;
14397   EXPAND_TAC "p";
14398   REWRITE_TAC[left ;reflAi;PAIR_SPLIT;];
14399   INT_ARITH_TAC;
14400   DISCH_TAC;
14401   TYPE_THEN `p` EXISTS_TAC;
14402   (* LAST *)
14403   ASSUME_TAC top2_top;
14404   TYPE_THEN `homeomorphism (reflAf (&:0)) top2 top2` SUBGOAL_TAC;
14405   ASM_MESON_TAC[reflA_homeo];
14406   DISCH_TAC;
14407   ASSUME_TAC top2_unions;
14408   TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
14409   MESON_TAC[squ_euclid;top2_unions];
14410   DISCH_TAC;
14411   CONJ_TAC; (* split *)
14412   UND 12;
14413   ASM_REWRITE_TAC[];
14414   EXPAND_TAC "e'";
14415   TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) (squ p)) = IMAGE (reflAf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC;
14416   IMATCH_MP_TAC  (GSYM homeo_closure);
14417   ASM_REWRITE_TAC[];
14418   DISCH_THEN_REWRITE;
14419   (* x *)
14420   DISCH_TAC;
14421   IMATCH_MP_TAC  (ISPEC `reflAf (&:0)` image_inj);
14422   TYPE_THEN `euclid 2` EXISTS_TAC;
14423   ASM_REWRITE_TAC[];
14424   CONJ_TAC;
14425   IMATCH_MP_TAC  INJ_UNIV;
14426   TYPE_THEN `(euclid 2)` EXISTS_TAC;
14427   REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;];
14428   CONJ_TAC;
14429     TYPE_THEN `edge e ` SUBGOAL_TAC;
14430   ASM_MESON_TAC[segment;ISUBSET];
14431   MESON_TAC[ISUBSET;edge_euclid2;];
14432   IMATCH_MP_TAC  closure_euclid;
14433   REWRITE_TAC[squ_euclid];
14434   (* last'' *)
14435   IMATCH_MP_TAC  (ISPEC `reflAf (&:0)` image_inj);
14436   TYPE_THEN `euclid 2` EXISTS_TAC;
14437   ASM_REWRITE_TAC[];
14438   CONJ_TAC;
14439   IMATCH_MP_TAC  INJ_UNIV;
14440   TYPE_THEN `(euclid 2)` EXISTS_TAC;
14441   REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;];
14442   CONJ_TAC;
14443   REWRITE_TAC[squ_euclid];
14444   CONJ_TAC;
14445   IMATCH_MP_TAC  SUBSET_TRANS;
14446   TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
14447   ASM_REWRITE_TAC[component_unions;ctop_unions];
14448   REWRITE_TAC[DIFF;SUBSET];
14449   MESON_TAC[];
14450   ASM_MESON_TAC[];
14451   ]);;
14452   (* }}} *)
14453
14454 let v_edge_cases = prove_by_refinement(
14455   `!j m. closure top2 (v_edge j) (pointI m) ==> (j = m) \/ (j = down m)`,
14456   (* {{{ proof *)
14457   [
14458   REWRITE_TAC[v_edge_closure;vc_edge];
14459   REP_BASIC_TAC;
14460   RULE_ASSUM_TAC (REWRITE_RULE[UNION;cell_clauses;INR IN_SING;plus_e12]);
14461   FIRST_ASSUM DISJ_CASES_TAC;
14462   ASM_MESON_TAC[];
14463   DISJ2_TAC;
14464   ASM_REWRITE_TAC[down;PAIR_SPLIT;];
14465   INT_ARITH_TAC;
14466   ]);;
14467   (* }}} *)
14468
14469 let squ_squc = prove_by_refinement(
14470   `!r n m. (IMAGE (reflBf r) (squ n) = squ m) ==>
14471     (IMAGE (reflBf r) (squc n) = squc m)`,
14472   (* {{{ proof *)
14473   [
14474   REP_BASIC_TAC;
14475   REWRITE_TAC[GSYM squ_closure];
14476   TYPE_THEN `IMAGE (reflBf r) (closure top2 (squ n)) = closure top2 (IMAGE (reflBf r) (squ n))` SUBGOAL_TAC;
14477   IMATCH_MP_TAC  homeo_closure;
14478   ASM_REWRITE_TAC[top2_top;top2_unions;reflB_homeo;squ_euclid;];
14479   DISCH_THEN_REWRITE;
14480   ASM_REWRITE_TAC[];
14481   ]);;
14482   (* }}} *)
14483
14484 let squ_squc_C = prove_by_refinement(
14485   `!n m. (IMAGE (reflCf) (squ n) = squ m) ==>
14486     (IMAGE (reflCf) (squc n) = squc m)`,
14487   (* {{{ proof *)
14488   [
14489   REP_BASIC_TAC;
14490   REWRITE_TAC[GSYM squ_closure];
14491   TYPE_THEN `IMAGE (reflCf) (closure top2 (squ n)) = closure top2 (IMAGE (reflCf) (squ n))` SUBGOAL_TAC;
14492   IMATCH_MP_TAC  homeo_closure;
14493   ASM_REWRITE_TAC[top2_top;top2_unions;reflC_homeo;squ_euclid;];
14494   DISCH_THEN_REWRITE;
14495   ASM_REWRITE_TAC[];
14496   ]);;
14497   (* }}} *)
14498
14499 let along_lemma8 = prove_by_refinement(
14500   `!G m n j x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
14501      (v_edge j SUBSET squc n) /\ (closure top2 (v_edge j) (pointI m)) /\
14502     (G (v_edge j)) /\ G e /\ (closure top2 e (pointI m)) ==>
14503    (?p. e SUBSET closure top2 (squ p) /\
14504        (squ p SUBSET (component  (ctop G) x))))`,
14505   (* {{{ proof *)
14506   [
14507   REP_BASIC_TAC;
14508   USE_FIRST (MATCH_MP v_edge_cases);
14509   FIRST_ASSUM (DISJ_CASES_TAC);
14510   IMATCH_MP_TAC  along_lemma7;
14511   ASM_MESON_TAC[];
14512   KILL 3;
14513   REWR 4;
14514   REWR 2;
14515   KILL 7;
14516   (* INSERT lemmas here *)
14517   TYPE_THEN `e' = IMAGE (reflBf (&:0)) e ` ABBREV_TAC ;
14518   TYPE_THEN `G' = IMAGE2 (reflBf (&:0)) G` ABBREV_TAC ;
14519   TYPE_THEN `x' = reflBf (&:0) x` ABBREV_TAC ;
14520   TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
14521   TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
14522   USE 5(REWRITE_RULE[SUBSET]);
14523   TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC;
14524   ASM_MESON_TAC[cell_nonempty;cell_rules];
14525   REWRITE_TAC[EMPTY_EXISTS];
14526   REP_BASIC_TAC;
14527   ASM_MESON_TAC[];
14528   TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
14529   ASM_MESON_TAC[ctop_top];
14530   ASM_SIMP_TAC [component_empty];
14531   DISCH_TAC;
14532   TYPE_THEN `component  (ctop G') x' = IMAGE (reflBf (&:0)) (component  (ctop G) x)` SUBGOAL_TAC;
14533   ASM_MESON_TAC[component_reflB;];
14534   DISCH_TAC;
14535   (*  gok to here *)
14536   TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
14537   IMATCH_MP_TAC  along_lemma7;
14538   TYPE_THEN `(reflBi (&:0))  m` EXISTS_TAC;
14539   TYPE_THEN `down (reflBi (&:0) n)` EXISTS_TAC;
14540   (SUBCONJ_TAC);
14541   (* 1st claus *)
14542   EXPAND_TAC "G'";
14543   IMATCH_MP_TAC reflB_segment;
14544   ASM_REWRITE_TAC[];
14545   DISCH_TAC;
14546   CONJ_TAC;
14547   (* 2nd clause *)
14548   ASM_REWRITE_TAC[GSYM reflB_squ];
14549   (* goal 2c *)
14550   IMATCH_MP_TAC   (ISPEC `reflBf (&:0)` IMAGE_SUBSET );
14551   ASM_REWRITE_TAC[];
14552   (* 3 *)
14553   TYPE_THEN `squc (down (reflBi (&:0) n)) = IMAGE (reflBf (&:0)) (squc n)` SUBGOAL_TAC;
14554   IMATCH_MP_TAC  (GSYM squ_squc);
14555   REWRITE_TAC[reflB_squ];
14556   DISCH_THEN_REWRITE;  (* end *)
14557   TYPE_THEN `v_edge (reflBi (&:0) m) = IMAGE (reflBf (&:0)) (v_edge (down m))` SUBGOAL_TAC;
14558   REWRITE_TAC[reflB_v_edge];
14559   AP_TERM_TAC ;
14560   REWRITE_TAC[reflBi;down;PAIR_SPLIT ];
14561   INT_ARITH_TAC;
14562   DISCH_THEN_REWRITE;
14563   CONJ_TAC;
14564   IMATCH_MP_TAC  IMAGE_SUBSET;
14565   ASM_REWRITE_TAC[];
14566   (* gok2 *)
14567   CONJ_TAC;
14568   EXPAND_TAC "G'";
14569   REWRITE_TAC[IMAGE2];
14570   UND 2;
14571   (* goal 3c *)
14572   MESON_TAC[image_imp];
14573   (* <2> gok1 *)
14574   CONJ_TAC;
14575   EXPAND_TAC "G'";
14576   EXPAND_TAC "e'";
14577   REWRITE_TAC[IMAGE2];
14578   ASM_MESON_TAC[image_imp];
14579   EXPAND_TAC "e'";
14580   (* 2 total *)
14581   TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) e) = IMAGE (reflBf (&:0)) (closure top2 e)` SUBGOAL_TAC;
14582   IMATCH_MP_TAC  (GSYM homeo_closure);
14583   ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;];
14584   TYPE_THEN `edge e ` SUBGOAL_TAC;
14585   ASM_MESON_TAC[segment;ISUBSET];
14586   MESON_TAC[ISUBSET;edge_euclid2;];
14587   DISCH_THEN_REWRITE;
14588   REWRITE_TAC[GSYM reflB_pointI];
14589   IMATCH_MP_TAC  image_imp;
14590   ASM_REWRITE_TAC[];
14591   REP_BASIC_TAC;
14592   (* <1> *)
14593   TYPE_THEN `p = down  (reflBi (&:0) p')` ABBREV_TAC ;
14594   TYPE_THEN `squ p' = IMAGE (reflBf (&:0) ) (squ p)` SUBGOAL_TAC;
14595   ASM_REWRITE_TAC[reflB_squ;];
14596   AP_TERM_TAC;
14597   EXPAND_TAC "p";
14598   REWRITE_TAC[down ;reflBi;PAIR_SPLIT;];
14599   INT_ARITH_TAC;
14600   DISCH_TAC;
14601   TYPE_THEN `p` EXISTS_TAC;
14602   (* LAST *)
14603   ASSUME_TAC top2_top;
14604   TYPE_THEN `homeomorphism (reflBf (&:0)) top2 top2` SUBGOAL_TAC;
14605   ASM_MESON_TAC[reflB_homeo];
14606   DISCH_TAC;
14607   ASSUME_TAC top2_unions;
14608   TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
14609   MESON_TAC[squ_euclid;top2_unions];
14610   DISCH_TAC;
14611   CONJ_TAC; (* split *)
14612   UND 12;
14613   ASM_REWRITE_TAC[];
14614   EXPAND_TAC "e'";
14615   TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) (squ p)) = IMAGE (reflBf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC;
14616   IMATCH_MP_TAC  (GSYM homeo_closure);
14617   ASM_REWRITE_TAC[];
14618   DISCH_THEN_REWRITE;
14619   (* x *)
14620   DISCH_TAC;
14621   IMATCH_MP_TAC  (ISPEC `reflBf (&:0)` image_inj);
14622   TYPE_THEN `euclid 2` EXISTS_TAC;
14623   ASM_REWRITE_TAC[];
14624   CONJ_TAC;
14625   IMATCH_MP_TAC  INJ_UNIV;
14626   TYPE_THEN `(euclid 2)` EXISTS_TAC;
14627   REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;];
14628   CONJ_TAC;
14629     TYPE_THEN `edge e ` SUBGOAL_TAC;
14630   ASM_MESON_TAC[segment;ISUBSET];
14631   MESON_TAC[ISUBSET;edge_euclid2;];
14632   IMATCH_MP_TAC  closure_euclid;
14633   REWRITE_TAC[squ_euclid];
14634   (* last'' *)
14635   IMATCH_MP_TAC  (ISPEC `reflBf (&:0)` image_inj);
14636   TYPE_THEN `euclid 2` EXISTS_TAC;
14637   ASM_REWRITE_TAC[];
14638   CONJ_TAC;
14639   IMATCH_MP_TAC  INJ_UNIV;
14640   TYPE_THEN `(euclid 2)` EXISTS_TAC;
14641   REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;];
14642   CONJ_TAC;
14643   REWRITE_TAC[squ_euclid];
14644   CONJ_TAC;
14645   IMATCH_MP_TAC  SUBSET_TRANS;
14646   TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
14647   ASM_REWRITE_TAC[component_unions;ctop_unions];
14648   REWRITE_TAC[DIFF;SUBSET];
14649   MESON_TAC[];
14650   ASM_MESON_TAC[];
14651   ]);;
14652   (* }}} *)
14653
14654 let along_lemma9 = prove_by_refinement(
14655   `!G m n e' x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
14656      (e' SUBSET squc n) /\ (closure top2 e' (pointI m)) /\ (edge e') /\
14657     (G e') /\ G e /\ (closure top2 e (pointI m)) ==>
14658    (?p. e SUBSET closure top2 (squ p) /\
14659        (squ p SUBSET (component  (ctop G) x))))`,
14660   (* {{{ proof *)
14661   [
14662     REP_BASIC_TAC;
14663   RULE_ASSUM_TAC (REWRITE_RULE[edge]);
14664   REP_BASIC_TAC;
14665   FIRST_ASSUM (DISJ_CASES_TAC);
14666   IMATCH_MP_TAC  along_lemma8;
14667   ASM_MESON_TAC[];
14668   TYPE_THEN `edge e` SUBGOAL_TAC;
14669   ASM_MESON_TAC[segment;ISUBSET];
14670   ASM_SIMP_TAC[];
14671   DISCH_TAC;
14672   KILL 3;
14673   REWR 4;
14674   REWR 2;
14675   REWR 5;
14676   KILL 8;
14677   (* INSERT lemmas here *)
14678   TYPE_THEN `e' = IMAGE (reflCf) e ` ABBREV_TAC ;
14679   TYPE_THEN `G' = IMAGE2 (reflCf) G` ABBREV_TAC ;
14680   TYPE_THEN `x' = reflCf x` ABBREV_TAC ;
14681   TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
14682   TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
14683   USE 6(REWRITE_RULE[SUBSET]);
14684   TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC;
14685   ASM_MESON_TAC[cell_nonempty;cell_rules];
14686   REWRITE_TAC[EMPTY_EXISTS];
14687   REP_BASIC_TAC;
14688   ASM_MESON_TAC[];
14689   TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
14690   ASM_MESON_TAC[ctop_top];
14691   ASM_SIMP_TAC [component_empty];
14692   DISCH_TAC;
14693   TYPE_THEN `component  (ctop G') x' = IMAGE (reflCf) (component  (ctop G) x)` SUBGOAL_TAC;
14694   ASM_MESON_TAC[component_reflC;];
14695   DISCH_TAC;
14696   (*  gok to here *)
14697   TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
14698   IMATCH_MP_TAC  along_lemma8;
14699   TYPE_THEN `(reflCi)  m` EXISTS_TAC;
14700   TYPE_THEN `(reflCi n)` EXISTS_TAC;
14701   TYPE_THEN `reflCi m'` EXISTS_TAC;
14702   (SUBCONJ_TAC);
14703   (* 1st claus *)
14704   EXPAND_TAC "G'";
14705   IMATCH_MP_TAC reflC_segment;
14706   ASM_REWRITE_TAC[];
14707   DISCH_TAC;
14708   CONJ_TAC;
14709   (* 2nd clause *)
14710   ASM_REWRITE_TAC[GSYM reflC_squ];
14711   (* goal 2c *)
14712   IMATCH_MP_TAC   (ISPEC `reflCf` IMAGE_SUBSET );
14713   ASM_REWRITE_TAC[];
14714   (* 3 *)
14715   TYPE_THEN `squc ( (reflCi n)) = IMAGE (reflCf) (squc n)` SUBGOAL_TAC;
14716   IMATCH_MP_TAC  (GSYM squ_squc_C);
14717   REWRITE_TAC[reflC_squ];
14718   DISCH_THEN_REWRITE;  (* end *)
14719   TYPE_THEN `v_edge (reflCi  m') = IMAGE (reflCf ) (h_edge ( m'))` SUBGOAL_TAC;
14720   REWRITE_TAC[reflC_hv_edge];
14721   DISCH_THEN_REWRITE;
14722   CONJ_TAC;
14723   IMATCH_MP_TAC  IMAGE_SUBSET;
14724   ASM_REWRITE_TAC[];
14725   (* gok2 *)
14726   (* INSERT *)
14727   TYPE_THEN `!e. (edge e) ==> (closure top2 (IMAGE (reflCf ) e) = IMAGE (reflCf) (closure top2 e))` SUBGOAL_TAC;
14728   DISCH_ALL_TAC;
14729   IMATCH_MP_TAC  (GSYM homeo_closure);
14730   ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;];
14731   IMATCH_MP_TAC  edge_euclid2;
14732   ASM_REWRITE_TAC[];
14733   DISCH_TAC ;
14734   TYPE_THEN `edge (h_edge m')` SUBGOAL_TAC;
14735   ASM_MESON_TAC[edge];
14736   DISCH_TAC;
14737   ASM_SIMP_TAC[];
14738   REWRITE_TAC[GSYM reflC_pointI];
14739   CONJ_TAC;
14740   ASM_MESON_TAC[image_imp];
14741   (* to here *)
14742   CONJ_TAC;
14743   EXPAND_TAC "G'";
14744   REWRITE_TAC[IMAGE2];
14745   UND 2;
14746   (* goal 3c *)
14747   MESON_TAC[image_imp];
14748   (* <2> gok1 *)
14749   CONJ_TAC;
14750   EXPAND_TAC "G'";
14751   EXPAND_TAC "e'";
14752   REWRITE_TAC[IMAGE2];
14753   ASM_MESON_TAC[image_imp];
14754   EXPAND_TAC "e'";
14755   (* 2 total *)
14756   ASM_SIMP_TAC[];
14757   IMATCH_MP_TAC  image_imp;
14758   ASM_REWRITE_TAC[];
14759   REP_BASIC_TAC;
14760   (* <1> *)
14761   TYPE_THEN `p = reflCi p'` ABBREV_TAC ;
14762   TYPE_THEN `squ p' = IMAGE (reflCf ) (squ p)` SUBGOAL_TAC;
14763   ASM_REWRITE_TAC[reflC_squ;];
14764   AP_TERM_TAC;
14765   EXPAND_TAC "p";
14766   REWRITE_TAC[reflCi_inv;PAIR_SPLIT;];
14767   DISCH_TAC;
14768   TYPE_THEN `p` EXISTS_TAC;
14769   (* LAST *)
14770   ASSUME_TAC top2_top;
14771   TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC;
14772   ASM_MESON_TAC[reflC_homeo];
14773   DISCH_TAC;
14774   ASSUME_TAC top2_unions;
14775   TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
14776   MESON_TAC[squ_euclid;top2_unions];
14777   DISCH_TAC;
14778   TYPE_THEN `closure top2 (IMAGE (reflCf) (squ p)) = IMAGE (reflCf) (closure top2 (squ p))` SUBGOAL_TAC;
14779   IMATCH_MP_TAC  (GSYM homeo_closure);
14780   ASM_REWRITE_TAC[];
14781   DISCH_TAC;
14782   CONJ_TAC; (* split *)
14783   IMATCH_MP_TAC  (ISPEC `reflCf` image_inj);
14784   TYPE_THEN `euclid 2` EXISTS_TAC;
14785   ASM_REWRITE_TAC[];
14786   CONJ_TAC;
14787   IMATCH_MP_TAC  INJ_UNIV;
14788   TYPE_THEN `(euclid 2)` EXISTS_TAC;
14789   REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;];
14790   CONJ_TAC;
14791   ASM_MESON_TAC[edge_euclid2];
14792   CONJ_TAC;
14793   IMATCH_MP_TAC  closure_euclid;
14794   REWRITE_TAC[squ_euclid];
14795   UND 21;
14796   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
14797   REWRITE_TAC[reflC_squ];
14798   TYPE_THEN `reflCi p = p'` SUBGOAL_TAC;
14799   EXPAND_TAC "p";
14800   REWRITE_TAC[reflCi_inv];
14801   DISCH_THEN_REWRITE;
14802   ASM_REWRITE_TAC[];
14803   (* last'' *)
14804   UND 13;
14805   ASM_REWRITE_TAC[];
14806   DISCH_TAC;
14807   IMATCH_MP_TAC  (ISPEC `reflCf` image_inj);
14808   TYPE_THEN `euclid 2` EXISTS_TAC;
14809   ASM_REWRITE_TAC[];
14810   CONJ_TAC;
14811   IMATCH_MP_TAC  INJ_UNIV;
14812   TYPE_THEN `(euclid 2)` EXISTS_TAC;
14813   REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;];
14814   CONJ_TAC;
14815   REWRITE_TAC[squ_euclid];
14816   IMATCH_MP_TAC  SUBSET_TRANS;
14817   TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
14818   ASM_REWRITE_TAC[component_unions;ctop_unions];
14819   REWRITE_TAC[DIFF;SUBSET];
14820   MESON_TAC[];
14821   ]);;
14822   (* }}} *)
14823
14824 let along_lemma10 = prove_by_refinement(
14825   `!G x. (segment G /\ ~(component  (ctop G) x  = EMPTY) ) ==>
14826     inductive_set G
14827         { e | (G e /\ (?p. (e SUBSET squc p) /\
14828               (squ p SUBSET component  (ctop G) x)) ) } `,
14829   (* {{{ proof *)
14830   [
14831   REP_BASIC_TAC;
14832   TYPE_THEN `S = { e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x)) ) } ` ABBREV_TAC ;
14833   REWRITE_TAC[inductive_set];
14834   CONJ_TAC;
14835   EXPAND_TAC "S";
14836   REWRITE_TAC[SUBSET];
14837   MESON_TAC[];
14838   CONJ_TAC;
14839   TYPE_THEN `(?m. squ m SUBSET (component  (ctop G) x))` SUBGOAL_TAC;
14840   IMATCH_MP_TAC  comp_squ;
14841   ASM_REWRITE_TAC[];
14842   REP_BASIC_TAC;
14843   TYPE_THEN `(?p e. G e /\ e SUBSET closure top2 (squ p) /\ squ p SUBSET component (ctop G) x)` SUBGOAL_TAC;
14844   IMATCH_MP_TAC  comp_squ_adj;
14845   ASM_MESON_TAC[];
14846   REP_BASIC_TAC;
14847   UND 3;
14848   REWRITE_TAC[EMPTY_EXISTS ];
14849   EXPAND_TAC "S";
14850   REWRITE_TAC[];
14851   REWRITE_TAC [squ_closure];
14852   TYPE_THEN `e` EXISTS_TAC;
14853   ASM_REWRITE_TAC[];
14854   TYPE_THEN `p` EXISTS_TAC;
14855   ASM_REWRITE_TAC[GSYM squ_closure];
14856   REP_BASIC_TAC;
14857   UND 5;
14858   EXPAND_TAC "S";
14859   REWRITE_TAC[];
14860   REP_BASIC_TAC;
14861   ASM_REWRITE_TAC[];
14862   TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
14863   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
14864   REP_BASIC_TAC;
14865   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
14866   ASM_MESON_TAC[];
14867   DISCH_TAC;
14868   TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC;
14869   IMATCH_MP_TAC  edge_inter;
14870   ASM_REWRITE_TAC[];
14871   REP_BASIC_TAC;
14872   REWRITE_TAC[GSYM squ_closure];
14873   IMATCH_MP_TAC  along_lemma9;
14874   RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing;]);
14875   TYPE_THEN `m` EXISTS_TAC;
14876   TYPE_THEN `p` EXISTS_TAC;
14877   TYPE_THEN `C` EXISTS_TAC;
14878   ASM_REWRITE_TAC[];
14879   ]);;
14880   (* }}} *)
14881
14882 let along_lemma11 = prove_by_refinement(
14883   `!G  x e .  (segment G /\ ~(component  (ctop G) x  = EMPTY)  /\
14884      (G e)) ==>
14885    (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x))`,
14886   (* {{{ proof *)
14887   [
14888   REP_BASIC_TAC;
14889   TYPE_THEN `S = {e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x)) ) }` ABBREV_TAC ;
14890   TYPE_THEN ` S = G` SUBGOAL_TAC;
14891   COPY  2;
14892   UND 4;
14893   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
14894   REP_BASIC_TAC;
14895   FIRST_ASSUM IMATCH_MP_TAC ;
14896   TYPE_THEN `inductive_set G S` SUBGOAL_TAC;
14897   EXPAND_TAC "S";
14898   IMATCH_MP_TAC  along_lemma10;
14899   ASM_REWRITE_TAC[];
14900   ASM_REWRITE_TAC[inductive_set];
14901   EXPAND_TAC "S";
14902   DISCH_TAC;
14903   USE 4 GSYM;
14904   PROOF_BY_CONTR_TAC;
14905   UND 0;
14906   REWRITE_TAC[];
14907   ONCE_ASM_REWRITE_TAC[];
14908   REWRITE_TAC[];
14909   ASM_MESON_TAC[];
14910   ]);;
14911   (* }}} *)
14912
14913
14914 (* along_lemma11
14915    is essentially the proof that there are only two connected
14916    components (because there are only two possible instantiations of p
14917    Come back and finish the proof  of the Jordan curve.  *)
14918
14919
14920 (* ------------------------------------------------------------------ *)
14921 (* SECTION I *)
14922 (* ------------------------------------------------------------------ *)
14923
14924 (* ALL about graphs *)
14925
14926 (*** JRH systematically changed (Y,X)graph to (X,Y)graph for all X and Y,
14927      and made corresponding changes to other type annotations.
14928      The core now alphabetically sorts the type variables in a definition.
14929  ***)
14930
14931 let (mk_graph_t,dest_graph_t) = abbrev_type
14932    `:(A->bool)#(B->bool)#(B->(A->bool))` "graph_t";;
14933
14934 let graph_vertex = jordan_def
14935    `graph_vertex (G:(A,B)graph_t) = FST (dest_graph_t G)`;;
14936
14937 let graph_edge = jordan_def
14938    `graph_edge (G:(A,B)graph_t) = part1 (dest_graph_t G)`;;
14939
14940 let graph_inc = jordan_def
14941    `graph_inc (G:(A,B)graph_t) = drop1 (dest_graph_t G)`;;
14942
14943 let graph = jordan_def `graph (G:(A,B)graph_t) <=>
14944    (IMAGE (graph_inc G) (graph_edge G)) SUBSET
14945    { s | (s SUBSET (graph_vertex G)) /\ (s HAS_SIZE 2) }`;;
14946
14947 let graph_incident = jordan_def `graph_incident
14948    (G:(A,B)graph_t) e x <=>
14949    (graph_edge G e) /\ (graph_inc G e x)`;;
14950
14951 let graph_iso = jordan_def
14952    `graph_iso f (G:(A,B)graph_t) (H:(A',B')graph_t) <=>
14953    (?u v. (f = (u,v)) /\ (BIJ u (graph_vertex G) (graph_vertex H)) /\
14954    (BIJ v (graph_edge G) (graph_edge H)) /\
14955    (!e. (graph_edge G e) ==>
14956       (graph_inc H (v e) = IMAGE u (graph_inc G e))))`;;
14957
14958 (* specify a graph by
14959    { {a,b}, .... } of endpoints of edges.  *)
14960
14961 let mk_simple_graph = jordan_def `mk_simple_graph (E:(A->bool)->bool) =
14962   mk_graph_t
14963   (UNIONS E, (E:(A->bool)->bool),
14964    (\ (x:A->bool) (y:A). (x y)))`;;
14965
14966 let K33 = jordan_def `K33 = mk_simple_graph
14967    { {1,10}, {2,10}, {3,10},
14968      {1,20}, {2,20}, {3,20},
14969      {1,30}, {2,30}, {3,30} }`;;
14970
14971 let graph_del = jordan_def `graph_del (G:(A,B)graph_t) V E =
14972   mk_graph_t
14973    ((graph_vertex G DIFF V),
14974     (graph_edge G DIFF
14975         (E UNION { (e:B) | ?(v:A). (V v /\ graph_incident G e v ) })),
14976     (graph_inc G))`;;
14977
14978 let graph_path = jordan_def `graph_path (G:(A,B)graph_t) f n <=>
14979    (?v e . (f = (v,e)) /\ (INJ v { m | m <=| n } (graph_vertex G)) /\
14980    (INJ e { m | m <| n } (graph_edge G)) /\
14981    (!i. (i <| n )  ==>
14982          (graph_inc G (e i) = {(v  i), (v (SUC i))})))`;;
14983
14984 let graph_cycle = jordan_def `graph_cycle (G:(A,B)graph_t) f n <=>
14985    (?v e . (f = (v,e)) /\ (INJ v { m | m <| n } (graph_vertex G)) /\
14986    (INJ e { m | m <| n } (graph_edge G)) /\
14987    (!i. (i <| n )  ==>
14988          (graph_inc G (e i) = {(v  i), (v ((SUC i) %| (n)))})))`;;
14989
14990 let graph_connected = jordan_def `graph_connected (G:(A,B)graph_t) <=>
14991   !v v'. (graph_vertex G v) /\ (graph_vertex G v') /\ ~(v = v') ==>
14992    (?f n. (graph_path G f n) /\ (FST f 0 = v) /\ (FST f n = v'))`;;
14993
14994 let graph_2_connected = jordan_def `graph_2_connected (G:(A,B)graph_t) <=>
14995   (graph_connected G) /\
14996   (!v. (graph_vertex G v) ==> (graph_connected
14997      (graph_del G {v} EMPTY)))`;;
14998
14999 let simple_arc = jordan_def `simple_arc (U:(A->bool)->bool) C <=>
15000    (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\
15001    (continuous f (top_of_metric(UNIV,d_real)) U) /\
15002    (INJ f { x | &.0 <= x /\ x <= &.1} (UNIONS U)))`;;
15003
15004 let simple_closed_curve = jordan_def
15005    `simple_closed_curve (U:(A->bool)->bool) C <=>
15006    (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\
15007    (continuous f (top_of_metric(UNIV,d_real)) U) /\
15008    (INJ f { x | &.0 <= x /\ x < &.1} (UNIONS U)) /\
15009    (f (&.0) = f (&.1)))`;;
15010
15011 let simple_polygonal_arc = jordan_def
15012    `simple_polygonal_arc PE C <=>
15013     (simple_arc (top_of_metric(euclid 2,d_euclid)) C) /\
15014     (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;;
15015
15016 let simple_polygonal_curve = jordan_def
15017    `simple_polygonal_curve PE C <=>
15018     (simple_closed_curve (top_of_metric(euclid 2,d_euclid)) C) /\
15019     (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;;
15020
15021 let hv_line = jordan_def
15022    `hv_line E <=> (!e. (E e) ==> (?x y. (e = mk_line (point x) (point y)) /\
15023       ((FST x = FST y) \/ (SND x = SND y))))`;;
15024
15025 let p_conn = jordan_def
15026    `p_conn A x y <=> (?C. (simple_polygonal_arc hv_line C) /\
15027      (C SUBSET A) /\ (C x) /\ (C y))`;;
15028
15029 let subf = jordan_def
15030    `subf A (f:A->B) g x = if (A x) then (f x) else (g x)`;;
15031
15032 let min_real_le = prove_by_refinement(
15033   `!x y. (min_real x y <= x) /\ (min_real x y <= y)`,
15034   (* {{{ proof *)
15035   [
15036   REP_BASIC_TAC;
15037   REWRITE_TAC[min_real];
15038   COND_CASES_TAC;
15039   UND 0;
15040   REAL_ARITH_TAC;
15041   UND 0;
15042   REAL_ARITH_TAC ;
15043   ]);;
15044   (* }}} *)
15045
15046 let subf_lemma = prove_by_refinement(
15047   `!X dX B (x:A).
15048      (metric_space (X,dX)) /\ (closed_ (top_of_metric(X,dX)) B) /\
15049      (~(B x)) /\ (X x) ==>
15050      (?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))`,
15051   (* {{{ proof *)
15052
15053   [
15054   REWRITE_TAC[closed;open_DEF ];
15055   REP_BASIC_TAC;
15056   UND 2;
15057   UND 3;
15058   ASM_SIMP_TAC[GSYM top_of_metric_unions];
15059   REP_BASIC_TAC;
15060   TYPE_THEN `(X DIFF B) x` SUBGOAL_TAC;
15061   REWRITE_TAC[DIFF];
15062   ASM_REWRITE_TAC[];
15063   DISCH_TAC;
15064   TYPEL_THEN [`X`;`dX`;`(X DIFF B)`;`x`] (fun t-> ASSUME_TAC (ISPECL t open_ball_nbd)); (* // *)
15065   REP_BASIC_TAC;
15066   REWR 6;
15067   TYPE_THEN `e` EXISTS_TAC;
15068   UND 6;
15069   REWRITE_TAC[open_ball;SUBSET;DIFF;];
15070   REP_BASIC_TAC;
15071   ASM_REWRITE_TAC[];
15072   REP_BASIC_TAC;
15073   ASM_MESON_TAC[ISUBSET ;];
15074   ]);;
15075
15076   (* }}} *)
15077
15078 let subf_cont = prove_by_refinement(
15079   `!X dX Y dY A B (f:A->B) g.
15080      ((metric_space (X,dX)) /\ (metric_space (Y,dY)) /\
15081      (closed_ (top_of_metric(X,dX)) A ) /\
15082      (closed_ (top_of_metric(X,dX)) B ) /\
15083      (metric_continuous f (A,dX) (Y,dY)) /\
15084      (metric_continuous g (B,dX) (Y,dY)) /\
15085      (!x. (A x /\ B x) ==> (f x = g x))) ==>
15086      (metric_continuous (subf A f g) (A UNION B,dX) (Y,dY))`,
15087   (* {{{ proof *)
15088   [
15089   REWRITE_TAC[metric_continuous;metric_continuous_pt];
15090   DISCH_ALL_TAC;
15091   DISCH_ALL_TAC;
15092   RIGHT_TAC "delta";
15093   DISCH_TAC;
15094   REWRITE_TAC[UNION];
15095   TYPE_THEN `(A x \/ ~(A x)) /\ (B x \/ (~(B x)))` (fun t-> MP_TAC (TAUT  t ));
15096   DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[GSYM DISJ_ASSOC;RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR] t));
15097   REP_CASES_TAC;
15098   TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL);
15099   TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL);
15100   REP_BASIC_TAC;
15101   REWR 8;
15102   REWR 9;
15103   TYPE_THEN `min_real delta delta'` EXISTS_TAC;
15104   CONJ_TAC;
15105   REWRITE_TAC[min_real];
15106   COND_CASES_TAC;
15107   ASM_REWRITE_TAC[];
15108   ASM_REWRITE_TAC[];
15109   REP_BASIC_TAC;
15110   TYPE_THEN `A y \/ (~(A y) /\ B y)` SUBGOAL_TAC;
15111   UND 9;
15112   MESON_TAC[];
15113   DISCH_THEN DISJ_CASES_TAC;
15114   REWRITE_TAC[subf];
15115   ASM_REWRITE_TAC[];
15116   UND 12;
15117   DISCH_THEN IMATCH_MP_TAC ;
15118   ASM_REWRITE_TAC[];
15119   UND 8;
15120   (* save_goal "ss" *)
15121   TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
15122   REWRITE_TAC[min_real_le];
15123   REAL_ARITH_TAC;
15124   (* 1b case *)
15125   REWRITE_TAC[subf];
15126   ASM_REWRITE_TAC[];
15127   TYPE_THEN `f x = g x` SUBGOAL_TAC;
15128   ASM_MESON_TAC[];
15129   DISCH_THEN_REWRITE;
15130   UND 10;
15131   DISCH_THEN IMATCH_MP_TAC ;
15132   ASM_REWRITE_TAC[];
15133   UND 8;
15134   TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
15135   REWRITE_TAC[min_real_le];
15136   REAL_ARITH_TAC ;
15137   (* 2nd case *)
15138   TYPE_THEN `X x` SUBGOAL_TAC;
15139   UND 2;
15140   REWRITE_TAC[closed;open_DEF;SUBSET ;];
15141   REP_BASIC_TAC;
15142   TSPEC  `x` 8;
15143   UND 8;
15144   ASM_REWRITE_TAC[];
15145   UND 0;
15146   SIMP_TAC[GSYM top_of_metric_unions];
15147   DISCH_TAC;
15148   TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))` SUBGOAL_TAC;
15149   IMATCH_MP_TAC  subf_lemma;
15150   TYPE_THEN `X` EXISTS_TAC;
15151   ASM_REWRITE_TAC[];
15152   REP_BASIC_TAC;
15153   TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL);
15154   REP_BASIC_TAC;
15155   REWR 4;
15156   TYPE_THEN `min_real delta delta'` EXISTS_TAC;
15157   CONJ_TAC;
15158   REWRITE_TAC[min_real];
15159   COND_CASES_TAC;
15160   ASM_REWRITE_TAC[];
15161   ASM_REWRITE_TAC[];
15162   REP_BASIC_TAC;
15163   TYPE_THEN `A y` SUBGOAL_TAC;
15164   TYPE_THEN `~(B y) ==> A y` SUBGOAL_TAC;
15165   ASM_MESON_TAC[];
15166   DISCH_THEN IMATCH_MP_TAC ;
15167   FIRST_ASSUM IMATCH_MP_TAC ;
15168   UND 4;
15169   TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
15170   REWRITE_TAC[min_real_le];
15171   REAL_ARITH_TAC;
15172   REWRITE_TAC[subf];
15173   DISCH_TAC;
15174   ASM_REWRITE_TAC[];
15175   FIRST_ASSUM IMATCH_MP_TAC ;
15176   ASM_REWRITE_TAC[];
15177   UND 4;
15178   TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
15179   REWRITE_TAC[min_real_le];
15180   REAL_ARITH_TAC;
15181   (* 2 LEFT *)
15182   TYPE_THEN `X x` SUBGOAL_TAC;
15183   UND 3;
15184   REWRITE_TAC[closed;open_DEF;SUBSET ;];
15185   REP_BASIC_TAC;
15186   TSPEC  `x` 8;
15187   UND 8;
15188   ASM_REWRITE_TAC[];
15189   UND 0;
15190   SIMP_TAC[GSYM top_of_metric_unions];
15191   DISCH_TAC;
15192   TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(A y))))` SUBGOAL_TAC;
15193   IMATCH_MP_TAC  subf_lemma;
15194   TYPE_THEN `X` EXISTS_TAC;
15195   ASM_REWRITE_TAC[];
15196   REP_BASIC_TAC;
15197   TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL);
15198   REP_BASIC_TAC;
15199   REWR 5;
15200   TYPE_THEN `min_real delta delta'` EXISTS_TAC;
15201   CONJ_TAC;
15202   REWRITE_TAC[min_real];
15203   COND_CASES_TAC;
15204   ASM_REWRITE_TAC[];
15205   ASM_REWRITE_TAC[];
15206   REP_BASIC_TAC;
15207   TYPE_THEN `~(A y)` SUBGOAL_TAC;
15208   FIRST_ASSUM IMATCH_MP_TAC ;
15209   UND 5;
15210   TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
15211   REWRITE_TAC[min_real_le];
15212   REAL_ARITH_TAC;
15213   REWRITE_TAC[subf];
15214   DISCH_TAC;
15215   ASM_REWRITE_TAC[];
15216   FIRST_ASSUM IMATCH_MP_TAC ;
15217   TYPE_THEN `B y` SUBGOAL_TAC;
15218   ASM_MESON_TAC[];
15219   DISCH_THEN_REWRITE;
15220   UND 5;
15221   TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
15222   REWRITE_TAC[min_real_le];
15223   REAL_ARITH_TAC;
15224   (* 1 LEFT *)
15225   TYPE_THEN `&1` EXISTS_TAC;
15226   ASM_MESON_TAC [REAL_ARITH `&0 < &1`];
15227   ]);;
15228   (* }}} *)
15229
15230 let p_conn_subset = prove_by_refinement(
15231   `!A B x y. (A SUBSET B) /\ (p_conn A x y) ==> (p_conn B x y)`,
15232   (* {{{ proof *)
15233   [
15234   REWRITE_TAC[p_conn];
15235   REP_BASIC_TAC;
15236   TYPE_THEN `C` EXISTS_TAC;
15237   ASM_REWRITE_TAC[];
15238   ASM_MESON_TAC[ISUBSET];
15239   ]);;
15240   (* }}} *)
15241
15242 let mk_line_symm = prove_by_refinement(
15243   `!x y. mk_line x y = mk_line y x`,
15244   (* {{{ proof *)
15245   [
15246   REWRITE_TAC[mk_line];
15247   REP_BASIC_TAC;
15248   IMATCH_MP_TAC  EQ_EXT;
15249   REP_BASIC_TAC;
15250   REWRITE_TAC[];
15251   EQ_TAC;
15252   REP_BASIC_TAC;
15253   TYPE_THEN `(&1 - t)` EXISTS_TAC;
15254   ONCE_REWRITE_TAC [euclid_add_comm];
15255   ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`];
15256   REP_BASIC_TAC;
15257   TYPE_THEN `(&1 - t)` EXISTS_TAC;
15258   ONCE_REWRITE_TAC [euclid_add_comm];
15259   ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`];
15260   ]);;
15261   (* }}} *)
15262
15263 let mk_line_sub = prove_by_refinement(
15264   `!x y z. ( ~(x = z) /\ (mk_line x y z)) ==>
15265         (mk_line x y = mk_line x z)`,
15266   (* {{{ proof *)
15267   [
15268   REWRITE_TAC[mk_line];
15269   REP_BASIC_TAC;
15270   IMATCH_MP_TAC  EQ_EXT;
15271   REP_BASIC_TAC;
15272   REWRITE_TAC[];
15273   EQ_TAC;
15274   REP_BASIC_TAC;
15275   TYPE_THEN `~(t = &1)` SUBGOAL_TAC;
15276   REP_BASIC_TAC;
15277   REWR 0;
15278   UND 0;
15279   REDUCE_TAC;
15280   REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero];
15281   ASM_REWRITE_TAC[];
15282   DISCH_TAC;
15283   TYPE_THEN `s = (&1 /(&1 - t))` ABBREV_TAC;
15284   TYPE_THEN `(t' - t)*s` EXISTS_TAC;
15285   ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;];
15286   TYPE_THEN `(&1 - t) * s = &1` SUBGOAL_TAC;
15287   EXPAND_TAC "s";
15288   IMATCH_MP_TAC  REAL_DIV_LMUL;
15289   UND 3;
15290   REAL_ARITH_TAC;
15291   DISCH_TAC;
15292   TYPE_THEN `(t' - t) * s + (&1 - (t' - t) * s) * t = (t' - t) *((&1- t)* s) + t ` SUBGOAL_TAC;
15293   real_poly_tac;
15294   DISCH_THEN_REWRITE;
15295   ASM_REWRITE_TAC[];
15296   TYPE_THEN `(&1 - (t' - t) * s)*(&1 - t) = (&1 - t) - (t' - t)*(&1-t)*s` SUBGOAL_TAC;
15297   real_poly_tac;
15298   DISCH_THEN_REWRITE;
15299   ASM_REWRITE_TAC[];
15300   REWRITE_TAC[REAL_ARITH  `((t' - t)* &1 + t = t') /\ (&1 - t - (t' - t)* &1 = (&1 - t'))`];
15301   (* 2nd half *)
15302   REP_BASIC_TAC;
15303   UND 2;
15304   ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;];
15305   DISCH_THEN_REWRITE;
15306   TYPE_THEN `t' + (&1 - t')*t` EXISTS_TAC;
15307   TYPE_THEN `(&1 - (t' + (&1 - t') * t)) = ((&1 - t') * (&1 - t))` SUBGOAL_TAC;
15308   real_poly_tac;
15309   DISCH_THEN_REWRITE;
15310   ]);;
15311   (* }}} *)
15312
15313 let mk_line_2 = prove_by_refinement(
15314   `!x y p q. (mk_line x y p) /\ (mk_line x y q) /\ (~(p = q)) ==>
15315     (mk_line x y = mk_line p q)`,
15316   (* {{{ proof *)
15317   [
15318   REP_BASIC_TAC;
15319   TYPE_THEN `x = p`  ASM_CASES_TAC ;
15320   ASM_REWRITE_TAC[];
15321   IMATCH_MP_TAC  mk_line_sub;
15322   ASM_MESON_TAC[];
15323   ASM_MESON_TAC[mk_line_sub;mk_line_symm];
15324   ]);;
15325   (* }}} *)
15326
15327 let mk_line_inter = prove_by_refinement(
15328   `!x y p q. ~(mk_line x y = mk_line p q) ==>
15329     (?z. (mk_line x y INTER mk_line p q) SUBSET {z} )`,
15330   (* {{{ proof *)
15331   [
15332   REP_BASIC_TAC;
15333   TYPE_THEN `(?z. (mk_line x y INTER mk_line p q) z)` ASM_CASES_TAC;
15334   REP_BASIC_TAC;
15335   TYPE_THEN `z` EXISTS_TAC;
15336   REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
15337   REP_BASIC_TAC;
15338   UND 1;
15339   REWRITE_TAC[INTER];
15340   REP_BASIC_TAC;
15341   ASM_MESON_TAC[mk_line_2];
15342   REWRITE_TAC[SUBSET;INR IN_SING];
15343   ASM_MESON_TAC[];
15344   ]);;
15345   (* }}} *)
15346
15347 let mk_line_fin_inter = prove_by_refinement(
15348   `!E. (FINITE E) /\ (!e. (E e) ==> (?x y. e = mk_line x y)) ==>
15349     (?X. (FINITE X) /\
15350     (!e f z. (E e) /\ (E f) /\ ~(e = f) /\ e z /\ f z ==> (X z)))`,
15351   (* {{{ proof *)
15352   [
15353   REP_BASIC_TAC;
15354   TYPE_THEN `E2 = { (e,f) | (E e) /\ (E f) /\ (~(e = f)) }` ABBREV_TAC;
15355   TYPE_THEN `EE = { (e,f) | (E e) /\ (E f) }` ABBREV_TAC;
15356   (*   *)
15357   TYPE_THEN `FINITE EE` SUBGOAL_TAC;
15358   EXPAND_TAC "EE";
15359   IMATCH_MP_TAC  (INR FINITE_PRODUCT);
15360   ASM_REWRITE_TAC[];
15361   DISCH_TAC;
15362   (*   *)
15363   TYPE_THEN `FINITE E2` SUBGOAL_TAC;
15364   EXPAND_TAC "E2";
15365   IMATCH_MP_TAC  FINITE_SUBSET;
15366   TYPE_THEN `EE` EXISTS_TAC;
15367   ASM_REWRITE_TAC[];
15368   EXPAND_TAC "EE";
15369   EXPAND_TAC "E2";
15370   REWRITE_TAC[SUBSET;];
15371   MESON_TAC[];
15372   DISCH_TAC;
15373   (*  *)
15374   TYPE_THEN `E3 = IMAGE (\u. (FST u INTER SND u)) E2` ABBREV_TAC;
15375   TYPE_THEN `FINITE E3` SUBGOAL_TAC;
15376   EXPAND_TAC "E3";
15377   IMATCH_MP_TAC  FINITE_IMAGE;
15378   ASM_REWRITE_TAC[];
15379   DISCH_TAC;
15380   (*  *)
15381   TYPE_THEN `UNIONS E3` EXISTS_TAC;
15382   CONJ_TAC;
15383   ASM_SIMP_TAC[FINITE_FINITE_UNIONS];
15384   GEN_TAC;
15385   EXPAND_TAC "E3";
15386   EXPAND_TAC "E2";
15387   REWRITE_TAC[IMAGE];
15388   CONV_TAC (dropq_conv "x");
15389   REP_BASIC_TAC;
15390   ASM_REWRITE_TAC[];
15391   TYPE_THEN `e` (WITH 0 o ISPEC);
15392   TYPE_THEN `f` (USE 0 o ISPEC);
15393   UND 0;
15394   UND 12;
15395   ASM_REWRITE_TAC[];
15396   REP_BASIC_TAC;
15397   ASM_REWRITE_TAC[];
15398   (*  *)
15399   TYPE_THEN `(?z. (mk_line x y INTER mk_line x' y') SUBSET {z} )` SUBGOAL_TAC;
15400   IMATCH_MP_TAC mk_line_inter;
15401   ASM_MESON_TAC[];
15402   REP_BASIC_TAC;
15403   IMATCH_MP_TAC  FINITE_SUBSET;
15404   TYPE_THEN `{z}` EXISTS_TAC;
15405   ASM_REWRITE_TAC[FINITE_SING ];
15406   REP_BASIC_TAC;
15407   EXPAND_TAC "E3";
15408   EXPAND_TAC "E2";
15409   REWRITE_TAC[IMAGE];
15410   REWRITE_TAC[UNIONS];
15411   CONV_TAC (dropq_conv "x");
15412   CONV_TAC (dropq_conv "u");
15413   REWRITE_TAC[INTER];
15414   TYPE_THEN `e` EXISTS_TAC;
15415   TYPE_THEN `f` EXISTS_TAC;
15416   ASM_REWRITE_TAC[];
15417   ]);;
15418   (* }}} *)
15419
15420 let euclid_euclid0 = prove_by_refinement(
15421   `!n. (euclid n (euclid0))`,
15422   (* {{{ proof *)
15423   [
15424   REWRITE_TAC[euclid0;euclid];
15425   ]);;
15426   (* }}} *)
15427
15428 let euclid0_point = prove_by_refinement(
15429   `euclid0 = point(&0,&0)`,
15430   (* {{{ proof *)
15431   [
15432   REWRITE_TAC[point_split;euclid_euclid0];
15433   REWRITE_TAC[euclid0];
15434   ]);;
15435   (* }}} *)
15436
15437 let EVEN2 = prove_by_refinement(
15438   `EVEN 0 /\ ~(EVEN 1) /\ (EVEN 2) /\ ~(EVEN 3) /\
15439   (EVEN 4) /\ ~(EVEN 5)`,
15440   (* {{{ proof *)
15441   [
15442   REWRITE_TAC[EVEN; ARITH_RULE `(1 = SUC 0) /\ (2 = SUC 1) /\ (3 = SUC 2) /\ (4 = SUC 3) /\ (5 = SUC 4)`];
15443   ]);;
15444   (* }}} *)
15445
15446 let h_seg_openball = prove_by_refinement(
15447   `!x e e'. (&0 < e) /\ (&0 <= e') /\ (e' < e) /\ (euclid 2 x) ==>
15448      (mk_segment x (x + e' *# e1) SUBSET
15449               (open_ball(euclid 2,d_euclid)) x e)`,
15450   (* {{{ proof *)
15451   [
15452   REP_BASIC_TAC;
15453   REWRITE_TAC[open_ball;mk_segment;SUBSET;];
15454   REP_BASIC_TAC;
15455   USE 4 (SYM);
15456   UND 4;
15457   REWRITE_TAC[GSYM euclid_add_assoc;euclid_ldistrib;GSYM euclid_rdistrib];
15458   REWRITE_TAC[REAL_ARITH `a + &1 - a = &1`;euclid_scale_one;euclid_scale_act];
15459   TYPE_THEN  `x'' = (((&1 - a) * e') *# e1)` ABBREV_TAC ;
15460   DISCH_TAC;
15461   ASM_REWRITE_TAC[];
15462   TYPE_THEN `euclid 2 x''` SUBGOAL_TAC;
15463   EXPAND_TAC "x''";
15464   IMATCH_MP_TAC  euclid_scale_closure;
15465   REWRITE_TAC[e1;euclid_point];
15466   DISCH_TAC;
15467   SUBCONJ_TAC;
15468   EXPAND_TAC "x'";
15469   IMATCH_MP_TAC  euclid_add_closure;
15470   ASM_REWRITE_TAC[];
15471   DISCH_TAC;
15472   TYPE_THEN `!x y.  d_euclid x y = d_euclid (x+euclid0) y ` SUBGOAL_TAC;
15473   REWRITE_TAC[euclid_rzero];
15474   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
15475   EXPAND_TAC "x'";
15476   ASSUME_TAC euclid_euclid0;
15477   KILL 7;
15478   TYPE_THEN `d_euclid (euclid_plus x euclid0) (euclid_plus x x'') = d_euclid euclid0 x''` SUBGOAL_TAC;
15479   ASM_MESON_TAC[metric_translate_LEFT];
15480   DISCH_THEN_REWRITE;
15481   EXPAND_TAC "x''";
15482   REWRITE_TAC[e1;point_scale];
15483   REDUCE_TAC;
15484   REWRITE_TAC[euclid0_point;d_euclid_point;];
15485   REDUCE_TAC;
15486   REWRITE_TAC[EXP_2;ARITH_RULE `0 *| 0 = 0`];
15487   REDUCE_TAC;
15488   REWRITE_TAC[REAL_ARITH `&0 - x = --x`;REAL_POW_NEG;EVEN2];
15489   TYPE_THEN `&0 <= (&1 - a) * e'` SUBGOAL_TAC;
15490   IMATCH_MP_TAC  REAL_LE_MUL;
15491   ASM_REWRITE_TAC[];
15492   UND 5;
15493   REAL_ARITH_TAC;
15494   ASM_SIMP_TAC[POW_2_SQRT;];
15495   DISCH_TAC;
15496   ASM_CASES_TAC `a = &0`;
15497   ASM_REWRITE_TAC[];
15498   REDUCE_TAC;
15499   ASM_REWRITE_TAC[];
15500   TYPE_THEN `(&1 - a) * e' < &1 * e ==> (&1 - a) * e' <  e` SUBGOAL_TAC;
15501   REAL_ARITH_TAC;
15502   DISCH_THEN IMATCH_MP_TAC ;
15503   IMATCH_MP_TAC  REAL_LT_MUL2;
15504   ASM_REWRITE_TAC[];
15505   UND 5;
15506   UND 6;
15507   UND 11;
15508   REAL_ARITH_TAC;
15509   ]);;
15510   (* }}} *)
15511
15512 let openball_convex = prove_by_refinement(
15513   `!x e n. (convex (open_ball (euclid n,d_euclid) x e))`,
15514   (* {{{ proof *)
15515   [
15516   REWRITE_TAC[convex;open_ball;SUBSET;mk_segment;];
15517   REP_BASIC_TAC;
15518   USE 0 SYM;
15519   ASM_REWRITE_TAC[];
15520   SUBCONJ_TAC;
15521   EXPAND_TAC "x''";
15522   IMATCH_MP_TAC  (euclid_add_closure);
15523   CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
15524   DISCH_TAC;
15525   TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC;
15526   REWRITE_TAC[trivial_lin_combo];
15527   DISCH_THEN_REWRITE;
15528   EXPAND_TAC "x''";
15529   (* special case *)
15530   ASM_CASES_TAC `a = &0` ;
15531   UND 10;
15532   DISCH_THEN_REWRITE;
15533   REDUCE_TAC;
15534   ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;];
15535   TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u < a*e) /\ (v <= (&1- a)*e))  ==> (d < e))` SUBGOAL_TAC;
15536   REP_BASIC_TAC;
15537   TYPE_THEN `u + v < (a*e) + (&1 - a)*e` SUBGOAL_TAC;
15538   IMATCH_MP_TAC  REAL_LTE_ADD2;
15539   ASM_REWRITE_TAC[];
15540   REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`];
15541   UND 13;
15542   REAL_ARITH_TAC ;
15543   DISCH_THEN IMATCH_MP_TAC ;
15544   TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC;
15545   TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC;
15546   TYPE_THEN `d_euclid z x''` EXISTS_TAC;
15547   TYPE_THEN `euclid n z` SUBGOAL_TAC;
15548   EXPAND_TAC "z";
15549   IMATCH_MP_TAC  (euclid_add_closure);
15550   CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
15551   DISCH_TAC;
15552   CONJ_TAC;
15553   EXPAND_TAC "x''";
15554   IMATCH_MP_TAC  metric_space_triangle;
15555   TYPE_THEN `euclid n` EXISTS_TAC;
15556   REWRITE_TAC[metric_euclid];
15557   ASM_REWRITE_TAC[trivial_lin_combo];
15558   CONJ_TAC;
15559   EXPAND_TAC "z";
15560   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;
15561   IMATCH_MP_TAC  metric_translate;
15562   TYPE_THEN `n` EXISTS_TAC;
15563   REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
15564   DISCH_THEN_REWRITE;
15565   TYPE_THEN `d_euclid (a *# x) (a *# x')  = abs  (a) * d_euclid x x'` SUBGOAL_TAC;
15566   IMATCH_MP_TAC  norm_scale_vec;
15567   ASM_MESON_TAC[];
15568   DISCH_THEN_REWRITE;
15569   TYPE_THEN `abs  a = a` SUBGOAL_TAC;
15570   ASM_MESON_TAC[REAL_ABS_REFL];
15571   DISCH_THEN_REWRITE;
15572   IMATCH_MP_TAC  REAL_PROP_LT_LMUL;
15573   ASM_REWRITE_TAC[];
15574   UND 10;
15575   UND 2;
15576   REAL_ARITH_TAC;
15577   (* LAST case *)
15578   EXPAND_TAC "z";
15579   EXPAND_TAC "x''";
15580   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;
15581   IMATCH_MP_TAC  metric_translate_LEFT;
15582   TYPE_THEN `n` EXISTS_TAC;
15583   REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
15584   DISCH_THEN_REWRITE;
15585   TYPE_THEN `!b. d_euclid (b *# x) (b *# y)  = abs  (b) * d_euclid x y` SUBGOAL_TAC;
15586   GEN_TAC;
15587   IMATCH_MP_TAC  norm_scale_vec;
15588   ASM_MESON_TAC[];
15589   DISCH_THEN_REWRITE;
15590   TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
15591   REWRITE_TAC [REAL_ABS_REFL];
15592   UND 1;
15593   REAL_ARITH_TAC;
15594   DISCH_THEN_REWRITE;
15595   IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
15596   ASM_REWRITE_TAC[];
15597   CONJ_TAC;
15598   UND 1;
15599   REAL_ARITH_TAC;
15600   UND 3;
15601   REAL_ARITH_TAC;
15602   ]);;
15603   (* }}} *)
15604
15605 let openball_mk_segment_end = prove_by_refinement(
15606   `!x e n u v.
15607      (open_ball(euclid n,d_euclid) x e u) /\
15608      (open_ball(euclid n,d_euclid) x e v) ==>
15609      (mk_segment u v SUBSET (open_ball(euclid n,d_euclid) x e))`,
15610   (* {{{ proof *)
15611   [
15612   REP_BASIC_TAC;
15613   ASSUME_TAC openball_convex;
15614   TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL);
15615   USE 2 (REWRITE_RULE[convex]);
15616   FIRST_ASSUM IMATCH_MP_TAC ;
15617   ASM_REWRITE_TAC[];
15618   ]);;
15619   (* }}} *)
15620
15621 let euclid_eq_minus = prove_by_refinement(
15622   `!x y. (x = y) <=> (euclid_minus x y = euclid0)`,
15623   (* {{{ proof *)
15624   [
15625   REWRITE_TAC[euclid_minus;euclid0];
15626   REP_BASIC_TAC;
15627   EQ_TAC ;
15628   DISCH_THEN_REWRITE;
15629   REDUCE_TAC;
15630   DISCH_TAC;
15631   IMATCH_MP_TAC  EQ_EXT;
15632   ONCE_REWRITE_TAC [REAL_ARITH `(a = b) <=> (a - b = &0)`];
15633   GEN_TAC;
15634   FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `x':num`));
15635   BETA_TAC ;
15636   MESON_TAC[];
15637   ]);;
15638   (* }}} *)
15639
15640 let euclid_plus_pair = prove_by_refinement(
15641   `!x y u v. (euclid_plus (x + y) (u + v) = (x + u) + (y + v))`,
15642   (* {{{ proof *)
15643   [
15644   REWRITE_TAC[euclid_plus];
15645   REP_BASIC_TAC;
15646   IMATCH_MP_TAC  EQ_EXT;
15647   BETA_TAC;
15648   REAL_ARITH_TAC;
15649   ]);;
15650   (* }}} *)
15651
15652 let euclid_minus_scale = prove_by_refinement(
15653   `!x y. (euclid_minus x y = euclid_plus x ((-- &.1) *# y))`,
15654   (* {{{ proof *)
15655   [
15656   REP_BASIC_TAC;
15657   REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
15658   IMATCH_MP_TAC  EQ_EXT;
15659   BETA_TAC;
15660   REAL_ARITH_TAC;
15661   ]);;
15662   (* }}} *)
15663
15664 let euclid_scale_cancel = prove_by_refinement(
15665   `!t x y . (~(t = &0)) /\ (t *# x = t *# y) ==> (x = y)`,
15666   (* {{{ proof *)
15667   [
15668   REP_BASIC_TAC;
15669   IMATCH_MP_TAC  EQ_EXT;
15670   GEN_TAC;
15671   FIRST_ASSUM  (fun t -> MP_TAC (AP_THM t `x':num`));
15672   REWRITE_TAC[euclid_scale;];
15673   ASM_MESON_TAC[REAL_MUL_LTIMES];
15674   ]);;
15675   (* }}} *)
15676
15677 let mk_segment_inj_image = prove_by_refinement(
15678   `!x y n. (euclid n x) /\ (euclid n y) /\ ~(x = y) ==> (?f.
15679      (continuous f
15680         (top_of_metric(UNIV,d_real))
15681         (top_of_metric (euclid n,d_euclid))) /\
15682       (INJ f {x | &0 <= x /\ x <= &1} (euclid n)) /\
15683      (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y))`,
15684   (* {{{ proof *)
15685
15686   [
15687   DISCH_ALL_TAC;
15688   TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
15689   CONJ_TAC;
15690   IMATCH_MP_TAC  cont_mk_segment;
15691   ASM_REWRITE_TAC[];
15692   REWRITE_TAC[joinf;IMAGE ];
15693   REWRITE_TAC[mk_segment];
15694   CONJ_TAC;
15695   (* new stuff *)
15696   REWRITE_TAC[INJ];
15697   CONJ_TAC;
15698   REP_BASIC_TAC;
15699   TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
15700   UND 4;
15701   REAL_ARITH_TAC;
15702   DISCH_THEN_REWRITE;
15703   ASM_CASES_TAC `x' < &1`;
15704   ASM_REWRITE_TAC[];
15705   IMATCH_MP_TAC  euclid_add_closure;
15706   CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
15707   ASM_REWRITE_TAC[];
15708   REP_BASIC_TAC;
15709   UND 3;
15710   TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
15711   UND 7;
15712   REAL_ARITH_TAC;
15713   DISCH_THEN_REWRITE;
15714   TYPE_THEN `~(y' < &0)` SUBGOAL_TAC;
15715   UND 5;
15716   REAL_ARITH_TAC;
15717   DISCH_THEN_REWRITE;
15718   TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC;
15719  TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC;
15720   UND 6;
15721   REAL_ARITH_TAC;
15722   DISCH_THEN   DISJ_CASES_TAC;
15723   ASM_REWRITE_TAC[];
15724   TYPE_THEN `~(x' < &1)` SUBGOAL_TAC;
15725   UND 3;
15726   REAL_ARITH_TAC;
15727   DISCH_THEN_REWRITE;
15728   ASM_REWRITE_TAC[];
15729   REDUCE_TAC;
15730   REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
15731   DISCH_THEN_REWRITE;
15732
15733   TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC;
15734  TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC;
15735   UND 4;
15736   REAL_ARITH_TAC;
15737   DISCH_THEN   DISJ_CASES_TAC;
15738   ASM_REWRITE_TAC[];
15739   TYPE_THEN `~(y' < &1)` SUBGOAL_TAC;
15740   UND 3;
15741   REAL_ARITH_TAC;
15742   DISCH_THEN_REWRITE;
15743   ASM_REWRITE_TAC[];
15744   REDUCE_TAC;
15745   REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
15746   DISCH_THEN_REWRITE;
15747   (* th *)
15748   ONCE_REWRITE_TAC [euclid_eq_minus];
15749   REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act];
15750   ONCE_REWRITE_TAC [euclid_plus_pair];
15751   REWRITE_TAC[GSYM euclid_rdistrib];
15752   REDUCE_TAC;
15753   REWRITE_TAC[REAL_ARITH  `x' + -- &1 * y' = x' - y'`];
15754   REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`];
15755   REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus];
15756   (* th1 *)
15757   DISCH_TAC;
15758   PROOF_BY_CONTR_TAC;
15759   UND 2;
15760   REWRITE_TAC[];
15761   IMATCH_MP_TAC  euclid_scale_cancel;
15762   TYPE_THEN `(x' - y')` EXISTS_TAC;
15763   ASM_REWRITE_TAC[];
15764   UND 8;
15765   REAL_ARITH_TAC;
15766   KILL 2;
15767   (* old stuff *)
15768   IMATCH_MP_TAC  EQ_EXT;
15769   GEN_TAC;
15770   ASM_REWRITE_TAC[];
15771   EQ_TAC;
15772   DISCH_TAC;
15773   CHO 2;
15774   UND 2;
15775   COND_CASES_TAC;
15776   DISCH_ALL_TAC;
15777   JOIN 3 2;
15778   ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
15779   DISCH_ALL_TAC;
15780   UND 5;
15781   COND_CASES_TAC;
15782   DISCH_TAC;
15783   TYPE_THEN `&1 - x''` EXISTS_TAC;
15784   SUBCONJ_TAC;
15785   UND 5;
15786   REAL_ARITH_TAC ;
15787   DISCH_TAC;
15788   CONJ_TAC;
15789   UND 3;
15790   REAL_ARITH_TAC ;
15791   ONCE_REWRITE_TAC [euclid_add_comm];
15792   REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
15793   ASM_MESON_TAC[];
15794   DISCH_TAC;
15795   ASM_REWRITE_TAC[];
15796   TYPE_THEN `&0` EXISTS_TAC;
15797   CONJ_TAC;
15798   REAL_ARITH_TAC ;
15799   CONJ_TAC;
15800   REAL_ARITH_TAC ;
15801   REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
15802   (* 2nd half *)
15803   DISCH_TAC;
15804   CHO 2;
15805   TYPE_THEN `&1 - a` EXISTS_TAC ;
15806   ASM_REWRITE_TAC[];
15807   CONJ_TAC;
15808   AND 2;
15809   AND 2;
15810   UND 3;
15811   UND 4;
15812   REAL_ARITH_TAC ;
15813   COND_CASES_TAC;
15814   ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
15815   COND_CASES_TAC;
15816   REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
15817   ASM_MESON_TAC [euclid_add_comm];
15818   TYPE_THEN `a = &.0` SUBGOAL_TAC;
15819   UND 4;
15820   UND 3;
15821   AND 2;
15822   UND 3;
15823   REAL_ARITH_TAC ;
15824   DISCH_TAC;
15825   REWR 2;
15826   REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
15827   ]);;
15828
15829   (* }}} *)
15830
15831 let h_simple_polygonal = prove_by_refinement(
15832   `!x e. (euclid 2 x) /\ (~(e = &0)) ==>
15833     (simple_polygonal_arc hv_line (mk_segment x (x + e *# e1)))`,
15834   (* {{{ proof *)
15835   [
15836   REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ];
15837   REP_BASIC_TAC;
15838   CONJ_TAC;
15839   ASSUME_TAC mk_segment_inj_image;
15840   TYPEL_THEN [`x`;`x + (e *# e1)`;`2`] (USE 2 o ISPECL);
15841   TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e1)) /\ ~(x = euclid_plus x (e *# e1))` SUBGOAL_TAC;
15842   ASM_REWRITE_TAC[];
15843   CONJ_TAC;
15844   IMATCH_MP_TAC  euclid_add_closure;
15845   ASM_REWRITE_TAC[];
15846   IMATCH_MP_TAC  euclid_scale_closure;
15847   REWRITE_TAC [e1;euclid_point];
15848   REP_BASIC_TAC;
15849   FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `0`));
15850   REWRITE_TAC[euclid_plus;euclid_scale;e1;coord01];
15851   UND 0;
15852   REAL_ARITH_TAC;
15853   DISCH_TAC;
15854   REWR 2;
15855   REP_BASIC_TAC;
15856   TYPE_THEN `f` EXISTS_TAC;
15857   ASM_REWRITE_TAC[];
15858   SIMP_TAC  [GSYM top_of_metric_unions;metric_euclid];
15859   ASM_REWRITE_TAC[];
15860   (* E *)
15861   USE 1 (MATCH_MP point_onto);
15862   REP_BASIC_TAC;
15863   TYPE_THEN `{(mk_line (point p) (point p + (e *# e1)))}` EXISTS_TAC;
15864   REWRITE_TAC[INR IN_SING];
15865   CONJ_TAC;
15866   REWRITE_TAC[e1;ISUBSET;mk_segment;mk_line];
15867   REP_BASIC_TAC;
15868   TYPE_THEN `a` EXISTS_TAC;
15869   ASM_MESON_TAC[];
15870   CONJ_TAC;
15871   REWRITE_TAC[FINITE_SING];
15872   REP_BASIC_TAC;
15873   ASM_REWRITE_TAC[];
15874   TYPE_THEN `p` EXISTS_TAC;
15875   TYPE_THEN `(FST p + e, SND p)` EXISTS_TAC;
15876   REWRITE_TAC[];
15877   AP_TERM_TAC;
15878   REWRITE_TAC[e1;point_scale];
15879   REDUCE_TAC;
15880   TYPE_THEN `euclid_plus (point p) (point (e,&0)) = euclid_plus (point (FST p,SND p)) (point (e,&0))` SUBGOAL_TAC;
15881   REWRITE_TAC[];
15882   DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]);
15883   REWRITE_TAC[point_add];
15884   REDUCE_TAC;
15885   ]);;
15886   (* }}} *)
15887
15888 let pconn_refl = prove_by_refinement(
15889   `!A x. (top2 A) /\ (A x) ==> (p_conn A x x)`,
15890   (* {{{ proof *)
15891   [
15892   REWRITE_TAC[p_conn;top2];
15893   REP_BASIC_TAC;
15894   TYPE_THEN `?e. (&0 < e) /\ (open_ball(euclid 2,d_euclid) x e SUBSET A)` SUBGOAL_TAC;
15895   ASM_MESON_TAC[open_ball_nbd;metric_euclid];
15896   REP_BASIC_TAC;
15897   TYPE_THEN `mk_segment x (x + (e/(&2))*# e1)` EXISTS_TAC;
15898   TYPE_THEN `euclid 2 x` SUBGOAL_TAC;
15899   USE 1(MATCH_MP sub_union);
15900   UND 1;
15901   ASM_MESON_TAC [top_of_metric_unions;metric_euclid;ISUBSET];
15902   DISCH_TAC;
15903   TYPE_THEN `~(e/(&2) = &0)` SUBGOAL_TAC;
15904   IMATCH_MP_TAC  (REAL_ARITH `(&0 < x) ==> (~(x = &0))` );
15905   ASM_REWRITE_TAC[REAL_LT_HALF1];
15906   DISCH_TAC;
15907   CONJ_TAC;
15908   IMATCH_MP_TAC  h_simple_polygonal;
15909   ASM_REWRITE_TAC[];
15910   CONJ_TAC;
15911   IMATCH_MP_TAC  SUBSET_TRANS;
15912   TYPE_THEN `open_ball (euclid 2,d_euclid) x e ` EXISTS_TAC;
15913   ASM_REWRITE_TAC[];
15914   IMATCH_MP_TAC  h_seg_openball;
15915   ASM_REWRITE_TAC[];
15916   UND 3;
15917   MESON_TAC[half_pos;REAL_ARITH `&0 < x ==> &0 <= x`];
15918   REWRITE_TAC[mk_segment];
15919   TYPE_THEN `&1` EXISTS_TAC;
15920   REDUCE_TAC;
15921   REWRITE_TAC[euclid_scale_one ;euclid_scale0;euclid_rzero;];
15922   ARITH_TAC;
15923   ]);;
15924   (* }}} *)
15925
15926 let pconn_symm = prove_by_refinement(
15927   `!A x y. (p_conn A x y ==> p_conn A y x)`,
15928   (* {{{ proof *)
15929   [
15930   REWRITE_TAC[p_conn;];
15931   MESON_TAC[];
15932   ]);;
15933   (* }}} *)
15934
15935 let compose_cont = prove_by_refinement(
15936   `!(f:A->B) (g:B->C) X dX Y dY Z dZ.
15937     (metric_continuous f (X,dX) (Y,dY)) /\
15938     (metric_continuous g (Y,dY) (Z,dZ)) /\
15939     (IMAGE f X SUBSET Y) ==>
15940     (metric_continuous (compose g f) (X,dX) (Z,dZ))`,
15941   (* {{{ proof *)
15942   [
15943   REWRITE_TAC[metric_continuous;metric_continuous_pt];
15944   REP_BASIC_TAC;
15945   RIGHT_TAC "delta";
15946   DISCH_TAC;
15947   REWRITE_TAC[compose];
15948   TYPEL_THEN [`f x`;`epsilon`] (USE 1 o ISPECL);
15949   REP_BASIC_TAC;
15950   REWR 1;
15951   REP_BASIC_TAC;
15952   TYPEL_THEN [`x`;`delta`] (USE 2 o ISPECL);
15953   REP_BASIC_TAC;
15954   REWR 2;
15955   REP_BASIC_TAC;
15956   TYPE_THEN `delta'` EXISTS_TAC;
15957   ASM_REWRITE_TAC[];
15958   REP_BASIC_TAC;
15959   FIRST_ASSUM IMATCH_MP_TAC ;
15960   USE 0 (REWRITE_RULE[IMAGE;SUBSET]);
15961   ASM_MESON_TAC[];
15962   ]);;
15963   (* }}} *)
15964
15965 let compose_image = prove_by_refinement(
15966   `!(f:A->B) (g:B->C) X.
15967    (IMAGE (compose g f) X) =
15968     (IMAGE g (IMAGE f X))`,
15969   (* {{{ proof *)
15970   [
15971   REWRITE_TAC[IMAGE];
15972   REP_BASIC_TAC;
15973   IMATCH_MP_TAC  EQ_EXT;
15974   REWRITE_TAC[];
15975   GEN_TAC;
15976   NAME_CONFLICT_TAC;
15977   REWRITE_TAC[compose];
15978   CONV_TAC (dropq_conv "x''");
15979   ]);;
15980   (* }}} *)
15981
15982 let linear_cont = prove_by_refinement(
15983   `!a b. metric_continuous (\t. t * a + (&1 - t)* b)
15984      (UNIV,d_real) (UNIV,d_real)`,
15985   (* {{{ proof *)
15986   [
15987   REP_BASIC_TAC;
15988   REWRITE_TAC[metric_continuous;metric_continuous_pt];
15989   REP_BASIC_TAC;
15990   RIGHT_TAC "delta";
15991   DISCH_TAC;
15992   TYPE_THEN `a = b` ASM_CASES_TAC;
15993   ASM_REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `!u. u + &1 - u = &1`];
15994   REDUCE_TAC;
15995   ASM_REWRITE_TAC[d_real;REAL_ARITH `b - b = &0`;ABS_0;];
15996   TYPE_THEN `epsilon` EXISTS_TAC;
15997   ASM_REWRITE_TAC[];
15998   (* snd *)
15999   TYPE_THEN `delta = epsilon/(abs  (a-b))` ABBREV_TAC;
16000   TYPE_THEN `delta` EXISTS_TAC;
16001   SUBCONJ_TAC;
16002   EXPAND_TAC "delta";
16003   IMATCH_MP_TAC  REAL_LT_DIV;
16004   ASM_REWRITE_TAC[];
16005   UND 1;
16006   REAL_ARITH_TAC;
16007   DISCH_TAC;
16008   REWRITE_TAC[d_real];
16009   REP_BASIC_TAC;
16010   TYPE_THEN `((x * a + (&1 - x) * b) - (y * a + (&1 - y) * b))  = (x - y)*(a - b)` SUBGOAL_TAC;
16011   real_poly_tac;
16012   DISCH_THEN_REWRITE;
16013   TYPE_THEN `epsilon = delta * (abs  (a - b))` SUBGOAL_TAC;
16014   EXPAND_TAC "delta";
16015   ONCE_REWRITE_TAC [EQ_SYM_EQ];
16016   IMATCH_MP_TAC  REAL_DIV_RMUL;
16017   UND 1;
16018   REAL_ARITH_TAC;
16019   DISCH_THEN_REWRITE;
16020   REWRITE_TAC[ABS_MUL];
16021   IMATCH_MP_TAC  REAL_PROP_LT_RMUL;
16022   ASM_REWRITE_TAC[];
16023   UND 1;
16024   REAL_ARITH_TAC;
16025   ]);;
16026   (* }}} *)
16027
16028 let linear_image_gen = prove_by_refinement(
16029   `!a b c d. (a < b) /\ (c < d) ==>
16030      (IMAGE (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b )
16031          {x | c <= x /\ x <= d } =
16032             {y | a <= y /\ y <= b})`,
16033   (* {{{ proof *)
16034   [
16035   REP_BASIC_TAC;
16036   REWRITE_TAC[IMAGE];
16037   IMATCH_MP_TAC  EQ_EXT;
16038   REP_BASIC_TAC;
16039   REWRITE_TAC[];
16040   TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC;
16041   UND 1;
16042   REAL_ARITH_TAC;
16043   TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
16044   UND 0;
16045   REAL_ARITH_TAC;
16046   REP_BASIC_TAC;
16047   ABBREV_TAC   `e = &1/(d-c)`;
16048   TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC;
16049   GEN_TAC;
16050   EXPAND_TAC "e";
16051   REWRITE_TAC[real_div];
16052   REDUCE_TAC;
16053   DISCH_TAC;
16054   ASM_REWRITE_TAC[];
16055   TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC;
16056   EXPAND_TAC "e";
16057   REWRITE_TAC[real_div];
16058   REDUCE_TAC;
16059   REWRITE_TAC[GSYM real_div];
16060   IMATCH_MP_TAC  REAL_DIV_REFL;
16061   UND 3;
16062   REAL_ARITH_TAC;
16063   DISCH_TAC;
16064   TYPE_THEN `&0 < e` SUBGOAL_TAC;
16065   EXPAND_TAC "e";
16066   IMATCH_MP_TAC  REAL_LT_DIV;
16067   ASM_REWRITE_TAC[];
16068   REAL_ARITH_TAC;
16069   DISCH_TAC;
16070   (*   *)
16071   EQ_TAC;
16072   REP_BASIC_TAC;
16073   ASM_REWRITE_TAC[];
16074   CONJ_TAC;
16075   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;
16076   ASM_REWRITE_TAC[REAL_MUL_ASSOC];
16077   REDUCE_TAC;
16078   DISCH_THEN IMATCH_MP_TAC ;
16079   ineq_le_tac `(d-c)*e*a + (d - x')*(b - a)*e = ((x' - c) * e) * a + ((d - x') * e) * b`;
16080   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;
16081   ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`];
16082   DISCH_THEN IMATCH_MP_TAC ;
16083   ineq_le_tac `(((x' - c) * e) * a + ((d - x') * e) * b) + (x'-c )*(b-a)*e = b * (d - c) * e`;
16084   (* 2nd direction *)
16085   REP_BASIC_TAC;
16086   TYPE_THEN `x' = ((d*b - a*c) - (d -c)*x)/(b - a)` ABBREV_TAC ;
16087   TYPE_THEN `x'` EXISTS_TAC;
16088   TYPE_THEN `x'*(b - a) = ((d*b - a*c) - (d -c)*x)` SUBGOAL_TAC;
16089   EXPAND_TAC "x'";
16090   IMATCH_MP_TAC  REAL_DIV_RMUL;
16091   UND 1;
16092   REAL_ARITH_TAC;
16093   DISCH_TAC;
16094   (* sv *)
16095   SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`;
16096   MESON_TAC[REAL_PROP_LE_RCANCEL];
16097   DISCH_TAC;
16098   CONJ_TAC;
16099   CONJ_TAC;
16100   FIRST_ASSUM IMATCH_MP_TAC ;
16101   TYPE_THEN `(b - a)` EXISTS_TAC;
16102   ASM_REWRITE_TAC[];
16103   ineq_le_tac `c * (b - a) + (d-c)*(b-x) = d * b - a * c - (d - c) * x`;
16104   FIRST_ASSUM IMATCH_MP_TAC ;
16105   TYPE_THEN `(b - a)` EXISTS_TAC;
16106   ASM_REWRITE_TAC[];
16107   ineq_le_tac `(d * b - a * c - (d - c) * x) + (d-c)*(x-a) = d * (b - a)`;
16108   TYPE_THEN `((x' - c) * e) * a + ((d - x') * e) * b = (d*b - c*a - x'*(b-a))*e` SUBGOAL_TAC;
16109   real_poly_tac;
16110   DISCH_THEN_REWRITE;
16111   ASM_REWRITE_TAC[];
16112   TYPE_THEN `(d * b - c * a - (d * b - a * c - (d - c) * x)) = x*(d-c)` SUBGOAL_TAC;
16113   real_poly_tac;
16114   DISCH_THEN_REWRITE;
16115   REWRITE_TAC[GSYM REAL_MUL_ASSOC];
16116   ASM_REWRITE_TAC[];
16117   REDUCE_TAC;
16118   ]);;
16119   (* }}} *)
16120
16121 let linear_image_rev = prove_by_refinement(
16122   `!a b c d. (a < b) /\ (c < d) ==>
16123      (IMAGE (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a )
16124          {x | c <= x /\ x <= d } =
16125             {y | a <= y /\ y <= b})`,
16126   (* {{{ proof *)
16127   [
16128   REP_BASIC_TAC;
16129   REWRITE_TAC[IMAGE];
16130   IMATCH_MP_TAC  EQ_EXT;
16131   REP_BASIC_TAC;
16132   REWRITE_TAC[];
16133   TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC;
16134   UND 1;
16135   REAL_ARITH_TAC;
16136   TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
16137   UND 0;
16138   REAL_ARITH_TAC;
16139   REP_BASIC_TAC;
16140   ABBREV_TAC   `e = &1/(d-c)`;
16141   TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC;
16142   GEN_TAC;
16143   EXPAND_TAC "e";
16144   REWRITE_TAC[real_div];
16145   REDUCE_TAC;
16146   DISCH_TAC;
16147   ASM_REWRITE_TAC[];
16148   TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC;
16149   EXPAND_TAC "e";
16150   REWRITE_TAC[real_div];
16151   REDUCE_TAC;
16152   REWRITE_TAC[GSYM real_div];
16153   IMATCH_MP_TAC  REAL_DIV_REFL;
16154   UND 3;
16155   REAL_ARITH_TAC;
16156   DISCH_TAC;
16157   TYPE_THEN `&0 < e` SUBGOAL_TAC;
16158   EXPAND_TAC "e";
16159   IMATCH_MP_TAC  REAL_LT_DIV;
16160   ASM_REWRITE_TAC[];
16161   REAL_ARITH_TAC;
16162   DISCH_TAC;
16163   (*   *)
16164   EQ_TAC;
16165   REP_BASIC_TAC;
16166   ASM_REWRITE_TAC[];
16167   CONJ_TAC;
16168   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;
16169   ASM_REWRITE_TAC[REAL_MUL_ASSOC];
16170   REDUCE_TAC;
16171   DISCH_THEN IMATCH_MP_TAC ;
16172   ineq_le_tac `(d-c)*e*a + (x' - c)*(b - a)*e = ((x' - c) * e) * b + ((d - x') * e) * a`;
16173   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;
16174   ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`];
16175   DISCH_THEN IMATCH_MP_TAC ;
16176   ineq_le_tac `(((x' - c) * e) * b + ((d - x') * e) * a) + (d - x' )*(b-a)*e = b * (d - c) * e`;
16177   (* 2nd direction *)
16178   REP_BASIC_TAC;
16179   TYPE_THEN `x' = ((b*c  - a*d) + (d -c)*x)/(b - a)` ABBREV_TAC ;
16180   TYPE_THEN `x'` EXISTS_TAC;
16181   TYPE_THEN `x'*(b - a) = ((b*c - a*d ) + (d -c)*x)` SUBGOAL_TAC;
16182   EXPAND_TAC "x'";
16183   IMATCH_MP_TAC  REAL_DIV_RMUL;
16184   UND 1;
16185   REAL_ARITH_TAC;
16186   DISCH_TAC;
16187   (* sv *)
16188   SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`;
16189   MESON_TAC[REAL_PROP_LE_RCANCEL];
16190   DISCH_TAC;
16191   CONJ_TAC;
16192   CONJ_TAC;
16193   FIRST_ASSUM IMATCH_MP_TAC ;
16194   TYPE_THEN `(b - a)` EXISTS_TAC;
16195   ASM_REWRITE_TAC[];
16196   ineq_le_tac `c * (b - a) + (d-c)*(x-a) = b*c  - a*d + (d - c) * x`;
16197   FIRST_ASSUM IMATCH_MP_TAC ;
16198   TYPE_THEN `(b - a)` EXISTS_TAC;
16199   ASM_REWRITE_TAC[];
16200   ineq_le_tac `(b*c - a*d + (d - c) * x) + (d-c)*(b - x) = d * (b - a)`;
16201   TYPE_THEN `((x' - c) * e) * b + ((d - x') * e) * a = (d*a - c*b + x'*(b-a))*e` SUBGOAL_TAC;
16202   real_poly_tac;
16203   DISCH_THEN_REWRITE;
16204   ASM_REWRITE_TAC[];
16205   TYPE_THEN `(d * a - c * b + b * c - a * d + (d - c) * x) = x*(d-c)` SUBGOAL_TAC;
16206   real_poly_tac;
16207   DISCH_THEN_REWRITE;
16208   REWRITE_TAC[GSYM REAL_MUL_ASSOC];
16209   ASM_REWRITE_TAC[];
16210   REDUCE_TAC;
16211   ]);;
16212   (* }}} *)
16213
16214 let linear_inj = prove_by_refinement(
16215   `!a b c d. (a < b) /\ (c < d) ==>
16216      (INJ (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b )
16217          {x | c <= x /\ x <= d }
16218             {y | a <= y /\ y <= b})`,
16219   (* {{{ proof *)
16220   [
16221   REP_BASIC_TAC;
16222   REWRITE_TAC[INJ];
16223   CONJ_TAC;
16224   REP_BASIC_TAC;
16225   ASSUME_TAC linear_image_gen;
16226   TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL);
16227   REWR 4;
16228   UND 4;
16229   REWRITE_TAC[IMAGE];
16230   DISCH_TAC;
16231   FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * a + (d - x) / (d - c) * b`));
16232   UND 5;
16233   REWRITE_TAC[];
16234   DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
16235   TYPE_THEN `x` EXISTS_TAC;
16236   ASM_REWRITE_TAC[];
16237   (* INJ proper *)
16238   REP_BASIC_TAC;
16239   UND 2;
16240   TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
16241   UND 0;
16242   REAL_ARITH_TAC;
16243   DISCH_TAC;
16244   TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ;
16245   TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC;
16246   REP_BASIC_TAC;
16247   EXPAND_TAC"e";
16248   REWRITE_TAC[real_div];
16249   REDUCE_TAC;
16250   DISCH_THEN_REWRITE;
16251   DISCH_TAC;
16252   USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]);
16253   UND 8;
16254   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;
16255   real_poly_tac;
16256   DISCH_THEN_REWRITE;
16257   REWRITE_TAC[REAL_ENTIRE];
16258   TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC;
16259   UND 1;
16260   REAL_ARITH_TAC;
16261   DISCH_THEN_REWRITE;
16262   TYPE_THEN `~(e = &0)` SUBGOAL_TAC;
16263   EXPAND_TAC"e";
16264   REWRITE_TAC[real_div];
16265   REDUCE_TAC;
16266   REWRITE_TAC[REAL_INV_EQ_0];
16267   UND 0;
16268   REAL_ARITH_TAC;
16269   REAL_ARITH_TAC;
16270   ]);;
16271   (* }}} *)
16272
16273 let linear_inj_rev = prove_by_refinement(
16274   `!a b c d. (a < b) /\ (c < d) ==>
16275      (INJ (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a )
16276          {x | c <= x /\ x <= d }
16277             {y | a <= y /\ y <= b})`,
16278   (* {{{ proof *)
16279   [
16280   REP_BASIC_TAC;
16281   REWRITE_TAC[INJ];
16282   CONJ_TAC;
16283   REP_BASIC_TAC;
16284   ASSUME_TAC linear_image_rev;
16285   TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL);
16286   REWR 4;
16287   UND 4;
16288   REWRITE_TAC[IMAGE];
16289   DISCH_TAC;
16290   FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * b + (d - x) / (d - c) * a`));
16291   UND 5;
16292   REWRITE_TAC[];
16293   DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
16294   TYPE_THEN `x` EXISTS_TAC;
16295   ASM_REWRITE_TAC[];
16296   (* INJ proper *)
16297   REP_BASIC_TAC;
16298   UND 2;
16299   TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
16300   UND 0;
16301   REAL_ARITH_TAC;
16302   DISCH_TAC;
16303   TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ;
16304   TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC;
16305   REP_BASIC_TAC;
16306   EXPAND_TAC"e";
16307   REWRITE_TAC[real_div];
16308   REDUCE_TAC;
16309   DISCH_THEN_REWRITE;
16310   DISCH_TAC;
16311   USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]);
16312   UND 8;
16313   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;
16314   real_poly_tac;
16315   DISCH_THEN_REWRITE;
16316   REWRITE_TAC[REAL_ENTIRE];
16317   TYPE_THEN `~(a-b = &0)` SUBGOAL_TAC;
16318   UND 1;
16319   REAL_ARITH_TAC;
16320   DISCH_THEN_REWRITE;
16321   TYPE_THEN `~(e = &0)` SUBGOAL_TAC;
16322   EXPAND_TAC"e";
16323   REWRITE_TAC[real_div];
16324   REDUCE_TAC;
16325   REWRITE_TAC[REAL_INV_EQ_0];
16326   UND 0;
16327   REAL_ARITH_TAC;
16328   REAL_ARITH_TAC;
16329   ]);;
16330   (* }}} *)
16331
16332 let comp_comp = prove_by_refinement(
16333   `(o) = (compose:(B->C) -> ((A->B)-> (A->C))) `,
16334   (* {{{ proof *)
16335   [
16336   IMATCH_MP_TAC  EQ_EXT;
16337   GEN_TAC;
16338   IMATCH_MP_TAC  EQ_EXT;
16339   GEN_TAC;
16340   IMATCH_MP_TAC  EQ_EXT;
16341   GEN_TAC;
16342   REWRITE_TAC[o_DEF;compose];
16343   ]);;
16344   (* }}} *)
16345
16346 let arc_reparameter_rev = prove_by_refinement(
16347   `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\
16348            INJ f {x | c <= x /\ x <= d} (euclid 2) /\
16349          (a < b) /\ (c < d)  ==>
16350            (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\
16351            INJ g {x | a <= x /\ x <= b} (euclid 2) /\
16352          (f d  = g a) /\ (f c = g b) /\
16353       (!x y x' y'. (f x = g x') /\ (f y = g y') /\
16354          (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\
16355          (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==>
16356            ((x < y) = (y' < x'))) /\
16357       (IMAGE f { x | c <= x /\ x <= d } =
16358          IMAGE g { x | a <= x /\ x <= b } )))`,
16359   (* {{{ proof *)
16360   [
16361   REP_BASIC_TAC;
16362   TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (c) + (b - t)/(b - a) *(d) )` ABBREV_TAC ;
16363   TYPE_THEN `g = (f o f2)` ABBREV_TAC ;
16364   TYPE_THEN `g` EXISTS_TAC;
16365   (* general facts *)
16366   TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC;
16367   MESON_TAC[metric_real;top_of_metric_unions];
16368   DISCH_TAC;
16369   (* continuity *)
16370   CONJ_TAC;
16371   EXPAND_TAC "g";
16372   IMATCH_MP_TAC  continuous_comp;
16373   TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
16374   ASM_REWRITE_TAC[];
16375   REWRITE_TAC[top2];
16376   ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
16377   TYPE_THEN `f2 = (\t. t* (c - d + d*b - c*a)/(b - a) + (&1 - t)*(d*b-c*a)/(b - a))` SUBGOAL_TAC;
16378   EXPAND_TAC "f2";
16379   IMATCH_MP_TAC  EQ_EXT;
16380   BETA_TAC;
16381   GEN_TAC;
16382   REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`];
16383   REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL];
16384   DISJ1_TAC ;
16385   real_poly_tac;
16386   DISCH_THEN_REWRITE;
16387   ASM_REWRITE_TAC[linear_cont];
16388   (* IMAGE *)
16389   TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC;
16390   REWRITE_TAC[];
16391   EXPAND_TAC "f2";
16392   ASM_SIMP_TAC[linear_image_gen];
16393   DISCH_TAC;
16394   TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC;
16395   EXPAND_TAC "g";
16396   REWRITE_TAC[comp_comp;compose_image;];
16397   AP_TERM_TAC;
16398   ASM_REWRITE_TAC[];
16399   DISCH_TAC;
16400   ASM_REWRITE_TAC[];
16401   (* INJ *)
16402   EXPAND_TAC "g";
16403   REWRITE_TAC[comp_comp];
16404   (* XXX *)
16405   CONJ_TAC;
16406   IMATCH_MP_TAC  (COMP_INJ);
16407   TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
16408   UND 2;
16409   DISCH_THEN_REWRITE;
16410   KILL 7;
16411   ASM_REWRITE_TAC[];
16412   EXPAND_TAC "f2";
16413   IMATCH_MP_TAC  linear_inj;
16414   ASM_REWRITE_TAC[];
16415   (* ends   *)
16416   IMATCH_MP_TAC  (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`);
16417   CONJ_TAC;
16418   EXPAND_TAC "f2";
16419   REWRITE_TAC[compose];
16420   REDUCE_TAC;
16421   REWRITE_TAC[real_div;REAL_MUL_ASSOC;];
16422   REDUCE_TAC;
16423   TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC;
16424   IMATCH_MP_TAC  REAL_MUL_RINV;
16425   UND 1;
16426   REAL_ARITH_TAC;
16427   DISCH_THEN_REWRITE;
16428   REDUCE_TAC;
16429   (* monotone *)
16430   REWRITE_TAC[compose];
16431   REP_BASIC_TAC;
16432   TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC;
16433   USE 7 (REWRITE_RULE[IMAGE]);
16434   TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
16435   REWRITE_TAC[];
16436   DISCH_THEN_REWRITE;
16437   TYPE_THEN `y'` EXISTS_TAC;
16438   ASM_REWRITE_TAC[];
16439   REP_BASIC_TAC;
16440   TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC;
16441   USE 7 (REWRITE_RULE[IMAGE]);
16442   TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
16443   REWRITE_TAC[];
16444   DISCH_THEN_REWRITE;
16445   TYPE_THEN `x'` EXISTS_TAC;
16446   ASM_REWRITE_TAC[];
16447   REP_BASIC_TAC;
16448   TYPE_THEN `x = f2 x'` SUBGOAL_TAC;
16449   USE 2 (REWRITE_RULE[INJ]);
16450   REP_BASIC_TAC;
16451   FIRST_ASSUM IMATCH_MP_TAC ;
16452   ASM_REWRITE_TAC[];
16453   DISCH_TAC;
16454   TYPE_THEN `y = f2 y'` SUBGOAL_TAC;
16455   USE 2 (REWRITE_RULE[INJ]);
16456   REP_BASIC_TAC;
16457   FIRST_ASSUM IMATCH_MP_TAC ;
16458   ASM_REWRITE_TAC[];
16459   DISCH_TAC;
16460   ASM_REWRITE_TAC[];
16461   EXPAND_TAC "f2";
16462   ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`];
16463   REWRITE_TAC[real_div];
16464   TYPE_THEN `e = inv(b-a)` ABBREV_TAC ;
16465   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;
16466   real_poly_tac;
16467   DISCH_THEN_REWRITE;
16468   TYPE_THEN `&0 < e` SUBGOAL_TAC;
16469   EXPAND_TAC"e";
16470   IMATCH_MP_TAC  REAL_PROP_POS_INV;
16471   UND 1;
16472   REAL_ARITH_TAC;
16473   TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
16474   UND 0;
16475   REAL_ARITH_TAC;
16476   REWRITE_TAC[REAL_MUL_ASSOC];
16477   ASM_SIMP_TAC[REAL_PROP_POS_RMUL];
16478   ]);;
16479   (* }}} *)
16480
16481 let arc_reparameter_gen = prove_by_refinement(
16482   `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\
16483            INJ f {x | c <= x /\ x <= d} (euclid 2) /\
16484          (a < b) /\ (c < d)  ==>
16485            (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\
16486            INJ g {x | a <= x /\ x <= b} (euclid 2) /\
16487          (f c  = g a) /\ (f d = g b) /\
16488       (!x y x' y'. (f x = g x') /\ (f y = g y') /\
16489          (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\
16490          (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==>
16491            ((x < y) = (x' < y'))) /\
16492       (IMAGE f { x | c <= x /\ x <= d } =
16493          IMAGE g { x | a <= x /\ x <= b } )))`,
16494   (* {{{ proof *)
16495   [
16496   REP_BASIC_TAC;
16497   TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (d) + (b - t)/(b - a) *(c) )` ABBREV_TAC ;
16498   TYPE_THEN `g = (f o f2)` ABBREV_TAC ;
16499   TYPE_THEN `g` EXISTS_TAC;
16500   (* general facts *)
16501   TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC;
16502   MESON_TAC[metric_real;top_of_metric_unions];
16503   DISCH_TAC;
16504   (* continuity *)
16505   CONJ_TAC;
16506   EXPAND_TAC "g";
16507   IMATCH_MP_TAC  continuous_comp;
16508   TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
16509   ASM_REWRITE_TAC[];
16510   REWRITE_TAC[top2];
16511   ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
16512   TYPE_THEN `f2 = (\t. t* (d - c + c*b - d*a)/(b - a) + (&1 - t)*(c*b-d*a)/(b - a))` SUBGOAL_TAC;
16513   EXPAND_TAC "f2";
16514   IMATCH_MP_TAC  EQ_EXT;
16515   BETA_TAC;
16516   GEN_TAC;
16517   REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`];
16518   REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL];
16519   DISJ1_TAC ;
16520   real_poly_tac;
16521   DISCH_THEN_REWRITE;
16522   ASM_REWRITE_TAC[linear_cont];
16523   (* IMAGE *)
16524   TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC;
16525   REWRITE_TAC[];
16526   EXPAND_TAC "f2";
16527   ASM_SIMP_TAC[linear_image_rev];
16528   DISCH_TAC;
16529   TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC;
16530   EXPAND_TAC "g";
16531   REWRITE_TAC[comp_comp;compose_image;];
16532   AP_TERM_TAC;
16533   ASM_REWRITE_TAC[];
16534   DISCH_TAC;
16535   ASM_REWRITE_TAC[];
16536   (* INJ *)
16537   EXPAND_TAC "g";
16538   REWRITE_TAC[comp_comp];
16539   (* XXX *)
16540   CONJ_TAC;
16541   IMATCH_MP_TAC  (COMP_INJ);
16542   TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
16543   UND 2;
16544   DISCH_THEN_REWRITE;
16545   KILL 7;
16546   ASM_REWRITE_TAC[];
16547   EXPAND_TAC "f2";
16548   IMATCH_MP_TAC  linear_inj_rev;
16549   ASM_REWRITE_TAC[];
16550   (* ends   *)
16551   IMATCH_MP_TAC  (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`);
16552   CONJ_TAC;
16553   EXPAND_TAC "f2";
16554   REWRITE_TAC[compose];
16555   REDUCE_TAC;
16556   REWRITE_TAC[real_div;REAL_MUL_ASSOC;];
16557   REDUCE_TAC;
16558   TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC;
16559   IMATCH_MP_TAC  REAL_MUL_RINV;
16560   UND 1;
16561   REAL_ARITH_TAC;
16562   DISCH_THEN_REWRITE;
16563   REDUCE_TAC;
16564   (* monotone *)
16565   REWRITE_TAC[compose];
16566   REP_BASIC_TAC;
16567   TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC;
16568   USE 7 (REWRITE_RULE[IMAGE]);
16569   TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
16570   REWRITE_TAC[];
16571   DISCH_THEN_REWRITE;
16572   TYPE_THEN `y'` EXISTS_TAC;
16573   ASM_REWRITE_TAC[];
16574   REP_BASIC_TAC;
16575   TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC;
16576   USE 7 (REWRITE_RULE[IMAGE]);
16577   TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
16578   REWRITE_TAC[];
16579   DISCH_THEN_REWRITE;
16580   TYPE_THEN `x'` EXISTS_TAC;
16581   ASM_REWRITE_TAC[];
16582   REP_BASIC_TAC;
16583   TYPE_THEN `x = f2 x'` SUBGOAL_TAC;
16584   USE 2 (REWRITE_RULE[INJ]);
16585   REP_BASIC_TAC;
16586   FIRST_ASSUM IMATCH_MP_TAC ;
16587   ASM_REWRITE_TAC[];
16588   DISCH_TAC;
16589   TYPE_THEN `y = f2 y'` SUBGOAL_TAC;
16590   USE 2 (REWRITE_RULE[INJ]);
16591   REP_BASIC_TAC;
16592   FIRST_ASSUM IMATCH_MP_TAC ;
16593   ASM_REWRITE_TAC[];
16594   DISCH_TAC;
16595   ASM_REWRITE_TAC[];
16596   EXPAND_TAC "f2";
16597   ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`];
16598   REWRITE_TAC[real_div];
16599   TYPE_THEN `e = inv(b-a)` ABBREV_TAC ;
16600   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;
16601   real_poly_tac;
16602   DISCH_THEN_REWRITE;
16603   TYPE_THEN `&0 < e` SUBGOAL_TAC;
16604   EXPAND_TAC"e";
16605   IMATCH_MP_TAC  REAL_PROP_POS_INV;
16606   UND 1;
16607   REAL_ARITH_TAC;
16608   TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
16609   UND 0;
16610   REAL_ARITH_TAC;
16611   REWRITE_TAC[REAL_MUL_ASSOC];
16612   ASM_SIMP_TAC[REAL_PROP_POS_RMUL];
16613   ]);;
16614   (* }}} *)
16615
16616 let image_preimage = prove_by_refinement(
16617   `!(f:A->B) X Y. IMAGE f (preimage X f Y) SUBSET Y`,
16618   (* {{{ proof *)
16619   [
16620   REP_BASIC_TAC;
16621   REWRITE_TAC[IMAGE;SUBSET;INR in_preimage ;];
16622   MESON_TAC[];
16623   ]);;
16624   (* }}} *)
16625
16626 let preimage_union2 = prove_by_refinement(
16627   `!(f:A->B) A B X. (preimage X f (A UNION B)) =
16628     (preimage X f A UNION preimage X f B)`,
16629   (* {{{ proof *)
16630   [
16631   REP_BASIC_TAC;
16632   IMATCH_MP_TAC  SUBSET_ANTISYM;
16633   CONJ_TAC;
16634   REWRITE_TAC[preimage_union;image_preimage;];
16635   REWRITE_TAC[preimage;SUBSET;];
16636   MESON_TAC[];
16637   REWRITE_TAC[union_subset];
16638   REWRITE_TAC[preimage;SUBSET;UNION];
16639   MESON_TAC[];
16640   ]);;
16641   (* }}} *)
16642
16643 let union_diff  = prove_by_refinement(
16644   `!(X:A->bool) A B. (X = A UNION B) /\ (A INTER B = EMPTY) ==>
16645      (X DIFF B = A)`,
16646   (* {{{ proof *)
16647   [
16648   REP_GEN_TAC;
16649   SET_TAC[];
16650   ]);;
16651   (* }}} *)
16652
16653 let preimage_closed = prove_by_refinement(
16654   `!U V C (f:A->B). (continuous f U V) /\ (closed_ V C) /\
16655        (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==>
16656            (closed_ U (preimage (UNIONS U) f C))`,
16657   (* {{{ proof *)
16658
16659   [
16660   REP_BASIC_TAC;
16661   REWRITE_TAC[closed;open_DEF;];
16662   TYPE_THEN `(UNIONS U DIFF (preimage (UNIONS U) f C)) = preimage (UNIONS U) f (UNIONS V DIFF C)` SUBGOAL_TAC;
16663   IMATCH_MP_TAC  union_diff;
16664   REWRITE_TAC[GSYM preimage_union2];
16665   CONJ_TAC;
16666   TYPE_THEN `UNIONS V DIFF C UNION C = UNIONS V` SUBGOAL_TAC;
16667   TYPE_THEN `!P. C SUBSET P ==> (P DIFF C UNION C = P)` SUBGOAL_TAC;
16668   SET_TAC[];
16669   TYPE_THEN `C SUBSET UNIONS V` SUBGOAL_TAC;
16670   UND 1;
16671   REWRITE_TAC[closed;open_DEF;];
16672   DISCH_THEN_REWRITE;
16673   DISCH_TAC;
16674   DISCH_THEN (fun t-> ASM_SIMP_TAC[t]);
16675   DISCH_THEN_REWRITE;
16676   IMATCH_MP_TAC  SUBSET_ANTISYM;
16677   ASM_REWRITE_TAC [  subset_preimage;];
16678   REWRITE_TAC[preimage;SUBSET];
16679   MESON_TAC[];
16680   IMATCH_MP_TAC  preimage_disjoint;
16681   SET_TAC[];
16682   DISCH_THEN_REWRITE;
16683   CONJ_TAC;
16684   REWRITE_TAC[SUBSET;preimage];
16685   MESON_TAC[];
16686   UND 2;
16687   REWRITE_TAC[continuous];
16688   DISCH_THEN IMATCH_MP_TAC ;
16689   UND 1;
16690   REWRITE_TAC[closed;open_DEF;];
16691   MESON_TAC[];
16692   ]);;
16693
16694   (* }}} *)
16695
16696 let preimage_restrict = prove_by_refinement(
16697   `!(f:A->B) Z A B.  (A SUBSET B) ==>
16698       (preimage A f Z = A INTER preimage B f Z)`,
16699   (* {{{ proof *)
16700   [
16701   REP_BASIC_TAC;
16702   REWRITE_TAC[preimage;INTER;];
16703   TYPE_THEN `!y. (A SUBSET B ==> (A y /\ B y <=> A y))` SUBGOAL_TAC;
16704   MESON_TAC[ISUBSET];
16705   ASM_SIMP_TAC[];
16706   DISCH_TAC;
16707   IMATCH_MP_TAC  EQ_EXT;
16708   REWRITE_TAC[];
16709   ASM_MESON_TAC[];
16710   ]);;
16711   (* }}} *)
16712
16713 let continuous_delta = prove_by_refinement(
16714   `continuous (\x. (x *# dirac_delta 0)) (top_of_metric(UNIV,d_real))
16715      (top_of_metric(euclid 1,d_euclid)) `,
16716   (* {{{ proof *)
16717   [
16718   TYPE_THEN `IMAGE (\x. (x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC;
16719   REWRITE_TAC[IMAGE;SUBSET;];
16720   MESON_TAC[euclid_dirac];
16721   ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real];
16722   REWRITE_TAC[metric_continuous;metric_continuous_pt];
16723   REP_BASIC_TAC;
16724   RIGHT_TAC "delta";
16725   REP_BASIC_TAC;
16726   TYPE_THEN `epsilon` EXISTS_TAC;
16727   ASM_REWRITE_TAC[];
16728   REP_BASIC_TAC;
16729   ASM_SIMP_TAC[euclid_dirac;euclid1_abs];
16730   REWRITE_TAC[dirac_0];
16731   USE 2 (REWRITE_RULE [d_real]);
16732   ASM_REWRITE_TAC[];
16733   ]);;
16734   (* }}} *)
16735
16736 let continuous_neg_delta = prove_by_refinement(
16737   `continuous (\x. ((-- x) *# dirac_delta 0))
16738    (top_of_metric(UNIV,d_real))
16739      (top_of_metric(euclid 1,d_euclid)) `,
16740   (* {{{ proof *)
16741   [
16742   TYPE_THEN `IMAGE (\x. (-- x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC;
16743   REWRITE_TAC[IMAGE;SUBSET;];
16744   MESON_TAC[euclid_dirac];
16745   ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real];
16746   REWRITE_TAC[metric_continuous;metric_continuous_pt];
16747   REP_BASIC_TAC;
16748   RIGHT_TAC "delta";
16749   REP_BASIC_TAC;
16750   TYPE_THEN `epsilon` EXISTS_TAC;
16751   ASM_REWRITE_TAC[];
16752   REP_BASIC_TAC;
16753   ASM_SIMP_TAC[euclid_dirac;euclid1_abs];
16754   REWRITE_TAC[dirac_0];
16755   USE 2 (REWRITE_RULE [d_real]);
16756   UND 2;
16757   REAL_ARITH_TAC;
16758   ]);;
16759   (* }}} *)
16760
16761 let compact_max_real = prove_by_refinement(
16762   `!(f:A->real) U K.
16763     continuous f U (top_of_metric (UNIV,d_real)) /\
16764           compact U K /\
16765           ~(K = {})
16766           ==> (?x. K x /\ (!y. K y ==> f y  <= f x ))`,
16767   (* {{{ proof *)
16768   [
16769   REP_BASIC_TAC;
16770   TYPE_THEN `g = (\x. (x *# dirac_delta 0)) o f` ABBREV_TAC ;
16771   TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC;
16772   IMATCH_MP_TAC  compact_max;
16773   TYPE_THEN `U` EXISTS_TAC;
16774   ASM_REWRITE_TAC[];
16775   EXPAND_TAC "g";
16776   REWRITE_TAC[IMAGE_o];
16777   TYPE_THEN `X = IMAGE f K` ABBREV_TAC ;
16778   REWRITE_TAC[IMAGE ;SUBSET];
16779   CONJ_TAC;
16780   IMATCH_MP_TAC  continuous_comp;
16781   TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
16782   ASM_REWRITE_TAC[continuous_delta];
16783   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
16784   MESON_TAC[euclid_dirac];
16785   REP_BASIC_TAC;
16786   TYPE_THEN `x` EXISTS_TAC;
16787   ASM_REWRITE_TAC[];
16788   REP_BASIC_TAC;
16789   UND 4;
16790   EXPAND_TAC "g";
16791   REWRITE_TAC[o_DEF;dirac_0];
16792   ASM_MESON_TAC[];
16793   ]);;
16794   (* }}} *)
16795
16796 let compact_min_real = prove_by_refinement(
16797   `!(f:A->real) U K.
16798     continuous f U (top_of_metric (UNIV,d_real)) /\
16799           compact U K /\
16800           ~(K = {})
16801           ==> (?x. K x /\ (!y. K y ==> f x  <= f y ))`,
16802   (* {{{ proof *)
16803   [
16804   REP_BASIC_TAC;
16805   TYPE_THEN `g = (\x. (-- x *# dirac_delta 0)) o f` ABBREV_TAC ;
16806   TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC;
16807   IMATCH_MP_TAC  compact_max;
16808   TYPE_THEN `U` EXISTS_TAC;
16809   ASM_REWRITE_TAC[];
16810   EXPAND_TAC "g";
16811   REWRITE_TAC[IMAGE_o];
16812   TYPE_THEN `X = IMAGE f K` ABBREV_TAC ;
16813   REWRITE_TAC[IMAGE ;SUBSET];
16814   CONJ_TAC;
16815   IMATCH_MP_TAC  continuous_comp;
16816   TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
16817   ASM_REWRITE_TAC[continuous_neg_delta];
16818   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
16819   MESON_TAC[euclid_dirac];
16820   REP_BASIC_TAC;
16821   TYPE_THEN `x` EXISTS_TAC;
16822   ASM_REWRITE_TAC[];
16823   REP_BASIC_TAC;
16824   UND 4;
16825   EXPAND_TAC "g";
16826   REWRITE_TAC[o_DEF;dirac_0];
16827   ASM_MESON_TAC[REAL_ARITH `!u v. (-- u <= --v) <=> (v <= u)`];
16828   ]);;
16829   (* }}} *)
16830
16831 let continuous_I = prove_by_refinement(
16832   `continuous I (top_of_metric(UNIV,d_real))
16833      (top_of_metric(UNIV,d_real))`,
16834   (* {{{ proof *)
16835   [
16836   REWRITE_TAC[continuous];
16837   REP_BASIC_TAC;
16838   REWRITE_TAC[preimage];
16839   SIMP_TAC [GSYM top_of_metric_unions;metric_real];
16840   REWRITE_TAC[I_DEF];
16841   TYPE_THEN `{x | v x} = v` SUBGOAL_TAC;
16842   IMATCH_MP_TAC  EQ_EXT;
16843   REWRITE_TAC[];
16844   DISCH_THEN_REWRITE;
16845   ASM_REWRITE_TAC[];
16846   ]);;
16847   (* }}} *)
16848
16849 let compact_sup = prove_by_refinement(
16850   `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==>
16851     (?x. (X x) /\ (!y. (X y) ==> (y <= x)))`,
16852   (* {{{ proof *)
16853   [
16854   TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC;
16855   REWRITE_TAC[I_DEF];
16856   DISCH_TAC;
16857   TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC;
16858   ASM_REWRITE_TAC[];
16859   DISCH_THEN (fun t ->  ONCE_REWRITE_TAC [t]);
16860   REP_BASIC_TAC;
16861   IMATCH_MP_TAC  compact_max_real;
16862   TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
16863   ASM_REWRITE_TAC[continuous_I];
16864   ]);;
16865   (* }}} *)
16866
16867 let compact_inf = prove_by_refinement(
16868   `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==>
16869     (?x. (X x) /\ (!y. (X y) ==> (x <= y)))`,
16870   (* {{{ proof *)
16871   [
16872   TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC;
16873   REWRITE_TAC[I_DEF];
16874   DISCH_TAC;
16875   TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC;
16876   ASM_REWRITE_TAC[];
16877   DISCH_THEN (fun t ->  ONCE_REWRITE_TAC [t]);
16878   REP_BASIC_TAC;
16879   IMATCH_MP_TAC  compact_min_real;
16880   TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
16881   ASM_REWRITE_TAC[continuous_I];
16882   ]);;
16883   (* }}} *)
16884
16885 let preimage_compact = prove_by_refinement(
16886   `!C (f:A->B) Y dY Z dZ Y0.
16887    metric_space (Y,dY) /\ metric_space (Z,dZ) /\
16888   (compact (top_of_metric(Y,dY)) Y0) /\
16889   (continuous f (top_of_metric(Y0,dY))
16890             (top_of_metric(Z,dZ))) /\
16891   (IMAGE f Y0 SUBSET Z) /\
16892   (closed_ (top_of_metric(Z,dZ)) C) /\
16893   ~(IMAGE f Y0 INTER C = EMPTY) ==>
16894   (compact (top_of_metric(Y,dY)) (preimage Y0 f C))`,
16895   (* {{{ proof *)
16896   [
16897   REP_BASIC_TAC;
16898   TYPE_THEN `X = preimage Y0 f C` ABBREV_TAC ;
16899   TYPE_THEN `(UNIONS (top_of_metric(Y,dY)) = Y) /\ (UNIONS(top_of_metric(Z,dZ)) = Z)` SUBGOAL_TAC;
16900   ASM_SIMP_TAC[GSYM top_of_metric_unions];
16901   REP_BASIC_TAC;
16902   TYPE_THEN `Y0 SUBSET Y` SUBGOAL_TAC;
16903   ASM_MESON_TAC [compact;];
16904   DISCH_TAC;
16905   WITH 10 (MATCH_MP preimage_restrict);
16906   TYPEL_THEN [`f`;`C`] (USE 11 o ISPECL);
16907   TYPE_THEN `metric_space (Y0,dY)` SUBGOAL_TAC;
16908   IMATCH_MP_TAC  metric_subspace;
16909   ASM_MESON_TAC[];
16910   DISCH_TAC;
16911   TYPE_THEN `closed_ (top_of_metric(Y0,dY)) X` SUBGOAL_TAC;
16912   EXPAND_TAC "X";
16913   TYPE_THEN `preimage Y0 f C = preimage (UNIONS (top_of_metric(Y0,dY))) f C` SUBGOAL_TAC;
16914   AP_THM_TAC;
16915   ASM_SIMP_TAC[GSYM top_of_metric_unions];
16916   DISCH_THEN_REWRITE;
16917   IMATCH_MP_TAC  preimage_closed;
16918   TYPE_THEN `(top_of_metric (Z,dZ))` EXISTS_TAC;
16919   ASM_REWRITE_TAC[];
16920   ASM_SIMP_TAC[GSYM top_of_metric_unions];
16921   DISCH_TAC;
16922   TYPE_THEN `~(X = EMPTY)` SUBGOAL_TAC;
16923   REWRITE_TAC[EMPTY_EXISTS;];
16924   UND 0;
16925   REWRITE_TAC[EMPTY_EXISTS];
16926   REP_BASIC_TAC;
16927   UND 0;
16928   REWRITE_TAC[IMAGE;INTER];
16929   REP_BASIC_TAC;
16930   TYPE_THEN `x` EXISTS_TAC;
16931   EXPAND_TAC "X";
16932   REWRITE_TAC[preimage];
16933   ASM_MESON_TAC[];
16934   DISCH_TAC;
16935   (* next X compact in the reals , take inf X, *)
16936   TYPE_THEN `U = top_of_metric(Y,dY)` ABBREV_TAC ;
16937   TYPE_THEN `U0 = top_of_metric(Y0,dY)` ABBREV_TAC ;
16938   TYPE_THEN `U00 = top_of_metric (X,dY)` ABBREV_TAC ;
16939   TYPE_THEN `X SUBSET Y0` SUBGOAL_TAC;
16940   EXPAND_TAC "X";
16941   KILL 7;
16942   ASM_REWRITE_TAC[];
16943   REWRITE_TAC[INTER;SUBSET;];
16944   MESON_TAC[];
16945   DISCH_TAC;
16946   TYPE_THEN `induced_top U Y0 = U0` SUBGOAL_TAC;
16947   EXPAND_TAC "U";
16948   EXPAND_TAC "U0";
16949   IMATCH_MP_TAC  top_of_metric_induced;
16950   ASM_MESON_TAC[];
16951   DISCH_TAC;
16952   TYPE_THEN `UNIONS U = Y` SUBGOAL_TAC;
16953   EXPAND_TAC "U";
16954   ASM_SIMP_TAC [GSYM top_of_metric_unions];
16955   DISCH_TAC;
16956   TYPE_THEN `compact U0 Y0` SUBGOAL_TAC;
16957   KILL 16;
16958   EXPAND_TAC "U0";
16959   ASM_SIMP_TAC[GSYM induced_compact;];
16960   REP_BASIC_TAC;
16961   (* ok to here *)
16962   TYPE_THEN `compact U0 X` SUBGOAL_TAC;
16963   IMATCH_MP_TAC  closed_compact;
16964   TYPE_THEN `Y0` EXISTS_TAC;
16965   ASM_REWRITE_TAC[];
16966   KILL 19;
16967   EXPAND_TAC "U0";
16968   IMATCH_MP_TAC  top_of_metric_top;
16969   ASM_REWRITE_TAC[];
16970   DISCH_TAC;
16971   (* done WITH compac U0 X *)
16972   TYPE_THEN `induced_top U0 X = U00` SUBGOAL_TAC;
16973   KILL 19;
16974   EXPAND_TAC "U0";
16975   EXPAND_TAC "U00";
16976   IMATCH_MP_TAC  top_of_metric_induced;
16977   ASM_REWRITE_TAC[];
16978   DISCH_TAC;
16979   TYPE_THEN `compact U00 X` SUBGOAL_TAC;
16980   EXPAND_TAC "U00";
16981   TYPE_THEN `X SUBSET UNIONS U0` SUBGOAL_TAC;
16982   KILL 19;
16983   EXPAND_TAC "U0";
16984   ASM_SIMP_TAC[GSYM top_of_metric_unions];
16985   ASM_SIMP_TAC[GSYM induced_compact];
16986   DISCH_TAC;
16987   TYPE_THEN `induced_top U X = U00` SUBGOAL_TAC;
16988   KILL 19;
16989   EXPAND_TAC "U";
16990   KILL 23;
16991   EXPAND_TAC "U00";
16992   IMATCH_MP_TAC  top_of_metric_induced;
16993   ASM_REWRITE_TAC[];
16994   IMATCH_MP_TAC  SUBSET_TRANS;
16995   ASM_MESON_TAC[];
16996   DISCH_TAC;
16997   UND 24;
16998   EXPAND_TAC "U00";
16999   TYPE_THEN `compact (induced_top U X) X = compact U X` SUBGOAL_TAC;
17000   IMATCH_MP_TAC  (GSYM induced_compact);
17001   ASM_REWRITE_TAC[];
17002   IMATCH_MP_TAC  SUBSET_TRANS;
17003   ASM_MESON_TAC[];
17004   MESON_TAC[];
17005   ]);;
17006   (* }}} *)
17007
17008 let preimage_compact_interval = prove_by_refinement(
17009   `!C n f a b.
17010   (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
17011             (top_of_metric(euclid n,d_euclid)) /\
17012   (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\
17013   (closed_ (top_of_metric(euclid n,d_euclid)) C) /\
17014   ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==>
17015   (compact (top_of_metric(UNIV,d_real))
17016          (preimage {x | a <= x /\ x <= b} f C))`,
17017   (* {{{ proof *)
17018   [
17019   REP_BASIC_TAC;
17020   IMATCH_MP_TAC  preimage_compact;
17021   TYPE_THEN `(euclid n)` EXISTS_TAC;
17022   TYPE_THEN `d_euclid` EXISTS_TAC;
17023   ASM_REWRITE_TAC[metric_real;metric_euclid;interval_compact;];
17024   ]);;
17025   (* }}} *)
17026
17027 let preimage_first = prove_by_refinement(
17028   `!C n f a b.
17029   (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
17030             (top_of_metric(euclid n,d_euclid)) /\
17031   (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\
17032   (closed_ (top_of_metric(euclid n,d_euclid)) C) /\
17033   ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==>
17034   (?t. (a <= t /\ t <= b) /\ (C (f t)) /\
17035     (!s. (a <=s /\ s < t) ==> ~(C (f s))))`,
17036   (* {{{ proof *)
17037   [
17038   REP_BASIC_TAC;
17039   TYPE_THEN `(compact (top_of_metric(UNIV,d_real)) (preimage {x | a <= x /\ x <= b} f C))` SUBGOAL_TAC;
17040   IMATCH_MP_TAC preimage_compact_interval;
17041   TYPE_THEN `n` EXISTS_TAC;
17042   ASM_REWRITE_TAC[];
17043   DISCH_TAC;
17044   TYPE_THEN `~(preimage {x | a <= x /\ x <= b} f C = EMPTY)` SUBGOAL_TAC;
17045   UND 0;
17046   REWRITE_TAC[EMPTY_EXISTS];
17047   REWRITE_TAC[IMAGE ;INTER;preimage];
17048   MESON_TAC[];
17049   DISCH_TAC;
17050   TYPE_THEN `X = preimage {x | a <= x /\ x <= b } f C` ABBREV_TAC ;
17051   TYPE_THEN `(?x. (X x) /\ (!y. (X y) ==> (x <= y)))` SUBGOAL_TAC;
17052   IMATCH_MP_TAC  compact_inf;
17053   ASM_REWRITE_TAC[];
17054   REP_BASIC_TAC;
17055   TYPE_THEN `x` EXISTS_TAC;
17056   UND 8;
17057   UND 7;
17058   EXPAND_TAC "X";
17059   REWRITE_TAC[preimage];
17060   REP_BASIC_TAC;
17061   ASM_REWRITE_TAC[];
17062   REP_BASIC_TAC;
17063   TSPEC `s` 10;
17064   REWR 10;
17065   UND 10;
17066   UND 12;
17067   UND 8;
17068   REAL_ARITH_TAC;
17069   ]);;
17070   (* }}} *)
17071
17072 let inj_subset_domain = prove_by_refinement(
17073   `!s s' t (f:A->B). INJ f s t /\ (s' SUBSET s) ==> INJ f s' t`,
17074   (* {{{ proof *)
17075   [
17076   REWRITE_TAC[INJ;SUBSET;];
17077   MESON_TAC[];
17078   ]);;
17079   (* }}} *)
17080
17081 let arc_restrict = prove_by_refinement(
17082   `!a b c d C f t t'. (c <= t /\ t < t' /\ t' <= d) /\ (a < b) /\
17083      (C = IMAGE f { x | c <= x /\ x <= d }) /\
17084      INJ f {x | c <= x /\ x <= d} (euclid 2) /\
17085      continuous f (top_of_metric(UNIV,d_real))
17086             (top_of_metric(euclid 2,d_euclid)) ==>
17087     (?g.
17088   (IMAGE g {x | a <= x /\ x <= b} = IMAGE f {x | t <= x /\ x <= t'})  /\
17089      (g a = f t) /\ (g b = f t') /\
17090        INJ g { x | a <= x /\ x <= b} (euclid 2) /\
17091        continuous g (top_of_metric(UNIV,d_real))
17092             (top_of_metric(euclid 2,d_euclid)))`,
17093   (* {{{ proof *)
17094
17095   [
17096   REP_BASIC_TAC;
17097   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;
17098   ASM_REWRITE_TAC[top2];
17099   IMATCH_MP_TAC  inj_subset_domain;
17100   TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
17101   ASM_REWRITE_TAC[];
17102   REWRITE_TAC[SUBSET;];
17103   UND 4;
17104   UND 5;
17105   UND 6;
17106   REAL_ARITH_TAC;
17107   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
17108   REP_BASIC_TAC;
17109   TYPE_THEN `g` EXISTS_TAC;
17110   ASM_REWRITE_TAC[];
17111   ASM_MESON_TAC[top2];
17112   ]);;
17113
17114   (* }}} *)
17115
17116 let continuous_induced_domain = prove_by_refinement(
17117   `!(f:A->B) U V K. (continuous f U V) /\ (K SUBSET (UNIONS U)) ==>
17118     (continuous f (induced_top U K) V)`,
17119   (* {{{ proof *)
17120   [
17121   REWRITE_TAC[continuous;induced_top_support;];
17122   REWRITE_TAC[preimage;induced_top];
17123   REP_BASIC_TAC;
17124   REWRITE_TAC[IMAGE];
17125   TYPE_THEN `{x | UNIONS U x /\ v (f x)}` EXISTS_TAC;
17126   ASM_SIMP_TAC[];
17127   REWRITE_TAC[INTER];
17128   IMATCH_MP_TAC  EQ_EXT;
17129   REWRITE_TAC[];
17130   MESON_TAC[];
17131   ]);;
17132   (* }}} *)
17133
17134 let inj_split = prove_by_refinement(
17135   `!A B Z (f:A->B). (INJ f A Z) /\ (INJ f B Z) /\
17136      (IMAGE f A INTER IMAGE f B = EMPTY) ==> (INJ f (A UNION B) Z)`,
17137   (* {{{ proof *)
17138   [
17139   REWRITE_TAC[INJ;INTER;IMAGE;UNION;];
17140   REP_BASIC_TAC;
17141   CONJ_TAC;
17142   ASM_MESON_TAC[];
17143   REP_GEN_TAC;
17144   REP_BASIC_TAC;
17145   UND 7;
17146   UND 6;
17147   REP_CASES_TAC;
17148   KILL 1;
17149   FIRST_ASSUM IMATCH_MP_TAC ;
17150   ASM_REWRITE_TAC[];
17151   UND 0;
17152   REWRITE_TAC[EQ_EMPTY];
17153   NAME_CONFLICT_TAC;
17154   DISCH_TAC;
17155   TSPEC `f y` 0;
17156   USE 0 (REWRITE_RULE[DE_MORGAN_THM]);
17157   ASM_MESON_TAC[];
17158   USE 0 (REWRITE_RULE[EQ_EMPTY]);
17159   TSPEC `f x` 0;
17160   ASM_MESON_TAC[];
17161   KILL 3;
17162   FIRST_ASSUM IMATCH_MP_TAC ;
17163   ASM_MESON_TAC[];
17164   ]);;
17165   (* }}} *)
17166
17167 let joinf_inj_below = prove_by_refinement(
17168   `!(f:real->B) g a A.
17169     (A SUBSET {x | x < a}) ==> (INJ (joinf f g a) A = INJ f A)`,
17170   (* {{{ proof *)
17171   [
17172   REWRITE_TAC[SUBSET];
17173   REP_BASIC_TAC;
17174   IMATCH_MP_TAC EQ_EXT;
17175   REWRITE_TAC[INJ];
17176   REP_BASIC_TAC;
17177   TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC;
17178   REP_BASIC_TAC;
17179   REWRITE_TAC[joinf];
17180   TSPEC `z` 0;
17181   REWR 0;
17182   ASM_REWRITE_TAC[];
17183   REP_BASIC_TAC;
17184   ASM_MESON_TAC[];
17185   ]);;
17186   (* }}} *)
17187
17188 let joinf_inj_above = prove_by_refinement(
17189   `!(f:real->B) g a A.
17190     (A SUBSET {x | a <= x}) ==> (INJ (joinf f g a) A = INJ g A)`,
17191   (* {{{ proof *)
17192   [
17193   REWRITE_TAC[SUBSET];
17194   REP_BASIC_TAC;
17195   IMATCH_MP_TAC EQ_EXT;
17196   REWRITE_TAC[INJ];
17197   REP_BASIC_TAC;
17198   TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC;
17199   REP_BASIC_TAC;
17200   REWRITE_TAC[joinf];
17201   TSPEC `z` 0;
17202   REWR 0;
17203   ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `];
17204   REP_BASIC_TAC;
17205   ASM_MESON_TAC[];
17206   ]);;
17207   (* }}} *)
17208
17209 let joinf_image_below = prove_by_refinement(
17210   `!(f:real->B) g a A.
17211     (A SUBSET {x | x < a}) ==> (IMAGE (joinf f g a) A = IMAGE f A)`,
17212   (* {{{ proof *)
17213   [
17214   REWRITE_TAC[SUBSET];
17215   REP_BASIC_TAC;
17216   IMATCH_MP_TAC EQ_EXT;
17217   REWRITE_TAC[IMAGE];
17218   REP_BASIC_TAC;
17219   TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC;
17220   REP_BASIC_TAC;
17221   REWRITE_TAC[joinf];
17222   TSPEC `z` 0;
17223   REWR 0;
17224   ASM_REWRITE_TAC[];
17225   REP_BASIC_TAC;
17226   ASM_MESON_TAC[];
17227   ]);;
17228   (* }}} *)
17229
17230 let joinf_image_above = prove_by_refinement(
17231   `!(f:real->B) g a A.
17232     (A SUBSET {x | a <= x}) ==> (IMAGE (joinf f g a) A = IMAGE g A)`,
17233   (* {{{ proof *)
17234
17235   [
17236   REWRITE_TAC[SUBSET];
17237   REP_BASIC_TAC;
17238   IMATCH_MP_TAC EQ_EXT;
17239   REWRITE_TAC[IMAGE];
17240   REP_BASIC_TAC;
17241   TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC;
17242   REP_BASIC_TAC;
17243   REWRITE_TAC[joinf];
17244   TSPEC `z` 0;
17245   REWR 0;
17246   ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `];
17247   REP_BASIC_TAC;
17248   ASM_MESON_TAC[];
17249   ]);;
17250
17251   (* }}} *)
17252
17253 let pconn_trans = prove_by_refinement(
17254   `!A x y z. (p_conn A x y /\ p_conn A y z ==> p_conn A x z)`,
17255   (* {{{ proof *)
17256   [
17257   REWRITE_TAC[p_conn;simple_polygonal_arc;simple_arc;];
17258   REP_BASIC_TAC;
17259   TYPE_THEN `C' x`  ASM_CASES_TAC;
17260   TYPE_THEN `C'` EXISTS_TAC;
17261   ASM_REWRITE_TAC[];
17262   CONJ_TAC;
17263   TYPE_THEN `f'` EXISTS_TAC;
17264   ASM_REWRITE_TAC[];
17265   ASM_MESON_TAC[];
17266   TYPE_THEN `~(x = y)` SUBGOAL_TAC;
17267   PROOF_BY_CONTR_TAC;
17268   ASM_MESON_TAC[];
17269   DISCH_TAC;
17270   (* now ~( x= y) *)
17271   TYPE_THEN `C z` ASM_CASES_TAC;
17272   TYPE_THEN `C` EXISTS_TAC;
17273   ASM_REWRITE_TAC[];
17274   CONJ_TAC;
17275   TYPE_THEN `f` EXISTS_TAC;
17276   ASM_REWRITE_TAC[];
17277   ASM_MESON_TAC[];
17278   TYPE_THEN `~(z = y)` SUBGOAL_TAC;
17279   ASM_MESON_TAC[];
17280   DISCH_TAC;
17281   (* now ~( z = y) *)
17282   TYPE_THEN `?tx. (&0 <= tx) /\ (tx <= &1) /\ (f tx = x)` SUBGOAL_TAC;
17283   UND 10;
17284   ASM_REWRITE_TAC[IMAGE;];
17285   REP_BASIC_TAC;
17286   ASM_MESON_TAC[];
17287   REP_BASIC_TAC;
17288   TYPE_THEN `?ty. (&0 <= ty) /\ (ty <= &1) /\ (f ty = y)` SUBGOAL_TAC;
17289   UND 9;
17290   ASM_REWRITE_TAC[IMAGE;];
17291   REP_BASIC_TAC;
17292   ASM_MESON_TAC[];
17293   REP_BASIC_TAC;
17294   TYPE_THEN `~(tx = ty)` SUBGOAL_TAC;
17295   ASM_MESON_TAC[];
17296   DISCH_TAC;
17297   (* reparameter C *)
17298   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;
17299   TYPE_THEN `(tx < ty) \/ (ty < tx)` SUBGOAL_TAC;
17300   UND 28;
17301   REAL_ARITH_TAC;
17302   DISCH_THEN DISJ_CASES_TAC;
17303   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;
17304   IMATCH_MP_TAC  arc_restrict;
17305   TYPE_THEN `&0` EXISTS_TAC;
17306   TYPE_THEN `&1` EXISTS_TAC;
17307   TYPE_THEN `C` EXISTS_TAC;
17308   ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;];
17309   UND 15;
17310   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
17311   REP_BASIC_TAC;
17312   TYPE_THEN `g` EXISTS_TAC;
17313   ASM_REWRITE_TAC[];
17314   IMATCH_MP_TAC  IMAGE_SUBSET;
17315   REWRITE_TAC[SUBSET];
17316   GEN_TAC;
17317   UND 24;
17318   UND 26;
17319   REAL_ARITH_TAC;
17320   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;
17321   IMATCH_MP_TAC  arc_restrict;
17322   TYPE_THEN `&0` EXISTS_TAC;
17323   TYPE_THEN `&1` EXISTS_TAC;
17324   TYPE_THEN `C` EXISTS_TAC;
17325   ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;];
17326   UND 15;
17327   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
17328   REP_BASIC_TAC;
17329   (* REVERSE reparameter on C XX0 *)
17330   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;
17331   IMATCH_MP_TAC  arc_reparameter_rev;
17332   ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;top2;];
17333   REP_BASIC_TAC;
17334   TYPE_THEN `g'` EXISTS_TAC;
17335   ASM_REWRITE_TAC[];
17336   CONJ_TAC;
17337   ASM_MESON_TAC[];  (* L80 *)
17338   CONJ_TAC;
17339   ASM_MESON_TAC[];
17340   CONJ_TAC;
17341   ASM_MESON_TAC[top2];
17342   TYPE_THEN `IMAGE g' {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx }` SUBGOAL_TAC;
17343   UND 34;
17344   UND 35;
17345   alpha_tac;
17346   MESON_TAC[];
17347   DISCH_THEN_REWRITE;
17348   IMATCH_MP_TAC  IMAGE_SUBSET;
17349   REWRITE_TAC[SUBSET];
17350   UND 23;
17351   UND 27;
17352   REAL_ARITH_TAC;
17353   REP_BASIC_TAC;
17354   (* now restrict C to [x,y'] *)
17355   (* rC *)
17356   TYPE_THEN `Cg = IMAGE g {x | &0 <= x /\ x <= &1 }` ABBREV_TAC ;
17357   TYPE_THEN `Z = Cg INTER C'` ABBREV_TAC ;
17358   TYPE_THEN `?t'. (&0 <= t' /\ t' <= &1) /\ (Z (g t')) /\ (!s. (&0 <=s /\ s < t') ==> ~(Z (g s)))` SUBGOAL_TAC;
17359   IMATCH_MP_TAC  preimage_first;
17360   EXISTS_TAC `2`;
17361   (* restriction conditions *)
17362   CONJ_TAC;
17363   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;
17364   ASM_SIMP_TAC[SUBSET_UNIV;metric_real;top_of_metric_induced];
17365   DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]);
17366   IMATCH_MP_TAC  continuous_induced_domain;
17367   ASM_REWRITE_TAC[];
17368   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
17369   SUBCONJ_TAC;
17370   UND 31;
17371   REWRITE_TAC[INJ;IMAGE;SUBSET;];
17372   MESON_TAC[];
17373   DISCH_TAC;
17374   CONJ_TAC;
17375   (* rC2 *)
17376   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;
17377   REP_BASIC_TAC;
17378   IMATCH_MP_TAC  compact_closed;
17379   ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
17380   ASM_SIMP_TAC[top_of_metric_top;metric_euclid];
17381   EXPAND_TAC "C''";
17382   IMATCH_MP_TAC  image_compact;
17383   TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
17384   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;interval_compact];
17385   ASM_SIMP_TAC[GSYM top2];
17386   EXPAND_TAC "C''";
17387   UND 38;
17388   REWRITE_TAC[INJ;IMAGE;SUBSET];
17389   MESON_TAC[];
17390   DISCH_TAC;
17391   REWRITE_TAC[GSYM top2];
17392   EXPAND_TAC "Z";
17393   IMATCH_MP_TAC  closed_inter2;
17394   REWRITE_TAC[top2_top];
17395   CONJ_TAC;
17396   FIRST_ASSUM IMATCH_MP_TAC ;
17397   TYPE_THEN `g` EXISTS_TAC;
17398   TYPE_THEN `&0` EXISTS_TAC;
17399   TYPE_THEN `&1` EXISTS_TAC;
17400   ASM_REWRITE_TAC[];  (* XX2 *)
17401   ASM_SIMP_TAC[top2];
17402   FIRST_ASSUM IMATCH_MP_TAC ;
17403   TYPE_THEN `f'` EXISTS_TAC;
17404   TYPE_THEN `&0` EXISTS_TAC;
17405   TYPE_THEN `&1` EXISTS_TAC;
17406   ASM_REWRITE_TAC[];
17407   ASM_SIMP_TAC[top2];
17408   UND 6;
17409   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
17410   EXPAND_TAC "Z";
17411   REWRITE_TAC[EMPTY_EXISTS;INTER;IMAGE];
17412   CONV_TAC (dropq_conv "u");
17413   TYPE_THEN `&1` EXISTS_TAC;
17414   EXPAND_TAC "Cg";
17415   ASM_REWRITE_TAC[IMAGE;];
17416   REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC)));
17417   EXPAND_TAC "Cg";  (* L160 *)
17418   (remark "LINE 160"; ALL_TAC);
17419   REWRITE_TAC[IMAGE];
17420   TYPE_THEN `&1` EXISTS_TAC;
17421   REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC)));
17422   ASM_REWRITE_TAC[];
17423   UND 1;
17424   ASM_REWRITE_TAC[IMAGE];
17425   REP_BASIC_TAC;
17426   TYPE_THEN `(t' = &0) \/ (&0 < t')` SUBGOAL_TAC;
17427   UND 39;
17428   REAL_ARITH_TAC;
17429   (* elim t' =0 *)
17430   DISCH_THEN DISJ_CASES_TAC;
17431   UND 37;
17432   EXPAND_TAC "Z";
17433   REWRITE_TAC[INTER];
17434   ASM_MESON_TAC[];
17435   (*  **  START ON 2nd BRANCH  ** *** ** *)
17436   (* 2b*)
17437   TYPE_THEN `?tz. (&0 <= tz) /\ (tz <= &1) /\ (f' tz = z)` SUBGOAL_TAC;
17438   UND 0;
17439   ASM_REWRITE_TAC[IMAGE;];
17440   DISCH_THEN (CHOOSE_THEN MP_TAC);
17441   LEFT_TAC "tz";
17442   TYPE_THEN `x'` EXISTS_TAC;
17443   MESON_TAC[];
17444   REP_BASIC_TAC;
17445   TYPE_THEN `?t''. (&0 <= t'') /\ (t'' <= &1) /\ (f' t'' = g t')` SUBGOAL_TAC;
17446   UND 37;
17447   EXPAND_TAC "Z";
17448   REWRITE_TAC[INTER];
17449   ASM_REWRITE_TAC[IMAGE;];
17450   DISCH_THEN (fun t-> MP_TAC (CONJUNCT2 t));
17451   ASM_MESON_TAC[];
17452   REP_BASIC_TAC;
17453   TYPE_THEN `~(tz = t'')` SUBGOAL_TAC;
17454   PROOF_BY_CONTR_TAC;
17455   TYPE_THEN `C (g t')` SUBGOAL_TAC;
17456   UND 37;
17457   EXPAND_TAC "Z";
17458   REWRITE_TAC[INTER];
17459   UND 29;
17460   REWRITE_TAC[SUBSET];
17461   MESON_TAC[];
17462   ASM_MESON_TAC[];
17463   DISCH_TAC;
17464   (* reparam on C' *)
17465   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;
17466   TYPE_THEN `(t'' < tz) \/ (tz < t'')` SUBGOAL_TAC;
17467   UND 47;
17468   REAL_ARITH_TAC;
17469   DISCH_THEN DISJ_CASES_TAC;
17470   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;
17471   IMATCH_MP_TAC  arc_restrict;
17472   TYPE_THEN `&0` EXISTS_TAC;
17473   TYPE_THEN `&1` EXISTS_TAC;
17474   TYPE_THEN `C'` EXISTS_TAC;
17475   ASM_REWRITE_TAC[];
17476   UND 6;
17477   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
17478   DISCH_TAC;
17479   REWRITE_TAC[REAL_LT_HALF2];
17480   REAL_ARITH_TAC;
17481   REP_BASIC_TAC;
17482   TYPE_THEN `h` EXISTS_TAC;
17483   ASM_REWRITE_TAC[];
17484   IMATCH_MP_TAC  IMAGE_SUBSET;
17485   REWRITE_TAC[SUBSET];
17486   GEN_TAC;
17487   UND 42;
17488   UND 46;
17489   REAL_ARITH_TAC;
17490   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;
17491   IMATCH_MP_TAC  arc_restrict;
17492   TYPE_THEN `&0` EXISTS_TAC;
17493   TYPE_THEN `&1` EXISTS_TAC;
17494   TYPE_THEN `C'` EXISTS_TAC;
17495   ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
17496   UND 6;
17497   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
17498   REP_BASIC_TAC;  (* L240 *)
17499   (remark "LINE 240"; ALL_TAC);
17500   (* REVERSE reparameter on C *)
17501   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;
17502   IMATCH_MP_TAC  arc_reparameter_rev;
17503   ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`;top2;];
17504   REP_BASIC_TAC;
17505   TYPE_THEN `h'` EXISTS_TAC;
17506   ASM_REWRITE_TAC[];
17507   CONJ_TAC;
17508   ASM_MESON_TAC[];
17509   CONJ_TAC;
17510   ASM_MESON_TAC[];
17511   CONJ_TAC;
17512   ASM_MESON_TAC[top2];
17513   TYPE_THEN `IMAGE h' {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' }` SUBGOAL_TAC;
17514   UND 53;  (* ZZZ *)
17515   UND 54;
17516   alpha_tac;
17517   MESON_TAC[];
17518   DISCH_THEN_REWRITE;
17519   IMATCH_MP_TAC  IMAGE_SUBSET;
17520   REWRITE_TAC[SUBSET];
17521   UND 43;
17522   UND 45;
17523   REAL_ARITH_TAC;
17524   REP_BASIC_TAC;
17525   (* reparam g [0,1/2] *)
17526   (* rg *)
17527   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 *)
17528   ASSUME_TAC arc_reparameter_gen;
17529   TYPEL_THEN [`g`;`&0`;`&1/(&2)`;`&0`;`t'`] (fun t-> FIRST_ASSUM (fun s-> (MP_TAC (ISPECL t s))));
17530   KILL 53;   (* ZZZ *)
17531   ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;REAL_LT_HALF1;];
17532   UND 30;
17533   REWRITE_TAC[top2];
17534   DISCH_THEN_REWRITE;
17535   TYPE_THEN `INJ g {x | &0 <= x /\ x <= t'} (euclid 2)` SUBGOAL_TAC;
17536   IMATCH_MP_TAC  inj_subset_domain;
17537   TYPE_THEN `{x | &0 <= x /\ x <= &1 }` EXISTS_TAC;
17538   ASM_REWRITE_TAC[];
17539   REWRITE_TAC[SUBSET];
17540   UND 38;
17541   REAL_ARITH_TAC;
17542   DISCH_THEN_REWRITE;
17543   REP_BASIC_TAC;
17544   TYPE_THEN `g'` EXISTS_TAC;
17545   ASM_REWRITE_TAC[];
17546   (* deleted lines here *)
17547   REP_BASIC_TAC;
17548   TYPE_THEN `fm = joinf g' h (&1/(&2))` ABBREV_TAC ;
17549   TYPE_THEN `Cm = IMAGE fm {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
17550   TYPE_THEN `Cm` EXISTS_TAC;
17551   (* final instantiation *)
17552   (* fi *)
17553   REPEAT (IMATCH_MP_TAC  (TAUT `A /\ B/\ C ==> (A /\ B) /\C`));
17554   CONJ_TAC;
17555   TYPE_THEN `fm` EXISTS_TAC;
17556   ASM_REWRITE_TAC[];
17557   CONJ_TAC;
17558   EXPAND_TAC "fm";
17559   IMATCH_MP_TAC  joinf_cont;
17560   ASM_REWRITE_TAC[];
17561   TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC;
17562   IMATCH_MP_TAC  EQ_EXT;
17563   REWRITE_TAC[UNION];
17564   GEN_TAC;
17565   TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC;
17566   REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
17567   REAL_ARITH_TAC;
17568   DISCH_THEN_REWRITE;
17569   IMATCH_MP_TAC  inj_split;
17570   EXPAND_TAC "fm";
17571   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;
17572   REWRITE_TAC[SUBSET];
17573   REAL_ARITH_TAC;
17574   KILL 58;
17575   ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below;joinf_image_above;joinf_image_below];
17576   DISCH_TAC;
17577   (* cases *)
17578   CONJ_TAC;
17579   IMATCH_MP_TAC  inj_subset_domain;  (* L320 *)
17580   (remark "LINE 320"; ALL_TAC);
17581   TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2) }` EXISTS_TAC;
17582   ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_euclid];
17583   REWRITE_TAC[SUBSET];
17584   REAL_ARITH_TAC;
17585   CONJ_TAC;
17586   ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_euclid];
17587   ASM_REWRITE_TAC[];
17588   TYPE_THEN `IMAGE g' { x | &0 <= x /\ x <= &1/(&2)} INTER IMAGE h {x | &1/(&2) <= x /\ x <= &1} SUBSET {(g t')}` SUBGOAL_TAC;
17589   ASM_REWRITE_TAC[];
17590   TYPE_THEN `IMAGE g { x | &0 <= x /\ x <= t' } SUBSET Cg` SUBGOAL_TAC;
17591   EXPAND_TAC "Cg";
17592   IMATCH_MP_TAC  IMAGE_SUBSET;
17593   REWRITE_TAC[SUBSET];
17594   UND 38;
17595   REAL_ARITH_TAC;
17596   DISCH_TAC;
17597   IMATCH_MP_TAC  SUBSET_TRANS;
17598   TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'} INTER Z` EXISTS_TAC;
17599   CONJ_TAC;
17600   EXPAND_TAC "Z";
17601   UND 48;
17602   UND 60;
17603   REWRITE_TAC[SUBSET;INTER];
17604   (* MESON_TAC[]; *)
17605   POP_ASSUM_LIST (fun t-> ALL_TAC);
17606   REP_BASIC_TAC;
17607   ASM_REWRITE_TAC[];
17608   (* LINE 350 *)
17609   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[];
17610   UND 36;
17611   REWRITE_TAC[INTER;SUBSET;IMAGE];
17612   UND 37;
17613   POP_ASSUM_LIST (fun t-> ALL_TAC);
17614   REP_BASIC_TAC;
17615   REWRITE_TAC[INR IN_SING];
17616   UND 0;
17617   ASM_REWRITE_TAC[];
17618   DISCH_TAC;
17619   TYPE_THEN `(x' = t') \/ (x' < t')` SUBGOAL_TAC;
17620   UND 2;
17621   REAL_ARITH_TAC;
17622   DISCH_THEN DISJ_CASES_TAC;
17623   ASM_REWRITE_TAC[];
17624   ASM_MESON_TAC[];
17625   DISCH_TAC;
17626   PROOF_BY_CONTR_TAC;
17627   USE 61 (REWRITE_RULE[EMPTY_EXISTS ]);
17628   REP_BASIC_TAC;
17629   TYPE_THEN `!B' B (u:num->real). (B' u /\ B' SUBSET B) ==> (B u)` SUBGOAL_TAC;
17630   MESON_TAC[ISUBSET];
17631   DISCH_TAC;
17632   TYPE_THEN `{(g t')} u` SUBGOAL_TAC;
17633   FIRST_ASSUM IMATCH_MP_TAC ;
17634   TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC;
17635   ASM_REWRITE_TAC[];
17636   IMATCH_MP_TAC  SUBSET_TRANS;
17637   TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x <= &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC;
17638   CONJ_TAC;
17639   REWRITE_TAC[INTER;SUBSET;IMAGE];
17640   MESON_TAC[REAL_ARITH `x < t ==> x <= t`];
17641   ASM_REWRITE_TAC[];
17642   REWRITE_TAC[INR IN_SING];
17643   REP_BASIC_TAC;
17644   UND 62;
17645   ASM_REWRITE_TAC[];
17646   REWRITE_TAC[INTER;IMAGE;DE_MORGAN_THM;];
17647   DISJ1_TAC;
17648   USE 56 SYM;
17649   ASM_REWRITE_TAC[];
17650   UND 55;
17651   POP_ASSUM_LIST (fun t-> ALL_TAC);
17652   REWRITE_TAC[INJ];
17653   REP_BASIC_TAC;
17654   USE 1(REWRITE_RULE [REAL_ARITH `(x < &1/(&2)) <=> (x <= &1/(&2) /\ ~(x = &1/(&2)))`]);
17655   TYPEL_THEN [`x`;`&1/(&2)`] (USE 3 o ISPECL);
17656   TYPE_THEN `&0 <= &1/ &2 /\ &1/ &2 <= &1/ (&2)` SUBGOAL_TAC;
17657   REWRITE_TAC[REAL_ARITH `x <= x`];
17658   IMATCH_MP_TAC  REAL_LE_DIV;
17659   REAL_ARITH_TAC;
17660   ASM_MESON_TAC[];
17661   (* Now E *)   (* L400 *)
17662   (remark "LINE 400"; ALL_TAC);
17663   (* ne *)
17664   TYPE_THEN ` {x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC;
17665   IMATCH_MP_TAC  EQ_EXT;
17666   REWRITE_TAC[UNION];
17667   GEN_TAC;
17668   TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC;
17669   REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
17670   REAL_ARITH_TAC;
17671   EXPAND_TAC "Cm";
17672   DISCH_THEN_REWRITE;
17673   REWRITE_TAC[IMAGE_UNION];
17674   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;
17675   REWRITE_TAC[SUBSET];
17676   REAL_ARITH_TAC;
17677   EXPAND_TAC "fm";
17678   KILL 58;
17679   ASM_SIMP_TAC[joinf_image_above;joinf_image_below];
17680   DISCH_TAC;
17681   TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION  IMAGE h {x | &1 / &2 <= x /\ x <= &1}) z` SUBGOAL_TAC;
17682   UND 51;
17683   REWRITE_TAC[UNION;IMAGE];
17684   POP_ASSUM_LIST (fun t->ALL_TAC);
17685   REP_BASIC_TAC;
17686   DISJ2_TAC;
17687   TYPE_THEN `&1` EXISTS_TAC;
17688   ASM_REWRITE_TAC[];
17689   REWRITE_TAC[REAL_ARITH `&1 <= &1`];
17690   IMATCH_MP_TAC  REAL_LE_LDIV;
17691   REAL_ARITH_TAC;
17692   DISCH_THEN_REWRITE;
17693   TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION  IMAGE h {x | &1 / &2 <= x /\ x <= &1}) x` SUBGOAL_TAC;
17694   UND 57;
17695   REWRITE_TAC[UNION;IMAGE];
17696   POP_ASSUM_LIST (fun t->ALL_TAC);
17697   REP_BASIC_TAC;
17698   DISJ1_TAC;
17699   TYPE_THEN `&0` EXISTS_TAC;
17700   ASM_REWRITE_TAC[];
17701   REWRITE_TAC[REAL_ARITH `&0 <= &0`];
17702   REWRITE_TAC[REAL_LT_HALF1];
17703   REAL_ARITH_TAC;
17704   DISCH_THEN_REWRITE;
17705   (* gh *)
17706   UND 48;
17707   TYPE_THEN `IMAGE g' {x | &0 <= x /\ x < &1/ &2} SUBSET C` SUBGOAL_TAC;
17708   IMATCH_MP_TAC  SUBSET_TRANS;
17709   TYPE_THEN `Cg ` EXISTS_TAC;
17710   ASM_REWRITE_TAC[];
17711   IMATCH_MP_TAC  SUBSET_TRANS;
17712   EXPAND_TAC "Cg";
17713   TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'}` EXISTS_TAC;
17714   CONJ_TAC;
17715   USE 53 SYM;
17716   ASM_REWRITE_TAC[];
17717   REWRITE_TAC[IMAGE;SUBSET];
17718   MESON_TAC[REAL_ARITH `x < t ==> x <= t`];
17719   REWRITE_TAC[IMAGE;SUBSET];
17720   UND 38;
17721   MESON_TAC[REAL_ARITH `t' <= &1 ==> (x <= t' ==> x<= &1)`];
17722   TYPE_THEN `GCG = IMAGE g' {x | &0 <= x /\ x < &1 / &2}` ABBREV_TAC ;
17723   TYPE_THEN `HCH = IMAGE h {x | &1 / &2 <= x /\ x <= &1}` ABBREV_TAC ;
17724   UND 11;
17725   UND 2;
17726   UND 4;
17727   UND 5;
17728   UND 13;
17729   UND 14;
17730   UND 12;
17731   UND 3;
17732   POP_ASSUM_LIST (fun t->ALL_TAC);
17733   REP_BASIC_TAC;
17734   CONJ_TAC;
17735   TYPE_THEN `E UNION E'` EXISTS_TAC;
17736   CONJ_TAC;
17737   REWRITE_TAC[UNIONS_UNION];
17738   REWRITE_TAC[union_subset];
17739   CONJ_TAC;
17740   UND 1;
17741   UND 7;
17742   REWRITE_TAC[UNION;SUBSET];  (* L480 *)
17743   (remark "LINE 480"; ALL_TAC);
17744   MESON_TAC[];
17745   UND 0;
17746   UND 5;
17747   REWRITE_TAC[UNION;SUBSET];
17748   MESON_TAC[];
17749   CONJ_TAC;
17750   ASM_REWRITE_TAC[FINITE_UNION];
17751   UND 8;
17752   UND 9;
17753   REWRITE_TAC[hv_line;UNION;];
17754   MESON_TAC[];
17755   UND 1;
17756   UND 0;
17757   UND 2;
17758   UND 3;
17759   REWRITE_TAC[SUBSET;UNION;];
17760   MESON_TAC[];
17761   ]);;
17762   (* }}} *)
17763
17764 (* ------------------------------------------------------------------ *)
17765 (* SECTION J *)
17766 (* ------------------------------------------------------------------ *)
17767
17768
17769 (* Conclusion of Jordan Curve, page 1 *)
17770
17771 let v_simple_polygonal = prove_by_refinement(
17772   `!x e. (euclid 2 x) /\ (~(e = &0)) ==>
17773     (simple_polygonal_arc hv_line (mk_segment x (x + e *# e2)))`,
17774   (* {{{ proof *)
17775
17776   [
17777   REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ];
17778   REP_BASIC_TAC;
17779   CONJ_TAC;
17780   ASSUME_TAC mk_segment_inj_image;
17781   TYPEL_THEN [`x`;`x + (e *# e2)`;`2`] (USE 2 o ISPECL);
17782   TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e2)) /\ ~(x = euclid_plus x (e *# e2))` SUBGOAL_TAC;
17783   ASM_REWRITE_TAC[];
17784   CONJ_TAC;
17785   IMATCH_MP_TAC  euclid_add_closure;
17786   ASM_REWRITE_TAC[];
17787   IMATCH_MP_TAC  euclid_scale_closure;
17788   REWRITE_TAC [e2;euclid_point];
17789   REP_BASIC_TAC;
17790   FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `1`));
17791   REWRITE_TAC[euclid_plus;euclid_scale;e2;coord01];
17792   UND 0;
17793   REAL_ARITH_TAC;
17794   DISCH_TAC;
17795   REWR 2;
17796   REP_BASIC_TAC;
17797   TYPE_THEN `f` EXISTS_TAC;
17798   ASM_REWRITE_TAC[];
17799   SIMP_TAC  [GSYM top_of_metric_unions;metric_euclid];
17800   ASM_REWRITE_TAC[];
17801   (* E *)
17802   USE 1 (MATCH_MP point_onto);
17803   REP_BASIC_TAC;
17804   TYPE_THEN `{(mk_line (point p) (point p + (e *# e2)))}` EXISTS_TAC;
17805   REWRITE_TAC[INR IN_SING];
17806   CONJ_TAC;
17807   REWRITE_TAC[e2;ISUBSET;mk_segment;mk_line];
17808   REP_BASIC_TAC;
17809   TYPE_THEN `a` EXISTS_TAC;
17810   ASM_MESON_TAC[];
17811   CONJ_TAC;
17812   REWRITE_TAC[FINITE_SING];
17813   REP_BASIC_TAC;
17814   ASM_REWRITE_TAC[];
17815   TYPE_THEN `p` EXISTS_TAC;
17816   TYPE_THEN `(FST p , SND p + e)` EXISTS_TAC;
17817   REWRITE_TAC[];
17818   AP_TERM_TAC;
17819   REWRITE_TAC[e2;point_scale];
17820   REDUCE_TAC;
17821   TYPE_THEN `euclid_plus (point p) (point (&0,e)) = euclid_plus (point (FST p,SND p)) (point (&0,e))` SUBGOAL_TAC;
17822   REWRITE_TAC[];
17823   DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]);
17824   REWRITE_TAC[point_add];
17825   REDUCE_TAC;
17826   ]);;
17827
17828   (* }}} *)
17829
17830 let p_conn_ball = prove_by_refinement(
17831   `! x y r. (open_ball(euclid 2,d_euclid) x r y) ==>
17832       (p_conn (open_ball(euclid 2,d_euclid) x r) x y)`,
17833   (* {{{ proof *)
17834
17835   [
17836   REP_BASIC_TAC;
17837   TYPE_THEN `open_ball (euclid 2,d_euclid) x r x` SUBGOAL_TAC;
17838   SIMP_TAC [metric_euclid;INR open_ball_nonempty_center];
17839   REWRITE_TAC[EMPTY_EXISTS];
17840   ASM_MESON_TAC[];
17841   DISCH_TAC;
17842
17843   TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBGOAL_TAC;
17844   RULE_ASSUM_TAC (REWRITE_RULE[open_ball]);
17845   ASM_REWRITE_TAC[];
17846   DISCH_ALL_TAC;
17847   RULE_ASSUM_TAC  (fun t -> try (MATCH_MP point_onto t) with  Failure _ -> t);
17848   REP_BASIC_TAC;
17849
17850   TYPE_THEN `y' = point(FST p,SND p')` ABBREV_TAC ;
17851   TYPE_THEN `A = open_ball(euclid 2,d_euclid) x r` ABBREV_TAC ;
17852
17853   TYPE_THEN `y' = euclid_plus x ((SND  p' - SND  p) *# e2)` SUBGOAL_TAC;
17854   ASM_REWRITE_TAC[];
17855   EXPAND_TAC "y'";
17856   REWRITE_TAC[e2];
17857   REWRITE_TAC[point_add;point_scale;];
17858   REDUCE_TAC;
17859   PURE_ONCE_REWRITE_TAC [GSYM PAIR];
17860   PURE_REWRITE_TAC [point_add];
17861   REWRITE_TAC[];
17862   REDUCE_TAC;
17863   AP_TERM_TAC;
17864   REWRITE_TAC[PAIR_SPLIT];
17865   REAL_ARITH_TAC;
17866   DISCH_TAC;
17867
17868   TYPE_THEN `A y'` SUBGOAL_TAC;
17869   UND 0;
17870   EXPAND_TAC "y'";
17871   KILL 4;
17872   EXPAND_TAC "A";
17873   KILL 5;
17874   ASM_REWRITE_TAC[open_ball;euclid_point;d_euclid_point;];
17875   REWRITE_TAC[REAL_ARITH `(x - x = &0)`;POW_0;ARITH_RULE  `2 = SUC 1`];
17876   IMATCH_MP_TAC  (REAL_ARITH `(x <= y) ==> (y < r ==> x < r)`);
17877   IMATCH_MP_TAC  SQRT_MONO_LE;
17878   REWRITE_TAC[REAL_ARITH `&0 + x = x`;ARITH_RULE `SUC 1 = 2`;REAL_PROP_NN_SQUARE];
17879   IMATCH_MP_TAC  (REAL_ARITH `&0 <= x ==> (y <= x + y)`);
17880   REWRITE_TAC[REAL_PROP_NN_SQUARE];
17881   DISCH_TAC;
17882
17883   TYPE_THEN `p_conn A x y'` SUBGOAL_TAC;
17884   TYPE_THEN `x = y'` ASM_CASES_TAC;
17885   EXPAND_TAC "y'";
17886   IMATCH_MP_TAC  pconn_refl;
17887   REWRITE_TAC[p_conn];
17888   CONJ_TAC;
17889   EXPAND_TAC "A";
17890   REWRITE_TAC[top2];
17891   IMATCH_MP_TAC  open_ball_open;
17892   MESON_TAC[metric_euclid];
17893   ASM_REWRITE_TAC[];
17894   REWRITE_TAC[p_conn];
17895   TYPE_THEN `mk_segment x y'` EXISTS_TAC;
17896   CONJ_TAC;
17897   UND 6;
17898   DISCH_THEN_REWRITE;
17899   IMATCH_MP_TAC  v_simple_polygonal;
17900   ASM_REWRITE_TAC[euclid_point];
17901   REWRITE_TAC[REAL_SUB_0];
17902   DISCH_ALL_TAC;
17903   UND 8;
17904   ASM_REWRITE_TAC[];
17905   EXPAND_TAC "y'";
17906   AP_TERM_TAC;
17907   ASM_MESON_TAC[PAIR];
17908   CONJ_TAC;
17909   EXPAND_TAC "A";
17910   IMATCH_MP_TAC  openball_mk_segment_end;
17911   ASM_MESON_TAC[];
17912   REWRITE_TAC[mk_segment_end];
17913   DISCH_TAC;
17914
17915   TYPE_THEN `y' = euclid_plus y ((FST   p - FST   p') *# e1)` SUBGOAL_TAC;
17916   KILL 6;
17917   ASM_REWRITE_TAC[];
17918   EXPAND_TAC "y'";
17919   REWRITE_TAC[e1];
17920   REWRITE_TAC[point_add;point_scale;];
17921   REDUCE_TAC;
17922   PURE_ONCE_REWRITE_TAC [GSYM PAIR];
17923   PURE_REWRITE_TAC [point_add];
17924   REWRITE_TAC[];
17925   REDUCE_TAC;
17926   AP_TERM_TAC;
17927   REWRITE_TAC[PAIR_SPLIT];
17928   REAL_ARITH_TAC;
17929   DISCH_TAC;
17930
17931   TYPE_THEN `p_conn A y y'` SUBGOAL_TAC;
17932   TYPE_THEN `y = y'` ASM_CASES_TAC;
17933   EXPAND_TAC "y'";
17934   IMATCH_MP_TAC  pconn_refl;
17935   CONJ_TAC;
17936   EXPAND_TAC "A";
17937   REWRITE_TAC[top2];
17938   IMATCH_MP_TAC  open_ball_open;
17939   MESON_TAC[metric_euclid];
17940   ASM_REWRITE_TAC[];
17941   REWRITE_TAC[p_conn];
17942   TYPE_THEN `mk_segment y y'` EXISTS_TAC;
17943   CONJ_TAC;
17944   UND 9;
17945   DISCH_THEN_REWRITE;
17946   IMATCH_MP_TAC  h_simple_polygonal;
17947   ASM_REWRITE_TAC[euclid_point];
17948   REWRITE_TAC[REAL_SUB_0];
17949   DISCH_ALL_TAC;
17950   UND 10;
17951   KILL 6;
17952   ASM_REWRITE_TAC[];
17953   EXPAND_TAC "y'";
17954   AP_TERM_TAC;
17955   ASM_MESON_TAC[PAIR];
17956   CONJ_TAC;
17957   EXPAND_TAC "A";
17958   IMATCH_MP_TAC  openball_mk_segment_end;
17959   ASM_MESON_TAC[];
17960   REWRITE_TAC[mk_segment_end];
17961   DISCH_TAC;
17962   IMATCH_MP_TAC  pconn_trans;
17963   TYPE_THEN `y'` EXISTS_TAC;
17964   UND 8;
17965   DISCH_THEN_REWRITE;
17966   UND 10;
17967   MESON_TAC[pconn_symm];
17968   (* Wed Aug  4 10:40:05 EDT 2004 *)
17969
17970   ]);;
17971
17972   (* }}} *)
17973
17974 let p_conn_euclid = prove_by_refinement(
17975   `!A x. p_conn A x SUBSET (euclid 2)`,
17976   (* {{{ proof *)
17977   [
17978   REWRITE_TAC[SUBSET;p_conn;simple_polygonal_arc;simple_arc;];
17979   REP_BASIC_TAC;
17980   UND 0;
17981   ASM_REWRITE_TAC[];
17982   UND 6;
17983   SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
17984   REWRITE_TAC[INJ;IMAGE];
17985   MESON_TAC[];
17986   (* Wed Aug  4 10:55:53 EDT 2004 *)
17987   ]);;
17988   (* }}} *)
17989
17990 let p_connA = prove_by_refinement(
17991   `!A x. p_conn A x SUBSET A`,
17992   (* {{{ proof *)
17993   [
17994   REP_BASIC_TAC;
17995   REWRITE_TAC[p_conn;SUBSET;];
17996   ASM_MESON_TAC[];
17997   (* Wed Aug  4 11:11:21 EDT 2004 *)
17998   ]);;
17999   (* }}} *)
18000
18001 let p_conn_open = prove_by_refinement(
18002   `!A x. top2 A ==> (top2 (p_conn A x))`,
18003   (* {{{ proof *)
18004   [
18005   (* Wed Aug  4 10:43:29 EDT 2004 *)
18006   REP_BASIC_TAC;
18007   ASM_SIMP_TAC[top2;top_of_metric_nbd;metric_euclid;p_conn_euclid];
18008   REP_BASIC_TAC;
18009
18010   TYPE_THEN `A a` SUBGOAL_TAC;
18011   ASM_MESON_TAC[p_connA;ISUBSET];
18012   DISCH_TAC;
18013
18014   TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC;
18015   ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;];
18016   REP_BASIC_TAC;
18017   TYPE_THEN `r` EXISTS_TAC;
18018   ASM_REWRITE_TAC[SUBSET;];
18019   REP_BASIC_TAC;
18020   IMATCH_MP_TAC  pconn_trans;
18021   TYPE_THEN `a` EXISTS_TAC;
18022   ASM_REWRITE_TAC[];
18023   IMATCH_MP_TAC  p_conn_subset;
18024   TYPE_THEN `open_ball (euclid 2,d_euclid) a r` EXISTS_TAC;
18025   ASM_REWRITE_TAC[];
18026   IMATCH_MP_TAC  p_conn_ball;
18027   ASM_REWRITE_TAC[];
18028   (* Wed Aug  4 11:21:18 EDT 2004 *)
18029   ]);;
18030   (* }}} *)
18031
18032 let p_conn_diff = prove_by_refinement(
18033   `!A x.  top2 A ==> (top2 (A DIFF (p_conn A x)))`,
18034   (* {{{ proof *)
18035   [
18036   REP_BASIC_TAC;
18037   SIMP_TAC[top2;metric_euclid;top_of_metric_nbd];
18038   CONJ_TAC;
18039   IMATCH_MP_TAC  SUBSET_TRANS;
18040   TYPE_THEN `A` EXISTS_TAC;
18041   REWRITE_TAC[SUBSET_DIFF];
18042   UND 0;
18043   REWRITE_TAC[top2;];
18044   DISCH_TAC;
18045   FIRST_ASSUM (fun t-> ASSUME_TAC (MATCH_MP sub_union t));
18046   UND 1;
18047   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
18048   REP_BASIC_TAC;
18049   RULE_ASSUM_TAC  (REWRITE_RULE[DIFF]);
18050   REP_BASIC_TAC;
18051
18052   TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC;
18053   ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;];
18054   REP_BASIC_TAC;
18055
18056   TYPE_THEN `r` EXISTS_TAC;
18057   ASM_REWRITE_TAC[DIFF_SUBSET];
18058   PROOF_BY_CONTR_TAC;
18059   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS;INTER]);
18060   REP_BASIC_TAC;
18061   FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP  p_conn_ball t));
18062   TYPE_THEN `p_conn A a u` SUBGOAL_TAC;
18063   IMATCH_MP_TAC  p_conn_subset;
18064   ASM_MESON_TAC[];
18065   DISCH_TAC;
18066   UND 1;
18067   REWRITE_TAC[];
18068   IMATCH_MP_TAC  pconn_trans;
18069   TYPE_THEN `u` EXISTS_TAC;
18070   ASM_MESON_TAC[pconn_symm];
18071   (* Wed Aug  4 12:00:13 EDT 2004 *)
18072   ]);;
18073   (* }}} *)
18074
18075 let p_conn_conn = prove_by_refinement(
18076   `!A x y. (top2 A /\ connected top2 A /\ A x /\ A y) ==>
18077      (p_conn A x y)`,
18078   (* {{{ proof *)
18079   [
18080   REWRITE_TAC[connected];
18081   REP_BASIC_TAC;
18082   TYPEL_THEN [`p_conn A x`;`A DIFF (p_conn A x)`] (USE 2 o ISPECL);
18083   UND 2;
18084   ASM_SIMP_TAC[p_conn_open;p_conn_diff];
18085
18086   TYPE_THEN `!(w:(num->real)->bool) z. (w INTER (z DIFF w) = EMPTY)` SUBGOAL_TAC;
18087   SET_TAC[INTER;DIFF];
18088   DISCH_THEN_REWRITE;
18089
18090   TYPE_THEN `!(x:(num->real)->bool) y. (x SUBSET (y UNION (x DIFF y)))` SUBGOAL_TAC;
18091   SET_TAC[SUBSET;UNION;DIFF];
18092   DISCH_THEN_REWRITE;
18093
18094   DISCH_THEN (DISJ_CASES_TAC);
18095   ASM_MESON_TAC[ISUBSET];
18096   UND 2;
18097   REWRITE_TAC[SUBSET;DIFF];
18098   ASM_MESON_TAC[pconn_refl];
18099   (* Wed Aug  4 12:42:12 EDT 2004 *)
18100   ]);;
18101   (* }}} *)
18102
18103 let plane_graph = jordan_def
18104   `plane_graph G <=>
18105      graph_vertex G SUBSET (euclid 2) /\
18106      graph G /\
18107      graph_edge G SUBSET (simple_arc top2) /\
18108      (!e. (graph_edge G e ==>
18109         (graph_inc G e = e INTER (graph_vertex G)))) /\
18110      (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e')) ==>
18111         (e INTER e' SUBSET (graph_vertex G)))`;;
18112
18113 let graph_isomorphic = jordan_def
18114   `graph_isomorphic (G:(A,B)graph_t) (H:(A',B')graph_t) <=>
18115      ?f. (graph_iso f G H)`;;
18116
18117 let I_BIJ = prove_by_refinement(
18118   `!(x:A->bool). BIJ I x x`,
18119   (* {{{ proof *)
18120   [
18121   REWRITE_TAC[BIJ;INJ;SURJ;I_THM;];
18122   MESON_TAC[];
18123   ]);;
18124   (* }}} *)
18125
18126 let graph_isomorphic_refl = prove_by_refinement(
18127   `!(G:(A,B)graph_t). graph_isomorphic G G`,
18128   (* {{{ proof *)
18129   [
18130   REWRITE_TAC[graph_isomorphic;graph_iso;];
18131   REP_BASIC_TAC;
18132   RIGHT_TAC  "f";
18133   RIGHT_TAC  "f";
18134   TYPE_THEN `I:A->A` EXISTS_TAC;
18135   TYPE_THEN `I:B->B` EXISTS_TAC;
18136   TYPE_THEN `(I:A->A,I:B->B)` EXISTS_TAC;
18137   ASM_REWRITE_TAC[I_THM;IMAGE_I;I_BIJ];
18138   (* Wed Aug  4 13:08:32 EDT 2004 *)
18139
18140   ]);;
18141   (* }}} *)
18142
18143 let graph_inc_subset = prove_by_refinement(
18144   `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e) ==>
18145        (graph_inc G e SUBSET graph_vertex G)`,
18146   (* {{{ proof *)
18147   [
18148   REWRITE_TAC[graph;IMAGE;SUBSET;];
18149   NAME_CONFLICT_TAC;
18150   REP_BASIC_TAC;
18151   USE 2 (CONV_RULE (dropq_conv "x''"));
18152   TSPEC  `e'` 2;
18153   REWR 2;
18154   ASM_MESON_TAC[];
18155   ]);;
18156   (* }}} *)
18157
18158 let graph_isomorphic_symm = prove_by_refinement(
18159   `!(G:(A,B)graph_t) (H:(A',B')graph_t).
18160      graph G /\ graph_isomorphic G H ==> graph_isomorphic H G`,
18161   (* {{{ proof *)
18162   [
18163   REWRITE_TAC[graph_isomorphic;graph_iso];
18164   REP_BASIC_TAC;
18165   RIGHT_TAC "f";
18166   RIGHT_TAC "f";
18167   TYPE_THEN `u' = INV u (graph_vertex G) (graph_vertex H)` ABBREV_TAC  ;
18168   TYPE_THEN `v' = INV v (graph_edge G) (graph_edge H)` ABBREV_TAC ;
18169   TYPE_THEN `u'` EXISTS_TAC;
18170   TYPE_THEN `v'` EXISTS_TAC;
18171   TYPE_THEN `(u',v')` EXISTS_TAC;
18172   REWRITE_TAC[];
18173   CONJ_TAC;
18174   EXPAND_TAC "u'";
18175   IMATCH_MP_TAC  INVERSE_BIJ;
18176   ASM_REWRITE_TAC[];
18177   CONJ_TAC;
18178   EXPAND_TAC "v'";
18179   IMATCH_MP_TAC  INVERSE_BIJ;
18180   ASM_REWRITE_TAC[];
18181   (* LAST step *)
18182   REP_BASIC_TAC;
18183   TYPE_THEN `e' = v' e` ABBREV_TAC ;
18184
18185   TYPE_THEN `e = v e'` SUBGOAL_TAC;
18186   ASM_MESON_TAC [inv_comp_right];
18187   DISCH_TAC;
18188   ASM_REWRITE_TAC[];
18189
18190   TYPE_THEN `BIJ v' (graph_edge H) (graph_edge G)` SUBGOAL_TAC;
18191   ASM_MESON_TAC[INVERSE_BIJ];
18192   DISCH_TAC;
18193
18194   TYPE_THEN `graph_edge G e'` SUBGOAL_TAC;
18195   EXPAND_TAC "e'";
18196   UND 10;
18197   REWRITE_TAC[BIJ;SURJ;];
18198   ASM_MESON_TAC[];
18199   DISCH_TAC;
18200   ASM_SIMP_TAC[];
18201   ONCE_REWRITE_TAC [EQ_SYM_EQ];
18202   EXPAND_TAC "u'";
18203   IMATCH_MP_TAC  image_inv_image;
18204   ASM_REWRITE_TAC[];
18205   IMATCH_MP_TAC  graph_inc_subset;
18206   ASM_MESON_TAC[];
18207   (* Wed Aug  4 13:53:24 EDT 2004 *)
18208
18209   ]);;
18210   (* }}} *)
18211
18212 let graph_isomorphic_trans = prove_by_refinement(
18213   `!(G:(A,B)graph_t) (H:(A',B')graph_t) (J:(A'',B'')graph_t).
18214     graph_isomorphic G H /\ graph_isomorphic H J ==>
18215      graph_isomorphic G J`,
18216   (* {{{ proof *)
18217   [
18218   REWRITE_TAC[graph_isomorphic;graph_iso;];
18219   REP_BASIC_TAC;
18220   KILL 3;
18221   KILL 7;
18222   RIGHT_TAC "f";
18223   RIGHT_TAC "f";
18224   TYPE_THEN `u' o u` EXISTS_TAC;
18225   TYPE_THEN `v' o v` EXISTS_TAC;
18226   TYPE_THEN `(u' o u, v' o v)` EXISTS_TAC;
18227   ASM_REWRITE_TAC[];
18228   CONJ_TAC;
18229   REWRITE_TAC[comp_comp];
18230   IMATCH_MP_TAC  COMP_BIJ;
18231   ASM_MESON_TAC[];
18232   CONJ_TAC;
18233   REWRITE_TAC[comp_comp];
18234   IMATCH_MP_TAC  COMP_BIJ;
18235   ASM_MESON_TAC[];
18236   REP_BASIC_TAC;
18237   REWRITE_TAC[IMAGE_o];
18238   REWRITE_TAC[o_DEF];
18239
18240   TYPE_THEN `graph_edge H (v e)` SUBGOAL_TAC;
18241   UND 5;
18242   REWRITE_TAC[BIJ;SURJ];
18243   UND 3;
18244   MESON_TAC[];
18245   ASM_SIMP_TAC[];
18246   (* Wed Aug  4 14:13:25 EDT 2004 *)
18247   ]);;
18248   (* }}} *)
18249
18250 let graph_isomorphic_graph = prove_by_refinement(
18251   `!(G:(A,B)graph_t) H.
18252      graph G /\ graph_isomorphic G (H:(A',B')graph_t) ==> graph H`,
18253   (* {{{ proof *)
18254
18255   [
18256   REP_BASIC_TAC;
18257   TYPE_THEN `!z. (graph_edge G z ==> graph_inc G z SUBSET graph_vertex G)` SUBGOAL_TAC;
18258   ASM_MESON_TAC[graph_inc_subset];
18259   DISCH_TAC;
18260   UND 0;
18261   UND 1;
18262   REWRITE_TAC[graph;graph_isomorphic;graph_iso];
18263   REP_BASIC_TAC;
18264   REWRITE_TAC[SUBSET;IMAGE;];
18265   NAME_CONFLICT_TAC;
18266   CONV_TAC (dropq_conv "x''");
18267   REP_BASIC_TAC;
18268   TYPE_THEN `?y'. (graph_edge G y' /\ (v y' = x'))` SUBGOAL_TAC;
18269   UND 1;
18270   REWRITE_TAC[BIJ;SURJ];
18271   UND 6;
18272   MESON_TAC[];
18273   REP_BASIC_TAC;
18274
18275   TYPE_THEN `graph_inc H x' = IMAGE u (graph_inc G y')` SUBGOAL_TAC;
18276   ASM_MESON_TAC[];
18277   DISCH_TAC;
18278
18279   TYPE_THEN `graph_inc G y' SUBSET graph_vertex G` SUBGOAL_TAC;
18280   ASM_SIMP_TAC[];
18281   DISCH_TAC;
18282   KILL 2;
18283
18284   SUBCONJ_TAC;
18285   ASM_REWRITE_TAC[IMAGE];
18286   UND 10;
18287   UND 3;
18288   REWRITE_TAC[BIJ;SURJ];
18289   MESON_TAC[ISUBSET];
18290   DISCH_TAC;
18291
18292   (* has size *)
18293   TYPE_THEN `(graph_inc G y') HAS_SIZE 2` SUBGOAL_TAC;
18294   UND 5;
18295   REWRITE_TAC[SUBSET;IMAGE];
18296   NAME_CONFLICT_TAC;
18297   CONV_TAC (dropq_conv "x''");
18298   UND 8;
18299   MESON_TAC[];
18300   DISCH_TAC;
18301
18302
18303   ASM_REWRITE_TAC[];
18304   REWRITE_TAC[HAS_SIZE];
18305   SUBCONJ_TAC;
18306   IMATCH_MP_TAC  FINITE_IMAGE;
18307   ASM_MESON_TAC[HAS_SIZE];
18308   DISCH_TAC;
18309   RULE_ASSUM_TAC  (REWRITE_RULE[HAS_SIZE]);
18310   REP_BASIC_TAC;
18311   UND 11;
18312   DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]);
18313   IMATCH_MP_TAC  CARD_IMAGE_INJ;
18314   ASM_REWRITE_TAC[];
18315   REP_BASIC_TAC;
18316   UND 3;
18317   REWRITE_TAC[BIJ;INJ];
18318   REP_BASIC_TAC;
18319   ASM_MESON_TAC[ISUBSET];
18320   (* Wed Aug  4 15:18:06 EDT 2004 *)
18321   ]);;
18322
18323   (* }}} *)
18324
18325 let planar_graph = jordan_def
18326   `planar_graph (G:(A,B)graph_t) <=>
18327       (?H. (plane_graph H) /\ (graph_isomorphic H G))`;;
18328
18329 let plane_planar = prove_by_refinement(
18330   `!G. (plane_graph G) ==> (planar_graph G)`,
18331   (* {{{ proof *)
18332
18333   [
18334   REWRITE_TAC[planar_graph];
18335   REP_BASIC_TAC;
18336   ASM_MESON_TAC[graph_isomorphic_refl];
18337   ]);;
18338
18339   (* }}} *)
18340
18341 let planar_is_graph = prove_by_refinement(
18342   `!(G:(A,B)graph_t). (planar_graph G ==> graph G)`,
18343   (* {{{ proof *)
18344
18345   [
18346   REWRITE_TAC[planar_graph;plane_graph];
18347   REP_BASIC_TAC;
18348   ASM_MESON_TAC[graph_isomorphic_graph];
18349   ]);;
18350
18351   (* }}} *)
18352
18353 let planar_iso = prove_by_refinement(
18354   `!G H. (planar_graph (G:(A,B)graph_t)) /\ (graph_isomorphic G H) ==>
18355     (planar_graph (H:(A',B')graph_t))`,
18356   (* {{{ proof *)
18357   [
18358   REWRITE_TAC[planar_graph];
18359   REP_BASIC_TAC;
18360   TYPE_THEN `H'` EXISTS_TAC;
18361   ASM_REWRITE_TAC[];
18362   JOIN 1 0;
18363   USE 0 (MATCH_MP graph_isomorphic_trans);
18364   ASM_REWRITE_TAC[];
18365   (* Wed Aug  4 15:41:05 EDT 2004 *)
18366
18367   ]);;
18368   (* }}} *)
18369
18370 (* almost the same ans num_MAX .  The minimization is num_WOP. *)
18371 let select_num_max = prove_by_refinement(
18372   `!Y. FINITE Y /\ (~(Y= EMPTY)) ==>
18373         (?z. (Y z /\ (!y. Y y ==> y <=| z)))`,
18374   (* {{{ proof *)
18375   [
18376   REP_BASIC_TAC;
18377   TYPE_THEN `f = \ (t:num). --. (&. t)` ABBREV_TAC ;
18378   TYPE_THEN `Z = IMAGE f Y` ABBREV_TAC ;
18379   TYPE_THEN `FINITE Z /\ ~(Z = {})` SUBGOAL_TAC;
18380   EXPAND_TAC "Z";
18381   CONJ_TAC;
18382   IMATCH_MP_TAC  FINITE_IMAGE;
18383   ASM_REWRITE_TAC[];
18384   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
18385   REP_BASIC_TAC;
18386   UND 0;
18387   REWRITE_TAC[EMPTY_EXISTS];
18388   TYPE_THEN `f u` EXISTS_TAC;
18389   REWRITE_TAC[IMAGE];
18390   ASM_MESON_TAC[];
18391   DISCH_TAC;
18392   USE 4 (MATCH_MP   min_finite);
18393   REP_BASIC_TAC;
18394   TYPE_THEN `?z. Y z /\ (f z = delta)` SUBGOAL_TAC;
18395   UND 5;
18396   EXPAND_TAC "Z";
18397   REWRITE_TAC[IMAGE;SUBSET];
18398   MESON_TAC[];
18399   REP_BASIC_TAC;
18400   TYPE_THEN `z` EXISTS_TAC;
18401   ASM_REWRITE_TAC[];
18402   REP_BASIC_TAC;
18403   TYPE_THEN `(f z <= f y) ==> (y <=| z)` SUBGOAL_TAC;
18404   EXPAND_TAC "f";
18405   REDUCE_TAC;
18406   DISCH_THEN IMATCH_MP_TAC ;
18407   TYPE_THEN `Z (f y)` SUBGOAL_TAC;
18408   EXPAND_TAC "Z";
18409   REWRITE_TAC[IMAGE;SUBSET];
18410   ASM_MESON_TAC[];
18411   ASM_MESON_TAC[];
18412   ]);;
18413   (* }}} *)
18414
18415 let select_image_num_max = prove_by_refinement(
18416   `!(X:A->bool) f.  (?N. (!x. (X x ==> f x <| N))) /\ ~(X = EMPTY)  ==>
18417       (?z. (X z /\ (!x. (X x ==> f x <=| f z))))`,
18418   (* {{{ proof *)
18419   [
18420   REP_BASIC_TAC;
18421   TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ;
18422   TYPE_THEN `Y SUBSET {n | n <| N}` SUBGOAL_TAC;
18423   EXPAND_TAC "Y";
18424   REWRITE_TAC[IMAGE;SUBSET;];
18425   ASM_MESON_TAC[];
18426   REP_BASIC_TAC;
18427   TYPE_THEN `FINITE Y /\ (~(Y= EMPTY))` SUBGOAL_TAC;
18428   CONJ_TAC;
18429   IMATCH_MP_TAC  FINITE_SUBSET;
18430   TYPE_THEN `{n | n <| N}` EXISTS_TAC;
18431   ASM_REWRITE_TAC[FINITE_NUMSEG_LT];
18432   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
18433   REWRITE_TAC[EMPTY_EXISTS];
18434   REP_BASIC_TAC;
18435   TYPE_THEN `f u` EXISTS_TAC;
18436   UND 2;
18437   UND 0;
18438   REWRITE_TAC[IMAGE;SUBSET];
18439   DISCH_TAC;
18440   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
18441   ASM_MESON_TAC[];
18442   DISCH_TAC;
18443   USE 4 (MATCH_MP   select_num_max);
18444   REP_BASIC_TAC;
18445   TYPE_THEN `?r. X r /\ (f r = z)` SUBGOAL_TAC;
18446   UND 5;
18447   EXPAND_TAC "Y";
18448   REWRITE_TAC[IMAGE;SUBSET];
18449   MESON_TAC[];
18450   REP_BASIC_TAC;
18451   TYPE_THEN `r` EXISTS_TAC;
18452   ASM_REWRITE_TAC[];
18453   REP_BASIC_TAC;
18454   TSPEC `f x` 4;
18455   TYPE_THEN `Y (f x)` SUBGOAL_TAC;
18456   EXPAND_TAC "Y";
18457   REWRITE_TAC[IMAGE;SUBSET];
18458   ASM_MESON_TAC[];
18459   ASM_MESON_TAC[];
18460   (* Wed Aug  4 16:41:51 EDT 2004 *)
18461
18462   ]);;
18463   (* }}} *)
18464
18465 let select_image_num_min = prove_by_refinement(
18466   `!(X:A->bool) f. (~(X = EMPTY)) ==>
18467      (?z. (X z  /\ (!x. (X x ==> f z <=| f x))))`,
18468   (* {{{ proof *)
18469   [
18470   REP_BASIC_TAC;
18471   TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ;
18472   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
18473   REP_BASIC_TAC;
18474   TYPE_THEN `(?n. Y n)` SUBGOAL_TAC;
18475   TYPE_THEN `f u` EXISTS_TAC;
18476   EXPAND_TAC "Y";
18477   REWRITE_TAC[IMAGE;SUBSET];
18478   ASM_MESON_TAC[];
18479   DISCH_TAC;
18480   RULE_ASSUM_TAC (ONCE_REWRITE_RULE[num_WOP]);
18481   REP_BASIC_TAC;
18482   TYPE_THEN `?z. (X z) /\ (f z = n)` SUBGOAL_TAC;
18483   UND 3;
18484   EXPAND_TAC "Y";
18485   REWRITE_TAC[IMAGE;SUBSET];
18486   MESON_TAC[];
18487   REP_BASIC_TAC;
18488   TYPE_THEN `z` EXISTS_TAC;
18489   ASM_REWRITE_TAC[];
18490   REP_BASIC_TAC;
18491   TSPEC `f x` 2;
18492   IMATCH_MP_TAC  (ARITH_RULE `~(f x <| n) ==> (n <=| f x)`);
18493   DISCH_ALL_TAC;
18494   UND 2;
18495   ASM_REWRITE_TAC[];
18496   EXPAND_TAC "Y";
18497   KILL 1;
18498   ASM_REWRITE_TAC[IMAGE;SUBSET];
18499    ASM_MESON_TAC[];
18500   (* Wed Aug  4 19:37:29 EDT 2004 *)
18501
18502   ]);;
18503   (* }}} *)
18504
18505 let select_card_max = prove_by_refinement(
18506   `!(X:(A->bool)->bool).  (~(X = EMPTY) /\ (FINITE (UNIONS X))) ==>
18507     (?z. (X z /\ (!x. (X x ==> (CARD x <= CARD z)))))`,
18508   (* {{{ proof *)
18509   [
18510   REP_BASIC_TAC;
18511   IMATCH_MP_TAC  select_image_num_max;
18512   ASM_REWRITE_TAC[];
18513   TYPE_THEN `SUC (CARD (UNIONS X))` EXISTS_TAC;
18514   REP_BASIC_TAC;
18515   TYPE_THEN `x SUBSET (UNIONS X)` SUBGOAL_TAC;
18516   IMATCH_MP_TAC  sub_union;
18517   ASM_REWRITE_TAC[];
18518   DISCH_TAC;
18519    REWRITE_TAC[ARITH_RULE `(a <| SUC b) <=> (a <=| b)`];
18520   IMATCH_MP_TAC  CARD_SUBSET;
18521   ASM_REWRITE_TAC[];
18522   (* Thu Aug  5 10:50:37 EDT 2004 *)
18523
18524   ]);;
18525   (* }}} *)
18526
18527 let select_card_min = prove_by_refinement(
18528   `!(X:(A->bool)->bool).  ~(X = EMPTY) ==>
18529     (?z. (X z /\ (!x. (X x ==> (CARD z <= CARD x)))))`,
18530   (* {{{ proof *)
18531   [
18532   REP_BASIC_TAC;
18533   IMATCH_MP_TAC  select_image_num_min;
18534   ASM_REWRITE_TAC[];
18535   (* Thu Aug  5 10:52:02 EDT 2004 *)
18536   ]);;
18537   (* }}} *)
18538
18539 (* D embeddings of planar graphs *)
18540
18541 let induced_top_interval = prove_by_refinement(
18542   `!a b. induced_top (top_of_metric(UNIV,d_real))
18543        {x | a <= x /\ x <= b } =
18544      top_of_metric ({x | a <= x /\ x <= b}, d_real)
18545       `,
18546   (* {{{ proof *)
18547   [
18548   REP_BASIC_TAC;
18549   IMATCH_MP_TAC  top_of_metric_induced;
18550   ASM_REWRITE_TAC[SUBSET_UNIV;metric_real];
18551   ]);;
18552   (* }}} *)
18553
18554 let continuous_interval = prove_by_refinement(
18555   `!f a b. (continuous f (top_of_metric(UNIV,d_real)) top2) ==>
18556      (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) top2)`,
18557   (* {{{ proof *)
18558   [
18559   DISCH_ALL_TAC;
18560   REWRITE_TAC[GSYM induced_top_interval];
18561   IMATCH_MP_TAC  continuous_induced_domain;
18562   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV ];
18563   ]);;
18564   (* }}} *)
18565
18566 let inj_image_subset  = prove_by_refinement(
18567   `!(f:A->B) X Y. (INJ f X Y ==> IMAGE f X SUBSET Y)`,
18568   (* {{{ proof *)
18569   [
18570   REWRITE_TAC[INJ;IMAGE;SUBSET];
18571   MESON_TAC[];
18572   ]);;
18573   (* }}} *)
18574
18575 let subset_contain = prove_by_refinement(
18576   `!a b c d. (c <= a) /\ (b <= d) ==>
18577         {x | a <= x /\ x <= b} SUBSET {x | c <= x /\ x <= d}`,
18578   (* {{{ proof *)
18579   [
18580   REWRITE_TAC[SUBSET];
18581   REAL_ARITH_TAC;
18582   ]);;
18583   (* }}} *)
18584
18585 let curve_restriction = prove_by_refinement(
18586   `!C K K' a b.
18587        simple_arc top2 C /\
18588        closed_ top2 K /\ closed_ top2 K' /\
18589        (C INTER K INTER K' = EMPTY) /\
18590        ~(C INTER K = EMPTY) /\
18591        ~(C INTER K' = EMPTY) /\
18592         (a <. b) ==>
18593        (?C' f. (C' = IMAGE f {x | a <= x /\ x <= b}) /\ (C' SUBSET C) /\
18594             continuous f (top_of_metric(UNIV,d_real)) top2 /\
18595             INJ f {x | a <= x /\ x <= b} (euclid 2) /\
18596             (C' INTER K = {(f a)}) /\
18597             (C' INTER K' = {(f b)})
18598        )
18599        `,
18600   (* {{{ proof *)
18601   [
18602   REWRITE_TAC[simple_arc];
18603   REP_BASIC_TAC;
18604   ASSUME_TAC top2_unions;
18605   (* K parameter *)
18606   TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K (f s)))` SUBGOAL_TAC;
18607   ASSUME_TAC preimage_first ;
18608   TYPEL_THEN [`K`;`2`] (USE 10 o ISPECL);
18609   FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
18610   KILL 10;
18611   ASM_REWRITE_TAC[GSYM top2;];
18612   ASM_SIMP_TAC[continuous_interval];
18613   UND 2;
18614   ASM_REWRITE_TAC[];
18615   DISCH_THEN_REWRITE;
18616   REWR 6;
18617   IMATCH_MP_TAC  inj_image_subset;
18618   ASM_REWRITE_TAC[];
18619   REP_BASIC_TAC;
18620   (* K' parameter *)
18621   TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K' (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K' (f s)))` SUBGOAL_TAC;
18622   ASSUME_TAC preimage_first ;
18623   TYPEL_THEN [`K'`;`2`] (USE 14 o ISPECL);
18624   FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
18625   KILL 14;
18626   ASM_REWRITE_TAC[GSYM top2;];
18627   ASM_SIMP_TAC[continuous_interval];
18628   UND 1;
18629   ASM_REWRITE_TAC[];
18630   DISCH_THEN_REWRITE;
18631   REWR 6;
18632   IMATCH_MP_TAC  inj_image_subset;
18633   ASM_REWRITE_TAC[];
18634   REP_BASIC_TAC;
18635   TYPE_THEN `(t < t' \/ t' < t)` SUBGOAL_TAC;
18636   REWRITE_TAC[(REAL_ARITH `(t < t' \/ t' < t) <=> ~( t = t')`)];
18637   DISCH_ALL_TAC;
18638   UND 3;
18639   REWRITE_TAC[EMPTY_EXISTS;INTER;];
18640   TYPE_THEN `(f t)` EXISTS_TAC;
18641   REWR 11;
18642   REWRITE_TAC[IMAGE;SUBSET];
18643   CONJ_TAC;
18644   TYPE_THEN `t'` EXISTS_TAC;
18645   ASM_REWRITE_TAC[];
18646   ASM_MESON_TAC[];
18647   (* main cases split [main] *)
18648   ASSUME_TAC (REAL_ARITH `&0 < &1`);
18649   DISCH_THEN (DISJ_CASES_TAC);
18650   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;
18651   ASM_REWRITE_TAC[];
18652   IMATCH_MP_TAC  inj_subset_domain;
18653   TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
18654   REWR 6;
18655   ASM_REWRITE_TAC[SUBSET ];
18656    UND 19;
18657   UND 16;
18658   UND 13;
18659   REAL_ARITH_TAC;
18660   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
18661   REP_BASIC_TAC;
18662   TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
18663   TYPE_THEN `Ca INTER K' = {(g (&0))}` SUBGOAL_TAC;
18664   IMATCH_MP_TAC  SUBSET_ANTISYM;
18665   CONJ_TAC;
18666   REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
18667   KILL 26;
18668   EXPAND_TAC "Ca";
18669   REWRITE_TAC[IMAGE;SUBSET];
18670   REP_BASIC_TAC;
18671   TYPE_THEN `x' < t' \/ (x' = t')` SUBGOAL_TAC;
18672   UND 28;
18673   REAL_ARITH_TAC;
18674   DISCH_THEN DISJ_CASES_TAC;
18675   PROOF_BY_CONTR_TAC;
18676   UND 26;
18677   ASM_REWRITE_TAC[];
18678   FIRST_ASSUM IMATCH_MP_TAC ;
18679   ASM_REWRITE_TAC[];
18680   UND 29;
18681   UND 13;
18682   REAL_ARITH_TAC;
18683   ASM_MESON_TAC[];
18684   REWRITE_TAC[SUBSET;INTER;INR IN_SING;];
18685   KILL 26;
18686   EXPAND_TAC "Ca";
18687   REWRITE_TAC[IMAGE;SUBSET];
18688   NAME_CONFLICT_TAC;
18689   REP_BASIC_TAC;
18690   CONJ_TAC;
18691   TYPE_THEN `t'` EXISTS_TAC;
18692   ASM_MESON_TAC[REAL_ARITH `(t < t' ==> t<= t') /\ (t' <= t')`];
18693   ASM_MESON_TAC[];
18694   DISCH_TAC;
18695   TYPE_THEN `~(Ca INTER K = EMPTY)` SUBGOAL_TAC;
18696   REWRITE_TAC[INTER;EMPTY_EXISTS];
18697   TYPE_THEN `f t` EXISTS_TAC;
18698   KILL 26;
18699   EXPAND_TAC "Ca";
18700   REWRITE_TAC[IMAGE;SUBSET;];
18701   ASM_REWRITE_TAC[];
18702   TYPE_THEN `t` EXISTS_TAC;
18703   ASM_REWRITE_TAC[REAL_ARITH `t <= t`];
18704   ASM_SIMP_TAC[REAL_ARITH `(t < t') ==> (t <= t')`];
18705   DISCH_TAC;
18706   KILL 21;
18707   (* ADD Ca SUBSET C *)
18708   TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC;
18709   KILL 26;
18710   EXPAND_TAC "Ca";
18711   KILL 20;
18712   ASM_REWRITE_TAC[];
18713   REWRITE_TAC[IMAGE;SUBSET];
18714   NAME_CONFLICT_TAC;
18715   REP_BASIC_TAC;
18716   TYPE_THEN `x'` EXISTS_TAC;
18717   ASM_REWRITE_TAC[];
18718   UND 21;
18719   UND 26;
18720   UND 13;
18721   UND 19;
18722   UND 16;
18723   REAL_ARITH_TAC;
18724   DISCH_TAC;
18725   (* t'' parameter for g and K *)
18726   TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K (g s)))` SUBGOAL_TAC;
18727   ASSUME_TAC preimage_first ;
18728   TYPEL_THEN [`K`;`2`] (USE 29 o ISPECL);
18729   FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
18730   KILL 29;
18731   ASM_REWRITE_TAC[GSYM top2;];
18732   ASM_SIMP_TAC[continuous_interval];
18733   EXPAND_TAC "Ca";
18734   IMATCH_MP_TAC  inj_image_subset;
18735   ASM_REWRITE_TAC[];
18736   REP_BASIC_TAC;
18737   (* set up for arc_reparameter_rev *)
18738   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;
18739   ASM_REWRITE_TAC[];
18740   TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC;
18741   UND 32;
18742   REAL_ARITH_TAC;
18743   DISCH_THEN DISJ_CASES_TAC;
18744   ASM_REWRITE_TAC[];
18745   IMATCH_MP_TAC  inj_subset_domain;
18746   TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
18747   ASM_REWRITE_TAC[SUBSET ];
18748   UND 31;
18749   REAL_ARITH_TAC;
18750   PROOF_BY_CONTR_TAC;
18751   UND 3;
18752   REWRITE_TAC[EMPTY_EXISTS;INTER;];
18753   TYPE_THEN `g (&0)` EXISTS_TAC;
18754   TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC;
18755   TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC;
18756   ASM_MESON_TAC[INTER_SUBSET];
18757   REWRITE_TAC[SUBSET;INR IN_SING];
18758   MESON_TAC[];
18759   DISCH_TAC;
18760   CONJ_TAC;
18761   UND 3;
18762   UND 21;
18763   MESON_TAC[ISUBSET];
18764   REWR 30;
18765   ASM_REWRITE_TAC[];
18766   UND 15;
18767   ASM_REWRITE_TAC[];
18768   DISCH_TAC;
18769   FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
18770   REP_BASIC_TAC;
18771   TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ;
18772   (* now finally go after the goal in the FIRST case *)
18773   TYPE_THEN `C'` EXISTS_TAC;
18774   TYPE_THEN `g'` EXISTS_TAC;
18775   ASM_REWRITE_TAC[];
18776   (* now finish off the three conditions *)
18777   KILL 34;
18778   TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC;
18779   KILL 43;
18780   EXPAND_TAC "C'";
18781   EXPAND_TAC "Ca";
18782   IMATCH_MP_TAC  IMAGE_SUBSET;
18783   IMATCH_MP_TAC subset_contain;
18784   ASM_REWRITE_TAC[];
18785   REAL_ARITH_TAC;
18786   DISCH_TAC;
18787   CONJ_TAC; (* 1*)
18788   ASM_REWRITE_TAC[];
18789   USE 8 GSYM;
18790   ASM_REWRITE_TAC[];
18791   IMATCH_MP_TAC  SUBSET_TRANS;
18792   TYPE_THEN `Ca` EXISTS_TAC ;
18793   ASM_MESON_TAC[];
18794   CONJ_TAC; (* 2 *)
18795   KILL 43;
18796   EXPAND_TAC "C'";
18797   IMATCH_MP_TAC  SUBSET_ANTISYM;
18798   CONJ_TAC;
18799   REWRITE_TAC[INTER;IMAGE;SUBSET];
18800   NAME_CONFLICT_TAC;
18801   REP_BASIC_TAC;
18802   REWRITE_TAC[INR IN_SING];
18803   TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC;
18804   UND 45;
18805   REAL_ARITH_TAC;
18806   DISCH_THEN DISJ_CASES_TAC;
18807   ASM_REWRITE_TAC[];
18808   PROOF_BY_CONTR_TAC;
18809   TSPEC `x'` 14;
18810   UND 43;
18811   ASM_MESON_TAC[];
18812   ASM_MESON_TAC[];
18813   REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING];
18814   NAME_CONFLICT_TAC;
18815   REP_BASIC_TAC;
18816   CONJ_TAC;
18817   ASM_REWRITE_TAC[];
18818   TYPE_THEN `t''` EXISTS_TAC;
18819   ASM_MESON_TAC[REAL_ARITH `t'' <= t''`];
18820   ASM_MESON_TAC[];
18821   (* 3 *)
18822   IMATCH_MP_TAC  SUBSET_ANTISYM;
18823   CONJ_TAC;
18824   IMATCH_MP_TAC  SUBSET_TRANS;
18825   TYPE_THEN `Ca INTER K'` EXISTS_TAC;
18826   CONJ_TAC;
18827   UND 34;
18828   REWRITE_TAC[SUBSET;INTER];
18829   MESON_TAC[];
18830   ASM_REWRITE_TAC[];
18831   REWRITE_TAC[SUBSET;INR IN_SING];
18832   REWRITE_TAC[SUBSET;INTER;INR IN_SING ];
18833   REP_BASIC_TAC;
18834   ASM_REWRITE_TAC[];
18835   CONJ_TAC;
18836   EXPAND_TAC "C'";
18837   REWRITE_TAC[IMAGE;SUBSET];
18838   TYPE_THEN `b` EXISTS_TAC;
18839   ASM_REWRITE_TAC[];
18840   UND 40;
18841   REAL_ARITH_TAC;
18842   ASM_MESON_TAC[];
18843   (* sh *)
18844   (*  *******************  START THE SECOND HALF ************  *)
18845
18846   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;
18847   ASM_REWRITE_TAC[];
18848   IMATCH_MP_TAC  inj_subset_domain;
18849   TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
18850   REWR 6;
18851   ASM_REWRITE_TAC[SUBSET ];
18852    UND 19;
18853   UND 12;
18854   UND 17;
18855   REAL_ARITH_TAC;
18856   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
18857   REP_BASIC_TAC;
18858   TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
18859   TYPE_THEN `Ca INTER K = {(g (&0))}` SUBGOAL_TAC;
18860   IMATCH_MP_TAC  SUBSET_ANTISYM;
18861   CONJ_TAC;
18862   REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
18863   KILL 26;
18864   EXPAND_TAC "Ca";
18865   REWRITE_TAC[IMAGE;SUBSET];
18866   REP_BASIC_TAC;
18867   TYPE_THEN `x' < t \/ (x' = t)` SUBGOAL_TAC;
18868   UND 28;
18869   REAL_ARITH_TAC;
18870   DISCH_THEN DISJ_CASES_TAC;
18871   PROOF_BY_CONTR_TAC;
18872   UND 26;
18873   ASM_REWRITE_TAC[];
18874   FIRST_ASSUM IMATCH_MP_TAC ;
18875   ASM_REWRITE_TAC[];
18876   UND 29;
18877   UND 17;
18878   REAL_ARITH_TAC;
18879   ASM_MESON_TAC[];
18880   REWRITE_TAC[SUBSET;INTER;INR IN_SING;];
18881   KILL 26;
18882   EXPAND_TAC "Ca";
18883   REWRITE_TAC[IMAGE;SUBSET];
18884   NAME_CONFLICT_TAC;
18885   REP_BASIC_TAC;
18886   CONJ_TAC;
18887   TYPE_THEN `t` EXISTS_TAC;
18888   ASM_MESON_TAC[REAL_ARITH `(t' < t ==> t'<= t) /\ (t <= t)`];
18889   ASM_MESON_TAC[];
18890   DISCH_TAC;
18891   TYPE_THEN `~(Ca INTER K' = EMPTY)` SUBGOAL_TAC;
18892   REWRITE_TAC[INTER;EMPTY_EXISTS];
18893   TYPE_THEN `f t'` EXISTS_TAC;
18894   KILL 26;
18895   EXPAND_TAC "Ca";
18896   REWRITE_TAC[IMAGE;SUBSET;];
18897   ASM_REWRITE_TAC[];
18898   TYPE_THEN `t'` EXISTS_TAC;
18899   ASM_REWRITE_TAC[REAL_ARITH `t' <= t'`];
18900   ASM_SIMP_TAC[REAL_ARITH `(t' < t) ==> (t' <= t)`];
18901   DISCH_TAC;
18902   KILL 21;
18903   (* ADD Ca SUBSET C *)
18904   TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC;
18905   KILL 26;
18906   EXPAND_TAC "Ca";
18907   KILL 20;
18908   ASM_REWRITE_TAC[];
18909   REWRITE_TAC[IMAGE;SUBSET];
18910   NAME_CONFLICT_TAC;
18911   REP_BASIC_TAC;
18912   TYPE_THEN `x'` EXISTS_TAC;
18913   ASM_REWRITE_TAC[];
18914   UND 21;
18915   UND 26;
18916   UND 17;
18917   UND 19;
18918   UND 12;
18919   REAL_ARITH_TAC;
18920   DISCH_TAC;
18921   (* gK *)
18922   (* t'' parameter for g and K *)
18923   TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K' (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K' (g s)))` SUBGOAL_TAC;
18924   ASSUME_TAC preimage_first ;
18925   TYPEL_THEN [`K'`;`2`] (USE 29 o ISPECL);
18926   FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
18927   KILL 29;
18928   ASM_REWRITE_TAC[GSYM top2;];
18929   ASM_SIMP_TAC[continuous_interval];
18930   EXPAND_TAC "Ca";
18931   IMATCH_MP_TAC  inj_image_subset;
18932   ASM_REWRITE_TAC[];
18933   REP_BASIC_TAC;
18934   (* set up for arc_reparameter_gen *)
18935   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;
18936   ASM_REWRITE_TAC[];
18937   TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC;
18938   UND 32;
18939   REAL_ARITH_TAC;
18940   DISCH_THEN DISJ_CASES_TAC;
18941   ASM_REWRITE_TAC[];
18942   IMATCH_MP_TAC  inj_subset_domain;
18943   TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
18944   ASM_REWRITE_TAC[SUBSET ];
18945   UND 31;
18946   REAL_ARITH_TAC;
18947   PROOF_BY_CONTR_TAC;
18948   UND 3;
18949   REWRITE_TAC[EMPTY_EXISTS;INTER;];
18950   TYPE_THEN `g (&0)` EXISTS_TAC;
18951   TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC;
18952   TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC;
18953   ASM_MESON_TAC[INTER_SUBSET];
18954   REWRITE_TAC[SUBSET;INR IN_SING];
18955   MESON_TAC[];
18956   DISCH_TAC;
18957   CONJ_TAC;
18958   UND 3;
18959   UND 21;
18960   MESON_TAC[ISUBSET];
18961   REWR 30;
18962   ASM_REWRITE_TAC[];
18963   UND 11;
18964   ASM_REWRITE_TAC[];
18965   DISCH_TAC;
18966   FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
18967   REP_BASIC_TAC;
18968   TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ;
18969   (* now finally go after the goal in the FIRST case *)
18970   TYPE_THEN `C'` EXISTS_TAC;
18971   TYPE_THEN `g'` EXISTS_TAC;
18972   ASM_REWRITE_TAC[];
18973   (* nfo *)
18974   (* now finish off the three conditions *)
18975   KILL 34;
18976   TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC;
18977   KILL 43;
18978   EXPAND_TAC "C'";
18979   EXPAND_TAC "Ca";
18980   IMATCH_MP_TAC  IMAGE_SUBSET;
18981   IMATCH_MP_TAC subset_contain;
18982   ASM_REWRITE_TAC[];
18983   REAL_ARITH_TAC;
18984   DISCH_TAC;
18985   CONJ_TAC; (* 1*)
18986   ASM_REWRITE_TAC[];
18987   USE 8 GSYM;
18988   ASM_REWRITE_TAC[];
18989   IMATCH_MP_TAC  SUBSET_TRANS;
18990   TYPE_THEN `Ca` EXISTS_TAC ;
18991   ASM_MESON_TAC[];
18992   (* s2 *)
18993   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
18994   CONJ_TAC ; (* 2 *)
18995   KILL 43;
18996   EXPAND_TAC "C'";
18997   IMATCH_MP_TAC  SUBSET_ANTISYM;
18998   CONJ_TAC;
18999   REWRITE_TAC[INTER;IMAGE;SUBSET];
19000   NAME_CONFLICT_TAC;
19001   REP_BASIC_TAC;
19002   REWRITE_TAC[INR IN_SING];
19003   TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC;
19004   UND 45;
19005   REAL_ARITH_TAC;
19006   DISCH_THEN DISJ_CASES_TAC;
19007   ASM_REWRITE_TAC[];
19008   PROOF_BY_CONTR_TAC;
19009   TSPEC `x'` 14;
19010   UND 43;
19011   ASM_MESON_TAC[];
19012   ASM_MESON_TAC[];
19013   REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING];
19014   NAME_CONFLICT_TAC;
19015   REP_BASIC_TAC;
19016   CONJ_TAC;
19017   ASM_REWRITE_TAC[];
19018   TYPE_THEN `t''` EXISTS_TAC;
19019   ASM_MESON_TAC[REAL_ARITH `t'' <= t''`];
19020   ASM_MESON_TAC[];
19021   (* s3 *)
19022   (* 3 *)
19023   IMATCH_MP_TAC  SUBSET_ANTISYM;
19024   CONJ_TAC;
19025   IMATCH_MP_TAC  SUBSET_TRANS;
19026   TYPE_THEN `Ca INTER K` EXISTS_TAC;
19027   CONJ_TAC;
19028   UND 34;
19029   REWRITE_TAC[SUBSET;INTER];
19030   MESON_TAC[];
19031   ASM_REWRITE_TAC[];
19032   REWRITE_TAC[SUBSET;INR IN_SING];
19033   REWRITE_TAC[SUBSET;INTER;INR IN_SING ];
19034   REP_BASIC_TAC;
19035   ASM_REWRITE_TAC[];
19036   CONJ_TAC;
19037   EXPAND_TAC "C'";
19038   REWRITE_TAC[IMAGE;SUBSET];
19039   TYPE_THEN `a` EXISTS_TAC;
19040   ASM_REWRITE_TAC[];
19041   UND 40;
19042   REAL_ARITH_TAC;
19043   ASM_MESON_TAC[];
19044   (* Thu Aug  5 08:09:38 EDT 2004  *)
19045
19046   ]);;
19047   (* }}} *)
19048
19049 let simple_arc_end = jordan_def
19050   `simple_arc_end C v v' <=>
19051     (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1 }) /\
19052        continuous f (top_of_metric(UNIV,d_real)) top2 /\
19053        INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
19054        (f (&0) = v) /\ (f(&1) = v'))`;;
19055
19056 let good_plane_graph = jordan_def
19057    `good_plane_graph G <=> plane_graph G /\
19058       (!e v v'. (graph_edge G e /\ ~(v = v') /\
19059            (graph_inc G e v) /\ (graph_inc G e v') ==>
19060            (simple_arc_end e v v')))`;;
19061
19062 let graph_edge_mod  = jordan_def
19063   `graph_edge_mod (G:(A,B)graph_t) (f:B->B') =
19064      mk_graph_t (graph_vertex G,IMAGE f (graph_edge G),
19065        (\ e' v. (?e. graph_edge G e /\ graph_inc G e v /\ (f e = e'))))`;;
19066
19067 let graph_edge_mod_v = prove_by_refinement(
19068   `!(G:(A,B)graph_t) (f:B->B').
19069      graph_vertex (graph_edge_mod G f) = graph_vertex G `,
19070   (* {{{ proof *)
19071   [
19072   REWRITE_TAC[graph_edge_mod;graph_vertex;dest_graph_t;];
19073   ]);;
19074   (* }}} *)
19075
19076 let graph_edge_mod_e = prove_by_refinement(
19077   `!(G:(A,B)graph_t) (f:B->B').
19078      graph_edge (graph_edge_mod G f) = IMAGE f (graph_edge G )`,
19079   (* {{{ proof *)
19080   [
19081   REWRITE_TAC[graph_edge_mod;graph_edge;dest_graph_t;part1;drop0];
19082   ]);;
19083   (* }}} *)
19084
19085 let graph_edge_mod_i = prove_by_refinement(
19086   `!(G:(A,B)graph_t) (f:B->B') e v.
19087      graph_inc (graph_edge_mod G f) e v <=>
19088          (?e'. (graph_edge G e' /\ graph_inc G e' v /\ (f e' = e)))`,
19089   (* {{{ proof *)
19090   [
19091   REWRITE_TAC[graph_edge_mod;graph_inc;dest_graph_t;part1;drop1];
19092   ]);;
19093   (* }}} *)
19094
19095 let inj_bij = prove_by_refinement(
19096   `!(f:A->B) X. (INJ f X UNIV) ==> (BIJ f X (IMAGE f X))`,
19097   (* {{{ proof *)
19098   [
19099   REWRITE_TAC[BIJ];
19100   REP_BASIC_TAC;
19101   REWRITE_TAC[IMAGE_SURJ];
19102   UND 0;
19103   REWRITE_TAC[INJ;IMAGE;SUBSET];
19104   MESON_TAC[];
19105   ]);;
19106   (* }}} *)
19107
19108 let graph_edge_iso = prove_by_refinement(
19109   `! f (G:(A,B)graph_t). (INJ (f:B->B') (graph_edge G) (UNIV)) ==>
19110     (graph_isomorphic G (graph_edge_mod G f))`,
19111   (* {{{ proof *)
19112
19113   [
19114   REWRITE_TAC[graph_isomorphic;graph_iso];
19115   REP_BASIC_TAC;
19116   RIGHT_TAC "f";
19117   RIGHT_TAC "f";
19118   TYPE_THEN `I:A->A` EXISTS_TAC ;
19119   TYPE_THEN `f` EXISTS_TAC;
19120   NAME_CONFLICT_TAC;
19121   EXISTS_TAC `(I:A->A,f:B->B')` ;
19122   REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e];
19123   CONJ_TAC;
19124   REWRITE_TAC[I_DEF;BIJ;INJ;SURJ;];
19125   MESON_TAC[];
19126   CONJ_TAC;
19127   IMATCH_MP_TAC  inj_bij;
19128   ASM_REWRITE_TAC[];
19129   REP_BASIC_TAC;
19130   IMATCH_MP_TAC  EQ_EXT;
19131   GEN_TAC;
19132   REWRITE_TAC[graph_edge_mod_i;IMAGE_I;];
19133   EQ_TAC;
19134   REP_BASIC_TAC;
19135   TYPE_THEN `e'' = e'` SUBGOAL_TAC;
19136   RULE_ASSUM_TAC(REWRITE_RULE  [INJ]);
19137   FIRST_ASSUM IMATCH_MP_TAC ;
19138   ASM_REWRITE_TAC[];
19139   ASM_MESON_TAC[];
19140   ASM_MESON_TAC[];
19141   ]);;
19142
19143   (* }}} *)
19144
19145 let graph_edge_graph = prove_by_refinement(
19146   `!f (G:(A,B)graph_t). (graph G) /\
19147       (INJ (f:B->B') (graph_edge G) (UNIV)) ==>
19148     (graph (graph_edge_mod G f)) `,
19149   (* {{{ proof *)
19150   [
19151   REP_BASIC_TAC;
19152   IMATCH_MP_TAC    graph_isomorphic_graph;
19153   TYPE_THEN `G` EXISTS_TAC;
19154   ASM_MESON_TAC[graph_edge_iso];
19155   ]);;
19156   (* }}} *)
19157
19158 let plane_graph_mod = prove_by_refinement(
19159   `!G f. (plane_graph G) /\ (INJ f (graph_edge G) UNIV) /\
19160       (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
19161         (f e INTER f e' SUBSET e INTER e') )) /\
19162       (!e. (graph_edge G e ==> (simple_arc top2 (f e)))) /\
19163       (!e. (graph_edge G e) ==>
19164          (e INTER graph_vertex G = (f e) INTER graph_vertex G)) ==>
19165       (plane_graph (graph_edge_mod G f))
19166   `,
19167   (* {{{ proof *)
19168
19169   [
19170   REWRITE_TAC[plane_graph];
19171   REP_BASIC_TAC;
19172   REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e;];
19173   CONJ_TAC;
19174   ASM_REWRITE_TAC[];
19175   CONJ_TAC;
19176   ASM_MESON_TAC[graph_edge_graph];
19177   CONJ_TAC;
19178   REWRITE_TAC[IMAGE;SUBSET];
19179   ASM_MESON_TAC[];
19180   CONJ_TAC;
19181   REWRITE_TAC[IMAGE;SUBSET];
19182   REP_BASIC_TAC;
19183   IMATCH_MP_TAC  EQ_EXT;
19184   REWRITE_TAC[INTER];
19185   REP_BASIC_TAC;
19186   REWRITE_TAC[graph_edge_mod_i];
19187   EQ_TAC;
19188   REP_BASIC_TAC;
19189   TYPE_THEN `e' = x` SUBGOAL_TAC;
19190    RULE_ASSUM_TAC  (REWRITE_RULE[INJ]);
19191   FIRST_ASSUM IMATCH_MP_TAC ;
19192   ASM_REWRITE_TAC[];
19193   TSPEC `e'` 5;
19194   TSPEC `e'` 0;
19195   UND 0;
19196   UND 5;
19197   ASM_REWRITE_TAC[];
19198   DISCH_ALL_TAC;
19199   TYPE_THEN `(f x INTER graph_vertex G) x'` SUBGOAL_TAC;
19200   ASM_MESON_TAC[];
19201   REWRITE_TAC[INTER;SUBSET];
19202   REP_BASIC_TAC;
19203   TYPE_THEN `x` EXISTS_TAC;
19204   ASM_REWRITE_TAC[];
19205   TSPEC `x` 5;
19206   TSPEC `x` 0;
19207   UND 0;
19208   REWR 5;
19209   ASM_REWRITE_TAC[];
19210   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
19211   ASM_SIMP_TAC[];
19212   REWRITE_TAC[INTER;SUBSET];
19213   ASM_MESON_TAC[];
19214   REP_BASIC_TAC;
19215   UND 10;
19216   REWRITE_TAC[IMAGE];
19217   REP_BASIC_TAC;
19218   UND 11;
19219   REWRITE_TAC[IMAGE];
19220   REP_BASIC_TAC;
19221   TYPE_THEN `~(x = x')` SUBGOAL_TAC;
19222   ASM_MESON_TAC[];
19223   DISCH_TAC;
19224   ASM_REWRITE_TAC[];
19225   IMATCH_MP_TAC  SUBSET_TRANS;
19226   TYPE_THEN `x' INTER x` EXISTS_TAC;
19227   CONJ_TAC;
19228   FIRST_ASSUM IMATCH_MP_TAC ;
19229   ASM_REWRITE_TAC[];
19230   FIRST_ASSUM IMATCH_MP_TAC ;
19231   ASM_REWRITE_TAC[];
19232   (* Thu Aug  5 10:17:38 EDT 2004 *)
19233
19234   ]);;
19235
19236   (* }}} *)
19237
19238 let compact_point = prove_by_refinement(
19239   `!U (x:A). (UNIONS U x) ==> (compact U {x})`,
19240   (* {{{ proof *)
19241   [
19242   REWRITE_TAC[compact];
19243   REP_BASIC_TAC;
19244   CONJ_TAC;
19245   ASM_REWRITE_TAC [single_subset];
19246   REP_BASIC_TAC;
19247   TYPE_THEN `?u. V u /\ u x` SUBGOAL_TAC;
19248   UND 2;
19249   REWRITE_TAC[SUBSET;UNIONS;INR IN_SING];
19250   MESON_TAC[];
19251   REP_BASIC_TAC;
19252   TYPE_THEN `{u}` EXISTS_TAC;
19253   ASM_REWRITE_TAC [single_subset;FINITE_SING];
19254   (* Thu Aug  5 12:02:40 EDT 2004 *)
19255
19256   ]);;
19257   (* }}} *)
19258
19259 let simple_arc_end_select = prove_by_refinement(
19260   `!C v v'. (simple_arc top2 C) /\ (C v) /\ (C v') /\ ~(v = v') ==>
19261     (?C'. (C' SUBSET C) /\ (simple_arc_end C' v v'))`,
19262   (* {{{ proof *)
19263   [
19264   REWRITE_TAC[simple_arc_end];
19265   REP_BASIC_TAC;
19266   (* A *)
19267   TYPE_THEN `!v. (C v) ==> (closed_ top2 {v})` SUBGOAL_TAC;
19268   REP_BASIC_TAC;
19269   IMATCH_MP_TAC  compact_closed;
19270   ASM_SIMP_TAC[top2_top;metric_hausdorff;top2;metric_euclid;compact_point];
19271   IMATCH_MP_TAC  compact_point;
19272   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
19273   UND 3;
19274   REWRITE_TAC[simple_arc];
19275   REP_BASIC_TAC;
19276   TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
19277   ASM_REWRITE_TAC[];
19278   IMATCH_MP_TAC  inj_image_subset;
19279   RULE_ASSUM_TAC (REWRITE_RULE [top2_unions]);
19280   ASM_REWRITE_TAC[];
19281   ASM_MESON_TAC[ISUBSET];
19282   DISCH_TAC;
19283   (* B hypotheses of curve_restriction *)
19284   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;
19285   ASM_REWRITE_TAC[];
19286   CONJ_TAC ;
19287   FIRST_ASSUM IMATCH_MP_TAC ;
19288   ASM_REWRITE_TAC[];
19289   CONJ_TAC ;
19290   FIRST_ASSUM IMATCH_MP_TAC ;
19291   ASM_REWRITE_TAC[];
19292   REWRITE_TAC[REAL_ARITH `&0 < &1`];
19293   REWRITE_TAC[INTER;INR IN_SING;EMPTY_EXISTS ];
19294   REWRITE_TAC[EQ_EMPTY];
19295   ASM_MESON_TAC[];
19296   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP curve_restriction t));
19297   REP_BASIC_TAC;
19298   TYPE_THEN `C'` EXISTS_TAC;
19299   ASM_REWRITE_TAC[];
19300   TYPE_THEN `f` EXISTS_TAC;
19301   ASM_REWRITE_TAC[];
19302   TYPE_THEN `!A u v. (A INTER {u} = {v}) ==> ( (v:num->real)=u)` SUBGOAL_TAC;
19303   REWRITE_TAC[eq_sing;INTER;INR IN_SING;];
19304   MESON_TAC[];
19305   ASM_MESON_TAC[];
19306   ]);;
19307   (* }}} *)
19308
19309 let graph_edge2 = prove_by_refinement(
19310   `!(G:(A,B)graph_t) e.
19311       (graph G /\ graph_edge G e) ==> (graph_inc G e HAS_SIZE 2)`,
19312   (* {{{ proof *)
19313   [
19314   REWRITE_TAC[graph];
19315   REWRITE_TAC[IMAGE;SUBSET];
19316   MESON_TAC[];
19317   ]);;
19318   (* }}} *)
19319
19320 let simple_arc_end_symm = prove_by_refinement(
19321   `!C' v v'. (simple_arc_end C' v v' ==> simple_arc_end C' v' v)`,
19322   (* {{{ proof *)
19323   [
19324   REWRITE_TAC[simple_arc_end];
19325   REP_BASIC_TAC;
19326   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;
19327   ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`];
19328   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
19329   REP_BASIC_TAC;
19330   TYPE_THEN `g` EXISTS_TAC;
19331   ASM_REWRITE_TAC[];
19332   ASM_MESON_TAC[];
19333   ]);;
19334   (* }}} *)
19335
19336 let simple_arc_end_plane_select = prove_by_refinement(
19337   `!G e. (plane_graph G /\ graph_edge G e) ==> (?e'.
19338      (e' SUBSET e /\
19339      (!v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==>
19340         simple_arc_end e' v v')))`,
19341   (* {{{ proof *)
19342
19343   [
19344   REP_BASIC_TAC;
19345   TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
19346   RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]);
19347   IMATCH_MP_TAC graph_edge2;
19348   ASM_REWRITE_TAC[];
19349   REWRITE_TAC[has_size2];
19350   REP_BASIC_TAC;
19351   TYPE_THEN `(?e'. (e' SUBSET e) /\ (simple_arc_end e' a b))` SUBGOAL_TAC;
19352   IMATCH_MP_TAC  simple_arc_end_select;
19353   ASM_REWRITE_TAC[];
19354   RULE_ASSUM_TAC  (REWRITE_RULE[plane_graph]);
19355   REP_BASIC_TAC;
19356   CONJ_TAC;
19357   UND 5;
19358   ASM_MESON_TAC [ISUBSET];
19359   TYPE_THEN `graph_inc G e a /\ graph_inc G e b` SUBGOAL_TAC;
19360   ASM_REWRITE_TAC[];
19361   REWRITE_TAC[in_pair];
19362   KILL 3;
19363   ASM_SIMP_TAC[];
19364   REWRITE_TAC[INTER;SUBSET];
19365   MESON_TAC[];
19366   REP_BASIC_TAC;
19367   TYPE_THEN `e'` EXISTS_TAC;
19368   ASM_REWRITE_TAC[in_pair];
19369   REP_BASIC_TAC;
19370   TYPE_THEN `((v = a) /\ (v' = b)) \/ ((v = b) /\ (v' =a ))` SUBGOAL_TAC;
19371   ASM_MESON_TAC[];
19372   DISCH_THEN DISJ_CASES_TAC;
19373   ASM_REWRITE_TAC[];
19374   REP_BASIC_TAC;
19375   ASM_REWRITE_TAC[];
19376   IMATCH_MP_TAC  simple_arc_end_symm;
19377   ASM_REWRITE_TAC[];
19378   (* Thu Aug  5 14:10:17 EDT 2004 *)
19379
19380   ]);;
19381
19382   (* }}} *)
19383
19384 let plane_graph_contain = prove_by_refinement(
19385   `!G e e'. (plane_graph G /\ graph_edge G e /\ graph_edge G e' /\
19386       (e SUBSET e') ==> (e = e'))`,
19387   (* {{{ proof *)
19388   [
19389   REP_BASIC_TAC;
19390   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
19391   REP_BASIC_TAC;
19392   PROOF_BY_CONTR_TAC;
19393   TYPE_THEN `e INTER e' SUBSET graph_vertex G` SUBGOAL_TAC;
19394   ASM_MESON_TAC[];
19395   DISCH_TAC;
19396   TYPE_THEN `e INTER e' SUBSET e' INTER graph_vertex G` SUBGOAL_TAC;
19397   REWRITE_TAC[SUBSET_INTER];
19398   ASM_REWRITE_TAC[];
19399   REWRITE_TAC[INTER;SUBSET];
19400   MESON_TAC[];
19401   TYPE_THEN `e' INTER graph_vertex G = graph_inc G e'` SUBGOAL_TAC;
19402   ASM_MESON_TAC[];
19403   DISCH_THEN_REWRITE;
19404   TYPE_THEN `graph_inc G e' HAS_SIZE 2` SUBGOAL_TAC;
19405   ASM_MESON_TAC[graph_edge2];
19406   TYPE_THEN `e INTER e' = e` SUBGOAL_TAC;
19407   UND 0;
19408   REWRITE_TAC[SUBSET_INTER_ABSORPTION];
19409   DISCH_THEN_REWRITE;
19410   REWRITE_TAC[has_size2];
19411   REP_BASIC_TAC;
19412   REWR 10;
19413   TYPE_THEN `simple_arc top2 e` SUBGOAL_TAC;
19414   ASM_MESON_TAC[ISUBSET];
19415   REWRITE_TAC[simple_arc];
19416   REP_BASIC_TAC;
19417   TYPE_THEN `!x. (&0 <= x /\ x <= &1) ==> {a,b} (f x)` SUBGOAL_TAC;
19418   REWR 10;
19419   UND 10;
19420   REWRITE_TAC[IMAGE;SUBSET];
19421   MESON_TAC[];
19422   REP_BASIC_TAC;
19423   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
19424   REP_BASIC_TAC;
19425   TYPE_THEN `(f (&0) = f(&1))` SUBGOAL_TAC;
19426   IMATCH_MP_TAC  two_exclusion;
19427   TYPE_THEN `{a,b}` EXISTS_TAC;
19428   TYPE_THEN `?t. (&0 < t /\ t < &1)` SUBGOAL_TAC;
19429   TYPE_THEN `&1/ (&2)` EXISTS_TAC;
19430   IMATCH_MP_TAC  half_pos;
19431   REAL_ARITH_TAC;
19432   REP_BASIC_TAC;
19433   TYPE_THEN `f t` EXISTS_TAC;
19434   CONJ_TAC;
19435   ASM_MESON_TAC[pair_size_2];
19436   CONJ_TAC;
19437   FIRST_ASSUM IMATCH_MP_TAC ;
19438   REAL_ARITH_TAC;
19439   CONJ_TAC;
19440   FIRST_ASSUM  IMATCH_MP_TAC ;
19441   REAL_ARITH_TAC;
19442   CONJ_TAC;
19443   FIRST_ASSUM  IMATCH_MP_TAC ;
19444   UND 18;
19445   UND 19;
19446   REAL_ARITH_TAC;
19447   CONJ_TAC;
19448   PROOF_BY_CONTR_TAC;
19449   TYPE_THEN `~(&0 = t)` SUBGOAL_TAC;
19450   UND 19;
19451   REAL_ARITH_TAC;
19452   REWRITE_TAC[];
19453   FIRST_ASSUM IMATCH_MP_TAC ;
19454   REWR 20;
19455   ASM_REWRITE_TAC[];
19456   UND 18;
19457   UND 19;
19458   REAL_ARITH_TAC;
19459   PROOF_BY_CONTR_TAC;
19460   TYPE_THEN `~(&1 = t)` SUBGOAL_TAC;
19461   UND 18;
19462   REAL_ARITH_TAC;
19463   REWRITE_TAC[];
19464   FIRST_ASSUM IMATCH_MP_TAC ;
19465   REWR 20;
19466   ASM_REWRITE_TAC[];
19467   UND 18;
19468   UND 19;
19469   REAL_ARITH_TAC;
19470   DISCH_TAC;
19471   TYPE_THEN `~(&0 = &1)` SUBGOAL_TAC;
19472   REAL_ARITH_TAC;
19473   REWRITE_TAC[];
19474   FIRST_ASSUM IMATCH_MP_TAC ;
19475   ASM_REWRITE_TAC[];
19476   REAL_ARITH_TAC;
19477   (* Thu Aug  5 15:11:20 EDT 2004 *)
19478
19479   ]);;
19480   (* }}} *)
19481
19482 let graph_edge_end_select = prove_by_refinement(
19483   `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e ==>
19484      (?v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v')))`,
19485   (* {{{ proof *)
19486   [
19487   REP_BASIC_TAC;
19488   TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
19489   IMATCH_MP_TAC  graph_edge2;
19490   ASM_REWRITE_TAC[];
19491   REWRITE_TAC[has_size2];
19492   REP_BASIC_TAC;
19493   TYPE_THEN `a` EXISTS_TAC;
19494   TYPE_THEN `b` EXISTS_TAC;
19495   ASM_REWRITE_TAC[in_pair];
19496   (* Thu Aug  5 19:26:02 EDT 2004 *)
19497
19498   ]);;
19499   (* }}} *)
19500
19501
19502 (* ------------------------------------------------------------------ *)
19503 (* SECTION K *)
19504 (* ------------------------------------------------------------------ *)
19505
19506 (* Thu Aug  5 21:17:36 EDT 2004 *)
19507
19508 (* Tweaked slightly now that there is an "inf" constant. JRH, 4 Dec 2011 *)
19509
19510 let inf =
19511   let inf_def =
19512     `inf (X:real->bool) =
19513       @s. ((!x. X x ==> s <= x) /\ (!y. (!x. X x ==> y <= x) ==> (y <= s)))` in
19514   let def =
19515     subst [mk_var("inf",`:(real->bool)->real`),mk_const("inf",[])] inf_def in
19516   jordan_def def;;
19517
19518 let interval_closed = prove_by_refinement(
19519   `!a b. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x /\ x <= b}`,
19520   (* {{{ proof *)
19521   [
19522   REP_BASIC_TAC;
19523   IMATCH_MP_TAC  compact_closed;
19524   ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real];
19525   ASM_SIMP_TAC[metric_hausdorff;metric_real;];
19526   ]);;
19527   (* }}} *)
19528
19529 let half_closed = prove_by_refinement(
19530   `!a. closed_ (top_of_metric(UNIV,d_real)) {x | x <= a}`,
19531   (* {{{ proof *)
19532   [
19533   REWRITE_TAC[closed];
19534   REP_BASIC_TAC;
19535   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
19536   TYPE_THEN `UNIV DIFF {x | x <= a } = {x | a < x}` SUBGOAL_TAC;
19537   IMATCH_MP_TAC  EQ_EXT;
19538   REWRITE_TAC[DIFF;UNIV];
19539   REAL_ARITH_TAC;
19540   DISCH_THEN_REWRITE;
19541   REWRITE_TAC [open_DEF;half_open_above];
19542   ]);;
19543   (* }}} *)
19544
19545 let half_closed_above = prove_by_refinement(
19546   `!a. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x}`,
19547   (* {{{ proof *)
19548   [
19549   REWRITE_TAC[closed];
19550   REP_BASIC_TAC;
19551   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
19552   TYPE_THEN `UNIV DIFF {x | a <= x } = {x | x < a}` SUBGOAL_TAC;
19553   IMATCH_MP_TAC  EQ_EXT;
19554   REWRITE_TAC[DIFF;UNIV];
19555   REAL_ARITH_TAC;
19556   DISCH_THEN_REWRITE;
19557   REWRITE_TAC [open_DEF;half_open];
19558   ]);;
19559   (* }}} *)
19560
19561 let inf_LB = prove_by_refinement(
19562   `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==>
19563      (!x. X x ==> inf X <= x) /\
19564           (!y. (!x. X x ==> y <= x) ==> (y <= inf X))`,
19565   (* {{{ proof *)
19566   [
19567   GEN_TAC;
19568   TYPE_THEN `topology_ (top_of_metric(UNIV,d_real))` SUBGOAL_TAC;
19569   ASM_SIMP_TAC[top_of_metric_top;metric_real];
19570   DISCH_TAC;
19571   (*  *)
19572   TYPE_THEN `X SUBSET closure (top_of_metric(UNIV,d_real)) X` SUBGOAL_TAC;
19573   ASM_SIMP_TAC[subset_closure];
19574   DISCH_TAC;
19575   (*  *)
19576   REWRITE_TAC[EMPTY_EXISTS];
19577   REP_BASIC_TAC;
19578   REWRITE_TAC[inf];
19579   SELECT_TAC;
19580   ASM_MESON_TAC[];
19581   PROOF_BY_CONTR_TAC;
19582   UND 4;
19583   KILL 5;
19584   REWRITE_TAC[];
19585   TYPE_THEN `XC = closure (top_of_metric(UNIV,d_real)) X INTER {x | t <= x /\ x <= u}` ABBREV_TAC ;
19586   TYPE_THEN `compact (top_of_metric(UNIV,d_real)) XC` SUBGOAL_TAC;
19587   IMATCH_MP_TAC  closed_compact;
19588   TYPE_THEN `{x | t <= x /\ x <= u}` EXISTS_TAC;
19589   ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real];
19590   EXPAND_TAC "XC";
19591   CONJ_TAC;
19592   IMATCH_MP_TAC  closed_inter2;
19593   ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real];
19594   IMATCH_MP_TAC  closure_closed;
19595   ASM_SIMP_TAC[top_of_metric_top;metric_real;GSYM top_of_metric_unions;];
19596   ASM_REWRITE_TAC[INTER_SUBSET];
19597   DISCH_TAC;
19598   (*   *)
19599   TYPE_THEN `(?z. (XC z /\ (!y. XC y ==> z <= y)))` SUBGOAL_TAC;
19600   IMATCH_MP_TAC  compact_inf;
19601   ASM_REWRITE_TAC[];
19602   REWRITE_TAC[EMPTY_EXISTS];
19603   TYPE_THEN `u` EXISTS_TAC;
19604   EXPAND_TAC "XC";
19605   REWRITE_TAC[INTER;SUBSET];
19606   CONJ_TAC;
19607   UND 1;
19608   REWRITE_TAC[SUBSET];
19609   ASM_MESON_TAC[];
19610   ASM_MESON_TAC[REAL_ARITH `u <= u`];
19611   REP_BASIC_TAC;
19612   TYPE_THEN `z` EXISTS_TAC;
19613   CONJ_TAC;
19614   REP_BASIC_TAC;
19615   TYPE_THEN `(x <= u) \/ (u < x)` SUBGOAL_TAC;
19616   REAL_ARITH_TAC;
19617   DISCH_THEN DISJ_CASES_TAC;
19618   TYPE_THEN `XC x` SUBGOAL_TAC;
19619   EXPAND_TAC "XC";
19620   REWRITE_TAC[INTER;SUBSET];
19621   CONJ_TAC;
19622   ASM_MESON_TAC[ISUBSET];
19623   ASM_MESON_TAC[];
19624   ASM_MESON_TAC[];
19625   UND 7;
19626   EXPAND_TAC "XC";
19627   REWRITE_TAC[INTER;SUBSET];
19628   REP_BASIC_TAC;
19629   ASM_MESON_TAC[REAL_ARITH `z <= u /\ u < x ==> z <= x`];
19630   REP_BASIC_TAC;
19631   TYPE_THEN `closed_ (top_of_metric (UNIV,d_real)) {x | y' <= x }` SUBGOAL_TAC;
19632   REWRITE_TAC[half_closed_above];
19633   DISCH_TAC;
19634   TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X SUBSET {x | y' <= x }` SUBGOAL_TAC;
19635   IMATCH_MP_TAC  closure_subset;
19636   ASM_REWRITE_TAC[SUBSET ];
19637   DISCH_TAC;
19638   TYPE_THEN `XC SUBSET {x | y' <= x}` SUBGOAL_TAC;
19639   EXPAND_TAC "XC";
19640   IMATCH_MP_TAC  SUBSET_TRANS;
19641   TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X ` EXISTS_TAC;
19642   ASM_REWRITE_TAC[];
19643   EXPAND_TAC "XC";
19644   REWRITE_TAC[INTER_SUBSET];
19645   REWRITE_TAC[SUBSET];
19646   ASM_MESON_TAC[];
19647   (* Fri Aug  6 05:51:24 EDT 2004 *)
19648
19649   ]);;
19650   (* }}} *)
19651
19652 let inf_eps = prove_by_refinement(
19653   `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==>
19654        (!epsilon. (&0 < epsilon) ==> (?x. X x /\ (x < inf X + epsilon)))`,
19655   (* {{{ proof *)
19656   [
19657   REP_BASIC_TAC;
19658   TYPE_THEN `(!y. (!x. X x ==> y <= x) ==> (y <= inf X))` SUBGOAL_TAC;
19659   ASM_MESON_TAC[inf_LB];
19660   DISCH_TAC;
19661   TSPEC `inf X + epsilon` 3;
19662   PROOF_BY_CONTR_TAC;
19663   TYPE_THEN `(!x. X x ==> inf X + epsilon <= x)` SUBGOAL_TAC;
19664   REP_BASIC_TAC;
19665   IMATCH_MP_TAC  (REAL_ARITH `~(v < u)  ==> u <= v`);
19666   ASM_MESON_TAC[];
19667   ASM_MESON_TAC[REAL_ARITH `(x + y <= x ==> ~(&0 < y))`];
19668   ]);;
19669   (* }}} *)
19670
19671 let supm = jordan_def `supm (X:real->bool) =
19672    --. (inf ({x | ?z. X z /\ (x = --. z)}))`;;
19673
19674 let supm_UB = prove_by_refinement(
19675   `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==>
19676      (!x. X x ==> x <= supm X ) /\
19677           (!y. (!x. X x ==> x <= y) ==> (supm X <= y))`,
19678   (* {{{ proof *)
19679   [
19680   REP_BASIC_TAC;
19681   REWRITE_TAC[supm];
19682   TYPE_THEN `Y = {x | ?z. X z /\ (x = --z)}` ABBREV_TAC ;
19683   TYPE_THEN `!u. (Y u = X (-- u)) /\ (Y (--u ) = X u)` SUBGOAL_TAC;
19684   EXPAND_TAC "Y";
19685   REWRITE_TAC[];
19686   MESON_TAC[REAL_ARITH `(-- (-- u) = u)`];
19687   DISCH_TAC;
19688   TYPE_THEN `(~(Y = EMPTY) /\ (?t. !x. (Y x ==> t <= x)))` SUBGOAL_TAC;
19689   UND 1;
19690   REWRITE_TAC[EMPTY_EXISTS];
19691   REP_BASIC_TAC;
19692   CONJ_TAC;
19693   TYPE_THEN `-- u` EXISTS_TAC;
19694   ASM_MESON_TAC[];
19695   TYPE_THEN `-- t` EXISTS_TAC;
19696   REP_BASIC_TAC;
19697   ASM_MESON_TAC[REAL_ARITH `--t <= x <=> (-- x <= t)`];
19698   DISCH_THEN ( ASSUME_TAC o (MATCH_MP inf_LB));
19699   CONJ_TAC;
19700   REP_BASIC_TAC;
19701   ASM_MESON_TAC[REAL_ARITH `y <= --x <=> x <= --y`];
19702   REP_BASIC_TAC;
19703   IMATCH_MP_TAC  (REAL_ARITH `--y <= inf Y ==> -- inf Y <= y`);
19704   FIRST_ASSUM IMATCH_MP_TAC ;
19705   REP_BASIC_TAC;
19706   ASM_MESON_TAC[ REAL_ARITH `--x <= y <=> --y <= x`];
19707   (* Fri Aug  6 06:42:14 EDT 2004 *)
19708
19709   ]);;
19710   (* }}} *)
19711
19712 let supm_eps = prove_by_refinement(
19713   `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==>
19714        (!epsilon.(&0 < epsilon) ==> (?x. X x /\ (supm X - epsilon < x)))`,
19715   (* {{{ proof *)
19716   [
19717   REP_BASIC_TAC;
19718   TYPE_THEN `(!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC;
19719   ASM_MESON_TAC[supm_UB];
19720   DISCH_TAC;
19721   TSPEC `supm X - epsilon` 3;
19722   PROOF_BY_CONTR_TAC;
19723   TYPE_THEN `(!x. X x ==> x <= supm X - epsilon)` SUBGOAL_TAC;
19724   REP_BASIC_TAC;
19725   IMATCH_MP_TAC  (REAL_ARITH `~(v < u)  ==> u <= v`);
19726   ASM_MESON_TAC[];
19727   ASM_MESON_TAC[REAL_ARITH `(x <= x - y  ==> ~(&0 < y))`];
19728   (* Fri Aug  6 06:47:22 EDT 2004 *)
19729
19730   ]);;
19731   (* }}} *)
19732
19733 let compact_subset = prove_by_refinement(
19734   `!(X:A->bool) K d. (K SUBSET X /\ metric_space(X,d)) ==>
19735         (compact(top_of_metric(X,d)) K = compact(top_of_metric(K,d))K) `,
19736   (* {{{ proof *)
19737   [
19738   REP_BASIC_TAC;
19739   ASM_SIMP_TAC[GSYM top_of_metric_induced];
19740   ASM_MESON_TAC[induced_compact;top_of_metric_unions];
19741   ]);;
19742   (* }}} *)
19743
19744 let exp_gt1 = prove_by_refinement(
19745   `!n. (0 < n) ==> (1 < 2 **| n)`,
19746   (* {{{ proof *)
19747   [
19748   TYPE_THEN `1 = 2 **| 0` SUBGOAL_TAC;
19749   REWRITE_TAC[EXP];
19750   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
19751   REP_BASIC_TAC;
19752   REWRITE_TAC[LT_EXP];
19753   UND 0;
19754   ARITH_TAC;
19755   ]);;
19756   (* }}} *)
19757
19758 let twopow_lt = prove_by_refinement(
19759   `!a b. (a < b) ==> (twopow a < twopow b)`,
19760   (* {{{ proof *)
19761   [
19762   ONCE_REWRITE_TAC [INT_ARITH `(a <: b) <=> (&:0 <: b -: a)`];
19763   ASSUME_TAC twopow_pos;
19764   ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> &1*x < y`];
19765   ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ];
19766   REWRITE_TAC[real_div];
19767   REWRITE_TAC[GSYM TWOPOW_INV;GSYM TWOPOW_ADD_INT;GSYM INT_SUB];
19768   REP_GEN_TAC;
19769   TYPE_THEN `C = b -: a` ABBREV_TAC ;
19770   ASSUME_TAC INT_REP2 ;
19771   TSPEC `C` 2;
19772   REP_BASIC_TAC;
19773   FIRST_ASSUM DISJ_CASES_TAC;
19774   UND 2;
19775   ASM_REWRITE_TAC[];
19776   REWRITE_TAC[TWOPOW_POS];
19777   REDUCE_TAC;
19778   REWRITE_TAC[INT_OF_NUM_LT;exp_gt1];
19779   PROOF_BY_CONTR_TAC;
19780   UND 2;
19781   ASM_REWRITE_TAC[];
19782   REWRITE_TAC[INT_ARITH `(~(&:0 <: --: y) <=> (&:0 <=: y))`];
19783   REWRITE_TAC[INT_OF_NUM_LE];
19784   ARITH_TAC;
19785   ]);;
19786   (* }}} *)
19787
19788 let compact_distance = prove_by_refinement(
19789   `!(X:A->bool) d K K'. (metric_space(X,d) /\
19790    ~(K=EMPTY) /\ ~(K' = EMPTY) /\
19791    (compact (top_of_metric(X,d)) K) /\ (compact(top_of_metric(X,d))K'))
19792    ==> (?p p'. (K p /\ K' p' /\ (!q q'. (K q /\ K' q') ==>
19793               (d p p' <= d q q'))))`,
19794   (* {{{ proof *)
19795   [
19796   REP_BASIC_TAC;
19797   TYPE_THEN `UNIONS (top_of_metric(X,d)) = X` SUBGOAL_TAC;
19798   ASM_SIMP_TAC[GSYM top_of_metric_unions];
19799   DISCH_TAC;
19800   TYPE_THEN `K SUBSET X /\ K' SUBSET X` SUBGOAL_TAC;
19801   RULE_ASSUM_TAC (REWRITE_RULE[compact]);
19802   REWR 0;
19803   REWR 1;
19804   ASM_REWRITE_TAC[];
19805   REP_BASIC_TAC;
19806   TYPE_THEN `Y = { z | ?q q'. (K q /\ K' q' /\ (z = d q q'))}` ABBREV_TAC ;
19807   TYPE_THEN `!y. (Y y) ==> (&0 <= y)` SUBGOAL_TAC;
19808   EXPAND_TAC "Y";
19809   REWRITE_TAC[];
19810   REP_BASIC_TAC;
19811   RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
19812   TYPEL_THEN [`q`;`q'`;`q'`] (USE 4 o ISPECL);
19813   ASM_MESON_TAC[metric_space;ISUBSET];
19814   REP_BASIC_TAC;
19815   (*  *)
19816   TYPE_THEN `~(Y= EMPTY)` SUBGOAL_TAC;
19817   RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
19818   REP_BASIC_TAC;
19819   UND 2;
19820   REWRITE_TAC[EMPTY_EXISTS];
19821   TYPE_THEN `d u' u` EXISTS_TAC;
19822   EXPAND_TAC "Y";
19823   REWRITE_TAC[];
19824   ASM_MESON_TAC[];
19825   DISCH_TAC;
19826   (* inf Y *)
19827   TYPE_THEN `(!epsilon. (&0 < epsilon) ==> (?x. Y x /\ (x < inf Y + epsilon)))` SUBGOAL_TAC;
19828   IMATCH_MP_TAC  inf_eps;
19829   ASM_MESON_TAC[];
19830   REP_BASIC_TAC;
19831   ASSUME_TAC twopow_pos;
19832   TYPE_THEN `(!n. ?p. ?p'. K p /\ K' p' /\ (d p p' < inf Y + twopow( -- (&:n))))` SUBGOAL_TAC;
19833   REP_BASIC_TAC;
19834   TYPE_THEN `(?x. Y x /\ x < inf Y + twopow (--: (&:n)))` SUBGOAL_TAC;
19835   FIRST_ASSUM IMATCH_MP_TAC ;
19836   ASM_REWRITE_TAC[];
19837   REP_BASIC_TAC;
19838   UND 14;
19839   EXPAND_TAC "Y";
19840   ASM_REWRITE_TAC[];
19841   ASM_MESON_TAC[];
19842   DISCH_TAC;
19843   RIGHT 13 "n";
19844   REP_BASIC_TAC;
19845   (* compact,complete,totally bounded *)
19846   TYPE_THEN `metric_space (K,d) /\ metric_space(K',d)` SUBGOAL_TAC;
19847   ASM_MESON_TAC[metric_subspace];
19848   REP_BASIC_TAC;
19849   TYPE_THEN `compact (top_of_metric(K,d)) K /\ compact (top_of_metric(K',d)) K'` SUBGOAL_TAC;
19850   ASM_MESON_TAC[compact_subset];
19851   REP_BASIC_TAC;
19852   TYPE_THEN `complete (K,d)  /\ complete (K',d) ` SUBGOAL_TAC;
19853   ASM_MESON_TAC[compact_complete];
19854   REP_BASIC_TAC;
19855   TYPE_THEN `totally_bounded(K,d) /\ totally_bounded(K',d)` SUBGOAL_TAC;
19856   ASM_MESON_TAC[compact_totally_bounded;];
19857   REP_BASIC_TAC;
19858   (* construct subseq of p *)
19859   TYPE_THEN `(?ss. subseq ss /\ converge (K,d) (p o ss))` SUBGOAL_TAC;
19860   IMATCH_MP_TAC  convergent_subseq;
19861   ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE];
19862   NAME_CONFLICT_TAC;
19863   CONV_TAC (dropq_conv "x''");
19864   RIGHT 13 "p'";
19865   ASM_MESON_TAC[];
19866   REWRITE_TAC[converge];
19867   REP_BASIC_TAC;
19868   (* construct q *)
19869   TYPE_THEN `!n. ?p'. K' p' /\ d x p' < inf Y + twopow(--: (&:n))` SUBGOAL_TAC;
19870   REP_BASIC_TAC;
19871   TSPEC `twopow (--: (&:(SUC(n))))` 22;
19872   REP_BASIC_TAC;
19873   REWR 22;
19874   TSPEC  `SUC(n') + SUC (n)` 22;
19875   RULE_ASSUM_TAC (REWRITE_RULE[ARITH_RULE `x <=| SUC x +| y`]);
19876   TSPEC `ss (SUC n' +| SUC n)` 13;
19877   REP_BASIC_TAC;
19878   TYPE_THEN `twopow (--: (&:(ss(SUC n'+SUC n)))) < twopow(--: (&:(SUC n)))` SUBGOAL_TAC;
19879   IMATCH_MP_TAC  twopow_lt;
19880   REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT;];
19881   IMATCH_MP_TAC (ARITH_RULE `(?t. (a <= t /\ t <| b)) ==> (a <| b)`);
19882   TYPE_THEN `ss (SUC n)` EXISTS_TAC;
19883   ASM_SIMP_TAC[SEQ_SUBLE;subseq];
19884   RULE_ASSUM_TAC (REWRITE_RULE[subseq]);
19885   FIRST_ASSUM IMATCH_MP_TAC ;
19886   ARITH_TAC;
19887   DISCH_TAC;
19888   TYPE_THEN `p'` EXISTS_TAC;
19889   ASM_REWRITE_TAC[];
19890   RULE_ASSUM_TAC  (REWRITE_RULE[metric_space]);
19891   REP_BASIC_TAC;
19892   TYPEL_THEN [`x`;`p (ss (SUC n' +| SUC n))`;`p'`] (USE 4 o ISPECL);
19893   REP_BASIC_TAC;
19894   TYPE_THEN `X x /\ X (p (ss (SUC n' +| SUC n))) /\ X p'` SUBGOAL_TAC;
19895   ASM_MESON_TAC[ISUBSET];
19896   DISCH_TAC;
19897   REWR 4;
19898   REP_BASIC_TAC;
19899   TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC;
19900   REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double];
19901   UND 4;
19902   UND 13;
19903   UND 27;
19904   UND 22;
19905   REWRITE_TAC[o_DEF];
19906   REAL_ARITH_TAC;
19907   DISCH_TAC;
19908   RIGHT 25 "n" ;
19909   REP_BASIC_TAC;
19910   (* take subseq of p' *)
19911   TYPE_THEN `(?ss'. subseq ss' /\ converge (K',d) (p' o ss'))` SUBGOAL_TAC;
19912   IMATCH_MP_TAC  convergent_subseq;
19913   ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE];
19914   NAME_CONFLICT_TAC;
19915   CONV_TAC (dropq_conv "x''");
19916   ASM_MESON_TAC[];
19917   REWRITE_TAC[converge];
19918   REP_BASIC_TAC;
19919   TYPE_THEN `x` EXISTS_TAC;
19920   TYPE_THEN `x'` EXISTS_TAC;
19921   ASM_REWRITE_TAC[];
19922   REP_BASIC_TAC;
19923   (* now go in for the KILL.  *)
19924   (*   Show d x x' <= inf Y because d x x' < inf Y + eps *)
19925   (* [K] *)
19926   IMATCH_MP_TAC  (REAL_ARITH `(?t. (t <= y) /\ (x <= t)) ==> (x <= y)`);
19927   TYPE_THEN `inf Y` EXISTS_TAC;
19928   CONJ_TAC;
19929   TYPE_THEN `(!y. Y y ==> inf Y <= y)` SUBGOAL_TAC;
19930   ASM_MESON_TAC[inf_LB];
19931   DISCH_THEN IMATCH_MP_TAC ;
19932   EXPAND_TAC "Y";
19933   REWRITE_TAC[];
19934   TYPE_THEN `q` EXISTS_TAC;
19935   TYPE_THEN `q'` EXISTS_TAC;
19936   ASM_REWRITE_TAC[];
19937   SUBGOAL_TAC  `!x y. (!e. (&0 <e) ==> (x < y + e)) ==> (x <= y)`;
19938   REP_GEN_TAC;
19939   DISCH_THEN (fun t -> MP_TAC (SPEC `x'' - y` t));
19940   REAL_ARITH_TAC;
19941   DISCH_THEN IMATCH_MP_TAC ;
19942   REP_BASIC_TAC;
19943   KILL 15;
19944   KILL 14;
19945   KILL 17;
19946   KILL 16;
19947   KILL 18;
19948   KILL 19;
19949   KILL 20;
19950   KILL 21;
19951   KILL 2;
19952   KILL 3;
19953   KILL 0;
19954   KILL 1;
19955   KILL 8;
19956   KILL 29;
19957   KILL 30;
19958   (* GEN needed inequalities *)
19959   (* [L] *)
19960   TYPE_THEN `?n. (&1)* twopow(--: (&:n)) < e` SUBGOAL_TAC;
19961   ASM_MESON_TAC[twopow_eps;REAL_ARITH `&0 < &1`];
19962   REDUCE_TAC;
19963   REP_BASIC_TAC;
19964   TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC;
19965   REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double];
19966   REP_BASIC_TAC;
19967   TSPEC `twopow(--: (&:(SUC n)))` 26;
19968   REP_BASIC_TAC;
19969   RULE_ASSUM_TAC (REWRITE_RULE[twopow_pos]);
19970
19971   TSPEC `SUC (n) + SUC n'` 2;
19972   USE 2(REWRITE_RULE[ARITH_RULE `a <=| b + SUC a`]);
19973   TSPEC `ss' (SUC n + SUC n')` 25;
19974   TYPE_THEN `twopow (--: (&:(ss' (SUC  n +| SUC n')))) < twopow (--: (&:(SUC n)))` SUBGOAL_TAC;
19975   IMATCH_MP_TAC  twopow_lt;
19976   REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT ];
19977   IMATCH_MP_TAC  (ARITH_RULE  `(?t. (a <=| t /\ (t <| b)))    ==> (a <| b)`);
19978   TYPE_THEN `(ss' (SUC n) )` EXISTS_TAC;
19979   ASM_SIMP_TAC[SEQ_SUBLE];
19980   RULE_ASSUM_TAC (REWRITE_RULE[subseq]);
19981   FIRST_ASSUM IMATCH_MP_TAC ;
19982   ARITH_TAC;
19983   DISCH_TAC;
19984   REP_BASIC_TAC;
19985   (* metric space ineq *)
19986   TYPE_THEN `X x /\ X x' /\ X (p' (ss' (SUC n +| SUC n')))` SUBGOAL_TAC;
19987   ASM_MESON_TAC[ISUBSET];
19988   REP_BASIC_TAC;
19989   RULE_ASSUM_TAC (REWRITE_RULE[o_DEF]);
19990   TYPE_THEN `r = p' (ss' (SUC n +| SUC n'))` ABBREV_TAC ;
19991   TYPE_THEN `d x' r = d r x'` SUBGOAL_TAC;
19992   IMATCH_MP_TAC  metric_space_symm;
19993   ASM_MESON_TAC[];
19994   TYPE_THEN `d x x' <= d x r + d r x'` SUBGOAL_TAC;
19995   IMATCH_MP_TAC  metric_space_triangle;
19996   ASM_MESON_TAC[];
19997   UND 0;
19998   UND 1;
19999   UND 2;
20000   UND 3;
20001   UND 8;
20002   REAL_ARITH_TAC;
20003   (* Fri Aug  6 11:54:33 EDT 2004 *)
20004   ]);;
20005   (* }}} *)
20006
20007 let max_real_le = prove_by_refinement(
20008   `!x y. x <= max_real x y  /\ y <= max_real x y `,
20009   (* {{{ proof *)
20010   [
20011   REWRITE_TAC[max_real];
20012   REP_GEN_TAC;
20013   COND_CASES_TAC;
20014   UND 0;
20015   REAL_ARITH_TAC;
20016   UND 0;
20017   REAL_ARITH_TAC;
20018   ]);;
20019   (* }}} *)
20020
20021 let min_real_le = prove_by_refinement(
20022   `!x y.  min_real x y <= x /\ min_real x y <= y`,
20023   (* {{{ proof *)
20024   [
20025   REWRITE_TAC[min_real];
20026   REP_GEN_TAC;
20027   COND_CASES_TAC;
20028   UND 0;
20029   REAL_ARITH_TAC;
20030   UND 0;
20031   REAL_ARITH_TAC;
20032   ]);;
20033   (* }}} *)
20034
20035 let finite_UB = prove_by_refinement(
20036   `!X. (FINITE X) ==> (?t. (!x. X x ==> x <=. t))`,
20037   (* {{{ proof *)
20038   [
20039   TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> x <= t))` SUBGOAL_TAC;
20040   INDUCT_TAC ;
20041   REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;];
20042   MESON_TAC[];
20043   REWRITE_TAC[HAS_SIZE_SUC];
20044   REWRITE_TAC[EMPTY_EXISTS];
20045   REP_BASIC_TAC;
20046   TSPEC `X DELETE u` 0;
20047   TYPE_THEN `(?t. !x. (X DELETE u) x ==> x <= t)` SUBGOAL_TAC;
20048   ASM_MESON_TAC[];
20049   REP_BASIC_TAC;
20050   TYPE_THEN `max_real t u` EXISTS_TAC;
20051   GEN_TAC;
20052   DISCH_TAC;
20053   TYPE_THEN `x = u` ASM_CASES_TAC;
20054   ASM_MESON_TAC[max_real_le];
20055   TSPEC `x` 3;
20056   RULE_ASSUM_TAC (REWRITE_RULE[DELETE]);
20057   ASM_MESON_TAC[max_real_le;REAL_LE_TRANS];
20058   REWRITE_TAC[HAS_SIZE];
20059   ASM_MESON_TAC[];
20060   (* Fri Aug  6 12:50:04 EDT 2004 *)
20061   ]);;
20062   (* }}} *)
20063
20064 let finite_LB = prove_by_refinement(
20065   `!X. (FINITE X) ==> (?t. (!x. X x ==> t <=. x))`,
20066   (* {{{ proof *)
20067   [
20068   TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> t <= x))` SUBGOAL_TAC;
20069   INDUCT_TAC ;
20070   REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;];
20071   MESON_TAC[];
20072   REWRITE_TAC[HAS_SIZE_SUC];
20073   REWRITE_TAC[EMPTY_EXISTS];
20074   REP_BASIC_TAC;
20075   TSPEC `X DELETE u` 0;
20076   TYPE_THEN `(?t. !x. (X DELETE u) x ==> t <= x)` SUBGOAL_TAC;
20077   ASM_MESON_TAC[];
20078   REP_BASIC_TAC;
20079   TYPE_THEN `min_real t u` EXISTS_TAC;
20080   GEN_TAC;
20081   DISCH_TAC;
20082   TYPE_THEN `x = u` ASM_CASES_TAC;
20083   ASM_MESON_TAC[min_real_le];
20084   TSPEC `x` 3;
20085   RULE_ASSUM_TAC (REWRITE_RULE[DELETE]);
20086   ASM_MESON_TAC[min_real_le;REAL_LE_TRANS];
20087   REWRITE_TAC[HAS_SIZE];
20088   ASM_MESON_TAC[];
20089   ]);;
20090   (* }}} *)
20091
20092 let finite_compact = prove_by_refinement(
20093   `!(X:A->bool) U. (FINITE X) /\ (X SUBSET UNIONS U) ==> (compact U X)`,
20094   (* {{{ proof *)
20095   [
20096   TYPE_THEN `!n (X:A->bool) U. (X HAS_SIZE n) /\ (X SUBSET UNIONS U) ==> (compact U X)` SUBGOAL_TAC;
20097   INDUCT_TAC;
20098   REWRITE_TAC[HAS_SIZE_0];
20099   REP_BASIC_TAC;
20100   ASM_REWRITE_TAC[];
20101   REWRITE_TAC[compact];
20102   REP_BASIC_TAC;
20103   TYPE_THEN `EMPTY:(A->bool)->bool` EXISTS_TAC;
20104   REWRITE_TAC[FINITE_RULES];
20105   REWRITE_TAC[HAS_SIZE_SUC;EMPTY_EXISTS;compact ;];
20106   REP_BASIC_TAC;
20107   ASM_REWRITE_TAC[];
20108   TYPE_THEN `X DELETE u HAS_SIZE n` SUBGOAL_TAC;
20109   ASM_MESON_TAC[];
20110   DISCH_TAC;
20111   TYPEL_THEN [`X DELETE u`;`U`] (USE 0 o ISPECL);
20112   REP_BASIC_TAC;
20113   REWR 0;
20114   TYPE_THEN `X DELETE u SUBSET UNIONS U` SUBGOAL_TAC;
20115   UND 1;
20116   REWRITE_TAC[SUBSET;DELETE];
20117   MESON_TAC[];
20118   DISCH_TAC;
20119   REWR 0;
20120   RULE_ASSUM_TAC (REWRITE_RULE[compact]);
20121   REP_BASIC_TAC;
20122   TSPEC `V` 0;
20123   REWR 0;
20124   TYPE_THEN `X DELETE u SUBSET UNIONS V` SUBGOAL_TAC;
20125   UND 6;
20126   REWRITE_TAC[SUBSET;DELETE];
20127   MESON_TAC[];
20128   DISCH_TAC;
20129   REWR 0;
20130   REP_BASIC_TAC;
20131   USE 6 (REWRITE_RULE[SUBSET;UNIONS]);
20132   TSPEC `u` 6;
20133   REWR 6;
20134   REP_BASIC_TAC;
20135   TYPE_THEN `u' INSERT W` EXISTS_TAC;
20136   CONJ_TAC;
20137   REWRITE_TAC[INSERT_SUBSET];
20138   ASM_REWRITE_TAC[];
20139   ASM_REWRITE_TAC[FINITE_INSERT];
20140   REWRITE_TAC[UNIONS_INSERT];
20141   IMATCH_MP_TAC  SUBSET_TRANS;
20142   TYPE_THEN `u' UNION (X DELETE u)` EXISTS_TAC;
20143   CONJ_TAC;
20144   REWRITE_TAC[SUBSET;DELETE;UNION];
20145   ASM_MESON_TAC[];
20146   UND 0;
20147   REWRITE_TAC[UNION;SUBSET];
20148   MESON_TAC[];
20149   REWRITE_TAC[HAS_SIZE];
20150   MESON_TAC[];
20151   ]);;
20152   (* }}} *)
20153
20154 let compact_supm = prove_by_refinement(
20155   `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==>
20156           X (supm X)`,
20157   (* {{{ proof *)
20158   [
20159   REP_BASIC_TAC;
20160   TYPE_THEN `(?x. X x /\ (!y. X y ==> y <= x))` SUBGOAL_TAC;
20161   IMATCH_MP_TAC  compact_sup;
20162   ASM_REWRITE_TAC[];
20163   REP_BASIC_TAC;
20164   TYPE_THEN `(!x. X x ==> x <= supm X ) /\ (!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC;
20165   IMATCH_MP_TAC  supm_UB;
20166   ASM_MESON_TAC[];
20167   REP_BASIC_TAC;
20168   TYPE_THEN `x = supm X` SUBGOAL_TAC;
20169   IMATCH_MP_TAC  (REAL_ARITH `x <= supm X /\ supm X <= x ==> (x = supm X)`);
20170   TSPEC `x` 4;
20171   REWR 4;
20172   ASM_REWRITE_TAC[];
20173   ASM_MESON_TAC[];
20174   ASM_MESON_TAC[];
20175
20176   ]);;
20177   (* }}} *)
20178
20179 let compact_infm = prove_by_refinement(
20180   `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==>
20181           X (inf X)`,
20182   (* {{{ proof *)
20183   [
20184   REP_BASIC_TAC;
20185   TYPE_THEN `(?x. X x /\ (!y. X y ==> x <= y))` SUBGOAL_TAC;
20186   IMATCH_MP_TAC  compact_inf;
20187   ASM_REWRITE_TAC[];
20188   REP_BASIC_TAC;
20189   TYPE_THEN `(!x. X x ==> inf X <= x ) /\ (!y. (!x. X x ==> y <= x) ==> ( y <= inf X))` SUBGOAL_TAC;
20190   IMATCH_MP_TAC  inf_LB;
20191   ASM_MESON_TAC[];
20192   REP_BASIC_TAC;
20193   TYPE_THEN `x = inf X` SUBGOAL_TAC;
20194   IMATCH_MP_TAC  (REAL_ARITH `x <= inf X /\ inf X <= x ==> (x = inf X)`);
20195   TSPEC `x` 4;
20196   REWR 4;
20197   ASM_REWRITE_TAC[];
20198   ASM_MESON_TAC[];
20199   ASM_MESON_TAC[];
20200   (* Fri Aug  6 13:45:50 EDT 2004 *)
20201
20202   ]);;
20203   (* }}} *)
20204
20205 let finite_supm = prove_by_refinement(
20206   `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (supm X)`,
20207   (* {{{ proof *)
20208   [
20209   REP_BASIC_TAC;
20210   IMATCH_MP_TAC  compact_supm;
20211   ASM_REWRITE_TAC[];
20212   IMATCH_MP_TAC  finite_compact;
20213   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;];
20214   ]);;
20215   (* }}} *)
20216
20217 let finite_inf = prove_by_refinement(
20218   `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (inf X)`,
20219   (* {{{ proof *)
20220   [
20221   REP_BASIC_TAC;
20222   IMATCH_MP_TAC  compact_infm;
20223   ASM_REWRITE_TAC[];
20224   IMATCH_MP_TAC  finite_compact;
20225   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;];
20226   (* Fri Aug  6 13:49:38 EDT 2004 *)
20227   ]);;
20228   (* }}} *)
20229
20230 let finite_supm_max = prove_by_refinement(
20231   `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> x <= supm X)`,
20232   (* {{{ proof *)
20233   [
20234   REP_BASIC_TAC;
20235   TYPE_THEN `(?t. !x. (X x ==> x <= t))` SUBGOAL_TAC;
20236   ASM_MESON_TAC[finite_UB];
20237   ASM_MESON_TAC[supm_UB];
20238   ]);;
20239   (* }}} *)
20240
20241 let finite_inf_min = prove_by_refinement(
20242   `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> inf X <= x)`,
20243   (* {{{ proof *)
20244   [
20245   REP_BASIC_TAC;
20246   TYPE_THEN `(?t. !x. (X x ==> t <= x))` SUBGOAL_TAC;
20247   ASM_MESON_TAC[finite_LB];
20248   ASM_MESON_TAC[inf_LB];
20249   ]);;
20250   (* }}} *)
20251
20252 let bij_inj_image = prove_by_refinement(
20253   `!(f:A->B) X Y. (INJ f X Y /\ Y SUBSET IMAGE f X) ==>
20254       (BIJ f X Y)`,
20255   (* {{{ proof *)
20256   [
20257   REWRITE_TAC[INJ;BIJ;SURJ;SUBSET;IMAGE];
20258   MESON_TAC[];
20259   ]);;
20260   (* }}} *)
20261
20262 let suc_interval = prove_by_refinement(
20263   `!n. {x | x <| SUC n} = {x | x <| n} UNION {n}`,
20264   (* {{{ proof *)
20265   [
20266   GEN_TAC;
20267   IMATCH_MP_TAC  EQ_EXT;
20268   REP_BASIC_TAC;
20269   REWRITE_TAC[UNION;INR IN_SING;];
20270   ARITH_TAC;
20271   ]);;
20272   (* }}} *)
20273
20274 let inj_domain_sub = prove_by_refinement(
20275   `!(f:A->B) g X Y. (!x. (X x ==> (f x = g x))) ==> (INJ f X Y = INJ g X Y)`,
20276   (* {{{ proof *)
20277   [
20278   REWRITE_TAC[INJ];
20279   MESON_TAC[];
20280   ]);;
20281   (* }}} *)
20282
20283 let image_domain_sub = prove_by_refinement(
20284   `!(f:A->B) g X . (!x. (X x ==> (f x = g x))) ==> (IMAGE f X  = IMAGE g X)`,
20285   (* {{{ proof *)
20286   [
20287   REWRITE_TAC[IMAGE];
20288   REP_BASIC_TAC;
20289   IMATCH_MP_TAC  EQ_EXT;
20290   REWRITE_TAC[];
20291   ASM_MESON_TAC[];
20292   ]);;
20293   (* }}} *)
20294
20295 let real_finite_increase = prove_by_refinement(
20296   `!X. ( (FINITE X) ==>
20297      (? u. (BIJ u {x | x <| CARD X} X) /\
20298         (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==>
20299          (u i <. u j)))))`,
20300   (* {{{ proof *)
20301   [
20302   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;
20303   INDUCT_TAC;
20304   REWRITE_TAC[HAS_SIZE_0];
20305   REP_BASIC_TAC;
20306   ASM_REWRITE_TAC[CARD_CLAUSES;BIJ;INJ;SURJ];
20307   REWRITE_TAC[ARITH_RULE `~(j <| 0)`];
20308   REP_BASIC_TAC;
20309   COPY 1;
20310   UND 1;
20311   REWRITE_TAC[HAS_SIZE_SUC;];
20312   REP_BASIC_TAC;
20313   TYPE_THEN `X (supm X)` SUBGOAL_TAC;
20314   IMATCH_MP_TAC  finite_supm;
20315   ASM_REWRITE_TAC[];
20316   KILL 0;
20317   USE 3(REWRITE_RULE[EMPTY_EXISTS]);
20318   REP_BASIC_TAC;
20319   TSPEC `u` 1;
20320   ASM_MESON_TAC[FINITE_DELETE;HAS_SIZE;];
20321   DISCH_TAC;
20322   TSPEC `supm X` 1;
20323   REWR 1;
20324   TSPEC `X DELETE supm X` 0;
20325   REWR 0;
20326   REP_BASIC_TAC;
20327   TYPE_THEN `v = (\j. if (j = n) then supm X else u j)` ABBREV_TAC ;
20328   TYPE_THEN `v` EXISTS_TAC;
20329   TYPE_THEN `CARD (X DELETE supm X) = n` SUBGOAL_TAC;
20330   ASM_MESON_TAC[HAS_SIZE];
20331   DISCH_TAC;
20332   (* [th] *)
20333   TYPE_THEN `!x. ({x | x <| n} x ==> (v x = u x))` SUBGOAL_TAC;
20334   REWRITE_TAC[];
20335   EXPAND_TAC "v";
20336   GEN_TAC;
20337   COND_CASES_TAC;
20338   ASM_REWRITE_TAC[ARITH_RULE `~(n <| n)`];
20339   REWRITE_TAC[];
20340   DISCH_TAC;
20341     TYPE_THEN `INJ v {x | x <| n} X = INJ u {x | x <| n} X` SUBGOAL_TAC;
20342   IMATCH_MP_TAC  inj_domain_sub;
20343   UND 8;
20344   ASM_REWRITE_TAC[];
20345   DISCH_TAC;
20346   TYPE_THEN `v n = supm X` SUBGOAL_TAC;
20347   EXPAND_TAC "v";
20348   ASM_REWRITE_TAC[];
20349   DISCH_TAC;
20350     TYPE_THEN `IMAGE v {x | x <| n} = IMAGE u {x | x <| n}` SUBGOAL_TAC;
20351   IMATCH_MP_TAC  image_domain_sub;
20352   UND 8;
20353   ASM_REWRITE_TAC[];
20354   DISCH_TAC;
20355   TYPE_THEN `IMAGE v {x | x <| n} = X DELETE supm X` SUBGOAL_TAC;
20356   ASM_REWRITE_TAC[];
20357   UND 5;
20358   ASM_REWRITE_TAC[];
20359   REWRITE_TAC[BIJ];
20360   alpha_tac;
20361   MESON_TAC[SURJ_IMAGE];
20362   DISCH_TAC;
20363   (* obligations *)
20364   CONJ_TAC;
20365   IMATCH_MP_TAC  bij_inj_image;
20366   CONJ_TAC;
20367   TYPE_THEN `{x | x <| CARD X} = {x | x <| n} UNION {n}` SUBGOAL_TAC;
20368   USE 2(REWRITE_RULE[HAS_SIZE]);
20369   ASM_REWRITE_TAC[];
20370   REWRITE_TAC[suc_interval];
20371   DISCH_THEN_REWRITE;
20372   IMATCH_MP_TAC  inj_split;
20373   CONJ_TAC;
20374   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;DELETE]);
20375   REP_BASIC_TAC;
20376   ASM_REWRITE_TAC[];
20377   UND 13;
20378   ASM_REWRITE_TAC[];
20379   REWRITE_TAC[INJ;SUBSET];
20380   MESON_TAC[];
20381   CONJ_TAC;
20382   REWRITE_TAC[INJ;SUBSET;INR IN_SING];
20383   ASM_MESON_TAC[];
20384   REWRITE_TAC[EQ_EMPTY;INTER;image_sing;INR IN_SING;];
20385   KILL 11;
20386   ASM_REWRITE_TAC[DELETE;SUBSET;];
20387   MESON_TAC[];
20388   TYPE_THEN `X = supm X INSERT (X DELETE supm X)` SUBGOAL_TAC;
20389   ASM_SIMP_TAC[INR INSERT_DELETE];
20390   USE 2 (REWRITE_RULE[HAS_SIZE]);
20391   ASM_REWRITE_TAC[];
20392   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
20393   REWRITE_TAC[INSERT_SUBSET];
20394   KILL 11;
20395   CONJ_TAC;
20396   REWRITE_TAC[IMAGE];
20397   TYPE_THEN `n` EXISTS_TAC;
20398   ASM_REWRITE_TAC[];
20399   ARITH_TAC;
20400   IMATCH_MP_TAC  SUBSET_TRANS;
20401   TYPE_THEN `IMAGE v {x| x <| n}` EXISTS_TAC;
20402   ASM_REWRITE_TAC[SUBSET_REFL];
20403   USE 12 GSYM;
20404   ASM_REWRITE_TAC[];
20405   IMATCH_MP_TAC  IMAGE_SUBSET;
20406   REWRITE_TAC[SUBSET];
20407   ARITH_TAC;
20408   REP_GEN_TAC;
20409   (* monotonicity [m] *)
20410   USE 2 (REWRITE_RULE[HAS_SIZE]);
20411   ASM_REWRITE_TAC[];
20412   TYPE_THEN `(!x. X x ==> x <= supm X)` SUBGOAL_TAC;
20413   ASM_MESON_TAC[finite_supm_max];
20414   DISCH_TAC;
20415   TYPE_THEN `j = n` ASM_CASES_TAC;
20416   ASM_REWRITE_TAC[];
20417   FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `(v:num->real) i`));
20418   REWRITE_TAC[IMAGE;DELETE;];
20419   TSPEC  `(v i)` 13;
20420   UND 13;
20421   MESON_TAC[REAL_ARITH `a < b <=> (a<= b /\ ~(a = b))`];
20422   KILL 3;
20423   KILL 4;
20424   KILL 5;
20425   REP_BASIC_TAC;
20426   TYPE_THEN `~(i = n)` SUBGOAL_TAC;
20427   UND 2;
20428   UND 3;
20429   ARITH_TAC;
20430   REWR 0;
20431   DISCH_TAC;
20432   TYPE_THEN `i <| n /\ j <| n` SUBGOAL_TAC;
20433   UND 3;
20434   UND 4;
20435   UND 14;
20436   UND 16;
20437   ARITH_TAC;
20438   REP_BASIC_TAC;
20439   REWR 8;
20440   ASM_SIMP_TAC[];
20441   (* end *)
20442   REWRITE_TAC[HAS_SIZE];
20443   REP_BASIC_TAC;
20444   RIGHT 1 "n" ;
20445   TSPEC `X` 1;
20446   TSPEC `CARD X` 1;
20447   alpha_tac;
20448   ASM_MESON_TAC[];
20449   (* Fri Aug  6 19:51:16 EDT 2004 *)
20450   ]);;
20451   (* }}} *)
20452
20453 let connected_nogap = prove_by_refinement(
20454   `!A a b. connected (top_of_metric(UNIV,d_real)) A /\
20455           A a /\ A b ==>
20456        {x | a <= x /\ x <= b } SUBSET A`,
20457   (* {{{ proof *)
20458   [
20459   REP_BASIC_TAC;
20460   TYPE_THEN `(a = b) \/ (b < a) \/ (a < b)` SUBGOAL_TAC;
20461   REAL_ARITH_TAC;
20462   REP_CASES_TAC;
20463   ASM_REWRITE_TAC[SUBSET];
20464   ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= b ==> (x = b)`];
20465   REWRITE_TAC[SUBSET];
20466   ASM_MESON_TAC[REAL_ARITH `a <=x /\ x <= b ==> ~(b < a)`];
20467   REWRITE_TAC[SUBSET];
20468   REP_BASIC_TAC;
20469   PROOF_BY_CONTR_TAC;
20470   TYPE_THEN `a < x` SUBGOAL_TAC;
20471   IMATCH_MP_TAC  (REAL_ARITH `(a <= x /\ ~(a = x)) ==> a < x`);
20472   ASM_MESON_TAC[];
20473   DISCH_TAC;
20474   TYPE_THEN `x < b` SUBGOAL_TAC;
20475   IMATCH_MP_TAC  (REAL_ARITH `(x <= b /\ ~(b = x)) ==> x < b`);
20476   ASM_MESON_TAC[];
20477   DISCH_TAC;
20478   RULE_ASSUM_TAC (REWRITE_RULE[connected]);
20479   REP_BASIC_TAC;
20480   TYPEL_THEN [` {t | t < x}`;` {t | x < t}`] (USE 2 o SPECL);
20481   UND 2;
20482   REWRITE_TAC[half_open;half_open_above];
20483   TYPE_THEN `({t | t < x} INTER {t | x < t} = {}) /\ A SUBSET {t | t < x} UNION {t | x < t}` SUBGOAL_TAC;
20484   REWRITE_TAC[INTER;EQ_EMPTY;UNION;SUBSET;];
20485   REWRITE_TAC[REAL_ARITH `x' < x \/ x < x' <=> ~(x' = x)`];
20486   CONJ_TAC;
20487   REAL_ARITH_TAC;
20488   ASM_MESON_TAC[];
20489   DISCH_THEN_REWRITE;
20490   REWRITE_TAC[SUBSET;];
20491   ASM_MESON_TAC[REAL_ARITH `x < b ==> ~(b < x)`];
20492   (* Fri Aug  6 20:24:45 EDT 2004 *)
20493
20494   ]);;
20495   (* }}} *)
20496
20497 let connected_open = prove_by_refinement(
20498   `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\
20499        (top_of_metric(UNIV,d_real) A) /\
20500        (~(A = EMPTY)) /\
20501        A SUBSET {x | a <= x /\ x <= b}) ==>
20502          ( A = {x | inf A < x /\ x < supm A})`,
20503   (* {{{ proof *)
20504   [
20505   REWRITE_TAC[SUBSET];
20506   REP_BASIC_TAC;
20507   TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ supm A - epsilon < x))` SUBGOAL_TAC;
20508   IMATCH_MP_TAC  supm_eps;
20509   ASM_MESON_TAC[];
20510   DISCH_TAC;
20511   TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ x < inf A + epsilon))` SUBGOAL_TAC;
20512   IMATCH_MP_TAC  inf_eps;
20513   ASM_MESON_TAC[];
20514   DISCH_TAC;
20515   TYPE_THEN `(!x. A x ==> x <= supm A)` SUBGOAL_TAC;
20516   ASM_MESON_TAC[supm_UB];
20517   DISCH_TAC;
20518   TYPE_THEN `(!x. A x ==> inf A <= x)` SUBGOAL_TAC;
20519   ASM_MESON_TAC[inf_LB];
20520   DISCH_TAC;
20521   IMATCH_MP_TAC  SUBSET_ANTISYM;
20522   TYPE_THEN `!x. (A x  ==> ?e. &0 < e /\ open_ball(UNIV,d_real) x e SUBSET A)` SUBGOAL_TAC;
20523   UND 2;
20524   MP_TAC metric_real;
20525   MESON_TAC[open_ball_nbd];
20526   REWRITE_TAC[open_ball;d_real];
20527   DISCH_TAC;
20528   (*  *)
20529   TYPE_THEN `!x. A x ==> (?y. A y /\ ~(x <= y))` SUBGOAL_TAC;
20530   REP_BASIC_TAC;
20531   TSPEC  `x` 8;
20532   REWR 8;
20533   REP_BASIC_TAC;
20534   USE 8(REWRITE_RULE[SUBSET]);
20535   TYPE_THEN `x - e/(&2)` EXISTS_TAC;
20536   REWRITE_TAC[REAL_ARITH `~(x <= x - e/(&2)) <=> (&0 < e/(&2))`];
20537   ASM_REWRITE_TAC[REAL_LT_HALF1];
20538   FIRST_ASSUM IMATCH_MP_TAC ;
20539   REWRITE_TAC[REAL_ARITH `(x - (x - t)) = t`];
20540   TYPE_THEN `abs  (e/(&2)) = (e/(&2))` SUBGOAL_TAC;
20541   REWRITE_TAC[REAL_ABS_REFL];
20542   IMATCH_MP_TAC  (REAL_ARITH `(a < b) ==> (a <= b)`);
20543   ASM_REWRITE_TAC[REAL_LT_HALF1];
20544   DISCH_THEN_REWRITE;
20545   ASM_REWRITE_TAC[REAL_LT_HALF2];
20546   DISCH_TAC;
20547   (*  *)
20548   TYPE_THEN `!x. A x ==> (?y. A y /\ ~(y <= x))` SUBGOAL_TAC;
20549   REP_BASIC_TAC;
20550   TSPEC  `x` 8;
20551   REWR 8;
20552   REP_BASIC_TAC;
20553   USE 8(REWRITE_RULE[SUBSET]);
20554   TYPE_THEN `x + e/(&2)` EXISTS_TAC;
20555   REWRITE_TAC[REAL_ARITH `~( x + e/(&2) <= x) <=> (&0 < e/(&2))`];
20556   ASM_REWRITE_TAC[REAL_LT_HALF1];
20557   FIRST_ASSUM IMATCH_MP_TAC ;
20558   REWRITE_TAC[REAL_ARITH `(x - (x + t)) = --. t`];
20559   TYPE_THEN `abs (--. (e/(&2))) = (e/(&2))` SUBGOAL_TAC;
20560   REWRITE_TAC[REAL_ABS_REFL;ABS_NEG;];
20561   IMATCH_MP_TAC  (REAL_ARITH `(a < b) ==> (a <= b)`);
20562   ASM_REWRITE_TAC[REAL_LT_HALF1];
20563   DISCH_THEN_REWRITE;
20564   ASM_REWRITE_TAC[REAL_LT_HALF2];
20565   DISCH_TAC;
20566   (* FIRST direction *)
20567   CONJ_TAC;
20568   REWRITE_TAC[SUBSET];
20569   REP_BASIC_TAC;
20570   REWRITE_TAC[REAL_ARITH `u < v  <=> (u <= v /\ ~(u = v))`];
20571   CONJ_TAC;
20572   CONJ_TAC;
20573   ASM_MESON_TAC[];
20574   ASM_MESON_TAC[];
20575   CONJ_TAC;
20576   ASM_MESON_TAC[];
20577   ASM_MESON_TAC[];
20578   (* 2 *)
20579   REWRITE_TAC[SUBSET];
20580   REP_BASIC_TAC;
20581   TYPE_THEN `?a'. A a' /\ (a' < x)` SUBGOAL_TAC;
20582   TSPEC `x - inf A` 5;
20583   USE 5 (REWRITE_RULE[REAL_ARITH `&0 < x - y <=> (y < x)`;REAL_ARITH `t + x - t = x`]);
20584   REWR 5;
20585   DISCH_TAC;
20586   TSPEC `supm A - x` 4;
20587   USE 4(REWRITE_RULE[REAL_ARITH `&0 < y - x <=> (x < y)`;REAL_ARITH `t - (t -x) = x`]);
20588   REWR 4;
20589   REP_BASIC_TAC;
20590   TYPE_THEN `{t | a' <= t /\ t <= x'} SUBSET A` SUBGOAL_TAC;
20591   IMATCH_MP_TAC  connected_nogap;
20592   ASM_REWRITE_TAC[];
20593   REWRITE_TAC[SUBSET];
20594   DISCH_TAC;
20595   TSPEC `x` 16;
20596   FIRST_ASSUM IMATCH_MP_TAC ;
20597   UND 4;
20598   UND 14;
20599   REAL_ARITH_TAC;
20600   (* Fri Aug  6 21:34:56 EDT 2004 *)
20601
20602   ]);;
20603   (* }}} *)
20604
20605 let closure_real_set = prove_by_refinement(
20606   `!Z a.
20607      (closure(top_of_metric(UNIV,d_real)) Z a <=>
20608        (!e. (&0 < e) ==> (?z. Z z /\ (abs  (a - z) <= e))))`,
20609   (* {{{ proof *)
20610   [
20611   REP_BASIC_TAC;
20612   TYPE_THEN `metric_space (UNIV,d_real) /\ Z SUBSET UNIV` SUBGOAL_TAC;
20613   REWRITE_TAC[metric_real;SUBSET_UNIV];
20614   DISCH_THEN (fun t -> MP_TAC (MATCH_MP closure_open_ball t));
20615   DISCH_THEN (fun t -> MP_TAC (AP_THM t `a:real`));
20616   REWRITE_TAC[];
20617   DISCH_THEN (fun t ->  REWRITE_TAC[GSYM t]);
20618   REWRITE_TAC[open_ball;d_real;];
20619   EQ_TAC;
20620   ASM_MESON_TAC[REAL_ARITH `a < b ==> a <= b`];
20621   REP_BASIC_TAC;
20622   TSPEC `r/(&2)` 1;
20623   RULE_ASSUM_TAC (REWRITE_RULE[REAL_LT_HALF1]);
20624   REWR 1;
20625   REP_BASIC_TAC;
20626   TYPE_THEN `z` EXISTS_TAC;
20627   ASM_REWRITE_TAC[];
20628   IMATCH_MP_TAC  (REAL_ARITH `(a <= b/(&2)) /\ (b/(&2) < b)   ==> (a < b)`);
20629   ASM_REWRITE_TAC[];
20630   ASM_MESON_TAC[half_pos];
20631   (* Sat Aug  7 08:14:28 EDT 2004 *)
20632
20633   ]);;
20634   (* }}} *)
20635
20636 let real_div_assoc = prove_by_refinement(
20637   `!a b c. (a*b)/c = a*(b/c)`,
20638   (* {{{ proof *)
20639   [
20640   REWRITE_TAC[real_div;REAL_MUL_AC;];
20641   ]);;
20642   (* }}} *)
20643
20644 let real_middle1_lt = prove_by_refinement(
20645   `!a b. (a < b) ==> a < (a + b)/(&2) `,
20646   (* {{{ proof *)
20647   [
20648   REP_BASIC_TAC;
20649   TYPE_THEN `(&2*a)/(&2) < (a+b)/(&2)` SUBGOAL_TAC;
20650   ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`];
20651   REWRITE_TAC[REAL_MUL_2];
20652   UND 0;
20653   REAL_ARITH_TAC;
20654   REWRITE_TAC[real_div_assoc];
20655   ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`];
20656   ]);;
20657   (* }}} *)
20658
20659 let real_middle2_lt = prove_by_refinement(
20660   `!a b. (a < b) ==>  (a + b)/(&2) < b `,
20661   (* {{{ proof *)
20662   [
20663   REP_BASIC_TAC;
20664   TYPE_THEN ` (a+b)/(&2) < (&2*b)/(&2)` SUBGOAL_TAC;
20665   ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`];
20666   REWRITE_TAC[REAL_MUL_2];
20667   UND 0;
20668   REAL_ARITH_TAC;
20669   REWRITE_TAC[real_div_assoc];
20670   ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`];
20671   ]);;
20672   (* }}} *)
20673
20674 let real_sub_half = prove_by_refinement(
20675   `!a b. (a - (a + b)/(&2) = (a - b)/(&2))`,
20676   (* {{{ proof *)
20677   [
20678   REP_BASIC_TAC;
20679   TYPE_THEN `((&2*a)/(&2) - (a+b)/(&2) = (a - b)/(&2))` SUBGOAL_TAC;
20680   REWRITE_TAC[real_div;GSYM REAL_SUB_RDISTRIB];
20681   REWRITE_TAC[REAL_EQ_RMUL_IMP];
20682   AP_THM_TAC;
20683   AP_TERM_TAC;
20684   REWRITE_TAC[REAL_MUL_2];
20685   REAL_ARITH_TAC;
20686   ASM_SIMP_TAC[REAL_ARITH `~(&2 = &0)`;REAL_DIV_LMUL;real_div_assoc];
20687   ]);;
20688   (* }}} *)
20689
20690 let closure_open_interval = prove_by_refinement(
20691   `!a b. (a < b) ==>
20692       (closure (top_of_metric(UNIV,d_real)) {x | a < x /\ x < b} =
20693        {x | a <= x /\ x <= b}) `,
20694   (* {{{ proof *)
20695   [
20696   REP_BASIC_TAC;
20697   IMATCH_MP_TAC  SUBSET_ANTISYM;
20698   CONJ_TAC;
20699   IMATCH_MP_TAC  closure_subset;
20700   ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real];
20701   REWRITE_TAC[SUBSET];
20702   REAL_ARITH_TAC;
20703   (* 2 *)
20704   TYPE_THEN `{x | a <= x /\ x <= b} = a INSERT (b INSERT {x | a < x /\ x < b})` SUBGOAL_TAC;
20705   IMATCH_MP_TAC  EQ_EXT;
20706   REWRITE_TAC[INSERT];
20707   GEN_TAC;
20708   UND 0;
20709   REAL_ARITH_TAC;
20710   DISCH_THEN_REWRITE;
20711   REWRITE_TAC[INSERT_SUBSET];
20712   ASM_SIMP_TAC[top_of_metric_top;metric_real;subset_closure;];
20713   (* USE closure_real_set *)
20714   REWRITE_TAC[closure_real_set];
20715   TYPE_THEN `!e. (&0 < e) ==> (a + e < b) \/ ((b - a)/(&2) < e)` SUBGOAL_TAC;
20716   REP_BASIC_TAC;
20717   ASM_CASES_TAC `(a + e < b)`;
20718   ASM_REWRITE_TAC[];
20719   ASM_REWRITE_TAC[];
20720   IMATCH_MP_TAC  (REAL_ARITH `(x <= y/(&2) /\ y/(&2) < y)  ==> (x < y)`);
20721   ASM_SIMP_TAC [half_pos];
20722   ASM_SIMP_TAC[REAL_LE_DIV2_EQ;REAL_ARITH `&0 < &2`];
20723   UND 2;
20724   REAL_ARITH_TAC;
20725   DISCH_ALL_TAC;
20726   (* 1 *)
20727   CONJ_TAC;
20728   REP_BASIC_TAC;
20729   TSPEC `e` 1;
20730   REWR 1;
20731   FIRST_ASSUM DISJ_CASES_TAC;
20732   TYPE_THEN `a + e` EXISTS_TAC;
20733   REWRITE_TAC[REAL_ARITH `(a < a + e <=> &0 < e) /\ (a - (a + e) = --. e)`];
20734   ASM_REWRITE_TAC[ABS_NEG;];
20735   IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
20736   REWRITE_TAC[REAL_ABS_REFL];
20737   UND 2;
20738   REAL_ARITH_TAC;
20739   (* 2 *)
20740   REP_BASIC_TAC;
20741   TYPE_THEN `(a + b)/(&2)` EXISTS_TAC;
20742   ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
20743   UND 3;
20744   UND 0;
20745   REWRITE_TAC[real_div;ABS_MUL];
20746   ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(a - b) = (b-a))`];
20747   TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC;
20748   REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ];
20749   REAL_ARITH_TAC;
20750   DISCH_THEN_REWRITE;
20751   REAL_ARITH_TAC;
20752   (* 3 *)
20753   REP_BASIC_TAC;
20754   TSPEC `e` 1;
20755   REWR 1;
20756   FIRST_ASSUM DISJ_CASES_TAC;
20757   TYPE_THEN `b - e` EXISTS_TAC;
20758   REWRITE_TAC[REAL_ARITH `(b - e < b <=> &0 < e) /\ (b - (b - e) =  e)`];
20759   REWRITE_TAC[REAL_ARITH `(a < b - e) <=> (a + e < b)`];
20760   ASM_REWRITE_TAC[];
20761   IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
20762   REWRITE_TAC[REAL_ABS_REFL];
20763   UND 2;
20764   REAL_ARITH_TAC;
20765   (* 4 *)
20766   REP_BASIC_TAC;
20767   TYPE_THEN `(b + a)/(&2)` EXISTS_TAC;
20768   ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
20769   ONCE_REWRITE_TAC [REAL_ARITH `(a + b) = (b + a)`];
20770   ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
20771   UND 3;
20772   UND 0;
20773   REWRITE_TAC[real_div;ABS_MUL];
20774   ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(b - a) = (b-a))`];
20775   TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC;
20776   REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ];
20777   REAL_ARITH_TAC;
20778   DISCH_THEN_REWRITE;
20779   REAL_ARITH_TAC;
20780   (* Sat Aug  7 09:45:29 EDT 2004 *)
20781   ]);;
20782
20783   (* }}} *)
20784
20785 let interval_subset  = prove_by_refinement(
20786   `!a b c d. {x | a <= x /\ x <= b} SUBSET  {x | c <= x /\ x <= d} <=>
20787       (b < a) \/ ((c <= a ) /\ (b <= d))`,
20788   (* {{{ proof *)
20789   [
20790   REWRITE_TAC[SUBSET ];
20791   REP_BASIC_TAC;
20792   ASM_CASES_TAC `b < a` ;
20793   ASM_REWRITE_TAC[];
20794   UND 0;
20795   REAL_ARITH_TAC;
20796   ASM_REWRITE_TAC[];
20797   EQ_TAC;
20798   REP_BASIC_TAC;
20799   TYPE_THEN `a` (WITH 1 o SPEC);
20800   TYPE_THEN `b` (USE 1 o SPEC);
20801   UND 0;
20802   UND 1;
20803   UND 2;
20804   REAL_ARITH_TAC;
20805   REAL_ARITH_TAC;
20806   ]);;
20807   (* }}} *)
20808
20809 let subset_antisym_eq = prove_by_refinement(
20810   `!(A:A->bool) B. (A = B) <=> (A SUBSET B /\ B SUBSET A) `,
20811   (* {{{ proof *)
20812   [
20813   REWRITE_TAC[SUBSET;FUN_EQ_THM ];
20814   MESON_TAC[];
20815   ]);;
20816   (* }}} *)
20817
20818 let interval_eq = prove_by_refinement(
20819 (**** Parens added by JRH for real right associativity of =
20820   `!a b c d. {x | a <= x /\ x <= b} =  {x | c <= x /\ x <= d} =
20821       ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`,
20822  ****)
20823   `!a b c d. ({x | a <= x /\ x <= b} =  {x | c <= x /\ x <= d}) <=>
20824       ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`,
20825   (* {{{ proof *)
20826   [
20827   REWRITE_TAC[subset_antisym_eq;interval_subset;];
20828   REAL_ARITH_TAC;
20829   ]);;
20830   (* }}} *)
20831
20832 let connected_open_closure = prove_by_refinement(
20833   `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\
20834        (top_of_metric(UNIV,d_real) A) /\
20835     (closure (top_of_metric(UNIV,d_real)) A = {x | a <= x /\ x <= b}) ==>
20836     (A = { x | a < x /\ x < b }))`,
20837   (* {{{ proof *)
20838   [
20839   REP_BASIC_TAC;
20840   (* deal WITH emptyset *)
20841   TYPE_THEN `A = EMPTY` ASM_CASES_TAC;
20842   REWR 0;
20843   UND 0;
20844   ASM_SIMP_TAC[top_of_metric_top;metric_real;closure_empty;];
20845   DISCH_TAC;
20846   IMATCH_MP_TAC  EQ_EXT;
20847   REWRITE_TAC[];
20848   GEN_TAC;
20849   FIRST_ASSUM (fun t -> MP_TAC (AP_THM t `x:real`));
20850   REWRITE_TAC[];
20851   REAL_ARITH_TAC;
20852   (* deal WITH containment *)
20853   TYPE_THEN `A SUBSET {x | a <= x /\ x <= b}` SUBGOAL_TAC;
20854   USE 0 SYM;
20855   ASM_REWRITE_TAC[];
20856   IMATCH_MP_TAC  subset_closure;
20857   ASM_SIMP_TAC[top_of_metric_top;metric_real];
20858   DISCH_TAC;
20859   (* quote previous result *)
20860   TYPE_THEN `( A = {x | inf A < x /\ x < supm A})` SUBGOAL_TAC;
20861   IMATCH_MP_TAC  connected_open;
20862   TYPE_THEN `a` EXISTS_TAC;
20863   TYPE_THEN `b` EXISTS_TAC;
20864   ASM_REWRITE_TAC[];
20865   DISCH_TAC;
20866   (* now USE the closure of an open interval is the closed interval *)
20867
20868   PROOF_BY_CONTR_TAC;
20869   RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
20870   REP_BASIC_TAC;
20871   UND 3;
20872   REWRITE_TAC[];
20873   ASM ONCE_REWRITE_TAC [];
20874   REWRITE_TAC[];
20875   DISCH_TAC;
20876   TYPE_THEN `inf A < supm A` SUBGOAL_TAC;
20877   UND 3;
20878   REAL_ARITH_TAC;
20879   DISCH_TAC;
20880   USE 7(MATCH_MP closure_open_interval);
20881   UND 6;
20882   UND 0;
20883   REWRITE_TAC[];
20884   ASM ONCE_REWRITE_TAC[];
20885   ASM_REWRITE_TAC[];
20886   DISCH_TAC;
20887   IMATCH_MP_TAC  EQ_EXT;
20888   REP_BASIC_TAC;
20889   REWRITE_TAC[];
20890   USE 0(REWRITE_RULE[interval_eq]);
20891   FIRST_ASSUM DISJ_CASES_TAC;
20892   UND 8;
20893   UND 3;
20894   UND 6;
20895   REAL_ARITH_TAC;
20896   ASM_REWRITE_TAC[];
20897   (* Sat Aug  7 10:38:12 EDT 2004 *)
20898
20899   ]);;
20900   (* }}} *)
20901
20902 (* Sat Aug  7 11:01:27 EDT 2004 *)
20903
20904 let closed_ball_empty = prove_by_refinement(
20905   `!n a r. (r < &0) ==> (closed_ball(euclid n,d_euclid) a r = EMPTY)`,
20906   (* {{{ proof *)
20907   [
20908   REWRITE_TAC[closed_ball;EQ_EMPTY;];
20909   ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> ~(r < &0)`];
20910   ]);;
20911   (* }}} *)
20912
20913 let closed_ball_pt = prove_by_refinement(
20914   `!n a. (closed_ball(euclid n,d_euclid) a (&0) SUBSET {a})`,
20915   (* {{{ proof *)
20916   [
20917   REWRITE_TAC[closed_ball;SUBSET;INR IN_SING;];
20918   ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;REAL_ARITH `(x <= &0 /\ &0 <= x) ==> (x = &0)`];
20919   ]);;
20920   (* }}} *)
20921
20922 let closed_ball_subset_open = prove_by_refinement(
20923   `!n a r. ?r'. closed_ball(euclid n,d_euclid) a r SUBSET
20924       open_ball(euclid n,d_euclid) a r'`,
20925   (* {{{ proof *)
20926   [
20927   REP_BASIC_TAC;
20928   REWRITE_TAC[closed_ball;open_ball;SUBSET ];
20929   TYPE_THEN `r + &1` EXISTS_TAC;
20930   MESON_TAC[ REAL_ARITH `(u <= r) ==> (u < r + &1)`];
20931   ]);;
20932   (* }}} *)
20933
20934 let closed_ball_compact = prove_by_refinement(
20935   `!n a r.  (compact (top_of_metric(euclid n,d_euclid))
20936         (closed_ball(euclid n,d_euclid) a r)) `,
20937   (* {{{ proof *)
20938   [
20939   REP_BASIC_TAC;
20940   TYPE_THEN `closed_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC;
20941   REWRITE_TAC[closed_ball;SUBSET];
20942   MESON_TAC[];
20943   DISCH_TAC;
20944   TYPE_THEN `open_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC;
20945   REWRITE_TAC[open_ball;SUBSET];
20946   MESON_TAC[];
20947   DISCH_TAC;
20948   ASM_SIMP_TAC[compact_euclid;closed_ball_closed;metric_euclid;];
20949   REWRITE_TAC[metric_bounded];
20950   TYPE_THEN `a` EXISTS_TAC;
20951   TYPE_THEN `r + &1`EXISTS_TAC;
20952   REWRITE_TAC[open_ball;SUBSET;];
20953   REP_BASIC_TAC;
20954   ASM_REWRITE_TAC[];
20955   UND 2;
20956   REWRITE_TAC[closed_ball];
20957   REP_BASIC_TAC;
20958   TYPE_THEN `d_euclid a a = &0` SUBGOAL_TAC;
20959   ASM_MESON_TAC[d_euclid_zero];
20960   DISCH_THEN_REWRITE;
20961   ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> &0 <= r`;REAL_ARITH `u <= r ==> (u < r + &1)`];
20962   (* Sat Aug  7 12:15:05 EDT 2004 *)
20963
20964   ]);;
20965   (* }}} *)
20966
20967 let set_dist = jordan_def
20968   `set_dist d (K:A->bool) (K':B->bool) =
20969        inf { z | (?p p'. (K p /\ K' p' /\ (z = d p p')))}`;;
20970
20971 let set_dist_inf = prove_by_refinement(
20972   `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
20973       (K' SUBSET X) ==>
20974     (!p p'. (K p /\ K' p' ==> (set_dist d K K' <= d p p')))`,
20975   (* {{{ proof *)
20976   [
20977   REWRITE_TAC[set_dist];
20978   REP_BASIC_TAC;
20979   TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
20980   TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
20981   GEN_TAC;
20982   EXPAND_TAC "Y";
20983   REWRITE_TAC[];
20984   REP_BASIC_TAC;
20985   ASM_REWRITE_TAC[];
20986   RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
20987   ASM_MESON_TAC[ISUBSET];
20988   DISCH_TAC;
20989   TYPE_THEN `Y (d p p')` SUBGOAL_TAC;
20990
20991   EXPAND_TAC "Y";
20992   REWRITE_TAC[];
20993   ASM_MESON_TAC[];
20994   DISCH_TAC;
20995
20996   TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
20997   CONJ_TAC;
20998   REWRITE_TAC[EMPTY_EXISTS];
20999   TYPE_THEN `d p p'` EXISTS_TAC;
21000   ASM_REWRITE_TAC[];
21001   ASM_MESON_TAC[];
21002   DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
21003   ASM_MESON_TAC[];
21004   ]);;
21005   (* }}} *)
21006
21007 let set_dist_nn = prove_by_refinement(
21008   `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
21009      ~(K = EMPTY) /\      ~(K' = EMPTY) /\
21010       (K' SUBSET X) ==> (&0 <= set_dist d K K')`,
21011   (* {{{ proof *)
21012   [
21013   REWRITE_TAC[set_dist];
21014   REP_BASIC_TAC;
21015   TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
21016   TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
21017   REP_BASIC_TAC;
21018   UND 6;
21019   EXPAND_TAC "Y";
21020   REWRITE_TAC[];
21021   REP_BASIC_TAC;
21022   ASM_REWRITE_TAC[];
21023   RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
21024   ASM_MESON_TAC[ISUBSET];
21025   DISCH_TAC;
21026   TYPE_THEN `~(Y = {})` SUBGOAL_TAC;
21027   REWRITE_TAC[EMPTY_EXISTS];
21028   RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
21029   REP_BASIC_TAC;
21030   TYPE_THEN `d u' u` EXISTS_TAC;
21031   EXPAND_TAC "Y";
21032   REWRITE_TAC[];
21033   ASM_MESON_TAC[];
21034   DISCH_TAC;
21035   TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
21036   ASM_MESON_TAC[];
21037   DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
21038   ASM_MESON_TAC[];
21039   ]);;
21040   (* }}} *)
21041
21042 let set_dist_eq = prove_by_refinement(
21043   `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
21044      ~(K = EMPTY) /\      ~(K' = EMPTY) /\
21045     (compact (top_of_metric(X,d)) K) /\
21046     (compact (top_of_metric (X,d)) K') /\
21047       (K' SUBSET X) ==>
21048     (?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))`,
21049   (* {{{ proof *)
21050   [
21051   REWRITE_TAC[set_dist];
21052   REP_BASIC_TAC;
21053   TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
21054   TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
21055   REP_BASIC_TAC;
21056   UND 8;
21057   EXPAND_TAC "Y";
21058   REWRITE_TAC[];
21059   REP_BASIC_TAC;
21060   ASM_REWRITE_TAC[];
21061   RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
21062   ASM_MESON_TAC[ISUBSET];
21063   DISCH_TAC;
21064   TYPE_THEN `~(Y = {})` SUBGOAL_TAC;
21065   REWRITE_TAC[EMPTY_EXISTS];
21066   RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
21067   REP_BASIC_TAC;
21068   TYPE_THEN `d u' u` EXISTS_TAC;
21069   EXPAND_TAC "Y";
21070   REWRITE_TAC[];
21071   ASM_MESON_TAC[];
21072   DISCH_TAC;
21073   TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
21074   ASM_MESON_TAC[];
21075   DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
21076   TYPE_THEN `(?p p'. K p /\ K' p' /\ (!q q'. K q /\ K' q' ==> d p p' <= d q q'))` SUBGOAL_TAC;
21077   IMATCH_MP_TAC  compact_distance;
21078   TYPE_THEN `X` EXISTS_TAC;
21079   ASM_REWRITE_TAC[];
21080   REP_BASIC_TAC;
21081   TYPE_THEN `p` EXISTS_TAC;
21082   TYPE_THEN `p'` EXISTS_TAC;
21083   ASM_REWRITE_TAC[];
21084   (* 1 *)
21085   TYPE_THEN `Y (d p p')` SUBGOAL_TAC;
21086   EXPAND_TAC "Y";
21087   REWRITE_TAC[];
21088   ASM_MESON_TAC[];
21089   DISCH_TAC;
21090   IMATCH_MP_TAC  (REAL_ARITH `a <= b /\ b <= a ==> (a = b)`);
21091   CONJ_TAC;
21092   FIRST_ASSUM IMATCH_MP_TAC ;
21093   ASM_REWRITE_TAC[];
21094   FIRST_ASSUM IMATCH_MP_TAC ;
21095   EXPAND_TAC "Y";
21096   REWRITE_TAC[];
21097   REP_BASIC_TAC;
21098   ASM_REWRITE_TAC[];
21099   FIRST_ASSUM IMATCH_MP_TAC ;
21100   ASM_REWRITE_TAC[];
21101   (* Sat Aug  7 13:19:01 EDT 2004 *)
21102
21103   ]);;
21104   (* }}} *)
21105
21106 (* ------------------------------------------------------------------ *)
21107 (* SECTION L *)
21108 (* ------------------------------------------------------------------ *)
21109
21110
21111 let simple_arc_compact = prove_by_refinement(
21112   `!C. simple_arc top2 C ==> compact top2 C`,
21113   (* {{{ proof *)
21114
21115   [
21116   REWRITE_TAC[simple_arc];
21117   REP_BASIC_TAC;
21118   ASM_REWRITE_TAC[];
21119   IMATCH_MP_TAC  image_compact;
21120   TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
21121   ASM_REWRITE_TAC[];
21122   ASM_SIMP_TAC[inj_image_subset;interval_compact;];
21123   (* Sat Aug  7 12:24:22 EDT 2004 *)
21124
21125   ]);;
21126
21127   (* }}} *)
21128
21129 let simple_arc_nonempty = prove_by_refinement(
21130   `!C. simple_arc top2 C ==> ~(C = EMPTY)`,
21131   (* {{{ proof *)
21132   [
21133   REWRITE_TAC[simple_arc;EMPTY_EXISTS;];
21134   REP_BASIC_TAC;
21135   ASM_REWRITE_TAC[IMAGE;];
21136   TYPE_THEN `f (&0)` EXISTS_TAC;
21137   TYPE_THEN `&0` EXISTS_TAC;
21138   REWRITE_TAC[];
21139   REAL_ARITH_TAC;
21140   ]);;
21141   (* }}} *)
21142
21143 let graph_edge_compact = prove_by_refinement(
21144   `!G e. (plane_graph G) /\ (graph_edge G e) ==>
21145       (compact top2 e)`,
21146   (* {{{ proof *)
21147   [
21148   REWRITE_TAC [plane_graph];
21149   REP_BASIC_TAC;
21150   USE 3 (REWRITE_RULE[SUBSET]);
21151   ASM_MESON_TAC[simple_arc_compact];
21152   ]);;
21153   (* }}} *)
21154
21155 let graph_vertex_exist = prove_by_refinement(
21156   `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==>
21157    (?v. graph_vertex G v)`,
21158   (* {{{ proof *)
21159
21160   [
21161   REWRITE_TAC[EMPTY_EXISTS];
21162   REP_BASIC_TAC;
21163   TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC;
21164   ASM_SIMP_TAC[graph_inc_subset];
21165   DISCH_TAC;
21166   TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC;
21167   ASM_SIMP_TAC[graph_edge2;];
21168   REWRITE_TAC[has_size2];
21169   REP_BASIC_TAC;
21170   REWR 2;
21171   UND 2;
21172   REWRITE_TAC[SUBSET ;INR in_pair ];
21173   MESON_TAC[];
21174   ]);;
21175
21176   (* }}} *)
21177
21178 let graph_vertex_2 = prove_by_refinement(
21179   `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==>
21180    (?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))`,
21181   (* {{{ proof *)
21182   [
21183   REWRITE_TAC[EMPTY_EXISTS];
21184   REP_BASIC_TAC;
21185   TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC;
21186   ASM_SIMP_TAC[graph_inc_subset];
21187   DISCH_TAC;
21188   TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC;
21189   ASM_SIMP_TAC[graph_edge2;];
21190   REWRITE_TAC[has_size2];
21191   REP_BASIC_TAC;
21192   REWR 2;
21193   TYPE_THEN `a` EXISTS_TAC;
21194   TYPE_THEN `b` EXISTS_TAC ;
21195   UND 2;
21196   REWRITE_TAC[SUBSET ;INR in_pair ];
21197   ASM_MESON_TAC[];
21198   ]);;
21199   (* }}} *)
21200
21201 let graph_disk_lemma1 = prove_by_refinement(
21202   `!G. plane_graph G /\ FINITE (graph_vertex G) /\ FINITE (graph_edge G)
21203        ==>
21204     FINITE {z | (?e v. graph_edge G e /\ graph_vertex G v /\
21205               ~(graph_inc G e v) /\ (z = (e,v)))}`,
21206   (* {{{ proof *)
21207   [
21208   REP_BASIC_TAC;
21209   TYPE_THEN `Y = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) /\ (z = (e,v)))}` ABBREV_TAC ;
21210   IMATCH_MP_TAC  FINITE_SUBSET;
21211   TYPE_THEN `{(e,v) | graph_edge G e /\ graph_vertex G v}` EXISTS_TAC;
21212   TYPEL_THEN [`graph_edge G `;`graph_vertex G `] (fun t -> ASSUME_TAC (ISPECL t FINITE_PRODUCT));
21213   REWR 4;
21214   ASM_REWRITE_TAC[];
21215   EXPAND_TAC "Y";
21216   REWRITE_TAC[SUBSET];
21217  MESON_TAC[];
21218   (* Sat Aug  7 14:21:19 EDT 2004 *)
21219
21220     ]);;
21221   (* }}} *)
21222
21223 let image_empty = prove_by_refinement(
21224   `!(A:A->bool) (f:A->B). (IMAGE f A = EMPTY) <=> (A = EMPTY)`,
21225   (* {{{ proof *)
21226   [
21227   REWRITE_TAC[IMAGE;FUN_EQ_THM;];
21228   MESON_TAC[];
21229   ]);;
21230   (* }}} *)
21231
21232 (* not used *)
21233 let pair_apply = prove_by_refinement(
21234   `!P. (!x. P x) <=> ! (u:A) (v:B) . P (u,v)`,
21235   (* {{{ proof *)
21236   [
21237   REP_BASIC_TAC;
21238   EQ_TAC;
21239   REP_BASIC_TAC;
21240   TSPEC `(u,v)` 0;
21241   ASM_REWRITE_TAC[];
21242   REP_BASIC_TAC;
21243   TYPEL_THEN [`FST x`;`SND x`] (USE 0 o ISPECL);
21244   USE 0(REWRITE_RULE[]);
21245   ASM_REWRITE_TAC[];
21246   ]);;
21247   (* }}} *)
21248
21249 let set_dist_pos = prove_by_refinement(
21250   `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
21251      ~(K = EMPTY) /\      ~(K' = EMPTY) /\
21252     (compact (top_of_metric(X,d)) K) /\
21253     (compact (top_of_metric (X,d)) K') /\ (K INTER K' = EMPTY) /\
21254       (K' SUBSET X) ==>
21255     (&0 < (set_dist d K K' ))`,
21256   (* {{{ proof *)
21257   [
21258   REP_BASIC_TAC;
21259   IMATCH_MP_TAC  (REAL_ARITH  `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`);
21260   CONJ_TAC;
21261   TYPE_THEN `(?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))` SUBGOAL_TAC;
21262   IMATCH_MP_TAC  set_dist_eq;
21263   TYPE_THEN `X` EXISTS_TAC;
21264   ASM_REWRITE_TAC[];
21265   REP_BASIC_TAC;
21266   TYPE_THEN `p = p'` SUBGOAL_TAC;
21267   REWR 9;
21268   TYPE_THEN `X p /\ X p'` SUBGOAL_TAC;
21269   ASM_MESON_TAC[ISUBSET];
21270   DISCH_TAC;
21271   USE 9 SYM;
21272   REP_BASIC_TAC;
21273   UND 9;
21274   ASM_MESON_TAC  [metric_space_zero2];
21275   UND 1;
21276   UND 10;
21277   UND 11;
21278   REWRITE_TAC[EQ_EMPTY;INTER;];
21279   MESON_TAC[];
21280   IMATCH_MP_TAC  set_dist_nn;
21281   TYPE_THEN `X` EXISTS_TAC;
21282   ASM_REWRITE_TAC[];
21283   ]);;
21284   (* }}} *)
21285
21286 let closed_ball_inter = prove_by_refinement(
21287   `!(x:A) y r r' X d. (metric_space(X,d) /\
21288     ~(closed_ball(X,d) x r INTER closed_ball(X,d) y r' = EMPTY) ==>
21289    (d x y <= r + r'))`,
21290   (* {{{ proof *)
21291
21292   [
21293   REWRITE_TAC[closed_ball;EMPTY_EXISTS;INTER];
21294   REP_BASIC_TAC;
21295   TYPE_THEN `d x y <= d x u + d u y` SUBGOAL_TAC;
21296   IMATCH_MP_TAC  metric_space_triangle;
21297   ASM_MESON_TAC[];
21298   TYPE_THEN `d u y = d y u` SUBGOAL_TAC;
21299   IMATCH_MP_TAC  metric_space_symm;
21300   ASM_MESON_TAC[];
21301   UND 0;
21302   UND 3;
21303   REAL_ARITH_TAC;
21304   ]);;
21305
21306   (* }}} *)
21307
21308 let graph_disk = prove_by_refinement(
21309   `!G. plane_graph G /\
21310        FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
21311      ~(graph_edge G = EMPTY)
21312       ==> (?r. (&0 < r ) /\
21313      (!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==>
21314         (closed_ball (euclid 2,d_euclid) v r INTER
21315             closed_ball (euclid 2,d_euclid) v' r = EMPTY)) /\
21316      (!e v. (graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) ==>
21317            (e INTER closed_ball (euclid 2,d_euclid) v r = EMPTY) )))`,
21318   (* {{{ proof *)
21319
21320   [
21321     REP_BASIC_TAC;
21322   (* A' *)
21323   TYPE_THEN `A = { (v,v') |  (graph_vertex G v) /\ graph_vertex G v' /\ ~(v = v') }` ABBREV_TAC ;
21324   TYPE_THEN `FINITE A` SUBGOAL_TAC;
21325   IMATCH_MP_TAC  FINITE_SUBSET;
21326   TYPE_THEN `{ (v,v') | (graph_vertex G v) /\ graph_vertex G v'}` EXISTS_TAC;
21327   TYPEL_THEN  [`graph_vertex G`;`graph_vertex G`] (fun t-> ASSUME_TAC (ISPECL   t FINITE_PRODUCT));
21328   REWR 5;
21329   ASM_REWRITE_TAC[];
21330   EXPAND_TAC "A";
21331   REWRITE_TAC[SUBSET];
21332   MESON_TAC[];
21333   DISCH_TAC;
21334   TYPE_THEN `A' = IMAGE  (\ (v,v'). (d_euclid v v')/(&2)) A` ABBREV_TAC ;
21335   TYPE_THEN `FINITE A'` SUBGOAL_TAC;
21336   EXPAND_TAC "A'";
21337   IMATCH_MP_TAC  FINITE_IMAGE;
21338   ASM_REWRITE_TAC[];
21339   DISCH_TAC;
21340   (* [B] *)
21341   TYPE_THEN `B = { (e,v) | graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) }` ABBREV_TAC ;
21342   TYPE_THEN `B' = IMAGE (\ (e,v). (set_dist d_euclid {v} e)) B`  ABBREV_TAC ;
21343   TYPE_THEN `FINITE B'` SUBGOAL_TAC;
21344   EXPAND_TAC "B'";
21345   IMATCH_MP_TAC  FINITE_IMAGE;
21346   TYPE_THEN `B = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~( graph_inc G e v) /\ (z = (e,v)))}` SUBGOAL_TAC;
21347   EXPAND_TAC "B";
21348   IMATCH_MP_TAC  EQ_EXT;
21349   REWRITE_TAC[];
21350   MESON_TAC[];
21351   DISCH_THEN_REWRITE;
21352   IMATCH_MP_TAC  graph_disk_lemma1;
21353   ASM_REWRITE_TAC[];
21354   DISCH_TAC;
21355   (* [C] : A' B' C nonempty *)
21356   TYPE_THEN `C' = A' UNION B'` ABBREV_TAC ;
21357   TYPE_THEN `FINITE C' /\ ~(C' = EMPTY)` SUBGOAL_TAC;
21358   EXPAND_TAC "C'";
21359   ASM_REWRITE_TAC[FINITE_UNION];
21360   EXPAND_TAC "C'";
21361   REWRITE_TAC[EMPTY_EXISTS;UNION;];
21362   TYPE_THEN `~(A' = EMPTY)` SUBGOAL_TAC;
21363   EXPAND_TAC "A'";
21364   REWRITE_TAC[image_empty; ];
21365   TYPE_THEN `(?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))` SUBGOAL_TAC;
21366   IMATCH_MP_TAC graph_vertex_2;
21367   ASM_REWRITE_TAC[];
21368   ASM_MESON_TAC[plane_graph];
21369   REP_BASIC_TAC;
21370   UND 12;
21371   REWRITE_TAC[];
21372   EXPAND_TAC "A";
21373   REWRITE_TAC[EMPTY_EXISTS];
21374   CONV_TAC (dropq_conv "u");
21375   TYPE_THEN `v` EXISTS_TAC;
21376   TYPE_THEN `v'` EXISTS_TAC ;
21377   ASM_REWRITE_TAC[];
21378   REWRITE_TAC[EMPTY_EXISTS];
21379   MESON_TAC[];
21380   DISCH_TAC;
21381   (* [D]:  C(inf C) *)
21382   TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
21383   UND 3;
21384   REWRITE_TAC[plane_graph];
21385   MESON_TAC[];
21386   DISCH_TAC;
21387   (* -- *)
21388   TYPE_THEN `C'(inf C')` SUBGOAL_TAC;
21389   IMATCH_MP_TAC  finite_inf;
21390   ASM_REWRITE_TAC[];
21391   DISCH_TAC;
21392   (* -- *)
21393   TYPE_THEN `!x. C' x ==> (inf C' <= x)` SUBGOAL_TAC;
21394   IMATCH_MP_TAC  finite_inf_min;
21395   ASM_REWRITE_TAC[];
21396   DISCH_TAC;
21397   (* -- *)
21398   TYPE_THEN `!v. (graph_vertex G v ==> compact top2 {v})` SUBGOAL_TAC;
21399   REP_BASIC_TAC;
21400   IMATCH_MP_TAC  compact_point;
21401   UND 13;
21402   REWRITE_TAC[SUBSET;top2_unions];
21403   UND 12;
21404   MESON_TAC[];
21405   DISCH_TAC;
21406   (* -- *)
21407   TYPE_THEN `!e. (graph_edge G e ==> compact top2 e)` SUBGOAL_TAC;
21408   ASM_MESON_TAC[graph_edge_compact];
21409   DISCH_TAC;
21410   (* -- *)
21411   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;
21412   EXPAND_TAC "A'";
21413   EXPAND_TAC "A";
21414   REWRITE_TAC[IMAGE];
21415   NAME_CONFLICT_TAC;
21416   CONV_TAC (dropq_conv "x'");
21417 (*** Next steps removed by JRH: now paired beta-conversion automatic ***)
21418   DISCH_TAC;
21419   (* -- *)
21420   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'))`
21421   SUBGOAL_TAC;
21422   EXPAND_TAC "B'";
21423   EXPAND_TAC "B";
21424   REWRITE_TAC[IMAGE];
21425   NAME_CONFLICT_TAC;
21426   CONV_TAC (dropq_conv "x'");
21427 (*** Next steps removed by JRH: now paired beta-conversion automatic ***)
21428   DISCH_TAC;
21429   (* -- [temp] *)
21430   TYPE_THEN `!x. C' x ==> (&0 < x)` SUBGOAL_TAC;
21431   EXPAND_TAC "C'";
21432   REWRITE_TAC[UNION];
21433   GEN_TAC;
21434   DISCH_THEN DISJ_CASES_TAC;
21435   UND 20;
21436   ASM_REWRITE_TAC[];
21437   REP_BASIC_TAC;
21438   ASM_REWRITE_TAC[REAL_LT_HALF1];
21439   IMATCH_MP_TAC  (REAL_ARITH `(&0 <= y /\ ~(y = &0) ) ==> &0 < y `);
21440   TYPE_THEN `euclid 2 v' /\ euclid 2 v''` SUBGOAL_TAC;
21441   ASM_MESON_TAC[ISUBSET];
21442   UND 20;
21443   ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;];
21444   (* -2-  *)
21445   UND 20;
21446   ASM_REWRITE_TAC[];
21447   REP_BASIC_TAC;
21448   ASM_REWRITE_TAC[];
21449   IMATCH_MP_TAC  set_dist_pos;
21450   TYPE_THEN `euclid 2` EXISTS_TAC ;
21451   REWRITE_TAC[metric_euclid;single_subset];
21452   CONJ_TAC;
21453   UND 13;
21454   REWRITE_TAC[SUBSET];
21455   UND 21;
21456   MESON_TAC[];
21457   CONJ_TAC;
21458   REWRITE_TAC[EMPTY_EXISTS;INR IN_SING;];
21459   MESON_TAC[];
21460   CONJ_TAC;
21461   IMATCH_MP_TAC  simple_arc_nonempty;
21462   UND 3;
21463   UND 22;
21464   REWRITE_TAC[plane_graph;SUBSET;];
21465   MESON_TAC[];
21466   REWRITE_TAC[GSYM top2];
21467   ASM_SIMP_TAC[];
21468   CONJ_TAC;
21469   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
21470   REP_BASIC_TAC;
21471   TSPEC `e'` 25;
21472   REWR 25;
21473   TYPE_THEN `v'` (fun u -> FIRST_ASSUM (fun t-> (MP_TAC (AP_THM t u))));
21474   ASM_REWRITE_TAC[EQ_EMPTY;];
21475   REWRITE_TAC[INTER];
21476   ASM_REWRITE_TAC[INR IN_SING;];
21477   MESON_TAC[];
21478   UND 22;
21479   UND 17;
21480   REWRITE_TAC[compact;top2_unions];
21481   MESON_TAC[];
21482   DISCH_TAC;
21483   (* [E] r good for A' *)
21484   TYPE_THEN `?r. (&0 < r /\ r < inf C')` SUBGOAL_TAC;
21485   TYPE_THEN `inf C' /(&2)` EXISTS_TAC;
21486   IMATCH_MP_TAC  half_pos;
21487   UND 20;
21488   UND 14;
21489   MESON_TAC[];
21490   REP_BASIC_TAC;
21491   TYPE_THEN `r` EXISTS_TAC;
21492   ASM_REWRITE_TAC[];
21493   CONJ_TAC;
21494   REP_BASIC_TAC;
21495   TYPE_THEN `A' ((d_euclid v v')/(&2))` SUBGOAL_TAC;
21496   ASM_REWRITE_TAC[];
21497   ASM_MESON_TAC[];
21498   DISCH_TAC;
21499   (* -2- *)
21500   TYPE_THEN `r < ((d_euclid v v')/(&2))` SUBGOAL_TAC;
21501   IMATCH_MP_TAC  (REAL_ARITH `(?t . (r < t /\ t <= u)) ==> (r < u)`);
21502   TYPE_THEN `inf C'` EXISTS_TAC;
21503   ASM_REWRITE_TAC[];
21504   FIRST_ASSUM IMATCH_MP_TAC ;
21505   EXPAND_TAC "C'";
21506   REWRITE_TAC[UNION];
21507   ASM_REWRITE_TAC[];
21508   DISCH_TAC;
21509   REWRITE_TAC[EQ_EMPTY ;INTER;];
21510   REP_BASIC_TAC;
21511   (* -2- triangle ineq *)
21512   UND 29;
21513   UND 30;
21514   UND 28;
21515   UND 21;
21516   POP_ASSUM_LIST (fun t-> ALL_TAC);
21517   REP_BASIC_TAC;
21518   (* [* temp] *)
21519   TYPE_THEN `d_euclid v v' <= r + r` SUBGOAL_TAC;
21520   IMATCH_MP_TAC  closed_ball_inter;
21521   TYPE_THEN `euclid 2` EXISTS_TAC;
21522   REWRITE_TAC[INTER;EMPTY_EXISTS ;metric_euclid;];
21523   ASM_MESON_TAC[];
21524   DISCH_TAC;
21525   TYPE_THEN `d_euclid v v' < d_euclid v v'/(&2) + d_euclid v v'/(&2)` SUBGOAL_TAC;
21526   IMATCH_MP_TAC  (REAL_ARITH `(?t. (d <= t + t /\ t < u)) ==> (d < u + u)`);
21527   TYPE_THEN `r` EXISTS_TAC;
21528   ASM_REWRITE_TAC[];
21529   REWRITE_TAC[REAL_HALF_DOUBLE];
21530   REAL_ARITH_TAC;
21531   (* [F] good for B' *)
21532   REP_BASIC_TAC;
21533   PROOF_BY_CONTR_TAC;
21534   USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER;]);
21535   REP_BASIC_TAC;
21536   (* -- *)
21537   TYPE_THEN `B' (set_dist d_euclid {v} e)` SUBGOAL_TAC;
21538   ASM_REWRITE_TAC[];
21539   TYPE_THEN `e` EXISTS_TAC;
21540   TYPE_THEN `v` EXISTS_TAC;
21541   ASM_REWRITE_TAC[];
21542   DISCH_TAC;
21543   (* -- *)
21544   TYPE_THEN `r < set_dist d_euclid {v} e` SUBGOAL_TAC;
21545   IMATCH_MP_TAC  (REAL_ARITH `(?t. (r < t /\ t <= q)) ==> (r < q)`);
21546   TYPE_THEN `inf C'` EXISTS_TAC;
21547   ASM_REWRITE_TAC[];
21548   FIRST_ASSUM IMATCH_MP_TAC ;
21549   EXPAND_TAC "C'";
21550   REWRITE_TAC[UNION];
21551   ASM_REWRITE_TAC[];
21552   DISCH_TAC;
21553   (* -- *)
21554   TYPE_THEN `(!p p'. ({v} p /\ e p' ==> (set_dist d_euclid {v} e <= d_euclid p p')))` SUBGOAL_TAC;
21555   IMATCH_MP_TAC  set_dist_inf;
21556   TYPE_THEN `euclid 2` EXISTS_TAC;
21557   ASM_REWRITE_TAC[metric_euclid;single_subset;];
21558   CONJ_TAC;
21559   UND 13;
21560   UND 25;
21561   MESON_TAC[ISUBSET];
21562   UND 17;
21563   UND 26;
21564   REWRITE_TAC[compact;top2_unions;];
21565   MESON_TAC[];
21566   DISCH_TAC;
21567   TYPE_THEN `set_dist d_euclid {v} e <= d_euclid v u` SUBGOAL_TAC;
21568   FIRST_ASSUM IMATCH_MP_TAC ;
21569   ASM_REWRITE_TAC[INR IN_SING];
21570   TYPE_THEN `d_euclid v u <= r` SUBGOAL_TAC;
21571   UND 27;
21572   REWRITE_TAC[closed_ball];
21573   MESON_TAC[];
21574   UND 30;
21575   REAL_ARITH_TAC;
21576   (* Sat Aug  7 21:33:13 EDT 2004 *)
21577
21578   ]);;
21579
21580   (* }}} *)
21581
21582 let norm2 = jordan_def `norm2 x = d_euclid x euclid0`;;
21583
21584 let cis = jordan_def `cis x = point(cos(x),sin(x))`;;
21585
21586 let norm2_cis = prove_by_refinement(
21587   `!x. norm2(cis(x)) = &1`,
21588   (* {{{ proof *)
21589   [
21590   REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point];
21591   REDUCE_TAC;
21592   ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`];
21593   REWRITE_TAC[SIN_CIRCLE;SQRT_1];
21594   (* Sat Aug  7 21:47:16 EDT 2004 *)
21595   ]);;
21596   (* }}} *)
21597
21598 let norm2_nn = prove_by_refinement(
21599   `!x . (euclid 2 x) ==> &0 <= norm2 x`,
21600   (* {{{ proof *)
21601   [
21602   REWRITE_TAC[norm2;euclid0_point];
21603   ASM_MESON_TAC[d_euclid_pos;euclid_point];
21604   (* Sat Aug  7 21:52:31 EDT 2004 *)
21605
21606   ]);;
21607   (* }}} *)
21608
21609 let norm2_0 = prove_by_refinement(
21610   `!x. (euclid 2 x) /\ (norm2 x = &0) <=> (x = euclid0)`,
21611   (* {{{ proof *)
21612   [
21613   REP_BASIC_TAC;
21614   EQ_TAC;
21615   REWRITE_TAC[norm2;euclid0_point;];
21616   MESON_TAC[d_euclid_zero;euclid_point];
21617   DISCH_THEN_REWRITE;
21618   REWRITE_TAC[euclid0_point;euclid_point;norm2;];
21619   ASM_MESON_TAC[d_euclid_zero;euclid_point];
21620   (* Sat Aug  7 21:59:11 EDT 2004 *)
21621   ]);;
21622   (* }}} *)
21623
21624 let cis_inj = prove_by_refinement(
21625   `!t t'. (&0 <= t /\ t < &2*pi) /\ (&0 <= t' /\ t' < &2*pi) ==>
21626       ((cis t = cis t') <=> (t = t'))`,
21627   (* {{{ proof *)
21628   [
21629   (* A trivial direction *)
21630   REP_BASIC_TAC;
21631   REWRITE_TAC[cis;point_inj;PAIR_SPLIT ];
21632   ONCE_REWRITE_TAC [EQ_SYM_EQ];
21633   EQ_TAC;
21634   DISCH_THEN_REWRITE;
21635   (* B  range of s *)
21636   REP_BASIC_TAC;
21637   TYPE_THEN `s = (\t. (if (t < pi) then t else ((&2)*pi - t)))` ABBREV_TAC ;
21638   TYPE_THEN `!t. (&0 <= t /\ t < (&2 * pi)) ==> (&0 <= s t /\ s t <= pi)` SUBGOAL_TAC;
21639   REP_BASIC_TAC;
21640   EXPAND_TAC "s";
21641   COND_CASES_TAC;
21642   UND 9;
21643   UND 8;
21644   REAL_ARITH_TAC;
21645   CONJ_TAC;
21646   UND 7;
21647   REAL_ARITH_TAC;
21648   REWRITE_TAC[REAL_MUL_2;];
21649   UND 9;
21650   REAL_ARITH_TAC;
21651   DISCH_TAC;
21652   (* [C] : cos (s t) *)
21653   TYPE_THEN `!t. cos (s t) = cos t` SUBGOAL_TAC;
21654   EXPAND_TAC "s";
21655   GEN_TAC;
21656   COND_CASES_TAC;
21657   REWRITE_TAC[];
21658   REWRITE_TAC  [REAL_ARITH `x - t = (--. t + x)`;COS_PERIODIC;COS_NEG];
21659   DISCH_TAC;
21660   (* D : (s t) = (s t') *)
21661   TYPE_THEN `(s t= s t') ==> ((t = t') \/ (t' = (&2 * pi - t)))` SUBGOAL_TAC;
21662   EXPAND_TAC "s";
21663   COND_CASES_TAC;
21664   COND_CASES_TAC;
21665   MESON_TAC[];
21666   REAL_ARITH_TAC;
21667   COND_CASES_TAC;
21668   REAL_ARITH_TAC;
21669   REAL_ARITH_TAC;
21670   DISCH_TAC;
21671   (* E : show s t = s t' *)
21672   USE 8 GSYM;
21673   UND 5;
21674   (ASM ONCE_REWRITE_TAC []);
21675   DISCH_THEN (fun t -> MP_TAC (AP_TERM `acs` t));
21676   DISCH_TAC;
21677   TYPE_THEN `s t = s t'` SUBGOAL_TAC;
21678   TYPE_THEN `acs (cos (s t)) = s t` SUBGOAL_TAC;
21679   IMATCH_MP_TAC  COS_ACS;
21680   FIRST_ASSUM IMATCH_MP_TAC ;
21681   ASM_REWRITE_TAC[];
21682   TYPE_THEN `acs (cos (s t')) = s t'` SUBGOAL_TAC;
21683   IMATCH_MP_TAC  COS_ACS;
21684   FIRST_ASSUM IMATCH_MP_TAC ;
21685   ASM_REWRITE_TAC[];
21686   ASM_MESON_TAC[];
21687   DISCH_TAC;
21688   REWR 9;
21689   FIRST_ASSUM DISJ_CASES_TAC;
21690   ASM_REWRITE_TAC[];
21691   PROOF_BY_CONTR_TAC;
21692   UND 4;
21693   ASM_REWRITE_TAC[];
21694   REWRITE_TAC[(REAL_ARITH `x - y = -- y + x`);SIN_PERIODIC ;SIN_NEG ;];
21695   REWRITE_TAC [(REAL_ARITH `(x = --x) <=> (x = &0)`)];
21696   REWRITE_TAC[SIN_ZERO_PI];
21697   PROOF_BY_CONTR_TAC;
21698   USE 4 (REWRITE_RULE[]);
21699   (* now t is a MULT of pi, finish *)
21700   FIRST_ASSUM DISJ_CASES_TAC;
21701   REP_BASIC_TAC;
21702   UND 2;
21703   ASM_REWRITE_TAC[];
21704   ASSUME_TAC PI_POS;
21705   ASM_SIMP_TAC[REAL_LT_RMUL_EQ];
21706   REWRITE_TAC  [REAL_LT];
21707   REWRITE_TAC[ARITH_RULE  `n <| 2 <=> (n = 0) \/ (n =1)`];
21708   DISCH_TAC;
21709   FIRST_ASSUM DISJ_CASES_TAC;
21710   REWR 13;
21711   REWR 11;
21712   UND 0;
21713   ASM_REWRITE_TAC[];
21714   REAL_ARITH_TAC;
21715   UND 12;
21716   ASM_REWRITE_TAC[];
21717   REAL_ARITH_TAC;
21718   REP_BASIC_TAC;
21719   UND 3;
21720   ASM_REWRITE_TAC[];
21721   ASSUME_TAC PI_POS;
21722   REWRITE_TAC[REAL_ARITH (` ~(&0 <= -- x) <=> (&0 <. x) `)];
21723   IMATCH_MP_TAC  REAL_LT_MUL;
21724   ASM_REWRITE_TAC[REAL_LT ];
21725   REWRITE_TAC[ARITH_RULE  `0 <| n <=> ~(n = 0)`];
21726   DISCH_TAC;
21727   UND 0;
21728   ASM_REWRITE_TAC[];
21729   REAL_ARITH_TAC;
21730   (* Sun Aug  8 08:42:13 EDT 2004 *)
21731
21732   ]);;
21733   (* }}} *)
21734
21735 let norm2_scale_cis = prove_by_refinement(
21736   `!x r. norm2(r *# cis(x)) = abs (r)`,
21737   (* {{{ proof *)
21738
21739   [
21740   REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;];
21741   REDUCE_TAC;
21742   REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB];
21743   ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`];
21744   REWRITE_TAC[SIN_CIRCLE;REAL_MUL_RID;POW_2_SQRT_ABS];
21745   (* Sun Aug  8 08:46:56 EDT 2004 *)
21746
21747   ]);;
21748
21749   (* }}} *)
21750
21751 let norm2_scale = prove_by_refinement(
21752   `!x r. (euclid 2 x) ==> (norm2(r *# x) = abs (r)*norm2(x))`,
21753   (* {{{ proof *)
21754   [
21755   REP_BASIC_TAC;
21756   TYPE_THEN `?u v. (x = point(u,v))` SUBGOAL_TAC;
21757   USE 0 (MATCH_MP point_onto);
21758   REP_BASIC_TAC;
21759   TYPE_THEN `FST p` EXISTS_TAC;
21760   TYPE_THEN `SND p` EXISTS_TAC;
21761   ASM_REWRITE_TAC[];
21762   REP_BASIC_TAC;
21763   ASM_REWRITE_TAC[];
21764   REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;];
21765   REDUCE_TAC;
21766   REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB];
21767   REWRITE_TAC[GSYM POW_2_SQRT_ABS];
21768   IMATCH_MP_TAC  SQRT_MUL;
21769   REWRITE_TAC[REAL_LE_SQUARE_POW];
21770   IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`);
21771   REWRITE_TAC[REAL_LE_SQUARE_POW];
21772
21773   ]);;
21774   (* }}} *)
21775
21776 let polar_inj = prove_by_refinement(
21777   `!x x' r r'. (&0 <= r) /\ (&0 <= r') /\ (&0 <= x) /\ (&0 <= x') /\
21778      (x < &2 *pi) /\ (x' < &2 * pi) /\ (r *# cis(x) = r' *# cis(x')) ==>
21779      ((r = &0) /\ (r' = &0)) \/ ((r = r') /\ (x = x'))`,
21780   (* {{{ proof *)
21781
21782   [
21783   REP_BASIC_TAC;
21784   TYPE_THEN `abs  r = abs  r'` SUBGOAL_TAC;
21785   FIRST_ASSUM (fun t -> MP_TAC (AP_TERM `norm2` t));
21786   REWRITE_TAC[norm2_scale_cis];
21787   DISCH_TAC;
21788   TYPE_THEN `r' = r` SUBGOAL_TAC;
21789   ASM_MESON_TAC[ABS_REFL];
21790   DISCH_TAC;
21791   ASM_REWRITE_TAC[];
21792   ASM_CASES_TAC `(r = &0)` ;
21793   ASM_REWRITE_TAC[];
21794   ASM_REWRITE_TAC[];
21795   REWR 0;
21796   TYPE_THEN `cis x = cis x'` SUBGOAL_TAC;
21797   IMATCH_MP_TAC  euclid_scale_cancel;
21798   ASM_MESON_TAC[];
21799   ASM_MESON_TAC[cis_inj];
21800   ]);;
21801
21802   (* }}} *)
21803
21804 let norm2_bounds = prove_by_refinement(
21805   `!a b s t. (&0 < a) /\ (a < b) /\ (&0 <= t) /\ (t <= &1) ==>
21806     (a <= norm2((a + t*(b-a))*# cis(s))) /\
21807     ( norm2((a + t*(b-a))*# cis(s)) <= b) `,
21808   (* {{{ proof *)
21809   [
21810   REP_BASIC_TAC;
21811   REWRITE_TAC[norm2_scale_cis];
21812   TYPE_THEN `a <= a + t*(b - a)` SUBGOAL_TAC;
21813   REWRITE_TAC[REAL_ARITH `x <= x + y <=> (&0 <= y)`];
21814   IMATCH_MP_TAC  REAL_LE_MUL;
21815   ASM_REWRITE_TAC[];
21816   UND 2;
21817   REAL_ARITH_TAC;
21818   DISCH_TAC;
21819   TYPE_THEN `&0 <= a + t*(b-a)` SUBGOAL_TAC;
21820   UND 4;
21821   UND 3;
21822   REAL_ARITH_TAC;
21823   DISCH_TAC;
21824   TYPE_THEN `abs  (a + t*(b-a)) = a + t*(b-a)` SUBGOAL_TAC;
21825   REWRITE_TAC[ABS_REFL];
21826   ASM_REWRITE_TAC[];
21827   DISCH_THEN_REWRITE;
21828   ASM_REWRITE_TAC[];
21829   ineq_le_tac `(a + t*(b-a)) + (&1 - t)*(b - a) = b`;
21830   (* Sun Aug  8 09:12:18 EDT 2004  *)
21831
21832   ]);;
21833   (* }}} *)
21834
21835 let norm2_point = prove_by_refinement(
21836   `!u v. norm2(point(u,v)) = sqrt(u pow 2 + v pow 2)`,
21837   (* {{{ proof *)
21838   [
21839   REWRITE_TAC[norm2;euclid0_point;d_euclid_point;];
21840   REDUCE_TAC;
21841   ]);;
21842   (* }}} *)
21843
21844 let cis_exist_lemma = prove_by_refinement(
21845   `!x. (euclid 2 x) /\ (norm2 x = &1) ==>
21846     (? t. x =  cis(t))`,
21847   (* {{{ proof *)
21848   [
21849   REP_BASIC_TAC;
21850   TYPE_THEN `? u v. x = point (u,v)` SUBGOAL_TAC;
21851   USE 1 (MATCH_MP point_onto);
21852   REP_BASIC_TAC;
21853   TYPE_THEN `FST p` EXISTS_TAC;
21854   TYPE_THEN `SND p` EXISTS_TAC;
21855   ASM_REWRITE_TAC[];
21856   REP_BASIC_TAC;
21857   ASM_REWRITE_TAC[];
21858   REWR 0;
21859   UND 0;
21860   REWRITE_TAC[norm2_point];
21861   DISCH_TAC;
21862   USE 0 (fun t -> AP_TERM `\t. t pow 2` t);
21863   UND 0;
21864   BETA_TAC;
21865   REDUCE_TAC;
21866   TYPE_THEN `(sqrt (u pow 2 + v pow 2) pow 2 = u pow 2 + v pow 2)` SUBGOAL_TAC;
21867   IMATCH_MP_TAC  SQRT_POW_2;
21868   IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`);
21869   ASM_REWRITE_TAC[REAL_LE_POW_2];
21870   DISCH_THEN_REWRITE;
21871   DISCH_THEN (fun t -> MP_TAC (MATCH_MP CIRCLE_SINCOS t));
21872   REP_BASIC_TAC;
21873   ASM_REWRITE_TAC[cis];
21874   MESON_TAC[];
21875
21876   ]);;
21877   (* }}} *)
21878
21879 let cos_period = prove_by_refinement(
21880   `! j t. (cos (t + &j * &2 *pi) = cos(t))`,
21881   (* {{{ proof *)
21882   [
21883   INDUCT_TAC;
21884   REDUCE_TAC;
21885   REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;];
21886   REDUCE_TAC;
21887   REWRITE_TAC[COS_PERIODIC];
21888   ASM_REWRITE_TAC[];
21889   ]);;
21890   (* }}} *)
21891
21892 let sin_period = prove_by_refinement(
21893   `! j t. (sin (t + &j * &2 *pi) = sin(t))`,
21894   (* {{{ proof *)
21895   [
21896   INDUCT_TAC;
21897   REDUCE_TAC;
21898   REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;];
21899   REDUCE_TAC;
21900   REWRITE_TAC[SIN_PERIODIC];
21901   ASM_REWRITE_TAC[];
21902   ]);;
21903   (* }}} *)
21904
21905 let cos_period_neg = prove_by_refinement(
21906   `! j t. (cos (t - &j * &2 *pi) = cos(t))`,
21907   (* {{{ proof *)
21908   [
21909   REP_BASIC_TAC;
21910   ASSUME_TAC cos_period;
21911   TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL);
21912   RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]);
21913   USE 0 SYM;
21914   ASM_REWRITE_TAC[];
21915   ]);;
21916   (* }}} *)
21917
21918 let sin_period_neg = prove_by_refinement(
21919   `! j t. (sin (t - &j * &2 *pi) = sin(t))`,
21920   (* {{{ proof *)
21921   [
21922   REP_BASIC_TAC;
21923   ASSUME_TAC sin_period;
21924   TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL);
21925   RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]);
21926   USE 0 SYM;
21927   ASM_REWRITE_TAC[];
21928   ]);;
21929   (* }}} *)
21930
21931 let cos_period_int = prove_by_refinement(
21932   `!m t. (cos (t + real_of_int m * &2 *pi) = cos (t))`,
21933   (* {{{ proof *)
21934   [
21935   REP_BASIC_TAC;
21936   ASSUME_TAC INT_REP2 ;
21937   TSPEC `m` 0;
21938   REP_BASIC_TAC;
21939   FIRST_ASSUM DISJ_CASES_TAC;
21940   ASM_REWRITE_TAC[int_of_num_th;cos_period];
21941   ASM_REWRITE_TAC[int_of_num_th;int_neg_th;cos_period_neg;GSYM real_sub;REAL_MUL_LNEG];
21942   ]);;
21943   (* }}} *)
21944
21945 let sin_period_int = prove_by_refinement(
21946   `!m t. (sin (t + real_of_int m * &2 *pi) = sin (t))`,
21947   (* {{{ proof *)
21948   [
21949   REP_BASIC_TAC;
21950   ASSUME_TAC INT_REP2 ;
21951   TSPEC `m` 0;
21952   REP_BASIC_TAC;
21953   FIRST_ASSUM DISJ_CASES_TAC;
21954   ASM_REWRITE_TAC[int_of_num_th;sin_period];
21955   ASM_REWRITE_TAC[int_of_num_th;int_neg_th;sin_period_neg;GSYM real_sub;REAL_MUL_LNEG];
21956   ]);;
21957   (* }}} *)
21958
21959 let cos_sin_reduce = prove_by_refinement(
21960   `!t. ?t'. (cos t = cos t') /\
21961       (sin t = sin t') /\ (&0 <= t') /\ (t' < &2 * pi)`,
21962   (* {{{ proof *)
21963
21964   [
21965   REP_BASIC_TAC;
21966     ASSUME_TAC floor_ineq;
21967   TSPEC `t/(&2 *pi)` 0;
21968   TYPE_THEN `f = floor (t/(&2 * pi))` ABBREV_TAC ;
21969   REP_BASIC_TAC;
21970   TYPE_THEN `t' = t - real_of_int(f)*(&2)*pi` ABBREV_TAC  ;
21971   TYPE_THEN `t'` EXISTS_TAC;
21972   TYPE_THEN `t' = t + real_of_int (--: f) *(&2)*pi` SUBGOAL_TAC;
21973   EXPAND_TAC "t'";
21974   REWRITE_TAC[REAL_ARITH `x -y = x + (-- y)`;REAL_ARITH `-- (x * y) = (-- x)*y`;GSYM int_neg_th];
21975   DISCH_TAC;
21976   CONJ_TAC;
21977   ASM_REWRITE_TAC[cos_period_int];
21978   CONJ_TAC;
21979   ASM_REWRITE_TAC[sin_period_int];
21980   EXPAND_TAC "t'";
21981   TYPE_THEN `&0 < (&2 *pi)` SUBGOAL_TAC;
21982   REWRITE_TAC[REAL_MUL_2];
21983   MP_TAC PI_POS;
21984   REAL_ARITH_TAC;
21985   DISCH_TAC;
21986   TYPE_THEN `~(&0 = &2* pi)` SUBGOAL_TAC;
21987   UND 5;
21988   REAL_ARITH_TAC;
21989   DISCH_TAC;
21990   TYPE_THEN `t = (t/(&2 *pi))*(&2 *pi)` SUBGOAL_TAC;
21991   ASM_SIMP_TAC[REAL_DIV_RMUL];
21992   DISCH_TAC;
21993   USE 7 SYM ;
21994   TYPE_THEN `&0 <= (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi)` SUBGOAL_TAC;
21995   REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
21996   IMATCH_MP_TAC  REAL_LE_MUL;
21997   UND 2;
21998   UND 5;
21999   REAL_ARITH_TAC;
22000     KILL 4;
22001   ASM_REWRITE_TAC[];
22002   DISCH_THEN_REWRITE;
22003   EXPAND_TAC "t'";
22004   TYPE_THEN ` (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi) < &1* &2*pi` SUBGOAL_TAC;
22005   REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
22006   IMATCH_MP_TAC  REAL_LT_RMUL;
22007   UND 0;
22008   UND 5;
22009   REAL_ARITH_TAC;
22010   ASM_REWRITE_TAC[];
22011   REDUCE_TAC;
22012   (* Tue Aug 10 09:57:36 EDT 2004 *)
22013
22014   ]);;
22015
22016   (* }}} *)
22017
22018 let cis_lemma = prove_by_refinement(
22019   `!x. (euclid 2 x) /\ (norm2 x = &1) ==>
22020     (?t. &0 <= t /\ t < &2 * pi /\ (x = cis t))`,
22021   (* {{{ proof *)
22022   [
22023   REP_BASIC_TAC;
22024   TYPE_THEN `(?t. x = cis t)` SUBGOAL_TAC;
22025   IMATCH_MP_TAC  cis_exist_lemma;
22026   ASM_REWRITE_TAC[];
22027   REP_BASIC_TAC;
22028   ASSUME_TAC cos_sin_reduce;
22029   TSPEC `t` 3;
22030   REP_BASIC_TAC;
22031   ASM_REWRITE_TAC[cis;point_inj;PAIR_SPLIT];
22032   ASM_MESON_TAC[];
22033   (* Tue Aug 10 10:01:55 EDT 2004 *)
22034   ]);;
22035   (* }}} *)
22036
22037 let polar_exist = prove_by_refinement(
22038   `!x. (euclid 2 x) ==>
22039     (?r t. (&0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = r *# cis(t))))`,
22040   (* {{{ proof *)
22041   [
22042   (* A: trivial case of norm 0 *)
22043   REP_BASIC_TAC;
22044   ASM_CASES_TAC `norm2 x = &0` ;
22045   TYPE_THEN `x = euclid0` SUBGOAL_TAC;
22046   ASM_MESON_TAC[norm2_0];
22047   DISCH_THEN_REWRITE;
22048   TYPE_THEN `&0` EXISTS_TAC;
22049   TYPE_THEN `&0` EXISTS_TAC;
22050   REWRITE_TAC[euclid_scale0;REAL_MUL_2 ];
22051   MP_TAC PI_POS;
22052   REAL_ARITH_TAC;
22053   (* B: rescale to 1 *)
22054   TYPE_THEN `&0 < norm2 x` SUBGOAL_TAC;
22055   IMATCH_MP_TAC  (REAL_ARITH `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`);
22056   ASM_REWRITE_TAC[];
22057   IMATCH_MP_TAC  norm2_nn;
22058   ASM_REWRITE_TAC[];
22059   TYPE_THEN `r = norm2 x ` ABBREV_TAC ;
22060   DISCH_TAC;
22061   TYPE_THEN `r` EXISTS_TAC;
22062   TYPE_THEN `y = (&1/r)*# x` ABBREV_TAC ;
22063   TYPE_THEN `x = r*# y` SUBGOAL_TAC;
22064   EXPAND_TAC "y";
22065   REWRITE_TAC[euclid_scale_act;GSYM real_div_assoc];
22066   REDUCE_TAC;
22067   ASM_SIMP_TAC[REAL_DIV_REFL; euclid_scale_one;];
22068   DISCH_TAC;
22069   REWR 2;
22070   ASM_REWRITE_TAC[];
22071   TYPE_THEN `euclid 2 y` SUBGOAL_TAC;
22072   EXPAND_TAC "y";
22073   IMATCH_MP_TAC  euclid_scale_closure;
22074   ASM_REWRITE_TAC[];
22075   DISCH_TAC;
22076   UND 2;
22077   ASM_SIMP_TAC[norm2_scale];
22078   TYPE_THEN `abs  r = r` SUBGOAL_TAC;
22079   ASM_REWRITE_TAC[REAL_ABS_REFL];
22080   UND 3;
22081   REAL_ARITH_TAC;
22082   DISCH_THEN_REWRITE;
22083   DISCH_TAC;
22084   TYPE_THEN `norm2 y = &1` SUBGOAL_TAC;
22085   IMATCH_MP_TAC  REAL_EQ_LCANCEL_IMP;
22086   TYPE_THEN `r` EXISTS_TAC;
22087   REDUCE_TAC;
22088   ASM_REWRITE_TAC[];
22089   DISCH_TAC;
22090   (* C: invoke norm2=1 case *)
22091   TYPE_THEN `(?t. &0 <= t /\ t < &2 * pi /\ (y = cis t))` SUBGOAL_TAC;
22092   IMATCH_MP_TAC  cis_lemma;
22093   ASM_REWRITE_TAC[];
22094   REP_BASIC_TAC;
22095   TYPE_THEN `t` EXISTS_TAC;
22096   ASM_REWRITE_TAC[];
22097   UND 3;
22098   REAL_ARITH_TAC;
22099   ]);;
22100   (* }}} *)
22101
22102 (*
22103 vert r = hyperplane 2 e1 r
22104 horz r = hyperplane 2 e2 r
22105 cf. line2D_F..., line2D_S....
22106 *)
22107
22108 let subset_union_pair = prove_by_refinement(
22109   `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==>
22110        (A UNION B) SUBSET (A' UNION B')`,
22111   (* {{{ proof *)
22112   [
22113   REWRITE_TAC[SUBSET;UNION];
22114   MESON_TAC[];
22115   ]);;
22116   (* }}} *)
22117
22118 let subset_inter_pair = prove_by_refinement(
22119   `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==>
22120        (A INTER B) SUBSET (A' INTER B')`,
22121   (* {{{ proof *)
22122   [
22123   REWRITE_TAC[SUBSET;INTER];
22124   MESON_TAC[];
22125   ]);;
22126   (* }}} *)
22127
22128 let simple_arc_end_simple = prove_by_refinement(
22129   `!C v v'. simple_arc_end C v v' ==> simple_arc top2 C`,
22130   (* {{{ proof *)
22131   [
22132   REWRITE_TAC[simple_arc_end;simple_arc];
22133   REP_BASIC_TAC;
22134   REWRITE_TAC[top2_unions];
22135   TYPE_THEN `f` EXISTS_TAC;
22136   ASM_REWRITE_TAC[];
22137   (* Tue Aug 10 10:33:30 EDT 2004 *)
22138
22139   ]);;
22140   (* }}} *)
22141
22142 let simple_arc_end_restriction = prove_by_refinement(
22143   `!C K K' . simple_arc top2 C /\ closed_ top2 K /\
22144       closed_ top2 K' /\ (C INTER K INTER K' = EMPTY ) /\
22145      ~(C INTER K = EMPTY ) /\ ~(C INTER K' = EMPTY) ==>
22146     (?C' v v'.   C' SUBSET C /\ simple_arc_end C' v v' /\
22147          (C' INTER K = {v}) /\ (C' INTER K' = {v'})) `,
22148   (* {{{ proof *)
22149
22150   [
22151   REP_BASIC_TAC;
22152   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;
22153   IMATCH_MP_TAC  curve_restriction;
22154   ASM_REWRITE_TAC[];
22155   REAL_ARITH_TAC;
22156   REP_BASIC_TAC;
22157   TYPE_THEN `C'` EXISTS_TAC;
22158   TYPE_THEN `f(&0)` EXISTS_TAC;
22159   TYPE_THEN `f(&1)` EXISTS_TAC;
22160   ASM_REWRITE_TAC[];
22161   REWRITE_TAC[simple_arc_end];
22162   TYPE_THEN `f` EXISTS_TAC;
22163   ASM_REWRITE_TAC[];
22164   ]);;
22165
22166   (* }}} *)
22167
22168 let simple_arc_end_trans  = prove_by_refinement(
22169   `!C C' v v' v'' . simple_arc_end C v v' /\ simple_arc_end C' v' v'' /\
22170    ( C INTER C' = {v'}) ==>
22171     simple_arc_end (C UNION C') v v''`,
22172   (* {{{ proof *)
22173   [
22174   REWRITE_TAC[simple_arc_end];
22175   REP_BASIC_TAC;
22176   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;
22177   ASM_REWRITE_TAC[REAL_LT_HALF1];
22178   REAL_ARITH_TAC;
22179   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
22180   REP_BASIC_TAC;
22181   KILL 12;
22182   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;
22183   ASM_REWRITE_TAC[REAL_LT_HALF2];
22184   REAL_ARITH_TAC;
22185   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
22186   REP_BASIC_TAC;
22187   KILL 17;
22188   TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC;
22189   (* A: prelims *)
22190   TYPE_THEN `&0 < &1/(&2) /\ &1/(&2) < &1` SUBGOAL_TAC;
22191   REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2];
22192   REAL_ARITH_TAC;
22193   DISCH_TAC;
22194   (* -- *)
22195   TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC;
22196   IMATCH_MP_TAC  (GSYM union_closed_interval);
22197   UND 17;
22198   REAL_ARITH_TAC;
22199   DISCH_TAC;
22200   (* -- *)
22201   TYPE_THEN `{x | &0 <= x /\ x < &1} SUBSET {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
22202   REWRITE_TAC[SUBSET];
22203   REAL_ARITH_TAC;
22204   DISCH_TAC;
22205   (* -- *)
22206   TYPE_THEN `{x | &0 <= x /\ x < &1 / &2} SUBSET {x | x < &1/(&2)}` SUBGOAL_TAC;
22207   REWRITE_TAC[SUBSET];
22208   REAL_ARITH_TAC;
22209   DISCH_TAC;
22210   (* -- *)
22211   TYPE_THEN `{x | &1 / &2 <= x /\ x <= &1} SUBSET {x | &1/ (&2) <= x}` SUBGOAL_TAC;
22212   REWRITE_TAC[SUBSET];
22213   REAL_ARITH_TAC;
22214   DISCH_TAC;
22215   TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)} = {x | &0 <= x /\ x < &1/(&2)} UNION {(&1 /(&2))}` SUBGOAL_TAC;
22216   IMATCH_MP_TAC  EQ_EXT;
22217   REWRITE_TAC[UNION;INR IN_SING ];
22218   GEN_TAC;
22219   UND 17;
22220   REAL_ARITH_TAC;
22221   DISCH_TAC;
22222   (* -- *)
22223   TYPE_THEN `g (&1/(&2)) = g' (&1/(&2))` SUBGOAL_TAC;
22224   ASM_MESON_TAC[];
22225   DISCH_TAC;
22226   (* -- *)
22227   (* [B]: IMAGE *)
22228   SUBCONJ_TAC;
22229   ASM_REWRITE_TAC[IMAGE_UNION];
22230   ASM_SIMP_TAC[joinf_image_above;joinf_image_below];
22231   IMATCH_MP_TAC  SUBSET_ANTISYM;
22232   CONJ_TAC;
22233   REWRITE_TAC[union_subset];
22234   CONJ_TAC;
22235   CONJ_TAC;
22236   REWRITE_TAC[SUBSET_UNION];
22237    REWRITE_TAC[SUBSET;UNION];
22238   REWRITE_TAC[IMAGE;INR IN_SING;];
22239   NAME_CONFLICT_TAC;
22240   ASM_REWRITE_TAC[];
22241   CONV_TAC (dropq_conv "x''");
22242   GEN_TAC;
22243   DISCH_THEN_REWRITE;
22244   UND 27;
22245   DISCH_THEN_REWRITE;
22246   DISJ2_TAC ;
22247   TYPE_THEN `&1/(&2)` EXISTS_TAC;
22248   REWRITE_TAC[];
22249   UND 17;
22250   REAL_ARITH_TAC;
22251   REWRITE_TAC[SUBSET_UNION];
22252   (* --2-- *)
22253   USE 26 SYM;
22254   ASM_REWRITE_TAC[GSYM IMAGE_UNION];
22255   REWRITE_TAC[union_subset];
22256   CONJ_TAC;
22257   IMATCH_MP_TAC  SUBSET_TRANS;
22258   TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
22259   CONJ_TAC;
22260   IMATCH_MP_TAC  IMAGE_SUBSET;
22261   ASM_REWRITE_TAC[SUBSET;];
22262   REAL_ARITH_TAC;
22263   REWRITE_TAC[SUBSET_UNION];
22264   REWRITE_TAC[SUBSET_UNION];
22265   DISCH_TAC;
22266   (* [C]: cont,INJ *)
22267   CONJ_TAC;
22268   IMATCH_MP_TAC  joinf_cont;
22269   ASM_REWRITE_TAC[];
22270   (* -- *)
22271   CONJ_TAC;
22272   ASM_REWRITE_TAC[];
22273   IMATCH_MP_TAC  inj_split;
22274   ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below];
22275   CONJ_TAC;
22276   IMATCH_MP_TAC  inj_subset_domain;
22277   TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
22278   ASM_REWRITE_TAC[SUBSET_UNION];
22279   (* --2-- *)
22280   TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
22281   ASM_SIMP_TAC[joinf_image_below];
22282   DISCH_THEN_REWRITE;
22283   TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC;
22284   ASM_SIMP_TAC[joinf_image_above];
22285   DISCH_THEN_REWRITE;
22286   TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 / &2} INTER IMAGE g' {x | &1 / &2 <= x /\ x <= &1} SUBSET {v'}` SUBGOAL_TAC;
22287   UND 0;
22288   DISCH_THEN (fun t -> REWRITE_TAC[SYM t]);
22289   USE 26 GSYM;
22290   ASM_REWRITE_TAC[];
22291   IMATCH_MP_TAC  subset_inter_pair;
22292   REWRITE_TAC[SUBSET_REFL];
22293   IMATCH_MP_TAC  IMAGE_SUBSET;
22294   ASM_REWRITE_TAC[SUBSET ];
22295   REAL_ARITH_TAC;
22296   DISCH_TAC;
22297   TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 /(&2)} INTER {v'} = EMPTY` SUBGOAL_TAC;
22298   REWRITE_TAC[EQ_EMPTY];
22299   GEN_TAC;
22300   REWRITE_TAC[IMAGE;INTER;INR IN_SING;DE_MORGAN_THM;];
22301   NAME_CONFLICT_TAC;
22302   LEFT_TAC  "x'";
22303   IMATCH_MP_TAC  (TAUT `(B ==> A)    ==> A \/ ~B`);
22304   DISCH_THEN_REWRITE;
22305   GEN_TAC;
22306   REP_BASIC_TAC;
22307   TYPE_THEN `x' = &1/(&2)` SUBGOAL_TAC;
22308   USE 15 (REWRITE_RULE[INJ]);
22309   REP_BASIC_TAC;
22310   FIRST_ASSUM IMATCH_MP_TAC ;
22311   ASM_REWRITE_TAC[];
22312   USE 27 GSYM;
22313   ASM_REWRITE_TAC[];
22314   TYPE_THEN `g x' = g(&1/(&2))` SUBGOAL_TAC;
22315   ASM_MESON_TAC[];
22316   DISCH_THEN_REWRITE;
22317   UND 30;
22318   UND 33;
22319   REAL_ARITH_TAC;
22320   UND 30;
22321   REAL_ARITH_TAC;
22322   UND 29;
22323   REWRITE_TAC[SUBSET;EQ_EMPTY ;INTER;INR IN_SING;];
22324   POP_ASSUM_LIST (fun t -> ALL_TAC);
22325   REP_BASIC_TAC;
22326   TSPEC  `x` 3;
22327   REWR 3;
22328   TSPEC `x` 2;
22329   REWR 2;
22330   (* [D] final touches *)
22331   CONJ_TAC;
22332   REWRITE_TAC[joinf];
22333   ASM_REWRITE_TAC[];
22334   ASM_MESON_TAC[];
22335   REWRITE_TAC[joinf];
22336   ASM_SIMP_TAC [REAL_ARITH `&1/(&2) < &1 ==> (&1 < &1/ &2 <=> F)`];
22337   ASM_MESON_TAC[];
22338   (* Tue Aug 10 13:15:07 EDT 2004 *)
22339
22340   ]);;
22341   (* }}} *)
22342
22343 let continuous_uninduced = prove_by_refinement(
22344   `!(f:A->B) U V Y.
22345      continuous f U (induced_top V Y) /\ IMAGE f (UNIONS U) SUBSET Y
22346      ==> continuous f U V`,
22347   (* {{{ proof *)
22348   [
22349   REWRITE_TAC[continuous;];
22350   REP_BASIC_TAC;
22351   TSPEC `v INTER Y` 2;
22352   TYPE_THEN `induced_top V Y (v INTER Y)` SUBGOAL_TAC;
22353   REWRITE_TAC[induced_top;IMAGE;];
22354   ASM_MESON_TAC[];
22355   DISCH_TAC;
22356   REWR 2;
22357   UND 2;
22358   REWRITE_TAC [preimage;INTER];
22359   TYPE_THEN `{x | UNIONS U x /\ v (f x) /\ Y (f x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC;
22360   IMATCH_MP_TAC  EQ_EXT;
22361   REWRITE_TAC[];
22362   GEN_TAC;
22363   TYPE_THEN `UNIONS U x ==> Y (f x)` SUBGOAL_TAC;
22364   UND 1;
22365   REWRITE_TAC[IMAGE;SUBSET];
22366   MESON_TAC[];
22367   MESON_TAC[];
22368   DISCH_THEN_REWRITE;
22369   (* Tue Aug 10 19:11:27 EDT 2004 *)
22370
22371   ]);;
22372   (* }}} *)
22373
22374 let simple_arc_homeo = prove_by_refinement(
22375   `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\
22376         (metric_space(X,d)) ==>
22377     (?f. homeomorphism f
22378    (top_of_metric({x | &0 <= x /\ x <= &1},d_real))
22379             (top_of_metric(C,d)))`,
22380   (* {{{ proof *)
22381
22382   [
22383   REWRITE_TAC[simple_arc];
22384   REP_BASIC_TAC;
22385   TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC;
22386   ASM_SIMP_TAC[GSYM top_of_metric_unions];
22387   DISCH_TAC;
22388   REWR 1;
22389   (* -- *)
22390   TYPE_THEN `C SUBSET X` SUBGOAL_TAC;
22391   ASM_REWRITE_TAC[];
22392   IMATCH_MP_TAC  inj_image_subset;
22393   ASM_REWRITE_TAC[];
22394   DISCH_TAC;
22395   (* -- *)
22396   TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC;
22397   KILL 3;
22398   ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace];
22399   DISCH_TAC;
22400   (* -- *)
22401   TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
22402   REWRITE_TAC[SUBSET_UNIV];
22403   DISCH_TAC;
22404   (* -- *)
22405   TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
22406   IMATCH_MP_TAC  metric_subspace;
22407   TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
22408   ASM_REWRITE_TAC[metric_real];
22409   DISCH_TAC;
22410   (* -- *)
22411   ASSUME_TAC metric_real;
22412   (* -- *)
22413   TYPE_THEN `compact (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
22414   TYPEL_THEN [`UNIV:real->bool`;`{x| &0 <= x /\ x <= &1}`;`d_real`] (fun t-> ASSUME_TAC (ISPECL t compact_subset));
22415   REWR 10;
22416   USE 10 SYM;
22417   ASM_REWRITE_TAC[interval_compact];
22418   DISCH_TAC;
22419   (* -- *)
22420   USE 3 GSYM ;
22421   (* -- *)
22422   (* A: show homeomorphism *)
22423   TYPE_THEN `f` EXISTS_TAC;
22424     IMATCH_MP_TAC  hausdorff_homeomorphsim;
22425   ASM_SIMP_TAC[GSYM top_of_metric_unions];
22426   ASM_SIMP_TAC[top_of_metric_top;metric_subspace];
22427   (* -- *)
22428     TYPE_THEN `metric_space (C,d)` SUBGOAL_TAC;
22429   ASM_MESON_TAC [metric_subspace];
22430   DISCH_TAC;
22431   TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET C` SUBGOAL_TAC;
22432   ASM_REWRITE_TAC[SUBSET_REFL ];
22433   DISCH_TAC;
22434   TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET X` SUBGOAL_TAC;
22435   IMATCH_MP_TAC  SUBSET_TRANS;
22436   TYPE_THEN `C` EXISTS_TAC;
22437   ASM_REWRITE_TAC[];
22438   DISCH_TAC;
22439   (* B: final obligations *)
22440   CONJ_TAC;
22441   EXPAND_TAC "C";
22442   IMATCH_MP_TAC  inj_bij;
22443   UND 1;
22444   REWRITE_TAC[INJ];
22445   MESON_TAC[];
22446   (* -- *)
22447   TYPE_THEN `induced_top (top_of_metric (UNIV,d_real)) {x| &0 <= x /\ x <= &1} {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
22448   ASM_SIMP_TAC[top_of_metric_induced];
22449   TYPE_THEN `topology_ (top_of_metric ({x | &0 <= x /\ x <= &1},d_real))` SUBGOAL_TAC;
22450   ASM_SIMP_TAC[top_of_metric_top];
22451   DISCH_THEN (fun t-> MP_TAC (MATCH_MP top_univ t));
22452   ASM_SIMP_TAC[GSYM top_of_metric_unions];
22453   DISCH_TAC;
22454   TYPE_THEN `continuous f (induced_top (top_of_metric (UNIV,d_real)) {x | &0 <= x /\ x <= &1}) (top_of_metric(X,d))` SUBGOAL_TAC;
22455   IMATCH_MP_TAC  continuous_induced_domain;
22456   ASM_REWRITE_TAC[];
22457   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
22458   ASM_SIMP_TAC[metric_real;top_of_metric_induced];
22459   ASM_SIMP_TAC[metric_continuous_continuous;metric_subspace];
22460   REWRITE_TAC[metric_continuous;metric_continuous_pt];
22461   DISCH_THEN_REWRITE;
22462   ASM_SIMP_TAC[top_of_metric_top];
22463   IMATCH_MP_TAC  metric_hausdorff;
22464   ASM_REWRITE_TAC[];
22465   (* Tue Aug 10 20:34:30 EDT 2004 *)
22466
22467   ]);;
22468
22469   (* }}} *)
22470
22471 let continuous_metric_extend = prove_by_refinement(
22472   `!(f:A->B) U C X d. (metric_space(X,d) /\
22473       continuous f U (top_of_metric (C,d)) /\
22474           IMAGE f (UNIONS U) SUBSET C /\ C SUBSET X ==>
22475     continuous f U (top_of_metric(X,d)))`,
22476   (* {{{ proof *)
22477   [
22478   REP_BASIC_TAC;
22479   TYPE_THEN `metric_space(C,d)` SUBGOAL_TAC;
22480   IMATCH_MP_TAC metric_subspace;
22481   ASM_MESON_TAC[];
22482   DISCH_TAC;
22483   (* -- *)
22484   TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d)) C` SUBGOAL_TAC;
22485   ASM_SIMP_TAC[top_of_metric_induced];
22486   DISCH_TAC;
22487   REWR 2;
22488   IMATCH_MP_TAC  continuous_uninduced;
22489   TYPE_THEN `C` EXISTS_TAC;
22490   ASM_REWRITE_TAC[];
22491   (* Tue Aug 10 20:47:53 EDT 2004 *)
22492
22493   ]);;
22494   (* }}} *)
22495
22496 let simple_arc_end_distinct = prove_by_refinement(
22497   `!C v v'. simple_arc_end C v v' ==> ~(v = v')`,
22498   (* {{{ proof *)
22499   [
22500   REWRITE_TAC[simple_arc_end;INJ];
22501   REP_BASIC_TAC;
22502   TYPE_THEN `&0 = &1` SUBGOAL_TAC;
22503   FIRST_ASSUM IMATCH_MP_TAC ;
22504   TYPE_THEN `f (&0)  = f(&1)` SUBGOAL_TAC;
22505   ASM_MESON_TAC[];
22506   DISCH_THEN_REWRITE;
22507   REAL_ARITH_TAC;
22508   REAL_ARITH_TAC;
22509   ]);;
22510   (* }}} *)
22511
22512 let bij_imp_image = prove_by_refinement(
22513   `!(f:A->B) X Y. BIJ f X Y ==> (IMAGE f X = Y)`,
22514   (* {{{ proof *)
22515   [
22516   REWRITE_TAC[BIJ;SURJ];
22517   REP_BASIC_TAC;
22518   REWRITE_TAC[IMAGE];
22519   IMATCH_MP_TAC  EQ_EXT;
22520   REWRITE_TAC[];
22521   ASM_MESON_TAC[];
22522   ]);;
22523   (* }}} *)
22524
22525 let homeo_inj = prove_by_refinement(
22526   `!(f:A->B) U C X d. (homeomorphism f U (top_of_metric(C,d))) /\
22527      (C SUBSET X) /\ (metric_space (X,d)) ==>
22528     ( continuous f U (top_of_metric(X,d)) /\ INJ f (UNIONS U) C /\
22529       (IMAGE f (UNIONS U) = C))`,
22530   (* {{{ proof *)
22531   [
22532   REWRITE_TAC[homeomorphism];
22533   REP_BASIC_TAC;
22534   TYPE_THEN`metric_space(C,d)` SUBGOAL_TAC;
22535   ASM_MESON_TAC [metric_subspace];
22536   DISCH_TAC;
22537   (* -- *)
22538   UND 4;
22539   ASM_SIMP_TAC[GSYM top_of_metric_unions;];
22540   DISCH_TAC;
22541   (* -- *)
22542   TYPE_THEN `IMAGE f (UNIONS U)= C` SUBGOAL_TAC;
22543   IMATCH_MP_TAC  bij_imp_image ;
22544   ASM_REWRITE_TAC[];
22545   DISCH_TAC;
22546   (* -- *)
22547   RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
22548   ASM_REWRITE_TAC[];
22549   IMATCH_MP_TAC  continuous_metric_extend;
22550   TYPE_THEN `C` EXISTS_TAC;
22551   ASM_REWRITE_TAC[SUBSET_REFL ];
22552   (* Tue Aug 10 20:58:37 EDT 2004 *)
22553
22554
22555   ]);;
22556   (* }}} *)
22557
22558 let simple_arc_coord = prove_by_refinement(
22559   `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\
22560         (metric_space(X,d)) ==>
22561     (?f.
22562   (continuous f (top_of_metric(C,d)) (top_of_metric(UNIV,d_real))) /\
22563   (INJ f C UNIV) /\
22564   (IMAGE f C = {x | &0 <= x /\ x <= &1}))`,
22565   (* {{{ proof *)
22566   [
22567   REP_BASIC_TAC;
22568   (* -- *)
22569   TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC;
22570   ASM_SIMP_TAC[GSYM top_of_metric_unions];
22571   DISCH_TAC;
22572   (* -- *)
22573   TYPE_THEN `C SUBSET X` SUBGOAL_TAC;
22574   ASM_REWRITE_TAC[];
22575   RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]);
22576   REP_BASIC_TAC;
22577   USE 4 GSYM;
22578   REWR 1;
22579   EXPAND_TAC "C";
22580   IMATCH_MP_TAC  inj_image_subset;
22581   ASM_REWRITE_TAC[];
22582   DISCH_TAC;
22583   (* -- *)
22584   TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC;
22585   ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace];
22586   DISCH_TAC;
22587   (* -- *)
22588   TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
22589   REWRITE_TAC[SUBSET_UNIV];
22590   DISCH_TAC;
22591   (* -- *)
22592   TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
22593   IMATCH_MP_TAC  metric_subspace;
22594   TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
22595   ASM_REWRITE_TAC[metric_real];
22596   DISCH_TAC;
22597   (* -- *)
22598   ASSUME_TAC metric_real;
22599   (* -- *)
22600   TYPE_THEN `(?f. homeomorphism f (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric(C,d)))` SUBGOAL_TAC;
22601   IMATCH_MP_TAC  simple_arc_homeo;
22602   TYPE_THEN `X` EXISTS_TAC; (* // *)
22603   ASM_REWRITE_TAC[];
22604   REP_BASIC_TAC;
22605   (* -- *)
22606   TYPE_THEN ` g = (INV f  ({x | &0 <= x /\ x <= &1}) (C:A->bool))` ABBREV_TAC ;
22607   TYPE_THEN `g = INV f  (UNIONS((top_of_metric({x | &0 <= x /\ x <= &1},d_real)))) (UNIONS((top_of_metric(C,d))))` SUBGOAL_TAC;
22608   ASM_REWRITE_TAC[];
22609   ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_subspace;];
22610   DISCH_TAC;
22611   (* A: *)
22612   TYPE_THEN `g` EXISTS_TAC;
22613   (* -- *)
22614   (* TYPE_THEN `U = top_of_metric({x | &0 <= x /\ x <= &1},d_real)` ABBREV_TAC ; *)
22615   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;
22616   ASM_REWRITE_TAC[];
22617   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));
22618   REWR 11;
22619   DISCH_TAC;
22620     USE 11 (MATCH_MP homeo_inj);
22621   REP_BASIC_TAC;
22622   KILL 9;
22623   KILL 10;
22624   ASM_REWRITE_TAC[];
22625   UND 11;
22626   UND 12;
22627   ASM_REWRITE_TAC[];
22628   UND 5;
22629   POP_ASSUM_LIST (fun t-> ALL_TAC);
22630   REP_BASIC_TAC;
22631   ASM_REWRITE_TAC[];
22632   ASM_MESON_TAC[INJ_UNIV];
22633   (* Tue Aug 10 21:49:22 EDT 2004 *)
22634
22635   ]);;
22636   (* }}} *)
22637
22638 (* slow! *)
22639 let image_interval = prove_by_refinement(
22640   `!a b f. (a < b) /\
22641    (continuous f (top_of_metric(UNIV,d_real))
22642         (top_of_metric( UNIV,d_real)))  /\
22643     (INJ f {x | a <= x /\ x <= b} UNIV) ==>
22644    (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\
22645     (IMAGE f {x | a <= x /\ x <= b} =
22646        {x | c <= x /\ x <= d})
22647      ) `,
22648   (* {{{ proof *)
22649   [
22650   REP_BASIC_TAC;
22651   (* -- *)
22652   ASSUME_TAC connect_real;
22653   TYPE_THEN `!a b. connected (top_of_metric(UNIV,d_real)) (IMAGE f {x |  a<= x /\ x <= b})` SUBGOAL_TAC;
22654   REP_GEN_TAC;
22655   IMATCH_MP_TAC  connect_image;
22656   TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC ;
22657   ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
22658   DISCH_TAC;
22659   (* -- *)
22660   TYPE_THEN `c = min_real (f a) (f b)` ABBREV_TAC ;
22661   TYPE_THEN `d = max_real (f a) (f b)` ABBREV_TAC ;
22662   TYPE_THEN `c`EXISTS_TAC;
22663   TYPE_THEN `d` EXISTS_TAC;
22664   TYPE_THEN `~(f a = f b)` SUBGOAL_TAC;
22665   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
22666   REP_BASIC_TAC;
22667   TYPE_THEN `a = b` SUBGOAL_TAC;
22668   FIRST_ASSUM IMATCH_MP_TAC ;
22669   ASM_REWRITE_TAC[];
22670   UND 2;
22671   REAL_ARITH_TAC;
22672   UND 2;
22673   REAL_ARITH_TAC;
22674   DISCH_TAC;
22675   (* -- *)
22676   SUBCONJ_TAC;
22677   EXPAND_TAC "d";
22678   EXPAND_TAC "c";
22679   REWRITE_TAC[min_real;max_real];
22680   TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
22681   UND 7;
22682   REAL_ARITH_TAC;
22683   DISCH_THEN DISJ_CASES_TAC;
22684   TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
22685   UND 8;
22686   REAL_ARITH_TAC;
22687   DISCH_THEN_REWRITE;
22688   ASM_REWRITE_TAC[];
22689   TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
22690   UND 8;
22691   REAL_ARITH_TAC;
22692   DISCH_THEN_REWRITE;
22693   ASM_REWRITE_TAC[];
22694   DISCH_TAC;
22695   (* -- *)
22696   SUBCONJ_TAC;
22697   IMATCH_MP_TAC  EQ_EXT;
22698   REWRITE_TAC[in_pair];
22699   EXPAND_TAC "d";
22700   EXPAND_TAC "c";
22701   REWRITE_TAC[max_real;min_real];
22702   TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
22703   UND 7;
22704   REAL_ARITH_TAC;
22705   DISCH_THEN DISJ_CASES_TAC;
22706   TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
22707   UND 9;
22708   REAL_ARITH_TAC;
22709   DISCH_THEN_REWRITE;
22710   ASM_REWRITE_TAC[];
22711   TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
22712   UND 9;
22713   REAL_ARITH_TAC;
22714   DISCH_THEN_REWRITE;
22715   ASM_REWRITE_TAC[];
22716   MESON_TAC[];
22717   DISCH_TAC;
22718   (* B *)
22719   IMATCH_MP_TAC  SUBSET_ANTISYM;
22720   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
22721   SUBCONJ_TAC;
22722   IMATCH_MP_TAC  connected_nogap;
22723   ASM_REWRITE_TAC[];
22724   EXPAND_TAC "c";
22725   EXPAND_TAC "d";
22726   REWRITE_TAC[max_real;min_real];
22727   TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
22728   UND 7;
22729   REAL_ARITH_TAC;
22730   DISCH_THEN DISJ_CASES_TAC;
22731   TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
22732   UND 10;
22733   REAL_ARITH_TAC;
22734   DISCH_THEN_REWRITE;
22735   ASM_REWRITE_TAC[];
22736   REWRITE_TAC[IMAGE;SUBSET];
22737   ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`];
22738   TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
22739   UND 10;
22740   REAL_ARITH_TAC;
22741   DISCH_THEN_REWRITE;
22742   ASM_REWRITE_TAC[];
22743   REWRITE_TAC[IMAGE;SUBSET];
22744   ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`];
22745   DISCH_TAC;
22746   (* C set up cases *)
22747   REWRITE_TAC[IMAGE;SUBSET;];
22748   REP_BASIC_TAC;
22749   ASM_REWRITE_TAC[];
22750   PROOF_BY_CONTR_TAC;
22751   USE 14 (REWRITE_RULE[DE_MORGAN_THM]);
22752   USE 9 (REWRITE_RULE[FUN_EQ_THM;in_pair ]);
22753   TYPE_THEN `((c = f a) /\ (d = f b)) \/ ((c = f b) /\ (d = f a))` SUBGOAL_TAC;
22754   UND 9;
22755   MESON_TAC[];
22756   DISCH_TAC;
22757   TYPE_THEN `f x' < c \/ d < f x'` SUBGOAL_TAC;
22758   UND 14;
22759   ARITH_TAC;
22760   DISCH_TAC;
22761   KILL 9;
22762   KILL 14;
22763   KILL 11;
22764   (* D generic case *)
22765   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;
22766   REP_BASIC_TAC;
22767   PROOF_BY_CONTR_TAC;
22768   TYPEL_THEN [`r`;`t`] (USE 4 o ISPECL);
22769   USE 4(REWRITE_RULE[connected]);
22770   REP_BASIC_TAC;
22771   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;
22772   FIRST_ASSUM IMATCH_MP_TAC ;
22773   REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;];
22774   CONJ_TAC;
22775   REAL_ARITH_TAC;
22776   REWRITE_TAC[IMAGE;SUBSET;UNION;];
22777   REP_BASIC_TAC;
22778   ASM_REWRITE_TAC[];
22779   IMATCH_MP_TAC (REAL_ARITH  `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` );
22780   DISCH_TAC;
22781   TYPE_THEN `x'' = s` SUBGOAL_TAC;
22782   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
22783   REP_BASIC_TAC;
22784   FIRST_ASSUM IMATCH_MP_TAC ;
22785   ASM_REWRITE_TAC[];
22786   UND 26;
22787   UND 27;
22788   UND 22;
22789   UND 17;
22790   REAL_ARITH_TAC;
22791   UND 9;
22792   UND 11;
22793   UND 23;
22794   UND 26;
22795   UND 27;
22796   POP_ASSUM_LIST (fun t-> ALL_TAC);
22797   REP_BASIC_TAC;
22798   TYPE_THEN `~(r = s)` SUBGOAL_TAC;
22799   ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
22800   TYPE_THEN `~(s = t)` SUBGOAL_TAC;
22801   ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
22802   KILL 1;
22803   KILL 2;
22804   UND 0;
22805   UND 3;
22806   UND 4;
22807   UND 5;
22808   REAL_ARITH_TAC;
22809   REWRITE_TAC[DE_MORGAN_THM ];
22810   CONJ_TAC;
22811   REWRITE_TAC[IMAGE;SUBSET;];
22812   LEFT_TAC "x";
22813   TYPE_THEN `f t` EXISTS_TAC;
22814   LEFT_TAC "x'";
22815   REP_BASIC_TAC;
22816   TSPEC `t` 25;
22817   UND 25;
22818   UND 9;
22819   UND 14;
22820   REAL_ARITH_TAC;
22821   REWRITE_TAC[IMAGE;SUBSET;];
22822   LEFT_TAC "x";
22823   TYPE_THEN `f r` EXISTS_TAC;
22824   REP_BASIC_TAC;
22825   LEFT 25 "x'" ;
22826   TSPEC `r` 25;
22827   UND 25;
22828   UND 14;
22829   UND 11;
22830   REAL_ARITH_TAC;
22831   (* D' generic case *)
22832   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;
22833   REP_BASIC_TAC;
22834   PROOF_BY_CONTR_TAC;
22835   TYPEL_THEN [`t`;`r`] (USE 4 o ISPECL);
22836   USE 4(REWRITE_RULE[connected]);
22837   REP_BASIC_TAC;
22838   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;
22839   FIRST_ASSUM IMATCH_MP_TAC ;
22840   REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;];
22841   CONJ_TAC;
22842   REAL_ARITH_TAC;
22843   REWRITE_TAC[IMAGE;SUBSET;UNION;];
22844   REP_BASIC_TAC;
22845   ASM_REWRITE_TAC[];
22846   IMATCH_MP_TAC (REAL_ARITH  `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` );
22847   DISCH_TAC;
22848   TYPE_THEN `x'' = s` SUBGOAL_TAC;
22849   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
22850   REP_BASIC_TAC;
22851   FIRST_ASSUM IMATCH_MP_TAC ;
22852   ASM_REWRITE_TAC[];
22853   UND 26;
22854   UND 27;
22855   UND 18;
22856   UND 21;
22857   REAL_ARITH_TAC;
22858   UND 9;
22859   UND 11;
22860   UND 23;
22861   UND 26;
22862   UND 27;
22863   POP_ASSUM_LIST (fun t-> ALL_TAC);
22864   REP_BASIC_TAC;
22865   TYPE_THEN `~(r = s)` SUBGOAL_TAC;
22866   ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
22867   TYPE_THEN `~(s = t)` SUBGOAL_TAC;
22868   ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
22869   KILL 1;
22870   KILL 2;
22871   UND 0;
22872   UND 3;
22873   UND 4;
22874   UND 5;
22875   REAL_ARITH_TAC;
22876   REWRITE_TAC[DE_MORGAN_THM ];
22877   CONJ_TAC;
22878   REWRITE_TAC[IMAGE;SUBSET;];
22879   LEFT_TAC "x";
22880   TYPE_THEN `f t` EXISTS_TAC;
22881   LEFT_TAC "x'";
22882   REP_BASIC_TAC;
22883   TSPEC `t` 25;
22884   UND 25;
22885   UND 9;
22886   UND 14;
22887   REAL_ARITH_TAC;
22888   REWRITE_TAC[IMAGE;SUBSET;];
22889   LEFT_TAC "x";
22890   TYPE_THEN `f r` EXISTS_TAC;
22891   REP_BASIC_TAC;
22892   LEFT 25 "x'" ;
22893   TSPEC `r` 25;
22894   UND 25;
22895   UND 14;
22896   UND 11;
22897   REAL_ARITH_TAC;
22898   REP_BASIC_TAC;
22899   (* end generic  *)
22900   KILL 4;
22901   KILL 3;
22902   KILL 0;
22903   KILL 1;
22904   KILL 10;
22905   KILL 6;
22906   KILL 5;
22907   (* E: actual cases *)
22908   UND 16;
22909   UND 15;
22910   REP_CASES_TAC;
22911   (* --2a-- *)
22912   KILL 11;
22913   TYPEL_THEN[`x'`;`a`;`b`] (USE 9 o ISPECL);
22914   TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC;
22915   REPEAT (POP_ASSUM MP_TAC);
22916   REAL_ARITH_TAC;
22917   DISCH_TAC;
22918   TYPE_THEN `~(x' = b)` SUBGOAL_TAC;
22919   ASM_MESON_TAC[];
22920   REPEAT (POP_ASSUM MP_TAC);
22921   REAL_ARITH_TAC;
22922   (* --2b-- *)
22923   KILL 11;
22924   TYPEL_THEN [`a`;`b`;`x'`] (USE 9 o ISPECL);
22925   TYPE_THEN `~(f a = f x')` SUBGOAL_TAC;
22926   REPEAT (POP_ASSUM MP_TAC);
22927   REAL_ARITH_TAC;
22928   DISCH_TAC;
22929   TYPE_THEN `~(a = x')` SUBGOAL_TAC;
22930   ASM_MESON_TAC[];
22931   REPEAT (POP_ASSUM MP_TAC);
22932   REAL_ARITH_TAC;
22933   (* --2c-- *)
22934   KILL 9;
22935   TYPEL_THEN [`x'`;`b`;`a`] (USE 11 o ISPECL);
22936   TYPE_THEN `~(f x' = f a)` SUBGOAL_TAC;
22937   REPEAT (POP_ASSUM MP_TAC);
22938   REAL_ARITH_TAC;
22939   DISCH_TAC;
22940   TYPE_THEN `~(a = x')` SUBGOAL_TAC;
22941   ASM_MESON_TAC[];
22942   REPEAT (POP_ASSUM MP_TAC);
22943   REAL_ARITH_TAC;
22944   (* --2d-- *)
22945   KILL 9;
22946   TYPEL_THEN [`b`;`a`;`x'`] (USE 11 o ISPECL);
22947   TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC;
22948   REPEAT (POP_ASSUM MP_TAC);
22949   REAL_ARITH_TAC;
22950   DISCH_TAC;
22951   TYPE_THEN `~(b = x')` SUBGOAL_TAC;
22952   ASM_MESON_TAC[];
22953   REPEAT (POP_ASSUM MP_TAC);
22954   REAL_ARITH_TAC;
22955   (* Wed Aug 11 09:36:14 EDT 2004 *)
22956   ]);;
22957   (* }}} *)
22958
22959 let metric_continuous_range = prove_by_refinement(
22960   `!(f:A->B) X dX Y dY Y'.
22961    metric_continuous f (X,dX) (Y,dY) <=>
22962    metric_continuous f (X,dX) (Y',dY)`,
22963   (* {{{ proof *)
22964   [
22965   REWRITE_TAC[metric_continuous;metric_continuous_pt];
22966   ]);;
22967   (* }}} *)
22968
22969 let continuous_range = prove_by_refinement(
22970   `!(f:A->B) X dX Y dY Y'.
22971    metric_space(X,dX) /\ metric_space(Y,dY) /\ metric_space(Y',dY) /\
22972    continuous f (top_of_metric(X,dX)) (top_of_metric(Y,dY)) /\
22973    IMAGE f X SUBSET Y /\ IMAGE f X SUBSET Y' ==>
22974    continuous f (top_of_metric(X,dX)) (top_of_metric(Y',dY))`,
22975   (* {{{ proof *)
22976   [
22977   REP_BASIC_TAC;
22978   TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y',dY)) = metric_continuous f (X,dX) (Y',dY)`  SUBGOAL_TAC;
22979   IMATCH_MP_TAC  metric_continuous_continuous;
22980   ASM_REWRITE_TAC[];
22981   DISCH_TAC;
22982   TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y,dY)) = metric_continuous f (X,dX) (Y,dY)`  SUBGOAL_TAC;
22983   IMATCH_MP_TAC  metric_continuous_continuous;
22984   ASM_REWRITE_TAC[];
22985   DISCH_TAC;
22986   ASM_REWRITE_TAC[];
22987   REWR 2;
22988   ASM_MESON_TAC[metric_continuous_range];
22989   ]);;
22990   (* }}} *)
22991
22992 let metric_continuous_domain = prove_by_refinement(
22993   `!(f:A->B) X dX Y dY Y' A.
22994    metric_continuous f (X,dX) (Y,dY) /\ A SUBSET X ==>
22995   metric_continuous f (A,dX) (Y',dY)`,
22996   (* {{{ proof *)
22997   [
22998   REWRITE_TAC[metric_continuous;metric_continuous_pt;SUBSET];
22999   MESON_TAC[];
23000   ]);;
23001   (* }}} *)
23002
23003 let pair_order_endpoint = prove_by_refinement(
23004   `!a b c d . (c < d) /\ ({c , d} = {a ,b}) ==>
23005     (c = min_real a b) /\ (d = max_real a b)`,
23006   (* {{{ proof *)
23007   [
23008   REP_BASIC_TAC;
23009   USE 0 (REWRITE_RULE[FUN_EQ_THM;in_pair]);
23010   TYPE_THEN `((c = a) /\ (d = b)) \/ ((c = b) /\ (d = a))` SUBGOAL_TAC;
23011   ASM_MESON_TAC[];
23012   DISCH_THEN DISJ_CASES_TAC;
23013   ASM_REWRITE_TAC[];
23014   REWR 1;
23015   ASM_REWRITE_TAC[min_real;max_real];
23016   ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`];
23017   ASM_REWRITE_TAC[];
23018   REWR 1;
23019   ASM_REWRITE_TAC[min_real;max_real];
23020   ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`];
23021   ]);;
23022   (* }}} *)
23023
23024 let cont_extend_real_lemma = prove_by_refinement(
23025   `!a b (f:real->A) Y dY. (a < b) /\
23026    (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
23027      (top_of_metric(Y,dY))) /\ (metric_space(Y,dY)) /\
23028    IMAGE f {x | a <= x /\ x <= b} SUBSET Y ==>
23029   (
23030    ?g. (continuous g (top_of_metric(UNIV,d_real))
23031    (top_of_metric(Y,dY))) /\
23032      (!x. (a <= x /\ x <= b) ==> (f x = g x)))`,
23033   (* {{{ proof *)
23034   [
23035   REP_BASIC_TAC;
23036   TYPE_THEN `?t. (a < t /\ t < b)` SUBGOAL_TAC;
23037   TYPE_THEN `(a+b)/(&2)` EXISTS_TAC;
23038   ASM_MESON_TAC[real_middle1_lt;real_middle2_lt];
23039   REP_BASIC_TAC;
23040   ASSUME_TAC metric_real;
23041   TYPE_THEN `{x | a <= x /\ x <= b} SUBSET UNIV` SUBGOAL_TAC;
23042   ASM_REWRITE_TAC[SUBSET_UNIV];
23043   DISCH_TAC;
23044   TYPE_THEN `metric_space ({x | a <= x /\ x <= b},d_real)` SUBGOAL_TAC;
23045   IMATCH_MP_TAC  metric_subspace;
23046   TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
23047   ASM_REWRITE_TAC[];
23048   DISCH_TAC;
23049   (* -- *)
23050   TYPE_THEN `metric_continuous f ({x | a <= x /\ x <= b},d_real) (Y,dY)` SUBGOAL_TAC;
23051   UND 2;
23052   ASM_SIMP_TAC [metric_continuous_continuous];
23053   DISCH_TAC;
23054   TYPE_THEN `A = {x | x <= a}` ABBREV_TAC ;
23055   TYPE_THEN `B = {x | b <= x}` ABBREV_TAC ;
23056   TYPE_THEN `fA  = (\(t:real). f a)` ABBREV_TAC ;
23057   TYPE_THEN `fB = (\(t:real). f b)` ABBREV_TAC ;
23058   ASSUME_TAC half_closed;
23059   ASSUME_TAC half_closed_above;
23060   (* -- *)
23061   TYPE_THEN `!r A. (Y r) ==> (metric_continuous (\t. r) (A,d_real) (Y,dY))` SUBGOAL_TAC;
23062   REWRITE_TAC[metric_continuous;metric_continuous_pt];
23063   REP_BASIC_TAC;
23064   RIGHT_TAC "delta";
23065   REP_BASIC_TAC;
23066   TYPE_THEN `epsilon` EXISTS_TAC;
23067   ASM_REWRITE_TAC[];
23068   REP_BASIC_TAC;
23069   ASM_MESON_TAC[metric_space_zero];
23070   DISCH_TAC;
23071   (* -- *)
23072   TYPE_THEN `metric_continuous (subf A fA fB) (A UNION B,d_real) (Y,dY)` SUBGOAL_TAC;
23073   IMATCH_MP_TAC  subf_cont;
23074   TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
23075   ASM_REWRITE_TAC[];
23076   EXPAND_TAC "A";
23077   EXPAND_TAC "B";
23078   ASM_REWRITE_TAC[];
23079   EXPAND_TAC "fA";
23080   EXPAND_TAC "fB";
23081   TYPE_THEN `!x. x <= a /\ b <= x <=> F` SUBGOAL_TAC;
23082   UND 3;
23083   REAL_ARITH_TAC ;
23084   DISCH_THEN_REWRITE;
23085   TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC;
23086   UND 0;
23087   REWRITE_TAC[IMAGE;SUBSET];
23088   TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC;
23089   UND 3;
23090   REAL_ARITH_TAC;
23091   MESON_TAC[];
23092   DISCH_TAC;
23093   CONJ_TAC;
23094   FIRST_ASSUM IMATCH_MP_TAC ;
23095   ASM_REWRITE_TAC[];
23096   FIRST_ASSUM IMATCH_MP_TAC ;
23097   ASM_REWRITE_TAC[];
23098   DISCH_TAC;
23099   (* -- *)
23100   TYPE_THEN `A' = A UNION B` ABBREV_TAC ;
23101   TYPE_THEN `B' = {x | a <= x /\ x <= b}` ABBREV_TAC ;
23102   TYPE_THEN `fA' = subf A fA fB` ABBREV_TAC ;
23103   TYPE_THEN `metric_continuous (subf A' fA' f) (A' UNION B',d_real) (Y,dY)` SUBGOAL_TAC;
23104   IMATCH_MP_TAC  subf_cont;
23105   TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
23106   ASM_REWRITE_TAC[];
23107   EXPAND_TAC "A'";
23108   EXPAND_TAC "B'";
23109   CONJ_TAC;
23110   IMATCH_MP_TAC  closed_union;
23111   EXPAND_TAC "A";
23112   EXPAND_TAC "B";
23113   ASM_SIMP_TAC[top_of_metric_top];
23114   ASM_REWRITE_TAC[interval_closed];
23115   EXPAND_TAC "fA'";
23116   EXPAND_TAC "A'";
23117   EXPAND_TAC "A";
23118   EXPAND_TAC "B";
23119   REWRITE_TAC[UNION];
23120   GEN_TAC ;
23121   DISCH_TAC;
23122   TYPE_THEN `(x = a) \/ (x = b)` SUBGOAL_TAC;
23123   UND 21;
23124   REAL_ARITH_TAC;
23125   EXPAND_TAC "fA";
23126   EXPAND_TAC "fB";
23127   DISCH_THEN DISJ_CASES_TAC;
23128   UND 22;
23129   DISCH_THEN_REWRITE;
23130   REWRITE_TAC[subf;REAL_ARITH `a <= a`];
23131   UND 22;
23132   DISCH_THEN_REWRITE;
23133   REWRITE_TAC[subf];
23134   TYPE_THEN `~(b <= a)` SUBGOAL_TAC;
23135   UND 3;
23136   REAL_ARITH_TAC;
23137   DISCH_THEN_REWRITE;
23138   DISCH_TAC;
23139   (* -- *)
23140   TYPE_THEN `A' UNION B' = UNIV` SUBGOAL_TAC;
23141   EXPAND_TAC "A'";
23142   EXPAND_TAC "A";
23143   EXPAND_TAC "B";
23144   EXPAND_TAC "B'";
23145   IMATCH_MP_TAC  EQ_EXT;
23146   REWRITE_TAC[UNION];
23147   REAL_ARITH_TAC;
23148   DISCH_TAC;
23149   (* -- *)
23150   TYPE_THEN `g = subf A' fA' f` ABBREV_TAC  ;
23151   TYPE_THEN `!x. A x ==> (g x = f a)` SUBGOAL_TAC;
23152   EXPAND_TAC "g";
23153   REWRITE_TAC[subf];
23154   EXPAND_TAC "A'";
23155   REWRITE_TAC[UNION];
23156   GEN_TAC;
23157   DISCH_TAC;
23158   ASM_REWRITE_TAC[];
23159   EXPAND_TAC "fA'";
23160   REWRITE_TAC[subf];
23161   ASM_REWRITE_TAC[];
23162   EXPAND_TAC "fA";
23163   REWRITE_TAC[];
23164   DISCH_TAC;
23165   (* -- *)
23166   TYPE_THEN `!x. B x ==> (g x = f b)` SUBGOAL_TAC;
23167   EXPAND_TAC "g";
23168   REWRITE_TAC[subf];
23169   EXPAND_TAC "A'";
23170   REWRITE_TAC[UNION];
23171   GEN_TAC;
23172   DISCH_TAC;
23173   ASM_REWRITE_TAC[];
23174   EXPAND_TAC "fA'";
23175   REWRITE_TAC[subf];
23176   TYPE_THEN `~(A x)` SUBGOAL_TAC;
23177   UND 25;
23178   EXPAND_TAC "B";
23179   EXPAND_TAC "A";
23180   REWRITE_TAC[];
23181   UND 3;
23182   REAL_ARITH_TAC;
23183   DISCH_THEN_REWRITE;
23184   EXPAND_TAC "fB";
23185   REWRITE_TAC[];
23186   DISCH_TAC;
23187   (* A  *)
23188   TYPE_THEN `!x. B' x ==> (g x = f x)` SUBGOAL_TAC;
23189   REP_BASIC_TAC;
23190   TYPE_THEN `A x` ASM_CASES_TAC;
23191   TYPE_THEN `A x /\ B' x ==> (x = a)` SUBGOAL_TAC;
23192   EXPAND_TAC "A";
23193   EXPAND_TAC "B'";
23194   REWRITE_TAC[];
23195   REAL_ARITH_TAC;
23196   DISCH_TAC;
23197   ASM_MESON_TAC[];
23198   (* --2-- *)
23199   TYPE_THEN `B x` ASM_CASES_TAC;
23200   TYPE_THEN `B x /\ B' x ==> (x = b)` SUBGOAL_TAC;
23201   EXPAND_TAC "B";
23202   EXPAND_TAC "B'";
23203   REWRITE_TAC[];
23204   REAL_ARITH_TAC;
23205   DISCH_TAC;
23206   ASM_MESON_TAC[];
23207   TYPE_THEN `~(A' x)` SUBGOAL_TAC;
23208   UND 27;
23209   UND 28;
23210   EXPAND_TAC "A'";
23211   REWRITE_TAC[UNION];
23212   MESON_TAC[];
23213   EXPAND_TAC "g";
23214   REWRITE_TAC[subf];
23215   DISCH_THEN_REWRITE;
23216   DISCH_TAC;
23217   (* B start on goal *)
23218   TYPE_THEN `g` EXISTS_TAC;
23219   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
23220   CONJ_TAC;
23221   UND 26;
23222   EXPAND_TAC "B'";
23223   REWRITE_TAC[];
23224   MESON_TAC[];
23225   TYPE_THEN `IMAGE g UNIV SUBSET Y /\ metric_space (UNIV,d_real) /\ metric_space (Y,dY)` SUBGOAL_TAC;
23226   ASM_REWRITE_TAC[];
23227   UND 22;
23228   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
23229   REWRITE_TAC[IMAGE_UNION;union_subset];
23230   CONJ_TAC;
23231   EXPAND_TAC "A'";
23232   REWRITE_TAC[IMAGE_UNION;union_subset];
23233   UND 24;
23234   UND 25;
23235   REWRITE_TAC[IMAGE;SUBSET];
23236     TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC;
23237   UND 0;
23238   EXPAND_TAC "B'";
23239   REWRITE_TAC[IMAGE;SUBSET];
23240   TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC;
23241   UND 3;
23242   REAL_ARITH_TAC;
23243   MESON_TAC[];
23244   MESON_TAC[];
23245   UND 26;
23246   UND 0;
23247   EXPAND_TAC "B'";
23248   REWRITE_TAC[IMAGE;SUBSET];
23249   MESON_TAC[];
23250   DISCH_TAC;
23251   COPY 27;
23252   (* C final KILL *)
23253   USE 28 (MATCH_MP metric_continuous_continuous);
23254   ASM_REWRITE_TAC[];
23255   REWR 21;
23256   (* Wed Aug 11 12:37:40 EDT 2004 *)
23257
23258   ]);;
23259   (* }}} *)
23260
23261 let image_interval2 = prove_by_refinement(
23262   `!a b f. (a < b) /\
23263    (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
23264         (top_of_metric( UNIV,d_real)))  /\
23265     (INJ f {x | a <= x /\ x <= b} UNIV) ==>
23266    (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\
23267     (IMAGE f {x | a <= x /\ x <= b} =
23268        {x | c <= x /\ x <= d})
23269      )`,
23270   (* {{{ proof *)
23271   [
23272   REP_BASIC_TAC;
23273   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;
23274   IMATCH_MP_TAC  cont_extend_real_lemma;
23275   ASM_REWRITE_TAC[metric_real];
23276   REP_BASIC_TAC;
23277   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;
23278   ASM_REWRITE_TAC[];
23279   TYPE_THEN `INJ g {x | a <= x /\ x <= b} UNIV= INJ f {x | a <= x /\ x <= b} UNIV` SUBGOAL_TAC;
23280   IMATCH_MP_TAC  inj_domain_sub;
23281   REWRITE_TAC[];
23282   ASM_MESON_TAC[];
23283   DISCH_THEN_REWRITE;
23284   ASM_REWRITE_TAC[];
23285   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP image_interval t));
23286   REP_BASIC_TAC;
23287   (* -- *)
23288   TYPE_THEN `c` EXISTS_TAC;
23289   TYPE_THEN `d` EXISTS_TAC;
23290   ASM_REWRITE_TAC[];
23291   CONJ_TAC;
23292   TYPE_THEN `(f a = g a) /\ (f b = g b)` SUBGOAL_TAC;
23293   UND 3;
23294   UND 2;
23295   MESON_TAC[REAL_ARITH `(a < b) ==> (a<= a /\ a <= b /\ b <= b)`];
23296   DISCH_THEN_REWRITE;
23297   USE 5 SYM;
23298   ASM_REWRITE_TAC[];
23299   IMATCH_MP_TAC  image_domain_sub;
23300   ASM_REWRITE_TAC[];
23301   (* Wed Aug 11 12:51:52 EDT 2004 *)
23302
23303   ]);;
23304   (* }}} *)
23305
23306 let simple_arc_euclid = prove_by_refinement(
23307   `!C. (simple_arc top2 C ==> (C SUBSET (euclid 2)))`,
23308   (* {{{ proof *)
23309   [
23310   REP_BASIC_TAC;
23311   USE 0 (MATCH_MP simple_arc_compact);
23312   RULE_ASSUM_TAC (REWRITE_RULE[compact;top2_unions]);
23313   ASM_REWRITE_TAC[];
23314   ]);;
23315   (* }}} *)
23316
23317 let simple_arc_end_inj = prove_by_refinement(
23318   `!A B C v v'. (simple_arc_end A v v' /\ simple_arc_end B v v') /\
23319      (simple_arc top2 C) /\ (A SUBSET C) /\ (B SUBSET C) ==>
23320      (A = B)`,
23321   (* {{{ proof *)
23322   [
23323   (* A: *)
23324   REWRITE_TAC[simple_arc_end];
23325   REP_BASIC_TAC;
23326   TYPE_THEN `simple_arc (top_of_metric(euclid 2,d_euclid)) C /\ (metric_space(euclid 2,d_euclid))` SUBGOAL_TAC;
23327   ASM_REWRITE_TAC[GSYM top2;metric_euclid];
23328   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP   simple_arc_coord t));
23329   REP_BASIC_TAC;
23330   (* push to reals *)
23331   TYPE_THEN `(IMAGE f'' A = IMAGE f'' B) <=> (A = B)` SUBGOAL_TAC;
23332   IMATCH_MP_TAC  INJ_IMAGE ;
23333   TYPE_THEN `C` EXISTS_TAC;
23334   ASM_REWRITE_TAC[];
23335   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
23336   (* -- *)
23337   TYPE_THEN `C SUBSET (euclid 2)` SUBGOAL_TAC;
23338   IMATCH_MP_TAC simple_arc_euclid;
23339   ASM_REWRITE_TAC[];
23340   DISCH_TAC;
23341   (* -- *)
23342   TYPE_THEN `metric_space (C,d_euclid )` SUBGOAL_TAC;
23343   ASM_MESON_TAC[metric_subspace;metric_euclid];
23344   DISCH_TAC;
23345   (* -- *)
23346   TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
23347   REWRITE_TAC[SUBSET_UNIV];
23348   DISCH_TAC;
23349   (* -- *)
23350   TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
23351   IMATCH_MP_TAC  metric_subspace;
23352   TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
23353   ASM_REWRITE_TAC[metric_real];
23354   DISCH_TAC;
23355   (* -- *)
23356   (* -- *)
23357   TYPE_THEN `g = f'' o f` ABBREV_TAC ;
23358   TYPE_THEN `g'= f'' o f'` ABBREV_TAC ;
23359   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;
23360   IMATCH_MP_TAC  (GSYM top_of_metric_induced);
23361   ASM_REWRITE_TAC[metric_real];
23362   DISCH_TAC;
23363   (* -- *)
23364   TYPE_THEN `continuous f (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC;
23365   ASM_REWRITE_TAC[top2 ];
23366   IMATCH_MP_TAC  continuous_induced_domain;
23367   ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real];
23368   DISCH_TAC;
23369   (* -- *)
23370   TYPE_THEN `continuous f' (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC;
23371   ASM_REWRITE_TAC[top2 ];
23372   IMATCH_MP_TAC  continuous_induced_domain;
23373   ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real];
23374   DISCH_TAC;
23375   KILL 11;
23376   KILL 6;
23377   (* A *)
23378   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;
23379   CONJ_TAC;
23380   REAL_ARITH_TAC;
23381   CONJ_TAC;
23382   EXPAND_TAC "g";
23383   IMATCH_MP_TAC  continuous_comp;
23384   TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC;
23385   USE 22 GSYM;
23386   ASM_REWRITE_TAC[];
23387   ASM_SIMP_TAC[GSYM top_of_metric_unions];
23388   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
23389   CONJ_TAC;
23390   UND 1;
23391   ASM_REWRITE_TAC[];
23392   IMATCH_MP_TAC  continuous_range;
23393   TYPE_THEN `euclid 2` EXISTS_TAC;
23394   ASM_REWRITE_TAC[GSYM top2];
23395   ASM_SIMP_TAC[metric_euclid];
23396   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
23397   SUBCONJ_TAC;
23398   UND 1;
23399   ASM_REWRITE_TAC[];
23400   DISCH_TAC;
23401   IMATCH_MP_TAC  SUBSET_TRANS;
23402   TYPE_THEN `C` EXISTS_TAC;
23403   ASM_REWRITE_TAC[];
23404   (* --2-- *)
23405   EXPAND_TAC "g";
23406   IMATCH_MP_TAC  (REWRITE_RULE[GSYM comp_comp] COMP_INJ);
23407   TYPE_THEN `C` EXISTS_TAC;
23408   ASM_REWRITE_TAC[];
23409   IMATCH_MP_TAC  inj_subset;
23410   TYPE_THEN `(euclid 2)` EXISTS_TAC;
23411   ASM_REWRITE_TAC[];
23412   UND 1;
23413   ASM_REWRITE_TAC[];
23414   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t));
23415   REP_BASIC_TAC;
23416   (* -- *)
23417   ASM_REWRITE_TAC[];
23418   REWRITE_TAC[GSYM IMAGE_o];
23419   ASM_REWRITE_TAC[];
23420   (* B *)
23421     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;
23422   CONJ_TAC;
23423   REAL_ARITH_TAC;
23424   CONJ_TAC;
23425   EXPAND_TAC "g'";
23426   IMATCH_MP_TAC  continuous_comp;
23427   TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC;
23428   USE 22 GSYM;
23429   ASM_REWRITE_TAC[];
23430   ASM_SIMP_TAC[GSYM top_of_metric_unions];
23431   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
23432   CONJ_TAC;
23433   UND 0;
23434   ASM_REWRITE_TAC[];
23435   IMATCH_MP_TAC  continuous_range;
23436   TYPE_THEN `euclid 2` EXISTS_TAC;
23437   ASM_REWRITE_TAC[GSYM top2];
23438   ASM_SIMP_TAC[metric_euclid];
23439   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
23440   SUBCONJ_TAC;
23441   UND 0;
23442   ASM_REWRITE_TAC[];
23443   DISCH_TAC;
23444   IMATCH_MP_TAC  SUBSET_TRANS;
23445   TYPE_THEN `C` EXISTS_TAC;
23446   ASM_REWRITE_TAC[];
23447   (* --2-- *)
23448   EXPAND_TAC "g'";
23449   IMATCH_MP_TAC  (REWRITE_RULE[GSYM comp_comp] COMP_INJ);
23450   TYPE_THEN `C` EXISTS_TAC;
23451   ASM_REWRITE_TAC[];
23452   IMATCH_MP_TAC  inj_subset;
23453   TYPE_THEN `(euclid 2)` EXISTS_TAC;
23454   ASM_REWRITE_TAC[];
23455   UND 0;
23456   ASM_REWRITE_TAC[];
23457   DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t));
23458   REP_BASIC_TAC;
23459   (* C final steps *)
23460   TYPE_THEN `(g (&0) = g'(&0)) /\ (g(&1) = g'(&1))` SUBGOAL_TAC;
23461   EXPAND_TAC "g";
23462   EXPAND_TAC "g'";
23463   REWRITE_TAC[o_DEF ];
23464   ASM_REWRITE_TAC[];
23465   DISCH_TAC;
23466   UND 11;
23467   ASM_REWRITE_TAC[];
23468   (* temp *)
23469   DISCH_TAC;
23470   TYPE_THEN `(c = min_real (g'(&0)) (g'(&1))) /\ (d = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC;
23471   IMATCH_MP_TAC  pair_order_endpoint;
23472   ASM_REWRITE_TAC[];
23473   DISCH_THEN_REWRITE;
23474   TYPE_THEN `(c' = min_real (g'(&0)) (g'(&1))) /\ (d' = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC;
23475   IMATCH_MP_TAC  pair_order_endpoint;
23476   ASM_REWRITE_TAC[];
23477   DISCH_THEN_REWRITE;
23478   (* Wed Aug 11 15:10:02 EDT 2004 *)
23479
23480   ]);;
23481   (* }}} *)
23482
23483 let simple_arc_end_cut = prove_by_refinement(
23484   `!C v v' v''. simple_arc_end C v v' /\ (C v'') /\ ~(v'' = v) /\
23485     ~(v'' = v') ==>
23486     (?C' C''. (simple_arc_end C' v v'') /\ (simple_arc_end C'' v'' v') /\
23487      (C' INTER C'' = {v''}) /\ (C' UNION C'' = C))`,
23488   (* {{{ proof *)
23489   [
23490   REWRITE_TAC[simple_arc_end];
23491   REP_BASIC_TAC;
23492   (* -- INTER *)
23493   TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v''))` SUBGOAL_TAC;
23494   UND 2;
23495   ASM_REWRITE_TAC[];
23496   REWRITE_TAC[IMAGE];
23497    MESON_TAC[];
23498   REP_BASIC_TAC;
23499   TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC;
23500   TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC;
23501   REP_BASIC_TAC;
23502   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;
23503   IMATCH_MP_TAC (GSYM inj_inter );
23504   TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
23505   TYPE_THEN `(euclid 2)` EXISTS_TAC;
23506   ASM_REWRITE_TAC[];
23507   REWRITE_TAC[SUBSET];
23508   UND 9;
23509   UND 10;
23510   REAL_ARITH_TAC;
23511   DISCH_THEN_REWRITE;
23512   TYPE_THEN `{x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x <= &1} = {t}` SUBGOAL_TAC;
23513   IMATCH_MP_TAC  EQ_EXT;
23514   REWRITE_TAC[INTER;INR IN_SING];
23515   UND 9;
23516   UND 10;
23517   REAL_ARITH_TAC;
23518   DISCH_THEN_REWRITE;
23519   REWRITE_TAC[image_sing];
23520   ASM_REWRITE_TAC[];
23521   (* A UNION *)
23522   REWRITE_TAC[GSYM IMAGE_UNION];
23523   TYPE_THEN `{x | &0 <= x /\ x <= t} UNION {x | t <= x /\ x <= &1} = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
23524   IMATCH_MP_TAC  EQ_EXT;
23525   REWRITE_TAC[UNION;];
23526   UND 9;
23527   UND 10;
23528   REAL_ARITH_TAC;
23529   DISCH_THEN_REWRITE;
23530   (* B FIRST piece *)
23531   CONJ_TAC;
23532   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;
23533   ASM_REWRITE_TAC[];
23534   CONJ_TAC;
23535   IMATCH_MP_TAC inj_subset_domain;
23536   TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
23537   ASM_REWRITE_TAC[];
23538   REWRITE_TAC[SUBSET];
23539   UND 9;
23540   REAL_ARITH_TAC;
23541   TYPE_THEN `~(&0 = t)` SUBGOAL_TAC;
23542   PROOF_BY_CONTR_TAC;
23543   REWR 11;
23544   REWR 4;
23545   UND 10;
23546   REAL_ARITH_TAC;
23547   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
23548   REP_BASIC_TAC;
23549   TYPE_THEN `g` EXISTS_TAC;
23550   ASM_REWRITE_TAC[];
23551   ASM_MESON_TAC[];
23552   (* C LAST piece  *)
23553   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;
23554   ASM_REWRITE_TAC[];
23555   CONJ_TAC;
23556   IMATCH_MP_TAC inj_subset_domain;
23557   TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
23558   ASM_REWRITE_TAC[];
23559   REWRITE_TAC[SUBSET];
23560   UND 10;
23561   REAL_ARITH_TAC;
23562   TYPE_THEN `~( &1 = t)` SUBGOAL_TAC;
23563   PROOF_BY_CONTR_TAC;
23564   REWR 11;
23565   REWR 3;
23566   UND 9;
23567   REAL_ARITH_TAC;
23568   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
23569   REP_BASIC_TAC;
23570   TYPE_THEN `g` EXISTS_TAC;
23571   ASM_REWRITE_TAC[];
23572   ASM_MESON_TAC[];
23573   (* Wed Aug 11 15:54:37 EDT 2004 *)
23574
23575   ]);;
23576   (* }}} *)
23577
23578 let simple_closed_curve_pt = prove_by_refinement(
23579   `!C  v. (simple_closed_curve top2 C /\ C v) ==>
23580     (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
23581                continuous f (top_of_metric (UNIV,d_real)) top2 /\
23582                INJ f {x | &0 <= x /\ x < &1} (UNIONS top2) /\
23583                (f (&0) = v) /\
23584                (f (&0) = f (&1)))`,
23585   (* {{{ proof *)
23586   [
23587   REWRITE_TAC[simple_closed_curve];
23588   REP_BASIC_TAC;
23589   TYPE_THEN `f(&0) = v` ASM_CASES_TAC;
23590   TYPE_THEN `f` EXISTS_TAC;
23591   ASM_REWRITE_TAC[];
23592   ASM_MESON_TAC[];
23593   (* -- *)
23594   TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v))` SUBGOAL_TAC;
23595   UND 0;
23596   ASM_REWRITE_TAC[];
23597   REWRITE_TAC[IMAGE];
23598   MESON_TAC[];
23599   REP_BASIC_TAC;
23600   TYPE_THEN `~(t = &0)` SUBGOAL_TAC;
23601   PROOF_BY_CONTR_TAC;
23602   REWR 9;
23603   REWR 6;
23604   ASM_MESON_TAC[];
23605   DISCH_TAC;
23606   TYPE_THEN `~(t = &1)` SUBGOAL_TAC;
23607   PROOF_BY_CONTR_TAC;
23608   ASM_MESON_TAC[];
23609   DISCH_TAC;
23610   (* -- *)
23611   TYPE_THEN `{x | t <= x /\ x <= &1} = {x | t <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC;
23612   IMATCH_MP_TAC  EQ_EXT;
23613   REWRITE_TAC[UNION;INR IN_SING];
23614   UND 7;
23615   REAL_ARITH_TAC;
23616   DISCH_TAC;
23617   (* -- *)
23618   TYPE_THEN `INJ f {x | t <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC;
23619   ASM_REWRITE_TAC[];
23620   IMATCH_MP_TAC  inj_split;
23621   CONJ_TAC;
23622   IMATCH_MP_TAC  inj_subset_domain;
23623   TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC ;
23624   ASM_REWRITE_TAC[GSYM top2_unions];
23625   REWRITE_TAC[SUBSET];
23626   UND 8;
23627   REAL_ARITH_TAC;
23628   CONJ_TAC;
23629   REWRITE_TAC[INJ;INR IN_SING;];
23630   USE 2 (REWRITE_RULE[top2_unions]);
23631   TYPE_THEN `euclid 2 (f (&0))` SUBGOAL_TAC;
23632   USE 2 (REWRITE_RULE[INJ]);
23633   REP_BASIC_TAC;
23634   FIRST_ASSUM IMATCH_MP_TAC ;
23635   REAL_ARITH_TAC;
23636   ASM_REWRITE_TAC[];
23637   MESON_TAC[];
23638   REWRITE_TAC[EQ_EMPTY;IMAGE;INTER;image_sing;INR IN_SING;];
23639   NAME_CONFLICT_TAC;
23640   CONV_TAC (dropq_conv "x''");
23641   REP_GEN_TAC;
23642   REP_BASIC_TAC;
23643   TYPE_THEN `x' = &0` SUBGOAL_TAC;
23644   USE 2(REWRITE_RULE[INJ]);
23645   REP_BASIC_TAC;
23646   FIRST_ASSUM IMATCH_MP_TAC ;
23647   ASM_REWRITE_TAC[];
23648   UND 14;
23649   UND 8;
23650   REAL_ARITH_TAC;
23651   UND 14;
23652   UND 8;
23653   UND 9;
23654   REAL_ARITH_TAC;
23655   DISCH_TAC;
23656   (* [A] reparameter 1st part *)
23657   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;
23658   ASM_REWRITE_TAC[REAL_LT_HALF1];
23659   UND 7;
23660   UND 10;
23661   REAL_ARITH_TAC;
23662   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP  arc_reparameter_gen t));
23663   REP_BASIC_TAC;
23664   KILL 14;
23665   (* B 2nd part *)
23666   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;
23667   ASM_REWRITE_TAC[REAL_LT_HALF2];
23668   CONJ_TAC;
23669   USE 2(REWRITE_RULE[top2_unions]);
23670   IMATCH_MP_TAC  inj_subset_domain;
23671   TYPE_THEN `{x | &0 <= x /\ x < &1} ` EXISTS_TAC;
23672   ASM_REWRITE_TAC[SUBSET];
23673   UND 7;
23674   UND 10;
23675   REAL_ARITH_TAC;
23676   UND 8;
23677   UND 9;
23678   REAL_ARITH_TAC;
23679   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP  arc_reparameter_gen t));
23680   REP_BASIC_TAC;
23681   KILL 19;
23682   (* [C] JOIN functions *)
23683   TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC;
23684   TYPE_THEN `&0 < &1/(&2)` SUBGOAL_TAC;
23685   ASM_REWRITE_TAC[REAL_LT_HALF1];
23686   REAL_ARITH_TAC;
23687   DISCH_TAC;
23688   TYPE_THEN `&1/(&2) < &1` SUBGOAL_TAC;
23689   ASM_REWRITE_TAC[REAL_LT_HALF2];
23690   REAL_ARITH_TAC ;
23691   DISCH_TAC;
23692   (* -- *)
23693   TYPE_THEN `joinf g g' (&1/(&2)) (&0) = v` SUBGOAL_TAC;
23694   ASM_REWRITE_TAC[joinf];
23695   ASM_MESON_TAC[];
23696   DISCH_TAC;
23697   ASM_REWRITE_TAC[];
23698   TYPE_THEN `joinf g g' (&1/(&2)) (&1) = v` SUBGOAL_TAC;
23699   ASM_REWRITE_TAC[joinf];
23700   ASM_SIMP_TAC[REAL_ARITH `(&1/ &2 < &1) ==> ~(&1 < (&1/(&2)))`];
23701   ASM_MESON_TAC[];
23702   DISCH_TAC;
23703   ASM_REWRITE_TAC[];
23704   (* -- *)
23705   TYPE_THEN `continuous (joinf g g' (&1 / &2)) (top_of_metric (UNIV,d_real)) top2` SUBGOAL_TAC;
23706   REWRITE_TAC[top2];
23707   IMATCH_MP_TAC  joinf_cont;
23708   ASM_REWRITE_TAC[GSYM top2];
23709   ASM_MESON_TAC[];
23710   DISCH_THEN_REWRITE;
23711   (* [D] INJ *)
23712   TYPE_THEN `{x | &0 <= x /\ x < &1} = {x | &0 <= x /\ x < (&1/(&2))} UNION {x | (&1/(&2)) <= x /\ x < &1}` SUBGOAL_TAC;
23713   IMATCH_MP_TAC  EQ_EXT;
23714   ASM_REWRITE_TAC[UNION];
23715   UND 24;
23716   UND 19;
23717   REAL_ARITH_TAC;
23718   DISCH_THEN_REWRITE;
23719   (* -- *)
23720   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
23721   REWRITE_TAC[top2_unions];
23722   RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
23723   CONJ_TAC;
23724   IMATCH_MP_TAC  inj_split;
23725   TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = INJ g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
23726   IMATCH_MP_TAC  joinf_inj_below;
23727   REWRITE_TAC[SUBSET];
23728   REAL_ARITH_TAC;
23729   DISCH_THEN_REWRITE;
23730   TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = INJ g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC;
23731   IMATCH_MP_TAC  joinf_inj_above;
23732   REWRITE_TAC[SUBSET];
23733   REAL_ARITH_TAC;
23734   DISCH_THEN_REWRITE ;
23735   CONJ_TAC;
23736   IMATCH_MP_TAC  inj_subset_domain;
23737   TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
23738   ASM_REWRITE_TAC[];
23739   REWRITE_TAC[SUBSET];
23740   REAL_ARITH_TAC;
23741   CONJ_TAC;
23742   IMATCH_MP_TAC  inj_subset_domain;
23743   TYPE_THEN `{x | &1/(&2) <= x /\ x <= &1}` EXISTS_TAC;
23744   ASM_REWRITE_TAC[];
23745   REWRITE_TAC[SUBSET];
23746   REAL_ARITH_TAC;
23747   (* --2-- E IMAGE *)
23748   REWRITE_TAC[EQ_EMPTY];
23749   TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
23750   IMATCH_MP_TAC  joinf_image_below;
23751   REWRITE_TAC[SUBSET];
23752   REAL_ARITH_TAC;
23753   DISCH_THEN_REWRITE;
23754   TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = IMAGE g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC;
23755   IMATCH_MP_TAC  joinf_image_above;
23756   REWRITE_TAC[SUBSET];
23757   REAL_ARITH_TAC;
23758   DISCH_THEN_REWRITE;
23759   REWRITE_TAC[INTER];
23760   GEN_TAC;
23761   REWRITE_TAC[IMAGE;];
23762   DISCH_TAC;
23763   REP_BASIC_TAC;
23764   REWR 27;
23765   KILL 30;
23766   USE 13 (REWRITE_RULE[FUN_EQ_THM ]);
23767   TSPEC `g x'` 13;
23768   USE 13 (REWRITE_RULE[IMAGE]);
23769   TYPE_THEN `(?x. (&0 <= x /\ x <= &1 / &2) /\ (g x' = g x))` SUBGOAL_TAC;
23770   ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`];
23771   DISCH_TAC;
23772   REWR 13;
23773   KILL 30;
23774   REP_BASIC_TAC;
23775   USE 14 (REWRITE_RULE[FUN_EQ_THM;]);
23776   TSPEC `g' x''` 14;
23777   USE 14 (REWRITE_RULE[IMAGE]);
23778   TYPE_THEN `(?x. (&1 / &2 <= x /\ x <= &1) /\ (g' x'' = g' x))` SUBGOAL_TAC;
23779   ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`];
23780   DISCH_TAC;
23781   REWR 14;
23782   KILL 34;
23783   REP_BASIC_TAC;
23784   TYPE_THEN `(x = x''')` SUBGOAL_TAC;
23785   USE 2 (REWRITE_RULE[INJ]);
23786   REP_BASIC_TAC;
23787   FIRST_ASSUM IMATCH_MP_TAC ;
23788   ASM_REWRITE_TAC[];
23789   TYPE_THEN `~(x = &0)` SUBGOAL_TAC;
23790   DISCH_TAC;
23791   TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC;
23792   ASM_MESON_TAC[];
23793   DISCH_TAC;
23794   TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC;
23795   USE 17(REWRITE_RULE[INJ]);
23796   REP_BASIC_TAC;
23797   FIRST_ASSUM IMATCH_MP_TAC ;
23798   ASM_REWRITE_TAC[];
23799   UND 31;
23800   UND 24;
23801   UND 19;
23802   REAL_ARITH_TAC;
23803   UND 31;
23804   REAL_ARITH_TAC;
23805   TYPE_THEN `~(x = &1)` SUBGOAL_TAC;
23806   DISCH_TAC;
23807   TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC;
23808   ASM_MESON_TAC[];
23809   DISCH_TAC;
23810   TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC;
23811   USE 17(REWRITE_RULE[INJ]);
23812   REP_BASIC_TAC;
23813   FIRST_ASSUM IMATCH_MP_TAC ;
23814   ASM_REWRITE_TAC[];
23815   UND 31;
23816   UND 24;
23817   UND 19;
23818   REAL_ARITH_TAC;
23819   UND 31;
23820   REAL_ARITH_TAC;
23821   UND 34;
23822   UND 7;
23823   UND 10;
23824   UND 33;
23825   UND 8;
23826   UND 9;
23827   UND 30;
23828   REAL_ARITH_TAC;
23829   DISCH_TAC;
23830   (* --2-- *)
23831   TYPE_THEN `x = t` SUBGOAL_TAC;
23832   UND 36;
23833   UND 35;
23834   UND 34;
23835   UND 33;
23836   UND 30;
23837   REAL_ARITH_TAC;
23838   DISCH_TAC;
23839   TYPE_THEN `g' (&1) = g'(x'')` SUBGOAL_TAC;
23840   ASM_MESON_TAC[];
23841   DISCH_TAC;
23842   TYPE_THEN `&1 = x''` SUBGOAL_TAC;
23843   USE 22(REWRITE_RULE[INJ]);
23844   REP_BASIC_TAC;
23845   FIRST_ASSUM IMATCH_MP_TAC ;
23846   ASM_REWRITE_TAC[];
23847   UND 28;
23848   UND 24;
23849   UND 19;
23850   REAL_ARITH_TAC;
23851   UND 28;
23852   REAL_ARITH_TAC;
23853   (* F IMAGE *)
23854   TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC;
23855   IMATCH_MP_TAC  EQ_EXT;
23856   REWRITE_TAC[UNION ];
23857   UND  24;
23858   UND 19;
23859   REAL_ARITH_TAC;
23860   DISCH_TAC;
23861   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 ));
23862   ASM_REWRITE_TAC[];
23863   USE 27 SYM;
23864   ASM_REWRITE_TAC[];
23865   TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
23866   IMATCH_MP_TAC  joinf_image_below;
23867   REWRITE_TAC[SUBSET];
23868   MESON_TAC[];
23869   DISCH_THEN_REWRITE;
23870   TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC;
23871   IMATCH_MP_TAC  joinf_image_above;
23872   REWRITE_TAC[SUBSET];
23873   MESON_TAC[];
23874   DISCH_THEN_REWRITE;
23875   USE 14 GSYM ;
23876   ASM_REWRITE_TAC[];
23877   (* F final  *)
23878   TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC;
23879   IMATCH_MP_TAC  EQ_EXT;
23880   REWRITE_TAC[UNION;INR IN_SING];
23881   REAL_ARITH_TAC;
23882   DISCH_TAC ;
23883   (* -- *)
23884   TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= &1} = IMAGE f {x | &0 <= x /\ x < &1}` SUBGOAL_TAC;
23885   ASM_REWRITE_TAC[];
23886   REWRITE_TAC[IMAGE_UNION;image_sing; ];
23887   IMATCH_MP_TAC  SUBSET_ANTISYM;
23888   CONJ_TAC;
23889   REWRITE_TAC[union_subset;SUBSET_REFL];
23890   REWRITE_TAC[SUBSET;INR IN_SING;];
23891   GEN_TAC;
23892   DISCH_THEN_REWRITE;
23893   UND 1;
23894   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
23895   REWRITE_TAC[IMAGE];
23896   TYPE_THEN `&0` EXISTS_TAC;
23897   REWRITE_TAC[];
23898   REAL_ARITH_TAC;
23899   REWRITE_TAC[SUBSET_UNION];
23900   DISCH_TAC;
23901   ASM_REWRITE_TAC[];
23902   (* -- *)
23903   TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1/(&2)} = IMAGE f {x | t <= x /\ x < &1}` SUBGOAL_TAC;
23904   IMATCH_MP_TAC  SUBSET_ANTISYM;
23905   CONJ_TAC;
23906   IMATCH_MP_TAC  SUBSET_TRANS;
23907   TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1} DELETE (f (&1))` EXISTS_TAC;
23908   CONJ_TAC;
23909   ASM_REWRITE_TAC[SUBSET_DELETE];
23910   CONJ_TAC;
23911   REWRITE_TAC[IMAGE;];
23912   REP_BASIC_TAC;
23913   TYPE_THEN `x = (&1/(&2))` SUBGOAL_TAC;
23914   USE 17(REWRITE_RULE[INJ]);
23915   REP_BASIC_TAC;
23916   FIRST_ASSUM IMATCH_MP_TAC ;
23917   ASM_REWRITE_TAC[];
23918   UND 32;
23919   UND 19;
23920   REAL_ARITH_TAC;
23921   UND 32;
23922   REAL_ARITH_TAC;
23923   IMATCH_MP_TAC  IMAGE_SUBSET;
23924   REWRITE_TAC[SUBSET];
23925   REAL_ARITH_TAC;
23926   REWRITE_TAC[DELETE;IMAGE;SUBSET;];
23927   REWRITE_TAC[REAL_ARITH `x <= &1 <=> (x < &1 \/ (x = &1))`];
23928   MESON_TAC[];
23929   (* --2--*)
23930   IMATCH_MP_TAC  SUBSET_TRANS;
23931   TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)} DELETE (g (&1/(&2)))` EXISTS_TAC;
23932   CONJ_TAC;
23933   USE 13 GSYM;
23934   USE 15 GSYM;
23935   ASM_REWRITE_TAC[SUBSET_DELETE];
23936   CONJ_TAC;
23937   REWRITE_TAC[IMAGE;];
23938   REP_BASIC_TAC;
23939   TYPE_THEN `&1 = x` SUBGOAL_TAC;
23940   USE 12(REWRITE_RULE[INJ]);
23941   REP_BASIC_TAC;
23942   FIRST_ASSUM IMATCH_MP_TAC ;
23943   ASM_REWRITE_TAC[];
23944   UND 32;
23945   REAL_ARITH_TAC;
23946   UND 32;
23947   REAL_ARITH_TAC;
23948   USE 11 SYM;
23949   ASM_REWRITE_TAC[];
23950   IMATCH_MP_TAC  IMAGE_SUBSET;
23951   REWRITE_TAC[SUBSET];
23952   REAL_ARITH_TAC;
23953   REWRITE_TAC[DELETE;IMAGE;SUBSET;];
23954   REWRITE_TAC[REAL_ARITH `x <= &1/(&2) <=> (x < &1/(&2) \/ (x = &1/(&2)))`];
23955   MESON_TAC[];
23956   DISCH_THEN_REWRITE;
23957   (* G *)
23958   REWRITE_TAC[GSYM IMAGE_UNION];
23959   AP_TERM_TAC;
23960   IMATCH_MP_TAC  EQ_EXT;
23961   REWRITE_TAC[UNION];
23962   UND 8;
23963   UND 7;
23964   UND 10;
23965   REAL_ARITH_TAC;
23966   (* -- World's worst proof *)
23967   (* Thu Aug 12 07:44:29 EDT 2004 *)
23968
23969   ]);;
23970
23971
23972   (* }}} *)
23973
23974 let shift_inj = prove_by_refinement(
23975   `!(f:real->A) X t. (INJ f {x | &0 <= x /\ x < &1} X) /\
23976           (f (&0) = f(&1)) /\ (&0 < t) ==>
23977      INJ f {x | t <= x /\ x <= &1} X`,
23978   (* {{{ proof *)
23979   [
23980   REWRITE_TAC[INJ];
23981   REP_BASIC_TAC;
23982   CONJ_TAC;
23983   REP_BASIC_TAC;
23984   TYPE_THEN `x < &1` ASM_CASES_TAC;
23985   FIRST_ASSUM IMATCH_MP_TAC ;
23986   ASM_REWRITE_TAC[];
23987   UND 5;
23988   UND 0;
23989   REAL_ARITH_TAC;
23990   TYPE_THEN `x = &1` SUBGOAL_TAC;
23991   UND 4;
23992   UND 6;
23993   REAL_ARITH_TAC;
23994   DISCH_THEN_REWRITE;
23995   USE 1 GSYM;
23996   ASM_REWRITE_TAC[];
23997   FIRST_ASSUM IMATCH_MP_TAC ;
23998   REAL_ARITH_TAC;
23999   REP_BASIC_TAC;
24000   (* -- *)
24001   TYPE_THEN `((x = &1) /\ (y = &1)) \/ ((x < &1) /\ (y = &1)) \/ ((x = &1) /\ (y < &1)) \/ ((x < &1) /\ (y < &1))` SUBGOAL_TAC;
24002   UND 5;
24003   UND 7;
24004   REAL_ARITH_TAC;
24005   REP_CASES_TAC;
24006   ASM_REWRITE_TAC[];
24007   USE 1 SYM ;
24008   REWR 4;
24009   TYPE_THEN `x = &0` SUBGOAL_TAC;
24010   FIRST_ASSUM  IMATCH_MP_TAC ;
24011   ASM_REWRITE_TAC[];
24012   UND 8;
24013   UND 0;
24014   REAL_ARITH_TAC;
24015   UND 8;
24016   UND 0;
24017   REAL_ARITH_TAC;
24018   USE 1 SYM;
24019   REWR 4;
24020   TYPE_THEN `y = &0` SUBGOAL_TAC;
24021   FIRST_ASSUM  IMATCH_MP_TAC ;
24022   ASM_REWRITE_TAC[];
24023   UND 6;
24024   UND 0;
24025   REAL_ARITH_TAC;
24026   UND 6;
24027   UND 0;
24028   REAL_ARITH_TAC;
24029   FIRST_ASSUM IMATCH_MP_TAC ;
24030   ASM_REWRITE_TAC[];
24031   UND 6;
24032   UND 8;
24033   UND 0;
24034   REAL_ARITH_TAC;
24035   (* Thu Aug 12 08:33:16 EDT 2004 *)
24036
24037   ]);;
24038   (* }}} *)
24039
24040 let simple_arc_segment = prove_by_refinement(
24041   `!f u v.
24042           continuous f (top_of_metric (UNIV,d_real)) top2 /\
24043               INJ f {x | &0 <= x /\ x < &1} (euclid 2) /\
24044               (f (&0) = f (&1)) /\
24045        (&0 <= u /\ u < v /\ v <= &1 /\ (&0 < u \/ v < &1)) ==>
24046      simple_arc_end (IMAGE f {x | u <= x /\ x <= v}) (f u) (f v)`,
24047   (* {{{ proof *)
24048   [
24049   REP_BASIC_TAC;
24050   REWRITE_TAC[simple_arc_end];
24051   (* -- *)
24052   TYPE_THEN `(&0 < u) ==> INJ f { x | u <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC ;
24053   DISCH_TAC;
24054   IMATCH_MP_TAC  shift_inj;
24055   ASM_REWRITE_TAC[];
24056   DISCH_TAC;
24057   (* -- *)
24058   TYPE_THEN `INJ f { x | u <= x /\ x <= v } (euclid 2)`  SUBGOAL_TAC;
24059   UND 0;
24060   DISCH_THEN DISJ_CASES_TAC;
24061   IMATCH_MP_TAC  inj_subset_domain;
24062   TYPE_THEN `{x | u <= x /\ x <= &1}` EXISTS_TAC;
24063   REWR 7;
24064   ASM_REWRITE_TAC[SUBSET ];
24065   UND 1;
24066   REAL_ARITH_TAC;
24067   IMATCH_MP_TAC  inj_subset_domain;
24068   TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
24069   ASM_REWRITE_TAC[];
24070   REWRITE_TAC[SUBSET];
24071   UND 0;
24072   UND 3;
24073   REAL_ARITH_TAC;
24074   DISCH_TAC;
24075   (* -- *)
24076   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;
24077   ASM_REWRITE_TAC[];
24078   REAL_ARITH_TAC;
24079   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
24080   REP_BASIC_TAC;
24081   TYPE_THEN `g` EXISTS_TAC;
24082   ASM_REWRITE_TAC[];
24083   (* Thu Aug 12 08:55:11 EDT 2004 *)
24084
24085   ]);;
24086   (* }}} *)
24087
24088 let simple_closed_cut = prove_by_refinement(
24089   `!C v v'. (simple_closed_curve top2 C /\ C v /\ C v' /\ ~(v = v')
24090    ==> (?C' C''. simple_arc_end C' v v' /\ simple_arc_end C'' v v'
24091       /\ (  C' UNION C'' = C) /\ (C' INTER C'' = {v,v'})))`,
24092   (* {{{ proof *)
24093   [
24094   REP_BASIC_TAC;
24095   TYPE_THEN `simple_closed_curve top2 C /\ C v` SUBGOAL_TAC;
24096   ASM_REWRITE_TAC[];
24097   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_closed_curve_pt t));
24098   REP_BASIC_TAC;
24099   (* -- *)
24100   TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f(t) = v'))` SUBGOAL_TAC;
24101   UND 1;
24102   ASM_REWRITE_TAC[IMAGE];
24103   MESON_TAC[];
24104   REP_BASIC_TAC;
24105   TYPE_THEN `t < &1` SUBGOAL_TAC;
24106   IMATCH_MP_TAC  (REAL_ARITH `~( t= &1) /\ (t <= &1) ==> (t  < &1)`);
24107   ASM_REWRITE_TAC[];
24108   DISCH_TAC;
24109   REWR 9;
24110   ASM_MESON_TAC[];
24111   DISCH_TAC;
24112   (* -- *)
24113   TYPE_THEN `&0 < t` SUBGOAL_TAC;
24114   IMATCH_MP_TAC  (REAL_ARITH `~(t = &0) /\ (&0 <= t) ==> (&0 < t)`);
24115   ASM_REWRITE_TAC[];
24116   DISCH_TAC;
24117   REWR 9;
24118   DISCH_TAC;
24119   (* -- *)
24120   TYPE_THEN `C' = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ;
24121   TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ;
24122   TYPE_THEN `C'` EXISTS_TAC;
24123   TYPE_THEN `C''` EXISTS_TAC;
24124   CONJ_TAC;
24125   EXPAND_TAC "C'";
24126   EXPAND_TAC "v";
24127   EXPAND_TAC "v'";
24128   IMATCH_MP_TAC simple_arc_segment;
24129   RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
24130   ASM_REWRITE_TAC[];
24131   ASM_MESON_TAC[REAL_ARITH `x <= x`];
24132   (* -- *)
24133   CONJ_TAC;
24134   USE 5 SYM;
24135   ASM_REWRITE_TAC[];
24136   EXPAND_TAC "C''";
24137   EXPAND_TAC "v'";
24138   IMATCH_MP_TAC  simple_arc_end_symm;
24139   IMATCH_MP_TAC  simple_arc_segment;
24140   RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
24141   ASM_REWRITE_TAC[];
24142   REAL_ARITH_TAC;
24143   (* -- *)
24144   CONJ_TAC;
24145   ASM_REWRITE_TAC[];
24146   EXPAND_TAC "C'";
24147   EXPAND_TAC "C''";
24148   REWRITE_TAC[GSYM IMAGE_UNION];
24149   AP_TERM_TAC;
24150   IMATCH_MP_TAC  EQ_EXT;
24151   REWRITE_TAC[UNION];
24152   UND 13;
24153   UND 12;
24154   REAL_ARITH_TAC;
24155   (* -- *)
24156   TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x < &1} UNION IMAGE f {(&1)}` SUBGOAL_TAC;
24157   REWRITE_TAC[GSYM IMAGE_UNION];
24158   EXPAND_TAC "C''";
24159   AP_TERM_TAC;
24160   IMATCH_MP_TAC  EQ_EXT;
24161   REWRITE_TAC[UNION;INR IN_SING ];
24162   UND 12;
24163   REAL_ARITH_TAC;
24164   DISCH_THEN_REWRITE;
24165   (* -- *)
24166   REWRITE_TAC[UNION_OVER_INTER;image_sing];
24167   EXPAND_TAC "C'";
24168   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;
24169   IMATCH_MP_TAC  inj_inter;
24170   TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
24171   TYPE_THEN `(UNIONS top2)` EXISTS_TAC;
24172   ASM_REWRITE_TAC[];
24173   REWRITE_TAC[SUBSET];
24174   UND 12;
24175   UND 13;
24176   REAL_ARITH_TAC;
24177   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
24178   (* -- *)
24179   TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x < &1}) = {t}` SUBGOAL_TAC;
24180   IMATCH_MP_TAC  EQ_EXT;
24181   REWRITE_TAC[INTER;INR IN_SING];
24182   UND 13;
24183   UND 12;
24184   REAL_ARITH_TAC;
24185   DISCH_THEN_REWRITE;
24186   TYPE_THEN `{(f (&1))} = IMAGE f {(&0)}` SUBGOAL_TAC;
24187   REWRITE_TAC[image_sing];
24188   ASM_MESON_TAC[];
24189   DISCH_THEN_REWRITE;
24190   TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER  {(&0)})  ) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {(&0)} )` SUBGOAL_TAC;
24191   IMATCH_MP_TAC  inj_inter;
24192   TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
24193   TYPE_THEN `UNIONS top2` EXISTS_TAC;
24194   ASM_REWRITE_TAC[];
24195   REWRITE_TAC[SUBSET;INR IN_SING];
24196   UND 12;
24197   UND 13;
24198   REAL_ARITH_TAC;
24199   DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
24200   (* -- *)
24201   TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {(&0)}) = {(&0)}` SUBGOAL_TAC;
24202   IMATCH_MP_TAC  EQ_EXT;
24203   REWRITE_TAC[INTER;INR IN_SING ];
24204   UND 11;
24205   REAL_ARITH_TAC;
24206   DISCH_THEN_REWRITE;
24207   REWRITE_TAC[image_sing];
24208   IMATCH_MP_TAC  EQ_EXT;
24209   REWRITE_TAC[in_pair];
24210   REWRITE_TAC[UNION;INR IN_SING];
24211   ASM_MESON_TAC[];
24212   (* Thu Aug 12 09:35:48 EDT 2004 *)
24213
24214   ]);;
24215   (* }}} *)
24216
24217 (* ------------------------------------------------------------------ *)
24218 (* SECTION M *)
24219 (* ------------------------------------------------------------------ *)
24220
24221
24222 let closed_point = prove_by_refinement(
24223   `!x. (euclid 2 x) ==> (closed_ top2 {x})`,
24224   (* {{{ proof *)
24225   [
24226   REP_BASIC_TAC;
24227   IMATCH_MP_TAC  compact_closed;
24228   REWRITE_TAC[top2_top];
24229   ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
24230   IMATCH_MP_TAC  compact_point;
24231   ASM_REWRITE_TAC[GSYM top2;top2_unions];
24232   (* Fri Aug 13 08:42:22 EDT 2004 *)
24233
24234   ]);;
24235   (* }}} *)
24236
24237 let simple_arc_end_closed = prove_by_refinement(
24238   `!C v v'. (simple_arc_end C v v' ==> closed_ top2 C) `,
24239   (* {{{ proof *)
24240   [
24241   REP_BASIC_TAC;
24242   IMATCH_MP_TAC  compact_closed;
24243   REWRITE_TAC[top2_top];
24244   ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
24245   REWRITE_TAC [GSYM top2];
24246   IMATCH_MP_TAC  simple_arc_compact;
24247   IMATCH_MP_TAC  simple_arc_end_simple;
24248   ASM_MESON_TAC[];
24249   (* Fri Aug 13 09:33:35 EDT 2004 *)
24250
24251   ]);;
24252   (* }}} *)
24253
24254 let simple_arc_end_end = prove_by_refinement(
24255   `!C v v'. (simple_arc_end C v v' ==> C v)`,
24256   (* {{{ proof *)
24257   [
24258   REWRITE_TAC[simple_arc_end];
24259   REP_BASIC_TAC;
24260   ASM_REWRITE_TAC[];
24261   EXPAND_TAC "v";
24262   REWRITE_TAC[IMAGE;];
24263   TYPE_THEN `&0` EXISTS_TAC;
24264   ASM_REWRITE_TAC[];
24265   REAL_ARITH_TAC;
24266   (* Fri Aug 13 09:40:59 EDT 2004 *)
24267
24268   ]);;
24269   (* }}} *)
24270
24271 let simple_arc_end_end2 = prove_by_refinement(
24272   `!C v v'. (simple_arc_end C v v' ==> C v')`,
24273   (* {{{ proof *)
24274   [
24275   REWRITE_TAC[simple_arc_end];
24276   REP_BASIC_TAC;
24277   ASM_REWRITE_TAC[];
24278   EXPAND_TAC "v'";
24279   REWRITE_TAC[IMAGE;];
24280   TYPE_THEN `&1` EXISTS_TAC;
24281   ASM_REWRITE_TAC[];
24282   REAL_ARITH_TAC;
24283   (* Fri Aug 13 09:42:07 EDT 2004 *)
24284   ]);;
24285   (* }}} *)
24286
24287 let simple_arc_end_end_closed = prove_by_refinement(
24288   `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v}`,
24289   (* {{{ proof *)
24290   [
24291   REP_BASIC_TAC;
24292   IMATCH_MP_TAC  closed_point;
24293   TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
24294   IMATCH_MP_TAC  simple_arc_euclid;
24295   IMATCH_MP_TAC  simple_arc_end_simple;
24296   ASM_MESON_TAC[];
24297   TYPE_THEN `C v` SUBGOAL_TAC;
24298   IMATCH_MP_TAC  simple_arc_end_end;
24299   ASM_MESON_TAC[];
24300   MESON_TAC[ISUBSET];
24301   ]);;
24302   (* }}} *)
24303
24304 let simple_arc_end_end_closed2 = prove_by_refinement(
24305   `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v'}`,
24306   (* {{{ proof *)
24307
24308   [
24309   ASM_MESON_TAC[simple_arc_end_end_closed;simple_arc_end_symm;];
24310   ]);;
24311
24312   (* }}} *)
24313
24314 let simple_arc_sep3 = prove_by_refinement(
24315   `!A C1 C2 C3 x p1 p2 p3.
24316      (C1 UNION C2 UNION C3 SUBSET A) /\
24317      (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\
24318      (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\
24319      (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==>
24320      (?x' C1' C2' C3'.
24321      (C1' UNION C2' UNION C3' SUBSET A) /\
24322      (simple_arc_end C1' x' p1) /\
24323      (simple_arc_end C2' x' p2) /\
24324      (simple_arc_end C3' x' p3) /\
24325      ~(C2' p3) /\ ~(C3' p2) /\
24326      (C1' INTER C2' = {x'} ) /\
24327      (C1' INTER C3' = {x'} ))
24328      `,
24329   (* {{{ proof *)
24330   [
24331   REP_BASIC_TAC;
24332   TYPE_THEN `K = C2 UNION C3` ABBREV_TAC ;
24333   TYPE_THEN `~((C1 INTER K) = EMPTY)` SUBGOAL_TAC;
24334   EXPAND_TAC "K";
24335   REWRITE_TAC[EMPTY_EXISTS;INTER ];
24336   REWRITE_TAC[UNION];
24337   TYPE_THEN `x` EXISTS_TAC;
24338   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
24339   DISCH_TAC;
24340   (* -- *)
24341   TYPE_THEN `closed_ top2 K` SUBGOAL_TAC;
24342   EXPAND_TAC "K";
24343   IMATCH_MP_TAC  closed_union;
24344   ASM_MESON_TAC[simple_arc_end_closed;top2_top];
24345   DISCH_TAC;
24346   (* -- *)
24347   TYPE_THEN `~((C1 INTER {p1}) = EMPTY)` SUBGOAL_TAC;
24348   REWRITE_TAC[INTER;EMPTY_EXISTS;INR IN_SING];
24349   ASM_MESON_TAC[simple_arc_end_end2];
24350   DISCH_TAC;
24351   (* -- *)
24352   TYPE_THEN `(?C1' x' v'. C1' SUBSET C1 /\ simple_arc_end C1' x' v' /\ (C1' INTER K = {x'}) /\ (C1' INTER {p1} = {v'}))` SUBGOAL_TAC;
24353   IMATCH_MP_TAC  simple_arc_end_restriction;
24354   ASM_REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING ];
24355   CONJ_TAC;
24356   ASM_MESON_TAC[simple_arc_end_simple];
24357   CONJ_TAC;
24358   IMATCH_MP_TAC  simple_arc_end_end_closed2;
24359   ASM_MESON_TAC[];
24360   CONV_TAC (dropq_conv "x");
24361   REWRITE_TAC[DE_MORGAN_THM];
24362   DISJ2_TAC;
24363   EXPAND_TAC "K";
24364   REWRITE_TAC[UNION];
24365   ASM_REWRITE_TAC[];
24366   REP_BASIC_TAC;
24367   (* -- *)
24368   TYPE_THEN `v' = p1` SUBGOAL_TAC;
24369   USE 14 (REWRITE_RULE[FUN_EQ_THM]);
24370   USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
24371   ASM_MESON_TAC[];
24372   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
24373   KILL 14;
24374   (* -- *)
24375   (* [A] case x' = x *)
24376   TYPE_THEN `x' = x` ASM_CASES_TAC;
24377   UND 14;
24378   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
24379   TYPE_THEN `x` EXISTS_TAC;
24380   TYPE_THEN `C1` EXISTS_TAC;
24381   TYPE_THEN `C2` EXISTS_TAC;
24382   TYPE_THEN `C3` EXISTS_TAC;
24383   ASM_REWRITE_TAC[];
24384   TYPE_THEN `C1' = C1` SUBGOAL_TAC;
24385   IMATCH_MP_TAC  simple_arc_end_inj;
24386   TYPE_THEN `C1` EXISTS_TAC;
24387   TYPE_THEN `x` EXISTS_TAC;
24388   TYPE_THEN `p1` EXISTS_TAC;
24389   ASM_REWRITE_TAC[SUBSET_REFL ];
24390   IMATCH_MP_TAC  simple_arc_end_simple;
24391   ASM_MESON_TAC[];
24392   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
24393   (* --2-- *)
24394   CONJ_TAC;
24395   IMATCH_MP_TAC  EQ_EXT;
24396   GEN_TAC;
24397   REWRITE_TAC[INTER;INR IN_SING];
24398   EQ_TAC;
24399   USE 15 (REWRITE_RULE[FUN_EQ_THM;]);
24400   USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
24401   UND 14;
24402   EXPAND_TAC "K";
24403   REWRITE_TAC[UNION];
24404   MESON_TAC[];
24405   DISCH_THEN_REWRITE;
24406   ASM_MESON_TAC[simple_arc_end_end];
24407   (* --2'-- *)
24408   IMATCH_MP_TAC  EQ_EXT;
24409   GEN_TAC;
24410   REWRITE_TAC[INTER;INR IN_SING];
24411   EQ_TAC;
24412   USE 15 (REWRITE_RULE[FUN_EQ_THM;]);
24413   USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
24414   UND 14;
24415   EXPAND_TAC "K";
24416   REWRITE_TAC[UNION];
24417   MESON_TAC[];
24418   DISCH_THEN_REWRITE;
24419   ASM_MESON_TAC[simple_arc_end_end];
24420   (* B cut C1 at- x'  *)
24421   TYPE_THEN `~(x' = p1)` SUBGOAL_TAC;
24422   ASM_MESON_TAC[simple_arc_end_distinct];
24423   DISCH_TAC;
24424   (* -- *)
24425   TYPE_THEN `C1' x'` SUBGOAL_TAC;
24426   IMATCH_MP_TAC  simple_arc_end_end;
24427   ASM_MESON_TAC[];
24428   DISCH_TAC;
24429   (* -- *)
24430   TYPE_THEN `simple_arc_end C1 x p1 /\ C1 x' /\ ~(x' = x) /\ ~(x' = p1)` SUBGOAL_TAC;
24431   ASM_REWRITE_TAC[];
24432   UND 17;
24433   UND 19;
24434   MESON_TAC[ISUBSET];
24435   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
24436   REP_BASIC_TAC;
24437   (* -- *)
24438   TYPE_THEN `C'' = C1'` SUBGOAL_TAC;
24439   IMATCH_MP_TAC  simple_arc_end_inj;
24440   TYPE_THEN `C1` EXISTS_TAC;
24441   TYPE_THEN `x'` EXISTS_TAC;
24442   TYPE_THEN `p1` EXISTS_TAC;
24443   ASM_REWRITE_TAC[];
24444   CONJ_TAC;
24445   IMATCH_MP_TAC  simple_arc_end_simple;
24446   ASM_MESON_TAC[];
24447   UND 20;
24448   SET_TAC[UNION;SUBSET];
24449   DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
24450   (* -- *)
24451   TYPE_THEN `C1 x'` SUBGOAL_TAC;
24452   UND 19;
24453   UND 17;
24454   MESON_TAC[ISUBSET];
24455   DISCH_TAC;
24456   (* -- *)
24457     TYPE_THEN `x'` EXISTS_TAC;
24458   TYPE_THEN `C1'` EXISTS_TAC;
24459   ASM_REWRITE_TAC[];
24460   ONCE_REWRITE_TAC[union_subset];
24461   TYPE_THEN `C1' SUBSET A` SUBGOAL_TAC;
24462   IMATCH_MP_TAC  SUBSET_TRANS;
24463   TYPE_THEN `C1 UNION K ` EXISTS_TAC;
24464   ASM_REWRITE_TAC[];
24465   IMATCH_MP_TAC  SUBSET_TRANS;
24466   TYPE_THEN `C1` EXISTS_TAC;
24467   ASM_REWRITE_TAC[SUBSET_UNION];
24468   DISCH_THEN_REWRITE;
24469   (* [C] C2 x'  *)
24470   (* ------- *)
24471   TYPE_THEN `C2 x'` ASM_CASES_TAC;
24472   TYPE_THEN `simple_arc_end C2 x p2 /\ C2 x' /\ ~(x' = x) /\ ~(x' = p2)` SUBGOAL_TAC;
24473   ASM_REWRITE_TAC[];
24474     ASM_MESON_TAC[];
24475   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
24476   REP_BASIC_TAC;
24477   TYPE_THEN `C2' = C''''` ABBREV_TAC ;
24478   KILL 30;
24479   (*---- *)
24480   TYPE_THEN `C2'` EXISTS_TAC;
24481   ASM_REWRITE_TAC[];
24482   TYPE_THEN `C2' SUBSET C2` SUBGOAL_TAC;
24483   USE 26 ( (REWRITE_RULE[FUN_EQ_THM]));
24484   USE 26 (REWRITE_RULE[UNION]);
24485   UND 26;
24486   REWRITE_TAC[SUBSET];
24487   MESON_TAC[];
24488   DISCH_TAC;
24489   TYPE_THEN `~C2' p3` SUBGOAL_TAC;
24490   UND 30;
24491   UND 3;
24492   MESON_TAC[ISUBSET];
24493   DISCH_THEN_REWRITE;
24494   ONCE_REWRITE_TAC [union_subset];
24495   TYPE_THEN `C2' SUBSET A` SUBGOAL_TAC;
24496   IMATCH_MP_TAC  SUBSET_TRANS;
24497   TYPE_THEN `C1 UNION K` EXISTS_TAC;
24498   ASM_REWRITE_TAC[];
24499   IMATCH_MP_TAC  SUBSET_TRANS;
24500   TYPE_THEN `C2` EXISTS_TAC;
24501   ASM_REWRITE_TAC[];
24502   EXPAND_TAC "K";
24503   REWRITE_TAC[SUBSET;UNION];
24504   MESON_TAC[];
24505   DISCH_THEN_REWRITE;
24506   TYPE_THEN `C1' INTER C2' = {x'}` SUBGOAL_TAC;
24507   IMATCH_MP_TAC  EQ_EXT;
24508   REWRITE_TAC[INTER;INR IN_SING];
24509   GEN_TAC;
24510   EQ_TAC;
24511   UND 15;
24512   UND 30;
24513   EXPAND_TAC "K";
24514   REWRITE_TAC [eq_sing];
24515   REWRITE_TAC[INTER;UNION;SUBSET];
24516   MESON_TAC[];
24517   DISCH_THEN_REWRITE;
24518   ASM_REWRITE_TAC[];
24519   ASM_MESON_TAC[simple_arc_end_end];
24520   DISCH_THEN_REWRITE;
24521   (* --[C2]-- branch again for C3 x' -- *)
24522   TYPE_THEN `C3 x'` ASM_CASES_TAC;
24523   TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC;
24524   ASM_REWRITE_TAC[];
24525   ASM_MESON_TAC[];
24526   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
24527   REP_BASIC_TAC;
24528   TYPE_THEN `C3' = C''''''` ABBREV_TAC ;
24529   KILL 36;
24530   TYPE_THEN `C3'` EXISTS_TAC;
24531   ASM_REWRITE_TAC[];
24532   TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC;
24533   UND 32;
24534   SET_TAC[UNION;SUBSET];
24535   DISCH_TAC;
24536   CONJ_TAC;
24537   IMATCH_MP_TAC  SUBSET_TRANS;
24538   TYPE_THEN `C1 UNION K` EXISTS_TAC;
24539   ASM_REWRITE_TAC[];
24540   EXPAND_TAC "K";
24541   UND 36;
24542   REWRITE_TAC[SUBSET;UNION];
24543   MESON_TAC[];
24544   CONJ_TAC;
24545   UND 36;
24546   UND 0;
24547   MESON_TAC[ISUBSET];
24548   TYPE_THEN `C3' x'` SUBGOAL_TAC;
24549   IMATCH_MP_TAC  simple_arc_end_end;
24550   ASM_MESON_TAC[];
24551   DISCH_TAC;
24552   IMATCH_MP_TAC  EQ_EXT;
24553   REWRITE_TAC[INR IN_SING];
24554   GEN_TAC;
24555   EQ_TAC;
24556   UND 15;
24557   UND 36;
24558   EXPAND_TAC "K";
24559   REWRITE_TAC[eq_sing ];
24560   REWRITE_TAC[UNION;SUBSET;INTER];
24561   MESON_TAC[];
24562   DISCH_THEN_REWRITE;
24563   REWRITE_TAC[INTER];
24564   ASM_REWRITE_TAC[];
24565   (* --[C2']-- now C3 doesn't meet x'. This will be repeated for C2 *)
24566   (* -- cut C' from {x'} to FIRST point on C3 -- *)
24567   TYPEL_THEN [`C'`;`{x'}`;`C3`] (fun t->  MP_TAC  (ISPECL t simple_arc_end_restriction));
24568   DISCH_THEN ANT_TAC;
24569   ASM_REWRITE_TAC[];
24570   CONJ_TAC;
24571   IMATCH_MP_TAC  simple_arc_end_simple;
24572   ASM_MESON_TAC[];
24573   CONJ_TAC;
24574   IMATCH_MP_TAC  simple_arc_end_end_closed;
24575   ASM_MESON_TAC[];
24576   CONJ_TAC;
24577   IMATCH_MP_TAC  simple_arc_end_closed;
24578   ASM_MESON_TAC[];
24579   CONJ_TAC;
24580   UND 31;
24581   REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
24582   MESON_TAC[];
24583   CONJ_TAC;
24584   REWRITE_TAC[EMPTY_EXISTS];
24585   REWRITE_TAC[INTER;INR IN_SING];
24586   USE 23 (MATCH_MP simple_arc_end_end2);
24587   UND 23;
24588   MESON_TAC[];
24589   REWRITE_TAC[EMPTY_EXISTS];
24590   REWRITE_TAC[INTER;INR IN_SING];
24591   USE 23 (MATCH_MP simple_arc_end_end);
24592   UND 23;
24593   USE 2 (MATCH_MP simple_arc_end_end);
24594   UND 2;
24595   MESON_TAC[];
24596   REP_BASIC_TAC;
24597   (* ---[a] *)
24598   TYPE_THEN `C3a = C'''''` ABBREV_TAC ;
24599   KILL 36;
24600   TYPE_THEN `v = x'` SUBGOAL_TAC;
24601   USE 33(REWRITE_RULE[FUN_EQ_THM]);
24602   USE 33(REWRITE_RULE[INTER;INR IN_SING]);
24603   UND 33;
24604   MESON_TAC[];
24605   DISCH_THEN (fun t -> (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
24606   KILL 33;
24607   TYPE_THEN `C3a SUBSET C1` SUBGOAL_TAC;
24608   IMATCH_MP_TAC  SUBSET_TRANS;
24609   TYPE_THEN `C'` EXISTS_TAC;
24610   ASM_REWRITE_TAC[];
24611   UND 20;
24612   SET_TAC[UNION;SUBSET];
24613   DISCH_TAC;
24614   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 ;
24615   ASM_REWRITE_TAC[];
24616   CONJ_TAC;
24617   IMATCH_MP_TAC  SUBSET_TRANS;
24618   TYPE_THEN `C1 UNION K` EXISTS_TAC;
24619   ASM_REWRITE_TAC[];
24620   IMATCH_MP_TAC  SUBSET_TRANS;
24621   TYPE_THEN `C1` EXISTS_TAC;
24622   REWRITE_TAC[SUBSET_UNION];
24623   IMATCH_MP_TAC  SUBSET_TRANS;
24624   TYPE_THEN `C1` EXISTS_TAC;
24625   ASM_REWRITE_TAC[SUBSET_REFL ];
24626   CONJ_TAC;
24627   UND 7;
24628   UND 33;
24629   MESON_TAC[ISUBSET];
24630   CONJ_TAC;
24631   IMATCH_MP_TAC  EQ_EXT;
24632   GEN_TAC;
24633   REWRITE_TAC[INR IN_SING];
24634   EQ_TAC;
24635   UND 21;
24636   UND 35;
24637   REWRITE_TAC[eq_sing];
24638   REWRITE_TAC[SUBSET;INTER];
24639   MESON_TAC[];
24640   DISCH_THEN_REWRITE;
24641   REWRITE_TAC[INTER];
24642   ASM_REWRITE_TAC[];
24643   ASM_MESON_TAC[simple_arc_end_end];
24644   (* --- *)
24645   CONJ_TAC;
24646   IMATCH_MP_TAC  EQ_EXT;
24647   GEN_TAC;
24648   REWRITE_TAC[INR IN_SING];
24649   EQ_TAC;
24650   UND 32;
24651   REWRITE_TAC[eq_sing];
24652   REWRITE_TAC[SUBSET;INTER];
24653   MESON_TAC[];
24654   DISCH_THEN_REWRITE;
24655   REWRITE_TAC[INTER];
24656   ASM_REWRITE_TAC[];
24657   UND 32;
24658   REWRITE_TAC[eq_sing];
24659   REWRITE_TAC[INTER];
24660   MESON_TAC[];
24661   UND 35;
24662   USE 20 (REWRITE_RULE[FUN_EQ_THM]);
24663   USE 20 (REWRITE_RULE[UNION]);
24664   UND 20;
24665   UND 6;
24666   MESON_TAC  [ISUBSET];
24667   KILL 32;
24668   KILL 33;
24669   KILL 34;
24670   KILL 31;
24671   REP_BASIC_TAC;
24672   (* --[b] *)
24673   TYPE_THEN `(v'' = x)` ASM_CASES_TAC;
24674   FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
24675   TYPE_THEN `C3 UNION C3a` EXISTS_TAC;
24676   ASM_REWRITE_TAC[];
24677   CONJ_TAC;
24678   ONCE_REWRITE_TAC[union_subset];
24679   ASM_REWRITE_TAC[];
24680   UND 9;
24681   EXPAND_TAC "K";
24682   REWRITE_TAC[union_subset];
24683   MESON_TAC[];
24684   (* --- *)
24685   CONJ_TAC;
24686   IMATCH_MP_TAC  simple_arc_end_symm;
24687   IMATCH_MP_TAC  simple_arc_end_trans;
24688   TYPE_THEN `x` EXISTS_TAC;
24689   ASM_REWRITE_TAC[];
24690   CONJ_TAC;
24691   IMATCH_MP_TAC  simple_arc_end_symm;
24692   ASM_REWRITE_TAC[];
24693   IMATCH_MP_TAC  simple_arc_end_symm;
24694   ASM_REWRITE_TAC[];
24695   CONJ_TAC;
24696   REWRITE_TAC[UNION;DE_MORGAN_THM];
24697   ASM_REWRITE_TAC[];
24698   (* --- *)
24699   IMATCH_MP_TAC  EQ_EXT;
24700   REWRITE_TAC[INTER;UNION;INR IN_SING];
24701   GEN_TAC;
24702   EQ_TAC ;
24703   REWRITE_TAC[LEFT_AND_OVER_OR];
24704   DISCH_THEN DISJ_CASES_TAC;
24705   UND 39;
24706   UND 15;
24707   EXPAND_TAC "K";
24708   REWRITE_TAC[eq_sing];
24709   REWRITE_TAC[INTER;UNION];
24710   MESON_TAC[];
24711   UND 39;
24712   UND 33;
24713   REWRITE_TAC[eq_sing ];
24714   REWRITE_TAC[INTER];
24715   MESON_TAC[];
24716   DISCH_THEN_REWRITE;
24717   ASM_REWRITE_TAC[];
24718   UND 33;
24719   REWRITE_TAC[eq_sing ];
24720   REWRITE_TAC[INTER];
24721   MESON_TAC[];
24722   (* -- *)
24723   (* --[c] cut off C3b at- v'' *)
24724   TYPEL_THEN [`C3`;`x`;`p3`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut));
24725   DISCH_THEN ANT_TAC;
24726   ASM_REWRITE_TAC[];
24727   CONJ_TAC;
24728   UND 32;
24729   REWRITE_TAC[eq_sing ];
24730   REWRITE_TAC[INTER];
24731   MESON_TAC[];
24732   PROOF_BY_CONTR_TAC;
24733   USE 39 (REWRITE_RULE[]);
24734   FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
24735   UND 31;
24736   REWRITE_TAC[];
24737   UND 32;
24738   REWRITE_TAC[eq_sing ];
24739   REWRITE_TAC[INTER];
24740   MESON_TAC[];
24741   REP_BASIC_TAC;
24742   TYPE_THEN `C3b = C'''''''` ABBREV_TAC ;
24743   KILL 43;
24744   TYPE_THEN `C3b SUBSET C3` SUBGOAL_TAC;
24745   UND 39;
24746   SET_TAC[UNION;SUBSET];
24747   DISCH_TAC;
24748   (* -- [d] EXISTS_TAC *)
24749   TYPE_THEN `C3a UNION C3b` EXISTS_TAC;
24750   ASM_REWRITE_TAC[];
24751   CONJ_TAC;
24752   IMATCH_MP_TAC  SUBSET_TRANS ;
24753   TYPE_THEN `C1 UNION K` EXISTS_TAC ;
24754   ASM_REWRITE_TAC[];
24755   IMATCH_MP_TAC  subset_union_pair;
24756   CONJ_TAC;
24757   IMATCH_MP_TAC  SUBSET_TRANS;
24758   TYPE_THEN `C'` EXISTS_TAC;
24759   ASM_REWRITE_TAC[];
24760   UND 20;
24761   SET_TAC[UNION;SUBSET];
24762   EXPAND_TAC "K";
24763   UND 43;
24764   REWRITE_TAC[SUBSET;UNION];
24765   MESON_TAC[];
24766   (* -- *)
24767   CONJ_TAC;
24768   IMATCH_MP_TAC  simple_arc_end_trans;
24769   (* IMATCH_MP_TAC  SUBSET_TRANS;    *)
24770   TYPE_THEN `v''` EXISTS_TAC;
24771   ASM_REWRITE_TAC[];
24772   UND 43;
24773   UND 32;
24774   UND 40;
24775   REWRITE_TAC[eq_sing ];
24776   REWRITE_TAC[INTER;SUBSET];
24777   MESON_TAC[];
24778   (* -- *)
24779   CONJ_TAC;
24780   REWRITE_TAC[UNION;DE_MORGAN_THM];
24781   ASM_REWRITE_TAC[];
24782   UND 43;
24783   UND 0;
24784   MESON_TAC[ISUBSET];
24785   IMATCH_MP_TAC  EQ_EXT ;
24786   REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR];
24787   GEN_TAC;
24788   EQ_TAC;
24789   DISCH_THEN DISJ_CASES_TAC;
24790   FIRST_ASSUM MP_TAC;
24791   UND 21;
24792   UND 33;
24793   REWRITE_TAC[eq_sing];
24794   REWRITE_TAC[INTER];
24795   MESON_TAC[];
24796   FIRST_ASSUM MP_TAC;
24797   UND 43;
24798   UND 15;
24799   EXPAND_TAC "K";
24800   REWRITE_TAC[eq_sing];
24801   REWRITE_TAC[INTER;UNION;SUBSET];
24802   MESON_TAC[];
24803   DISCH_THEN_REWRITE;
24804   ASM_REWRITE_TAC[];
24805   DISJ1_TAC;
24806   UND 36;
24807   MESON_TAC[simple_arc_end_end];
24808   (* D *)
24809   TYPE_THEN `C3 x'` SUBGOAL_TAC;
24810   UND 25;
24811   UND 15;
24812   REWRITE_TAC[eq_sing];
24813   EXPAND_TAC "K";
24814   REWRITE_TAC[INTER;UNION];
24815   MESON_TAC[];
24816   DISCH_TAC;
24817   (* [E]  back to ONE goal *)
24818   (* TYPE_THEN `C3 x'` ASM_CASES_TAC; *)
24819   TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC;
24820   ASM_REWRITE_TAC[];
24821     ASM_MESON_TAC[];
24822   DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
24823   REP_BASIC_TAC;
24824   TYPE_THEN `C3' = C''''` ABBREV_TAC ;
24825   KILL 31;
24826   (*---- *)
24827   LEFT_TAC "C3'";
24828   USE 10 (ONCE_REWRITE_RULE[UNION_COMM]);
24829   TYPE_THEN `C3'` EXISTS_TAC;
24830   ASM_REWRITE_TAC[];
24831   TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC;
24832   USE 27 ( (REWRITE_RULE[FUN_EQ_THM]));
24833   USE 27 (REWRITE_RULE[UNION]);
24834   UND 27;
24835   REWRITE_TAC[SUBSET];
24836   MESON_TAC[];
24837   DISCH_TAC;
24838   TYPE_THEN `~C3' p2` SUBGOAL_TAC;
24839   UND 31;
24840   UND 0;
24841   MESON_TAC[ISUBSET];
24842   DISCH_THEN_REWRITE;
24843   ONCE_REWRITE_TAC [union_subset];
24844   TYPE_THEN `C3' SUBSET A` SUBGOAL_TAC;
24845   IMATCH_MP_TAC  SUBSET_TRANS;
24846   TYPE_THEN `C1 UNION K` EXISTS_TAC;
24847   ASM_REWRITE_TAC[];
24848   IMATCH_MP_TAC  SUBSET_TRANS;
24849   TYPE_THEN `C3` EXISTS_TAC;
24850   ASM_REWRITE_TAC[];
24851   EXPAND_TAC "K";
24852   REWRITE_TAC[SUBSET;UNION];
24853   MESON_TAC[];
24854   DISCH_THEN_REWRITE;
24855   TYPE_THEN `C1' INTER C3' = {x'}` SUBGOAL_TAC;
24856   IMATCH_MP_TAC  EQ_EXT;
24857   REWRITE_TAC[INTER;INR IN_SING];
24858   GEN_TAC;
24859   EQ_TAC;
24860   UND 15;
24861   UND 31;
24862   EXPAND_TAC "K";
24863   REWRITE_TAC [eq_sing];
24864   REWRITE_TAC[INTER;UNION;SUBSET];
24865   MESON_TAC[];
24866   DISCH_THEN_REWRITE;
24867   ASM_REWRITE_TAC[];
24868   ASM_MESON_TAC[simple_arc_end_end];
24869   DISCH_THEN_REWRITE;
24870   (* --[XC2]-- now C2 doesn't meet x'. This is repeat. *)
24871   (* -- cut C' from {x'} to FIRST point on C2 -- *)
24872   TYPEL_THEN [`C'`;`{x'}`;`C2`] (fun t->  MP_TAC  (ISPECL t simple_arc_end_restriction));
24873   DISCH_THEN ANT_TAC;
24874   ASM_REWRITE_TAC[];
24875   CONJ_TAC;
24876   IMATCH_MP_TAC  simple_arc_end_simple;
24877   ASM_MESON_TAC[];
24878   CONJ_TAC;
24879   IMATCH_MP_TAC  simple_arc_end_end_closed;
24880   ASM_MESON_TAC[];
24881   CONJ_TAC;
24882   IMATCH_MP_TAC  simple_arc_end_closed;
24883   ASM_MESON_TAC[];
24884   CONJ_TAC;
24885   UND 25;
24886   REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
24887   MESON_TAC[];
24888   CONJ_TAC;
24889   REWRITE_TAC[EMPTY_EXISTS];
24890   REWRITE_TAC[INTER;INR IN_SING];
24891   USE 23 (MATCH_MP simple_arc_end_end2);
24892   UND 23;
24893   MESON_TAC[];
24894   REWRITE_TAC[EMPTY_EXISTS];
24895   REWRITE_TAC[INTER;INR IN_SING];
24896   USE 23 (MATCH_MP simple_arc_end_end);
24897   UND 23;
24898   USE 5 (MATCH_MP simple_arc_end_end);
24899   UND 5;
24900   MESON_TAC[];
24901   REP_BASIC_TAC;
24902   (* ---[Xa] *)
24903   TYPE_THEN `C2a = C'''''` ABBREV_TAC ;
24904   KILL 36;
24905   TYPE_THEN `v = x'` SUBGOAL_TAC;
24906   USE 33(REWRITE_RULE[FUN_EQ_THM]);
24907   USE 33(REWRITE_RULE[INTER;INR IN_SING]);
24908   UND 33;
24909   MESON_TAC[];
24910   DISCH_THEN (fun t -> (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
24911   KILL 33;
24912   TYPE_THEN `C2a SUBSET C1` SUBGOAL_TAC;
24913   IMATCH_MP_TAC  SUBSET_TRANS;
24914   TYPE_THEN `C'` EXISTS_TAC;
24915   ASM_REWRITE_TAC[];
24916   UND 20;
24917   SET_TAC[UNION;SUBSET];
24918   DISCH_TAC;
24919   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 ;
24920   ASM_REWRITE_TAC[];
24921   CONJ_TAC;
24922   IMATCH_MP_TAC  SUBSET_TRANS;
24923   TYPE_THEN `C1 UNION K` EXISTS_TAC;
24924   ASM_REWRITE_TAC[];
24925   IMATCH_MP_TAC  SUBSET_TRANS;
24926   TYPE_THEN `C1` EXISTS_TAC;
24927   REWRITE_TAC[SUBSET_UNION];
24928   IMATCH_MP_TAC  SUBSET_TRANS;
24929   TYPE_THEN `C1` EXISTS_TAC;
24930   ASM_REWRITE_TAC[SUBSET_REFL ];
24931   CONJ_TAC;
24932   UND 6;
24933   UND 33;
24934   MESON_TAC[ISUBSET];
24935   CONJ_TAC;
24936   IMATCH_MP_TAC  EQ_EXT;
24937   GEN_TAC;
24938   REWRITE_TAC[INR IN_SING];
24939   EQ_TAC;
24940   UND 21;
24941   UND 35;
24942   REWRITE_TAC[eq_sing];
24943   REWRITE_TAC[SUBSET;INTER];
24944   MESON_TAC[];
24945   DISCH_THEN_REWRITE;
24946   REWRITE_TAC[INTER];
24947   ASM_REWRITE_TAC[];
24948   ASM_MESON_TAC[simple_arc_end_end];
24949   (* --- *)
24950   CONJ_TAC;
24951   IMATCH_MP_TAC  EQ_EXT;
24952   GEN_TAC;
24953   REWRITE_TAC[INR IN_SING];
24954   EQ_TAC;
24955   UND 32;
24956   REWRITE_TAC[eq_sing];
24957   REWRITE_TAC[SUBSET;INTER];
24958   MESON_TAC[];
24959   DISCH_THEN_REWRITE;
24960   REWRITE_TAC[INTER];
24961   ASM_REWRITE_TAC[];
24962   UND 32;
24963   REWRITE_TAC[eq_sing];
24964   REWRITE_TAC[INTER];
24965   MESON_TAC[];
24966   UND 35;
24967   USE 20 (REWRITE_RULE[FUN_EQ_THM]);
24968   USE 20 (REWRITE_RULE[UNION]);
24969   UND 20;
24970   UND 7;
24971   MESON_TAC  [ISUBSET];
24972   KILL 32;
24973   KILL 33;
24974   KILL 34;
24975   KILL 35;  (*  attention *)
24976   REP_BASIC_TAC;
24977   (* --[Xb] *)
24978   TYPE_THEN `(v'' = x)` ASM_CASES_TAC;
24979   FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
24980   TYPE_THEN `C2 UNION C2a` EXISTS_TAC;
24981   ASM_REWRITE_TAC[];
24982   CONJ_TAC;
24983   ONCE_REWRITE_TAC[union_subset];
24984   ASM_REWRITE_TAC[];
24985   UND 9;
24986   EXPAND_TAC "K";
24987   REWRITE_TAC[union_subset];
24988   MESON_TAC[];
24989   (* --- *)
24990   CONJ_TAC;
24991   IMATCH_MP_TAC  simple_arc_end_symm;
24992   IMATCH_MP_TAC  simple_arc_end_trans;
24993   TYPE_THEN `x` EXISTS_TAC;
24994   ASM_REWRITE_TAC[];
24995   CONJ_TAC;
24996   IMATCH_MP_TAC  simple_arc_end_symm;
24997   ASM_REWRITE_TAC[];
24998   IMATCH_MP_TAC  simple_arc_end_symm;
24999   ASM_REWRITE_TAC[];
25000   CONJ_TAC;
25001   REWRITE_TAC[UNION;DE_MORGAN_THM];
25002   ASM_REWRITE_TAC[];
25003   (* --- *)
25004   IMATCH_MP_TAC  EQ_EXT;
25005   REWRITE_TAC[INTER;UNION;INR IN_SING];
25006   GEN_TAC;
25007   EQ_TAC ;
25008   REWRITE_TAC[LEFT_AND_OVER_OR];
25009   DISCH_THEN DISJ_CASES_TAC;
25010   UND 39;
25011   UND 15;
25012   EXPAND_TAC "K";
25013   REWRITE_TAC[eq_sing];
25014   REWRITE_TAC[INTER;UNION];
25015   MESON_TAC[];
25016   UND 39;
25017   UND 34;
25018   REWRITE_TAC[eq_sing ];
25019   REWRITE_TAC[INTER];
25020   MESON_TAC[];
25021   DISCH_THEN_REWRITE;
25022   ASM_REWRITE_TAC[];
25023   UND 34;
25024   REWRITE_TAC[eq_sing ];
25025   REWRITE_TAC[INTER];
25026   MESON_TAC[];
25027   (* -- *)
25028   (* --[Xc] cut off C3b at- v'' *)
25029   TYPEL_THEN [`C2`;`x`;`p2`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut));
25030   DISCH_THEN ANT_TAC;
25031   ASM_REWRITE_TAC[];
25032   CONJ_TAC;
25033   UND 33;
25034   REWRITE_TAC[eq_sing ];
25035   REWRITE_TAC[INTER];
25036   MESON_TAC[];
25037   PROOF_BY_CONTR_TAC;
25038   USE 39 (REWRITE_RULE[]);
25039   FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
25040   UND 32;
25041   REWRITE_TAC[];
25042   UND 33;
25043   REWRITE_TAC[eq_sing ];
25044   REWRITE_TAC[INTER];
25045   MESON_TAC[];
25046   REP_BASIC_TAC;
25047   TYPE_THEN `C2b = C''''''` ABBREV_TAC ;
25048   KILL 43;
25049   TYPE_THEN `C2b SUBSET C2` SUBGOAL_TAC;
25050   UND 39;
25051   SET_TAC[UNION;SUBSET];
25052   DISCH_TAC;
25053   (* -- [Xd] EXISTS_TAC *)
25054   TYPE_THEN `C2a UNION C2b` EXISTS_TAC;
25055   ASM_REWRITE_TAC[];
25056   CONJ_TAC;
25057   REWRITE_TAC[union_subset ];
25058   ASM_REWRITE_TAC[];
25059   IMATCH_MP_TAC  SUBSET_TRANS ;
25060   TYPE_THEN `C1 UNION K` EXISTS_TAC ;
25061   ASM_REWRITE_TAC[];
25062   IMATCH_MP_TAC  SUBSET_TRANS;
25063   TYPE_THEN `C2` EXISTS_TAC;
25064   ASM_REWRITE_TAC[];
25065   EXPAND_TAC "K";
25066   REWRITE_TAC[SUBSET;UNION];
25067   MESON_TAC[];
25068   (* -- *)
25069   CONJ_TAC;
25070   IMATCH_MP_TAC  simple_arc_end_trans;
25071   TYPE_THEN `v''` EXISTS_TAC;
25072   ASM_REWRITE_TAC[];
25073   UND 43;
25074   UND 33;
25075   UND 40;
25076   REWRITE_TAC[eq_sing ];
25077   REWRITE_TAC[INTER;SUBSET];
25078   MESON_TAC[];
25079   (* -- *)
25080   CONJ_TAC;
25081   REWRITE_TAC[UNION;DE_MORGAN_THM];
25082   ASM_REWRITE_TAC[];
25083   UND 43;
25084   UND 3;
25085   MESON_TAC[ISUBSET];
25086   IMATCH_MP_TAC  EQ_EXT ;
25087   REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR];
25088   GEN_TAC;
25089   EQ_TAC;
25090   DISCH_THEN DISJ_CASES_TAC;
25091   FIRST_ASSUM MP_TAC;
25092   UND 21;
25093   UND 34;
25094   REWRITE_TAC[eq_sing];
25095   REWRITE_TAC[INTER];
25096   MESON_TAC[];
25097   FIRST_ASSUM MP_TAC;
25098   UND 43;
25099   UND 15;
25100   EXPAND_TAC "K";
25101   REWRITE_TAC[eq_sing];
25102   REWRITE_TAC[INTER;UNION;SUBSET];
25103   MESON_TAC[];
25104   DISCH_THEN_REWRITE;
25105   ASM_REWRITE_TAC[];
25106   DISJ1_TAC;
25107   UND 36;
25108   MESON_TAC[simple_arc_end_end];
25109   (* Fri Aug 13 17:43:15 EDT 2004 *)
25110
25111   ]);;
25112
25113   (* }}} *)
25114
25115
25116 let simple_arc_sep2 = prove_by_refinement(
25117   `!A C1 C2 C3 x p1 p2 p3.
25118      (
25119      C1 UNION C2 UNION C3 SUBSET A /\
25120      (simple_arc_end C1 x p1) /\
25121      (simple_arc_end C2 x p2) /\
25122      (simple_arc_end C3 x p3) /\
25123      (C1 INTER C2 = {x}) /\
25124      (C1 INTER C3 = {x}) /\
25125      ~(C2 p3) /\ ~(C3 p2)) ==>
25126      (?x' C1' C2' C3'.
25127      (C1' UNION C2' UNION C3' SUBSET A) /\
25128      (simple_arc_end C1' x' p1) /\
25129      (simple_arc_end C2' x' p2) /\
25130      (simple_arc_end C3' x' p3) /\
25131      (C1' INTER C2' = {x'}) /\
25132      (C2' INTER C3' = {x'}) /\
25133      (C3' INTER C1' = {x'})
25134      )`,
25135   (* {{{ proof *)
25136   [
25137   REP_BASIC_TAC;
25138   TYPEL_THEN[`C2`;`C3`;`{p2}`] (fun t -> ANT_TAC (ISPECL t simple_arc_end_restriction));
25139   CONJ_TAC;
25140   IMATCH_MP_TAC  simple_arc_end_simple;
25141   ASM_MESON_TAC[];
25142   CONJ_TAC;
25143   IMATCH_MP_TAC  simple_arc_end_closed;
25144   ASM_MESON_TAC[];
25145   CONJ_TAC;
25146   IMATCH_MP_TAC  simple_arc_end_end_closed;
25147   TYPE_THEN `C2` EXISTS_TAC;
25148   TYPE_THEN `x` EXISTS_TAC;
25149   IMATCH_MP_TAC  simple_arc_end_symm;
25150   ASM_MESON_TAC[];
25151   REWRITE_TAC[EMPTY_EXISTS];
25152   REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
25153   TYPE_THEN `C2 p2` SUBGOAL_TAC;
25154   ASM_MESON_TAC[simple_arc_end_end2];
25155   TYPE_THEN `C2 x` SUBGOAL_TAC;
25156   ASM_MESON_TAC[simple_arc_end_end];
25157   TYPE_THEN `C3 x` SUBGOAL_TAC;
25158   ASM_MESON_TAC[simple_arc_end_end];
25159   ASM_MESON_TAC[];
25160   REP_BASIC_TAC;
25161   TYPE_THEN `v' = p2` SUBGOAL_TAC;
25162   UND 8;
25163   REWRITE_TAC[eq_sing; INR IN_SING;];
25164   REWRITE_TAC[INTER;INR IN_SING ];
25165   MESON_TAC[];
25166   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
25167   KILL 8;
25168   TYPE_THEN `v` EXISTS_TAC;
25169   LEFT_TAC "C2'";
25170   TYPE_THEN `C'` EXISTS_TAC;
25171   ASM_REWRITE_TAC[];
25172   (* A easy case *)
25173   TYPE_THEN `v = x` ASM_CASES_TAC;
25174   FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]);
25175   TYPE_THEN `C' = C2` SUBGOAL_TAC;
25176   IMATCH_MP_TAC  simple_arc_end_inj;
25177   TYPE_THEN `C2` EXISTS_TAC;
25178   TYPE_THEN `x` EXISTS_TAC;
25179   TYPE_THEN `p2` EXISTS_TAC;
25180   ASM_REWRITE_TAC[];
25181   CONJ_TAC;
25182   IMATCH_MP_TAC  simple_arc_end_simple;
25183   ASM_MESON_TAC[];
25184   REWRITE_TAC[SUBSET_REFL];
25185   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]);
25186   TYPE_THEN `C1` EXISTS_TAC;
25187   TYPE_THEN `C3` EXISTS_TAC;
25188   ASM_REWRITE_TAC[];
25189   ONCE_REWRITE_TAC [INTER_COMM];
25190   ASM_REWRITE_TAC[];
25191   (* [B] general case *)
25192   TYPEL_THEN [`C3`;`x`;`p3`;`v`] (fun t-> ANT_TAC (ISPECL t simple_arc_end_cut));
25193   ASM_REWRITE_TAC[];
25194   CONJ_TAC;
25195   UND 9;
25196   REWRITE_TAC[eq_sing;INTER];
25197   MESON_TAC[];
25198   DISCH_TAC;
25199   FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
25200   TYPE_THEN `C' p3` SUBGOAL_TAC;
25201   ASM_MESON_TAC[simple_arc_end_end];
25202   UND 1;
25203   UND 11;
25204   REWRITE_TAC[SUBSET];
25205   MESON_TAC[];
25206   REP_BASIC_TAC;
25207   TYPE_THEN `C1 UNION C''` EXISTS_TAC;
25208   TYPE_THEN `C'''` EXISTS_TAC;
25209   ASM_REWRITE_TAC[];
25210   TYPE_THEN `(C1 UNION C'') UNION C' UNION C''' = C1 UNION C' UNION (C'' UNION C''')` SUBGOAL_TAC;
25211   SET_TAC[UNION];
25212   DISCH_THEN_REWRITE;
25213   CONJ_TAC;
25214   IMATCH_MP_TAC  SUBSET_TRANS;
25215   TYPE_THEN `C1 UNION C2 UNION C3` EXISTS_TAC;
25216   ASM_REWRITE_TAC[];
25217   IMATCH_MP_TAC subset_union_pair ;
25218   REWRITE_TAC[SUBSET_REFL];
25219   IMATCH_MP_TAC  subset_union_pair ;
25220   ASM_REWRITE_TAC[SUBSET_REFL];
25221   (* -- *)
25222   CONJ_TAC;
25223   IMATCH_MP_TAC  simple_arc_end_symm;
25224   IMATCH_MP_TAC  simple_arc_end_trans;
25225   TYPE_THEN `x` EXISTS_TAC;
25226   ASM_REWRITE_TAC[];
25227   CONJ_TAC;
25228   IMATCH_MP_TAC  simple_arc_end_symm;
25229   ASM_REWRITE_TAC[];
25230   IMATCH_MP_TAC  EQ_EXT;
25231   REWRITE_TAC[INTER;INR IN_SING ];
25232   GEN_TAC;
25233   EQ_TAC ;
25234   UND 2;
25235   TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC;
25236   UND 12;
25237   SET_TAC [SUBSET;UNION];
25238   REWRITE_TAC[eq_sing;INTER;SUBSET];
25239   MESON_TAC[];
25240   DISCH_THEN_REWRITE;
25241   ASM_REWRITE_TAC[];
25242   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
25243   (* --[a] *)
25244   TYPE_THEN `(C1 UNION C'') v /\ (C' v) /\ (C''' v)` SUBGOAL_TAC;
25245   REWRITE_TAC[UNION];
25246   ASM_REWRITE_TAC[];
25247   CONJ_TAC;
25248   DISJ2_TAC;
25249   ASM_MESON_TAC[simple_arc_end_end2];
25250   ASM_MESON_TAC[simple_arc_end_end;];
25251   DISCH_TAC;
25252   (* -- *)
25253   TYPE_THEN `C''' SUBSET C3` SUBGOAL_TAC;
25254   UND 12;
25255   SET_TAC[UNION;SUBSET];
25256   DISCH_TAC;
25257   TYPE_THEN `C' INTER C''' = {v}` SUBGOAL_TAC;
25258   IMATCH_MP_TAC  EQ_EXT;
25259   REWRITE_TAC[INR IN_SING];
25260   GEN_TAC;
25261   EQ_TAC;
25262   UND 17;
25263   UND 9;
25264   REWRITE_TAC[eq_sing;SUBSET;INTER];
25265   MESON_TAC[];
25266   DISCH_THEN_REWRITE;
25267   ASM_REWRITE_TAC[INTER;];
25268   DISCH_THEN_REWRITE;
25269   (* -- *)
25270   TYPEL_THEN [`C2`;`p2`;`x`;`v`] (fun t-> ANT_TAC(ISPECL t simple_arc_end_cut));
25271   ASM_REWRITE_TAC[];
25272   CONJ_TAC;
25273   IMATCH_MP_TAC  simple_arc_end_symm;
25274   ASM_REWRITE_TAC[];
25275   CONJ_TAC;
25276   UND 11;
25277   REP_BASIC_TAC;
25278   UND 11;
25279   UND 18;
25280   MESON_TAC[ISUBSET];
25281   IMATCH_MP_TAC  simple_arc_end_distinct;
25282   TYPE_THEN `C'` EXISTS_TAC;
25283   ASM_REWRITE_TAC[];
25284   REP_BASIC_TAC;
25285   (* -- *)
25286   TYPE_THEN `C'''' = C'` SUBGOAL_TAC;
25287   IMATCH_MP_TAC  simple_arc_end_inj;
25288   TYPE_THEN `C2` EXISTS_TAC;
25289   TYPE_THEN `p2` EXISTS_TAC;
25290   TYPE_THEN `v` EXISTS_TAC;
25291   ASM_REWRITE_TAC[];
25292   CONJ_TAC;
25293   IMATCH_MP_TAC  simple_arc_end_symm;
25294   ASM_REWRITE_TAC[];
25295   CONJ_TAC;
25296   IMATCH_MP_TAC  simple_arc_end_simple;
25297   ASM_MESON_TAC[];
25298   UND 16;
25299   SET_TAC[UNION;SUBSET];
25300   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
25301   (* -- *)
25302   TYPE_THEN `~C' x` SUBGOAL_TAC;
25303   PROOF_BY_CONTR_TAC;
25304   REWR 24;
25305   TYPE_THEN `C''''' x` SUBGOAL_TAC;
25306   ASM_MESON_TAC[simple_arc_end_end2];
25307   UND 8;
25308   UND 18;
25309   UND 24;
25310   REWRITE_TAC[eq_sing;INTER;];
25311   MESON_TAC[];
25312   DISCH_TAC;
25313   (* -- *)
25314   KILL 7;
25315   KILL 6;
25316   KILL 5;
25317   KILL 4;
25318   TYPE_THEN `C'' x` SUBGOAL_TAC;
25319   ASM_MESON_TAC[simple_arc_end_end];
25320   DISCH_TAC;
25321   KILL 15;
25322   KILL 14;
25323   KILL 20;
25324   KILL 19;
25325   (* --[b] *)
25326   CONJ_TAC;
25327   IMATCH_MP_TAC  EQ_EXT;
25328   REWRITE_TAC[UNION;INTER;INR IN_SING];
25329   GEN_TAC;
25330   EQ_TAC;
25331   TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC;
25332   UND 12;
25333   SET_TAC[UNION;SUBSET];
25334   UND 2;
25335   UND 3;
25336   UND 11;
25337   UND 24;
25338   UND 9;
25339   REWRITE_TAC[SUBSET;INTER;eq_sing];
25340   MESON_TAC[];
25341   DISCH_THEN_REWRITE;
25342   ASM_REWRITE_TAC[];
25343   UND 13;
25344   REWRITE_TAC[eq_sing;INTER];
25345   MESON_TAC[];
25346   (* -- *)
25347   TYPE_THEN `~ (C''' x)` SUBGOAL_TAC;
25348   DISCH_TAC;
25349   UND 13;
25350   UND 5;
25351   UND 4;
25352   UND 8;
25353   REWRITE_TAC[eq_sing;INTER;];
25354   MESON_TAC[];
25355   DISCH_TAC;
25356   IMATCH_MP_TAC  EQ_EXT;
25357   REWRITE_TAC[INTER;UNION;INR IN_SING];
25358   GEN_TAC;
25359   EQ_TAC ;
25360   UND 13;
25361   UND 2;
25362   UND 17;
25363   UND 5;
25364   REWRITE_TAC[SUBSET;INTER;eq_sing];
25365   MESON_TAC[];
25366   DISCH_THEN_REWRITE;
25367   ASM_REWRITE_TAC[];
25368   UND 23;
25369   REWRITE_TAC[UNION];
25370   (* Fri Aug 13 20:36:09 EDT 2004 *)
25371
25372   ]);;
25373
25374   (* }}} *)
25375
25376 let simple_arc_sep = prove_by_refinement(
25377   `!A C1 C2 C3 x p1 p2 p3.
25378      (C1 UNION C2 UNION C3 SUBSET A) /\
25379      (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\
25380      (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\
25381      (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==>
25382   (?x' C1' C2' C3'.
25383      (C1' UNION C2' UNION C3' SUBSET A) /\
25384      (simple_arc_end C1' x' p1) /\
25385      (simple_arc_end C2' x' p2) /\
25386      (simple_arc_end C3' x' p3) /\
25387      (C1' INTER C2' = {x'}) /\
25388      (C2' INTER C3' = {x'}) /\
25389      (C3' INTER C1' = {x'})
25390      )`,
25391   (* {{{ proof *)
25392   [
25393   REP_GEN_TAC;
25394   DISCH_TAC;
25395   IMATCH_MP_TAC  simple_arc_sep2;
25396   USE 0 (MATCH_MP simple_arc_sep3);
25397   REP_BASIC_TAC;
25398   TYPE_THEN `C1'` EXISTS_TAC;
25399   TYPE_THEN `C2'` EXISTS_TAC;
25400   TYPE_THEN `C3'` EXISTS_TAC;
25401   TYPE_THEN `x'` EXISTS_TAC;
25402   ASM_REWRITE_TAC[];
25403   ]);;
25404   (* }}} *)
25405
25406 (* ------------------------------------------------------------------ *)
25407 (* SECTION N *)
25408 (* ------------------------------------------------------------------ *)
25409
25410 (*  K33 stuff *)
25411
25412 let isthree = prove_by_refinement(
25413   `?x. (\t. (t < 3)) x`,
25414   (* {{{ proof *)
25415
25416   [
25417   TYPE_THEN `0` EXISTS_TAC;
25418   BETA_TAC;
25419   ARITH_TAC;
25420   (* Sat Aug 14 11:56:32 EDT 2004 *)
25421   ]);;
25422
25423   (* }}} *)
25424
25425 let three_t = new_type_definition "three_t" ("ABS3","REP3")
25426   isthree;;
25427
25428 let type_bij = prove_by_refinement(
25429   `!X (fXY:A->B) gYX.
25430      (!a. fXY (gYX a) = a)  /\ (!r. X r = (gYX (fXY r) = r)) ==>
25431     (BIJ fXY X UNIV) /\ (BIJ gYX UNIV X)`,
25432   (* {{{ proof *)
25433
25434   [
25435   REP_BASIC_TAC;
25436   CONJ_TAC;
25437   IMATCH_MP_TAC  bij_inj_image;
25438   REWRITE_TAC[INJ;SUBSET;IMAGE ;];
25439   CONJ_TAC;
25440   REP_BASIC_TAC;
25441   USE 2 (AP_TERM `gYX:B->A` );
25442   REWR 3;
25443   REWR 4;
25444   REWR 2;
25445   (* -- *)
25446   IMATCH_MP_TAC  EQ_EXT;
25447   REWRITE_TAC[];
25448   NAME_CONFLICT_TAC;
25449   GEN_TAC;
25450   TYPE_THEN `gYX x''` EXISTS_TAC;
25451   ASM_REWRITE_TAC[];
25452   (* -- *)
25453   IMATCH_MP_TAC  bij_inj_image;
25454   REWRITE_TAC[INJ;SUBSET;IMAGE];
25455   CONJ_TAC;
25456   REP_BASIC_TAC;
25457   CONJ_TAC;
25458   ASM_REWRITE_TAC[];
25459   REP_BASIC_TAC;
25460   USE 2(AP_TERM `fXY:A->B`);
25461   REWR 2;
25462   REP_BASIC_TAC;
25463   TYPE_THEN `fXY x` EXISTS_TAC;
25464   REWR 2;
25465   ASM_REWRITE_TAC[];
25466   ]);;
25467
25468   (* }}} *)
25469
25470 let thr_bij  = prove_by_refinement(
25471   `(BIJ ABS3 {x | x < 3} UNIV) /\ (BIJ REP3 UNIV {x | x < 3})`,
25472   (* {{{ proof *)
25473   [
25474   IMATCH_MP_TAC  type_bij ;
25475   ASSUME_TAC three_t;
25476   ASM_REWRITE_TAC[];
25477   REWRITE_TAC[three_t];
25478   REP_BASIC_TAC;
25479   UND 0;
25480   BETA_TAC;
25481   DISCH_THEN_REWRITE;
25482   ]);;
25483   (* }}} *)
25484
25485 let thr_finite = prove_by_refinement(
25486   `(UNIV:three_t->bool) HAS_SIZE 3`,
25487   (* {{{ proof *)
25488   [
25489   REWRITE_TAC [has_size_bij2];
25490   TYPE_THEN `REP3` EXISTS_TAC;
25491   ASM_REWRITE_TAC[thr_bij];
25492   (* Sat Aug 14 12:28:58 EDT 2004 *)
25493   ]);;
25494   (* }}} *)
25495
25496 let has_size3_bij = prove_by_refinement(
25497   `!(A:A->bool).  A HAS_SIZE 3 <=> (?f. BIJ f (UNIV:three_t->bool) A)`,
25498   (* {{{ proof *)
25499
25500   [
25501   REWRITE_TAC[has_size_bij];
25502   REP_BASIC_TAC;
25503   EQ_TAC;
25504   REP_BASIC_TAC;
25505   ASSUME_TAC thr_bij;
25506   TYPE_THEN `compose f REP3` EXISTS_TAC;
25507   IMATCH_MP_TAC  COMP_BIJ;
25508   TYPE_THEN `{m | m < 3}` EXISTS_TAC;
25509   ASM_REWRITE_TAC[];
25510   (* -- *)
25511   REP_BASIC_TAC;
25512   TYPE_THEN `compose f ABS3` EXISTS_TAC;
25513   IMATCH_MP_TAC  COMP_BIJ;
25514   TYPE_THEN `UNIV:three_t->bool` EXISTS_TAC;
25515   ASM_REWRITE_TAC[thr_bij];
25516   (* Sat Aug 14 12:36:22 EDT 2004 *)
25517
25518   ]);;
25519
25520   (* }}} *)
25521
25522 let has_size3_bij2 = prove_by_refinement(
25523   `!(A:A->bool). A HAS_SIZE 3 <=> (?f. BIJ f A (UNIV:three_t->bool) )`,
25524   (* {{{ proof *)
25525   [
25526   REWRITE_TAC[has_size_bij2];
25527   GEN_TAC;
25528   EQ_TAC;
25529   REP_BASIC_TAC;
25530   TYPE_THEN `compose ABS3 f` EXISTS_TAC;
25531   IMATCH_MP_TAC  COMP_BIJ;
25532   TYPE_THEN `{m | m < 3}` EXISTS_TAC;
25533   ASM_REWRITE_TAC[thr_bij];
25534   (* -- *)
25535   REP_BASIC_TAC;
25536   TYPE_THEN `compose REP3 f` EXISTS_TAC;
25537   IMATCH_MP_TAC  COMP_BIJ;
25538   TYPE_THEN `UNIV:three_t ->bool` EXISTS_TAC;
25539   ASM_REWRITE_TAC[thr_bij];
25540   (* Sat Aug 14 12:40:48 EDT 2004 *)
25541
25542   ]);;
25543   (* }}} *)
25544
25545 let cartesian = jordan_def
25546   `cartesian (X:A->bool) (Y:B->bool) =
25547        { (x,y) | X x /\ Y y}`;;
25548
25549 let cartesian_pair = prove_by_refinement(
25550   `!X Y (x:A) (y:B).  cartesian X Y (x,y) <=> (X x) /\ (Y y)`,
25551   (* {{{ proof *)
25552   [
25553   REWRITE_TAC[cartesian;PAIR_SPLIT ;];
25554   MESON_TAC[];
25555   ]);;
25556   (* }}} *)
25557
25558 let cartesian_el = prove_by_refinement(
25559 `!X Y (x:(A#B)).  cartesian X Y x  <=> (X (FST x)) /\ (Y (SND x))`,
25560   (* {{{ proof *)
25561   [
25562   REP_BASIC_TAC;
25563   REWRITE_TAC[cartesian];
25564   EQ_TAC;
25565   REP_BASIC_TAC;
25566   ASM_REWRITE_TAC[];
25567   DISCH_TAC;
25568   TYPE_THEN`FST x` EXISTS_TAC;
25569   TYPE_THEN `SND x` EXISTS_TAC;
25570   ASM_REWRITE_TAC[];
25571   ]);;
25572   (* }}} *)
25573
25574 (* ignore earlier K33 def *)
25575
25576 let k33_graph = jordan_def
25577   `k33_graph = mk_graph_t (
25578            cartesian (UNIV:three_t ->bool) UNIV,
25579            cartesian UNIV UNIV,
25580            (\e. { (FST e,T),  (SND e,F)} ) )`;;
25581
25582 let graph_edge_mk_graph = prove_by_refinement(
25583   `!(V:A->bool) (E:B->bool) C. graph_edge(mk_graph_t (V,E,C)) = E`,
25584   (* {{{ proof *)
25585   [
25586   REWRITE_TAC[graph_edge;dest_graph_t;part1;drop0];
25587   ]);;
25588   (* }}} *)
25589
25590 let graph_vertex_mk_graph = prove_by_refinement(
25591  `!(V:A->bool) (E:B->bool) C. graph_vertex(mk_graph_t (V,E,C)) = V`,
25592   (* {{{ proof *)
25593   [
25594   REWRITE_TAC[graph_vertex;dest_graph_t;];
25595   ]);;
25596   (* }}} *)
25597
25598 let graph_inc_mk_graph = prove_by_refinement(
25599  `!(V:A->bool) (E:B->bool) C. graph_inc(mk_graph_t (V,E,C)) = C`,
25600   (* {{{ proof *)
25601   [
25602   REWRITE_TAC[graph_inc;dest_graph_t;drop1];
25603   ]);;
25604   (* }}} *)
25605
25606 let k33_isgraph = prove_by_refinement(
25607   `graph (k33_graph)`,
25608   (* {{{ proof *)
25609   [
25610   REWRITE_TAC[graph;has_size2];
25611   REWRITE_TAC[IMAGE;SUBSET;];
25612   NAME_CONFLICT_TAC;
25613   REWRITE_TAC[k33_graph;graph_inc_mk_graph;graph_edge_mk_graph;graph_vertex_mk_graph;in_pair;cartesian];
25614   REP_BASIC_TAC;
25615   ASM_REWRITE_TAC[];
25616   REWRITE_TAC[in_pair];
25617   CONJ_TAC;
25618   GEN_TAC;
25619   DISCH_THEN DISJ_CASES_TAC;
25620   ASM_MESON_TAC[];
25621   ASM_MESON_TAC[];
25622   TYPE_THEN `(x,T)` EXISTS_TAC;
25623   TYPE_THEN `(y,F)` EXISTS_TAC;
25624   REWRITE_TAC[];
25625   REWRITE_TAC[PAIR_SPLIT];
25626   (* Sat Aug 14 13:18:16 EDT 2004 *)
25627
25628   ]);;
25629   (* }}} *)
25630
25631 let k33_iso = prove_by_refinement(
25632   `!(A:A->bool) B (E:B->bool) f.
25633       A HAS_SIZE 3 /\ B HAS_SIZE 3 /\ (A INTER B = EMPTY) /\
25634       BIJ f E (cartesian A B) ==>
25635     (graph_isomorphic k33_graph
25636          (mk_graph_t
25637              (A UNION B, E,( \ e. { (FST (f e)), (SND (f e)) }))))`,
25638   (* {{{ proof *)
25639   [
25640   REP_BASIC_TAC;
25641   REWRITE_TAC[graph_isomorphic;graph_iso;k33_graph;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph;];
25642   RULE_ASSUM_TAC (REWRITE_RULE[has_size3_bij]);
25643   REP_BASIC_TAC;
25644   TYPE_THEN `u = ( \ t. (if (SND t) then (f'' (FST t)) else (f'(FST t))))` ABBREV_TAC ;
25645   LEFT_TAC "u";
25646   TYPE_THEN `u` EXISTS_TAC;
25647   TYPE_THEN `g = INV f E (cartesian A B)` ABBREV_TAC ;
25648   TYPE_THEN `v = ( \t . (g (f'' (FST t), f' (SND t))))` ABBREV_TAC ;
25649   LEFT_TAC "v";
25650   TYPE_THEN `v` EXISTS_TAC;
25651   TYPE_THEN `(u,v)` EXISTS_TAC;
25652   REWRITE_TAC[];
25653   (* A  u *)
25654   CONJ_TAC;
25655   REWRITE_TAC[BIJ;SURJ;INJ];
25656   SUBCONJ_TAC ;
25657   CONJ_TAC;
25658   EXPAND_TAC "u";
25659   REWRITE_TAC[cartesian_el];
25660   REWRITE_TAC[UNION;];
25661   GEN_TAC;
25662   COND_CASES_TAC;
25663   UND 2;
25664   REWRITE_TAC[BIJ;SURJ];
25665   MESON_TAC[];
25666   UND 3;
25667   REWRITE_TAC[BIJ;SURJ];
25668   MESON_TAC[];
25669   REWRITE_TAC[cartesian_el;];
25670   EXPAND_TAC "u";
25671   REP_GEN_TAC ;
25672   COND_CASES_TAC;
25673   COND_CASES_TAC;
25674   UND 2;
25675   REWRITE_TAC[BIJ;INJ];
25676   REP_BASIC_TAC;
25677   REWRITE_TAC[PAIR_SPLIT];
25678   ASM_REWRITE_TAC[];
25679   FIRST_ASSUM IMATCH_MP_TAC ;
25680   ASM_REWRITE_TAC[];
25681   REP_BASIC_TAC;
25682   PROOF_BY_CONTR_TAC;
25683   UND 1;
25684   REWRITE_TAC[EMPTY_EXISTS ];
25685   TYPE_THEN `f'' (FST x)` EXISTS_TAC;
25686   REWRITE_TAC[INTER];
25687   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
25688   ASM_MESON_TAC[];
25689   COND_CASES_TAC;
25690   REP_BASIC_TAC;
25691   PROOF_BY_CONTR_TAC;
25692   UND 1;
25693   REWRITE_TAC[EMPTY_EXISTS ];
25694   TYPE_THEN `f' (FST x)` EXISTS_TAC;
25695   REWRITE_TAC[INTER];
25696   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
25697   ASM_MESON_TAC[];
25698   REWRITE_TAC[PAIR_SPLIT];
25699   ASM_REWRITE_TAC[];
25700   DISCH_TAC;
25701   USE 3(REWRITE_RULE[BIJ;INJ]);
25702   REP_BASIC_TAC;
25703   FIRST_ASSUM IMATCH_MP_TAC ;
25704   ASM_REWRITE_TAC[];
25705   DISCH_THEN_REWRITE ;
25706   REWRITE_TAC[UNION];
25707   GEN_TAC;
25708   DISCH_THEN DISJ_CASES_TAC;
25709   TYPE_THEN `( ((INV f'' UNIV A) x ), T )` EXISTS_TAC;
25710   CONJ_TAC;
25711   REWRITE_TAC[cartesian_el];
25712   EXPAND_TAC "u";
25713   REWRITE_TAC[SND ];
25714   IMATCH_MP_TAC  inv_comp_right;
25715   ASM_REWRITE_TAC[];
25716   TYPE_THEN `( ((INV f' UNIV B) x ), F )` EXISTS_TAC;
25717   REWRITE_TAC[cartesian_el];
25718   EXPAND_TAC "u";
25719   REWRITE_TAC[SND ];
25720   IMATCH_MP_TAC  inv_comp_right;
25721   ASM_REWRITE_TAC[];
25722   (* B graph_inc  *)
25723   REWRITE_TAC[cartesian_el];
25724   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
25725   CONJ_TAC;
25726   GEN_TAC;
25727   EXPAND_TAC "u";
25728   REWRITE_TAC[IMAGE_CLAUSES];
25729   EXPAND_TAC "v";
25730   EXPAND_TAC "g";
25731   TYPE_THEN `cartesian A B (f'' (FST e), f' (SND e))` SUBGOAL_TAC;
25732   REWRITE_TAC[cartesian_el];
25733   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
25734   ASM_MESON_TAC[];
25735   ASM_SIMP_TAC[inv_comp_right];
25736   (* C  BIJ v *)
25737   TYPE_THEN `BIJ g (cartesian A B) E` SUBGOAL_TAC;
25738   EXPAND_TAC "g";
25739   IMATCH_MP_TAC  INVERSE_BIJ;
25740   ASM_REWRITE_TAC[];
25741   DISCH_TAC;
25742   REWRITE_TAC[BIJ];
25743   SUBCONJ_TAC;
25744   REWRITE_TAC[INJ];
25745   REWRITE_TAC[cartesian_el];
25746   EXPAND_TAC "v";
25747   CONJ_TAC;
25748   (* --- *)
25749   USE 7(REWRITE_RULE[BIJ;SURJ]);
25750   REP_BASIC_TAC;
25751   FIRST_ASSUM IMATCH_MP_TAC ;
25752   REWRITE_TAC[cartesian_el];
25753   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
25754   ASM_MESON_TAC[];
25755   REP_BASIC_TAC;
25756   TYPE_THEN `(f'' (FST x),f' (SND x)) = (f''(FST y),f' (SND y))` SUBGOAL_TAC;
25757   USE 7(REWRITE_RULE[BIJ;INJ]);
25758   REP_BASIC_TAC;
25759   FIRST_ASSUM IMATCH_MP_TAC ;
25760   ASM_REWRITE_TAC [cartesian_el];
25761   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
25762   ASM_MESON_TAC[];
25763   REWRITE_TAC[PAIR_SPLIT];
25764   REP_BASIC_TAC;
25765   CONJ_TAC;
25766   USE 2 (REWRITE_RULE[BIJ;INJ]);
25767   REP_BASIC_TAC;
25768   FIRST_ASSUM IMATCH_MP_TAC ;
25769   ASM_REWRITE_TAC[];
25770   USE 3 (REWRITE_RULE[BIJ;INJ]);
25771   REP_BASIC_TAC;
25772   FIRST_ASSUM IMATCH_MP_TAC ;
25773   ASM_REWRITE_TAC[];
25774   (* -- *)
25775   REWRITE_TAC[INJ;SURJ];
25776   DISCH_THEN_REWRITE;
25777   REWRITE_TAC[cartesian_el];
25778   EXPAND_TAC "v";
25779   REP_BASIC_TAC;
25780   (* -- *)
25781   TYPE_THEN `?u0. (f'' u0 = FST (f x))` SUBGOAL_TAC ;
25782   USE 2 (REWRITE_RULE[BIJ;SURJ]);
25783   REP_BASIC_TAC ;
25784   FIRST_ASSUM IMATCH_MP_TAC ;
25785   USE 0 (REWRITE_RULE[BIJ;SURJ]);
25786   REP_BASIC_TAC;
25787   TSPEC `x` 11;
25788   REWR 11;
25789   USE 11(REWRITE_RULE[cartesian_el]);
25790   ASM_REWRITE_TAC[];
25791   REP_BASIC_TAC;
25792   (* -- *)
25793   TYPE_THEN `?u1. (f' u1 = SND (f x))` SUBGOAL_TAC ;
25794   USE 3 (REWRITE_RULE[BIJ;SURJ]);
25795   REP_BASIC_TAC ;
25796   FIRST_ASSUM IMATCH_MP_TAC ;
25797   USE 0 (REWRITE_RULE[BIJ;SURJ]);
25798   REP_BASIC_TAC;
25799   TSPEC `x` 12;
25800   REWR 12;
25801   USE 12(REWRITE_RULE[cartesian_el]);
25802   ASM_REWRITE_TAC[];
25803   REP_BASIC_TAC;
25804   TYPE_THEN `(u0,u1)` EXISTS_TAC;
25805   ASM_REWRITE_TAC[];
25806   EXPAND_TAC "g";
25807   IMATCH_MP_TAC  inv_comp_left;
25808   ASM_REWRITE_TAC[];
25809   (* Sat Aug 14 14:58:11 EDT 2004 *)
25810
25811   ]);;
25812   (* }}} *)
25813
25814
25815 (* ********************************************************* *)
25816
25817 let mk_segment_inj_image2 = prove_by_refinement(
25818   `!x y n.
25819     euclid n x /\ euclid n y /\ ~(x = y)
25820           ==> (?f. continuous f (top_of_metric (UNIV,d_real))
25821                    (top_of_metric (euclid n,d_euclid)) /\
25822                    INJ f {x | &0 <= x /\ x <= &1} (euclid n) /\
25823                    (f (&0) = x) /\ (f (&1) = y) /\
25824                    (IMAGE f {t | &0 <= t /\ t <= &1} = mk_segment x y))`,
25825   (* {{{ proof *)
25826   [
25827   DISCH_ALL_TAC;
25828   TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
25829   CONJ_TAC;
25830   IMATCH_MP_TAC  cont_mk_segment;
25831   ASM_REWRITE_TAC[];
25832   REWRITE_TAC[joinf;IMAGE ];
25833   REWRITE_TAC[mk_segment];
25834   (* new new *)
25835   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;
25836   REWRITE_TAC[REAL_ARITH `~(&0 < &0) /\ ~(&1 < &0) /\ (&0 < &1) /\ ~(&1 < &1)`];
25837   REDUCE_TAC;
25838   REWRITE_TAC[euclid_scale0; euclid_scale_one ; euclid_lzero];
25839   DISCH_THEN_REWRITE;
25840   (* end new new *)
25841   CONJ_TAC;
25842   (* new stuff *)
25843   REWRITE_TAC[INJ];
25844   CONJ_TAC;
25845   REP_BASIC_TAC;
25846   TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
25847   UND 4;
25848   REAL_ARITH_TAC;
25849   DISCH_THEN_REWRITE;
25850   ASM_CASES_TAC `x' < &1`;
25851   ASM_REWRITE_TAC[];
25852   IMATCH_MP_TAC  euclid_add_closure;
25853   CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
25854   ASM_REWRITE_TAC[];
25855   REP_BASIC_TAC;
25856   UND 3;
25857   TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
25858   UND 7;
25859   REAL_ARITH_TAC;
25860   DISCH_THEN_REWRITE;
25861   TYPE_THEN `~(y' < &0)` SUBGOAL_TAC;
25862   UND 5;
25863   REAL_ARITH_TAC;
25864   DISCH_THEN_REWRITE;
25865   TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC;
25866  TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC;
25867   UND 6;
25868   REAL_ARITH_TAC;
25869   DISCH_THEN   DISJ_CASES_TAC;
25870   ASM_REWRITE_TAC[];
25871   TYPE_THEN `~(x' < &1)` SUBGOAL_TAC;
25872   UND 3;
25873   REAL_ARITH_TAC;
25874   DISCH_THEN_REWRITE;
25875   ASM_REWRITE_TAC[];
25876   REDUCE_TAC;
25877   REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
25878   DISCH_THEN_REWRITE;
25879
25880   TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC;
25881  TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC;
25882   UND 4;
25883   REAL_ARITH_TAC;
25884   DISCH_THEN   DISJ_CASES_TAC;
25885   ASM_REWRITE_TAC[];
25886   TYPE_THEN `~(y' < &1)` SUBGOAL_TAC;
25887   UND 3;
25888   REAL_ARITH_TAC;
25889   DISCH_THEN_REWRITE;
25890   ASM_REWRITE_TAC[];
25891   REDUCE_TAC;
25892   REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
25893   DISCH_THEN_REWRITE;
25894   (* th *)
25895   ONCE_REWRITE_TAC [euclid_eq_minus];
25896   REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act];
25897   ONCE_REWRITE_TAC [euclid_plus_pair];
25898   REWRITE_TAC[GSYM euclid_rdistrib];
25899   REDUCE_TAC;
25900   REWRITE_TAC[REAL_ARITH  `x' + -- &1 * y' = x' - y'`];
25901   REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`];
25902   REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus];
25903   (* th1 *)
25904   DISCH_TAC;
25905   PROOF_BY_CONTR_TAC;
25906   UND 2;
25907   REWRITE_TAC[];
25908   IMATCH_MP_TAC  euclid_scale_cancel;
25909   TYPE_THEN `(x' - y')` EXISTS_TAC;
25910   ASM_REWRITE_TAC[];
25911   UND 8;
25912   REAL_ARITH_TAC;
25913   KILL 2;
25914   (* old stuff *)
25915   IMATCH_MP_TAC  EQ_EXT;
25916   GEN_TAC;
25917   ASM_REWRITE_TAC[];
25918   EQ_TAC;
25919   DISCH_TAC;
25920   CHO 2;
25921   UND 2;
25922   COND_CASES_TAC;
25923   DISCH_ALL_TAC;
25924   JOIN 3 2;
25925   ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
25926   DISCH_ALL_TAC;
25927   UND 5;
25928   COND_CASES_TAC;
25929   DISCH_TAC;
25930   TYPE_THEN `&1 - x''` EXISTS_TAC;
25931   SUBCONJ_TAC;
25932   UND 5;
25933   REAL_ARITH_TAC ;
25934   DISCH_TAC;
25935   CONJ_TAC;
25936   UND 3;
25937   REAL_ARITH_TAC ;
25938   ONCE_REWRITE_TAC [euclid_add_comm];
25939   REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
25940   ASM_MESON_TAC[];
25941   DISCH_TAC;
25942   ASM_REWRITE_TAC[];
25943   TYPE_THEN `&0` EXISTS_TAC;
25944   CONJ_TAC;
25945   REAL_ARITH_TAC ;
25946   CONJ_TAC;
25947   REAL_ARITH_TAC ;
25948   REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
25949   (* 2nd half *)
25950   DISCH_TAC;
25951   CHO 2;
25952   TYPE_THEN `&1 - a` EXISTS_TAC ;
25953   ASM_REWRITE_TAC[];
25954   CONJ_TAC;
25955   AND 2;
25956   AND 2;
25957   UND 3;
25958   UND 4;
25959   REAL_ARITH_TAC ;
25960   COND_CASES_TAC;
25961   ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
25962   COND_CASES_TAC;
25963   REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
25964   ASM_MESON_TAC [euclid_add_comm];
25965   TYPE_THEN `a = &.0` SUBGOAL_TAC;
25966   UND 4;
25967   UND 3;
25968   AND 2;
25969   UND 3;
25970   REAL_ARITH_TAC ;
25971   DISCH_TAC;
25972   REWR 2;
25973   REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
25974    ]);;
25975   (* }}} *)
25976
25977 let mk_segment_simple_arc_end = prove_by_refinement(
25978   `!x y.
25979      (euclid 2 x) /\ (euclid 2 y) /\ ~(x = y) ==>
25980        simple_arc_end (mk_segment x y) x y`,
25981   (* {{{ proof *)
25982
25983   [
25984   REP_BASIC_TAC;
25985   REWRITE_TAC[simple_arc_end];
25986   TYPEL_THEN [`x`;`y`;`2`] (fun t-> ANT_TAC (ISPECL t mk_segment_inj_image2));
25987   ASM_REWRITE_TAC[];
25988   REP_BASIC_TAC;
25989   TYPE_THEN `f` EXISTS_TAC;
25990   RULE_ASSUM_TAC  (REWRITE_RULE[GSYM top2 ]);
25991   ASM_REWRITE_TAC[];
25992   (* Tue Aug 17 10:10:00 EDT 2004 *)
25993
25994   ]);;
25995
25996   (* }}} *)
25997
25998 let cis0 = prove_by_refinement(
25999   `cis (&0) = e1`,
26000   (* {{{ proof *)
26001   [
26002   REWRITE_TAC[cis;COS_0;SIN_0;e1;];
26003   ]);;
26004   (* }}} *)
26005
26006 let cispi2 = prove_by_refinement(
26007   `cis (pi/(&2)) = e2`,
26008   (* {{{ proof *)
26009   [
26010   REWRITE_TAC [cis;COS_PI2;SIN_PI2;e2];
26011   ]);;
26012   (* }}} *)
26013
26014 let neg_point = prove_by_refinement(
26015   `!x y. -- (point (x,y)) = point (--x, --y)`,
26016   (* {{{ proof *)
26017   [
26018   REP_BASIC_TAC;
26019   REWRITE_TAC[euclid_neg];
26020   IMATCH_MP_TAC  EQ_EXT;
26021   REP_BASIC_TAC;
26022   BETA_TAC;
26023   MP_TAC (ARITH_RULE  `(x' = 0) \/ (x' = 1) \/ (2 <=| x')`);
26024   REP_CASES_TAC ;
26025   ASM_REWRITE_TAC[coord01];
26026   ASM_REWRITE_TAC[coord01];
26027   TYPE_THEN `euclid 2(point(x,y)) /\ euclid 2(point(--x,--y))` SUBGOAL_TAC;
26028   ASM_MESON_TAC[euclid_point];
26029   REWRITE_TAC[euclid];
26030   REP_BASIC_TAC;
26031   TSPEC `x'` 1;
26032   TSPEC `x'` 2;
26033   ASM_MESON_TAC[REAL_ARITH `-- &0 = &0`];
26034   (* Tue Aug 17 10:27:14 EDT 2004 *)
26035
26036   ]);;
26037   (* }}} *)
26038
26039 let cispi = prove_by_refinement(
26040   `cis(pi) = -- e1`,
26041   (* {{{ proof *)
26042   [
26043   REWRITE_TAC[cis;COS_PI ;SIN_PI;e1];
26044   REWRITE_TAC[neg_point];
26045   AP_TERM_TAC;
26046   REWRITE_TAC[PAIR_SPLIT];
26047   REAL_ARITH_TAC;
26048   (* Tue Aug 17 10:28:55 EDT 2004 *)
26049
26050   ]);;
26051   (* }}} *)
26052
26053 let cis3pi2 = prove_by_refinement(
26054   `cis(&3 *pi/(&2)) = -- e2`,
26055   (* {{{ proof *)
26056   [
26057   TYPE_THEN `&3 *pi/(&2) = pi/(&2) + pi` SUBGOAL_TAC;
26058   REWRITE_TAC[REAL_ARITH `&3 = &1 + &1 + &1`];
26059   REWRITE_TAC[REAL_ARITH `(x + y)*z = x*z + y*z`];
26060   REDUCE_TAC;
26061   DISCH_THEN_REWRITE;
26062   REWRITE_TAC[cis;COS_PERIODIC_PI;SIN_PERIODIC_PI;GSYM neg_point;];
26063   AP_TERM_TAC;
26064   REWRITE_TAC[GSYM cis;cispi2];
26065   (* Tue Aug 17 10:34:32 EDT 2004 *)
26066
26067   ]);;
26068   (* }}} *)
26069
26070 let closedball_convex = prove_by_refinement(
26071   `!x e n. (convex (closed_ball (euclid n,d_euclid) x e))`,
26072   (* {{{ proof *)
26073   [
26074   REWRITE_TAC[convex;closed_ball;SUBSET;mk_segment;];
26075   REP_BASIC_TAC;
26076   USE 0 SYM;
26077   ASM_REWRITE_TAC[];
26078   SUBCONJ_TAC;
26079   EXPAND_TAC "x''";
26080   IMATCH_MP_TAC  (euclid_add_closure);
26081   CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
26082   DISCH_TAC;
26083   TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC;
26084   REWRITE_TAC[trivial_lin_combo];
26085   DISCH_THEN_REWRITE;
26086   EXPAND_TAC "x''";
26087   (* special case *)
26088   ASM_CASES_TAC `a = &0` ;
26089   UND 10;
26090   DISCH_THEN_REWRITE;
26091   REDUCE_TAC;
26092   ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;];
26093   TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u <= a*e) /\ (v <= (&1- a)*e))  ==> (d <= e))` SUBGOAL_TAC;
26094   REP_BASIC_TAC;
26095   TYPE_THEN `u + v <= (a*e) + (&1 - a)*e` SUBGOAL_TAC;
26096   IMATCH_MP_TAC  REAL_LE_ADD2;
26097   ASM_REWRITE_TAC[];
26098   REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`];
26099   UND 13;
26100   REAL_ARITH_TAC ;
26101   DISCH_THEN IMATCH_MP_TAC ;
26102   TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC;
26103   TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC;
26104   TYPE_THEN `d_euclid z x''` EXISTS_TAC;
26105   TYPE_THEN `euclid n z` SUBGOAL_TAC;
26106   EXPAND_TAC "z";
26107   IMATCH_MP_TAC  (euclid_add_closure);
26108   CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
26109   DISCH_TAC;
26110   CONJ_TAC;
26111   EXPAND_TAC "x''";
26112   IMATCH_MP_TAC  metric_space_triangle;
26113   TYPE_THEN `euclid n` EXISTS_TAC;
26114   REWRITE_TAC[metric_euclid];
26115   ASM_REWRITE_TAC[trivial_lin_combo];
26116   CONJ_TAC;
26117   EXPAND_TAC "z";
26118   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;
26119   IMATCH_MP_TAC  metric_translate;
26120   TYPE_THEN `n` EXISTS_TAC;
26121   REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
26122   DISCH_THEN_REWRITE;
26123   TYPE_THEN `d_euclid (a *# x) (a *# x')  = abs  (a) * d_euclid x x'` SUBGOAL_TAC;
26124   IMATCH_MP_TAC  norm_scale_vec;
26125   ASM_MESON_TAC[];
26126   DISCH_THEN_REWRITE;
26127   TYPE_THEN `abs  a = a` SUBGOAL_TAC;
26128   ASM_MESON_TAC[REAL_ABS_REFL];
26129   DISCH_THEN_REWRITE;
26130   IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
26131   ASM_REWRITE_TAC[];
26132
26133   (* LAST case *)
26134   EXPAND_TAC "z";
26135   EXPAND_TAC "x''";
26136   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;
26137   IMATCH_MP_TAC  metric_translate_LEFT;
26138   TYPE_THEN `n` EXISTS_TAC;
26139   REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
26140   DISCH_THEN_REWRITE;
26141   TYPE_THEN `!b. d_euclid (b *# x) (b *# y)  = abs  (b) * d_euclid x y` SUBGOAL_TAC;
26142   GEN_TAC;
26143   IMATCH_MP_TAC  norm_scale_vec;
26144   ASM_MESON_TAC[];
26145   DISCH_THEN_REWRITE;
26146   TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
26147   REWRITE_TAC [REAL_ABS_REFL];
26148   UND 1;
26149   REAL_ARITH_TAC;
26150   DISCH_THEN_REWRITE;
26151   IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
26152   ASM_REWRITE_TAC[];
26153   UND 1;
26154   REAL_ARITH_TAC;
26155   ]);;
26156   (* }}} *)
26157
26158 let closedball_mk_segment_end = prove_by_refinement(
26159   `!x e n u v.
26160      (closed_ball(euclid n,d_euclid) x e u) /\
26161      (closed_ball(euclid n,d_euclid) x e v) ==>
26162      (mk_segment u v SUBSET (closed_ball(euclid n,d_euclid) x e))`,
26163   (* {{{ proof *)
26164   [
26165   REP_BASIC_TAC;
26166   ASSUME_TAC closedball_convex;
26167   TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL);
26168   USE 2 (REWRITE_RULE[convex]);
26169   FIRST_ASSUM IMATCH_MP_TAC ;
26170   ASM_REWRITE_TAC[];
26171   ]);;
26172   (* }}} *)
26173
26174 let euclid2_e12 = prove_by_refinement(
26175   `euclid 2 e1 /\ euclid 2 e2`,
26176   (* {{{ proof *)
26177   [
26178   REWRITE_TAC[e1;e2;euclid_point];
26179   ]);;
26180   (* }}} *)
26181
26182 let in_union = prove_by_refinement(
26183   `!X Y Z. (X:A->bool) SUBSET Y \/ (X SUBSET Z) ==> (X SUBSET Y UNION Z)`,
26184   (* {{{ proof *)
26185   [
26186   REWRITE_TAC[SUBSET;UNION ];
26187   ASM_MESON_TAC[];
26188   ]);;
26189   (* }}} *)
26190
26191 let mk_segment_hyperplane = prove_by_refinement(
26192   `!p r i. (i < 4) /\ (&0 <r) /\ (euclid 2 p) ==>
26193     (mk_segment p (p + r *# (cis(&i * pi/(&2))))) SUBSET
26194      (hyperplane 2 e2 (p 1) UNION
26195                      hyperplane 2 e1 (p 0))  `,
26196   (* {{{ proof *)
26197   [
26198   REP_BASIC_TAC;
26199   TYPE_THEN `?x y. p = point (x,y)` SUBGOAL_TAC;
26200   USE 0 (MATCH_MP point_onto);
26201   REP_BASIC_TAC;
26202   TYPE_THEN `FST p'` EXISTS_TAC;
26203   TYPE_THEN `SND p'` EXISTS_TAC;
26204   ASM_REWRITE_TAC[];
26205   REP_BASIC_TAC;
26206   UND 3;
26207   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
26208   REWRITE_TAC[coord01];
26209   (* -- *)
26210   TYPE_THEN `convex(hyperplane 2 e2 y)` SUBGOAL_TAC;
26211   IMATCH_MP_TAC  hyperplane_convex;
26212   REWRITE_TAC[euclid2_e12];
26213   TYPE_THEN `convex(hyperplane 2 e1 x)` SUBGOAL_TAC;
26214   IMATCH_MP_TAC  hyperplane_convex;
26215   REWRITE_TAC[euclid2_e12];
26216   REWRITE_TAC[convex];
26217   REP_BASIC_TAC;
26218   TYPE_THEN `hyperplane 2 e1 x (point(x,y)) /\ hyperplane 2 e2 y (point(x,y))` SUBGOAL_TAC;
26219   REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM  line2D_F];
26220   CONJ_TAC;
26221   TYPE_THEN `(x,y)` EXISTS_TAC;
26222   ASM_REWRITE_TAC[];
26223   TYPE_THEN `(x,y)` EXISTS_TAC;
26224   ASM_REWRITE_TAC[];
26225   REP_BASIC_TAC;
26226   USE 2 (MATCH_MP (ARITH_RULE (`(i < 4) ==> (i = 0) \/ (i = 1) \/ (i = 2) \/ (i = 3)`)));
26227   (* -- *)
26228   IMATCH_MP_TAC  in_union;
26229   TYPE_THEN `z = (euclid_plus (point (x,y)) (r *# cis (&i * pi / &2)))` ABBREV_TAC ;
26230   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;
26231   ASM_MESON_TAC[];
26232   DISCH_THEN IMATCH_MP_TAC ;
26233   (* -- *)
26234   TYPE_THEN `( (cis (&i *pi/(&2))) 0 = &0) ==> (hyperplane 2 e1 x z)` SUBGOAL_TAC;
26235   REWRITE_TAC[e1;GSYM line2D_F];
26236   EXPAND_TAC "z";
26237   REWRITE_TAC[cis;coord01];
26238   DISCH_THEN_REWRITE;
26239   REWRITE_TAC[point_scale;point_add];
26240   REDUCE_TAC;
26241   TYPE_THEN `(x, y+ r*sin (&i *pi/(&2)))` EXISTS_TAC;
26242   REWRITE_TAC[];
26243   (* -- *)
26244   TYPE_THEN `( (cis (&i *pi/(&2))) 1 = &0) ==> (hyperplane 2 e2 y z)` SUBGOAL_TAC;
26245   REWRITE_TAC[e2;GSYM line2D_S];
26246   EXPAND_TAC "z";
26247   REWRITE_TAC[cis;coord01];
26248   DISCH_THEN_REWRITE;
26249   REWRITE_TAC[point_scale;point_add];
26250   REDUCE_TAC;
26251   TYPE_THEN `(x + r*cos(&i *pi/(&2)) , y)` EXISTS_TAC;
26252   REWRITE_TAC[];
26253   REP_BASIC_TAC;
26254   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;
26255   ASM_MESON_TAC[];
26256   DISCH_THEN IMATCH_MP_TAC ;
26257   UND 2;
26258   POP_ASSUM_LIST (fun t-> ALL_TAC);
26259   (* A -- *)
26260   REP_CASES_TAC;
26261   ASM_REWRITE_TAC[];
26262   REDUCE_TAC;
26263   ASM_REWRITE_TAC[cis0;e1;coord01];
26264   ASM_REWRITE_TAC[];
26265   REDUCE_TAC;
26266   ASM_REWRITE_TAC[cispi2;e2;coord01];
26267   ASM_REWRITE_TAC[];
26268   REWRITE_TAC[REAL_MUL_2];
26269   REDUCE_TAC;
26270   ASM_REWRITE_TAC[cispi;e1;coord01;neg_point];
26271   REDUCE_TAC;
26272   ASM_REWRITE_TAC[cis3pi2;e2;coord01;neg_point];
26273   REDUCE_TAC;
26274   (* Tue Aug 17 11:46:56 EDT 2004 *)
26275
26276   ]);;
26277   (* }}} *)
26278
26279 let d_euclid_mk_segment = prove_by_refinement(
26280   `!n a p q . (&0 <= a) /\ (a <= &1) /\ (euclid n p) /\ (euclid n q) ==>
26281       (d_euclid p (a*#p + (&1 - a)*#q) = (&1 - a)*(d_euclid p q))`,
26282   (* {{{ proof *)
26283   [
26284   REP_BASIC_TAC;
26285   TYPE_THEN `!z. d_euclid (a*# p + (&1 - a)*# p) z = d_euclid p z` SUBGOAL_TAC;
26286   REWRITE_TAC[trivial_lin_combo];
26287   DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
26288   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;
26289   ASM_MESON_TAC [metric_translate_LEFT;euclid_scale_closure];
26290   DISCH_THEN_REWRITE;
26291   TYPE_THEN `d_euclid ((&1 - a) *# p) ((&1 - a) *# q) = abs  (&1- a) * d_euclid p q` SUBGOAL_TAC;
26292   ASM_MESON_TAC[euclid_scale_closure;norm_scale_vec];
26293   DISCH_THEN_REWRITE;
26294   TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
26295   UND 2;
26296   REAL_ARITH_TAC;
26297   DISCH_THEN_REWRITE;
26298   REWRITE_TAC[trivial_lin_combo];
26299   (* Tue Aug 17 12:24:07 EDT 2004 *)
26300
26301   ]);;
26302   (* }}} *)
26303
26304 let mk_segment_eq = prove_by_refinement(
26305   `! a p x y. ((a*# p + (&1 - a)*# x) = (a *# p + (&1 - a)*# y)) ==>
26306       (a = &1) \/ (x = y)`,
26307   (* {{{ proof *)
26308   [
26309   ONCE_REWRITE_TAC[euclid_eq_minus];
26310   REWRITE_TAC[euclid_minus;euclid_plus;euclid0;euclid_scale];
26311   REP_BASIC_TAC;
26312   USE 0 (REWRITE_RULE[FUN_EQ_THM]);
26313   IMATCH_MP_TAC  (TAUT `(~A ==>B) ==> (A \/ B)`);
26314   REP_BASIC_TAC;
26315   IMATCH_MP_TAC  EQ_EXT;
26316   GEN_TAC;
26317   BETA_TAC;
26318   USE 0 (SPEC `x':num` );
26319   UND 0;
26320   REWRITE_TAC[REAL_ARITH  `(a*b + r*c ) - (a*b + r*d) = r*c - r*d`];
26321   REWRITE_TAC[REAL_ARITH `a*y - a*z = a*(y-z)`];
26322   REWRITE_TAC[REAL_ENTIRE];
26323   UND 1;
26324   REAL_ARITH_TAC;
26325   ]);;
26326   (* }}} *)
26327
26328 let mk_segment_endpoint = prove_by_refinement(
26329   `!p x y n . (d_euclid p x = d_euclid p y) /\ ~(x = y) /\
26330        (euclid n x) /\ (euclid n y) /\ (euclid n p) ==>
26331     (mk_segment p x INTER mk_segment p y = {p})`,
26332   (* {{{ proof *)
26333   [
26334   REP_BASIC_TAC;
26335   IMATCH_MP_TAC  EQ_EXT;
26336   REWRITE_TAC[INTER;INR IN_SING];
26337   GEN_TAC;
26338   (* A -- *)
26339   EQ_TAC;
26340   REWRITE_TAC[mk_segment];
26341   REP_BASIC_TAC;
26342   UND 5;
26343   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
26344   PROOF_BY_CONTR_TAC;
26345   TYPE_THEN `~(a' = &1)` SUBGOAL_TAC;
26346   DISCH_TAC;
26347   UND 11;
26348   DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
26349   UND 5;
26350   REDUCE_TAC;
26351   REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero];
26352   REP_BASIC_TAC;
26353   (* -- *)
26354   TYPE_THEN `(&1- a')*d_euclid p y = (&1- a)*d_euclid p x` SUBGOAL_TAC;
26355   KILL 4;
26356   ASM_MESON_TAC[d_euclid_mk_segment];
26357   ASM_REWRITE_TAC[];
26358   PROOF_BY_CONTR_TAC;
26359   REWR 12;
26360   (* -- *)
26361   TYPE_THEN `d_euclid p y = &0` ASM_CASES_TAC;
26362   TYPE_THEN `p = y` SUBGOAL_TAC;
26363   ASM_MESON_TAC [d_euclid_zero];
26364   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
26365   ASM_MESON_TAC[d_euclid_zero];
26366   USE 12 (REWRITE_RULE[REAL_EQ_MUL_RCANCEL]);
26367   REWR 12;
26368   TYPE_THEN `a' = a` SUBGOAL_TAC;
26369   UND 12;
26370   REAL_ARITH_TAC;
26371   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
26372   USE 8 (MATCH_MP mk_segment_eq);
26373   REWR 8;
26374   (* -- *)
26375   DISCH_THEN_REWRITE;
26376   REWRITE_TAC[mk_segment_end];
26377   (* Tue Aug 17 14:04:19 EDT 2004 *)
26378
26379   ]);;
26380   (* }}} *)
26381
26382 let cases4 = prove_by_refinement(
26383   `!i j.  (i < j) /\ (j < 4) ==> ((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/
26384            ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/
26385          ((i=2)/\ (j=3))`,
26386   (* {{{ proof *)
26387   [
26388   REP_BASIC_TAC;
26389   TYPE_THEN `!k. (k < 4) ==> (k = 0) \/ (k =1)\/ (k=2) \/ (k=3)` SUBGOAL_TAC;
26390   ARITH_TAC;
26391   DISCH_TAC;
26392   TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2) \/ (j = 3)` SUBGOAL_TAC;
26393   FIRST_ASSUM IMATCH_MP_TAC ;
26394   ASM_REWRITE_TAC[];
26395   DISCH_TAC;
26396   TYPE_THEN `~(j=0)` SUBGOAL_TAC;
26397   UND 1;
26398   ARITH_TAC;
26399   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
26400   TYPE_THEN `(i < 3)` SUBGOAL_TAC;
26401   UND 0;
26402   UND 1;
26403   ARITH_TAC;
26404   DISCH_TAC;
26405   TYPE_THEN `(i=0) \/ (i = 1) \/ (i=2)` SUBGOAL_TAC;
26406   UND 4;
26407   ARITH_TAC;
26408   DISCH_TAC;
26409   JOIN 5 3;
26410   USE 3 (REWRITE_RULE [RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]);
26411   TYPE_THEN `!k. ~((i = k) /\ (j = k))` SUBGOAL_TAC;
26412   GEN_TAC;
26413   UND 1;
26414   ARITH_TAC;
26415   DISCH_THEN (fun t-> USE 3 (REWRITE_RULE[t]));
26416   TYPE_THEN `~((i=2) /\ (j = 1))` SUBGOAL_TAC;
26417   UND 1;
26418   ARITH_TAC ;
26419   DISCH_THEN (fun t-> USE 3(REWRITE_RULE[t]));
26420   ASM_REWRITE_TAC[];
26421   UND 3;
26422   REP_CASES_TAC THEN (ASM_REWRITE_TAC[]);
26423   ]);;
26424   (* }}} *)
26425
26426 let cis_distinct = prove_by_refinement(
26427   `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (&0 < r) ==>
26428         ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))`,
26429   (* {{{ proof *)
26430
26431   [
26432   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;
26433   REP_BASIC_TAC;
26434   TYPE_THEN `!p x y. (euclid_plus p x = euclid_plus p y) ==> (x = y)` SUBGOAL_TAC;
26435   REWRITE_TAC[euclid_plus];
26436   REP_BASIC_TAC;
26437   USE 6 (REWRITE_RULE[FUN_EQ_THM]);
26438   IMATCH_MP_TAC  EQ_EXT;
26439   GEN_TAC;
26440   TSPEC `x'` 6;
26441   UND 6;
26442   REAL_ARITH_TAC;
26443   DISCH_THEN (fun t-> USE 0 (MATCH_MP t));
26444   USE 0 (AP_TERM `( *# ) (&1/r)`);
26445   USE 0 (REWRITE_RULE [euclid_scale_act]);
26446   TYPE_THEN `&1/r * r = &1` SUBGOAL_TAC;
26447   ONCE_REWRITE_TAC [REAL_ARITH `x*y = y*x`];
26448   ASM_MESON_TAC[REAL_DIV_LMUL;REAL_ARITH `&0 < r ==> ~(r = &0)`];
26449   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
26450   USE 0(REWRITE_RULE[euclid_scale_one]);
26451   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;
26452   IMATCH_MP_TAC  cases4;
26453   ASM_REWRITE_TAC[];
26454   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[]);
26455   REP_BASIC_TAC;
26456   TYPE_THEN `( i <| j) \/ (j <| i)` SUBGOAL_TAC;
26457   UND 2;
26458   ARITH_TAC;
26459   REP_CASES_TAC;
26460   TYPEL_THEN [`i`;`j`;`r`] (USE 5 o ISPECL);
26461   ASM_MESON_TAC[];
26462   TYPEL_THEN [`j`;`i`;`r`] (USE 5 o ISPECL);
26463   ASM_MESON_TAC[];
26464   (* Tue Aug 17 15:01:38 EDT 2004 *)
26465
26466
26467
26468
26469   ]);;
26470
26471   (* }}} *)
26472
26473 let cis_nz = prove_by_refinement(
26474   `!t. ~(cis(t) = euclid0)`,
26475   (* {{{ proof *)
26476   [
26477   REP_BASIC_TAC;
26478   USE 0 (AP_TERM `norm2`);
26479   RULE_ASSUM_TAC (REWRITE_RULE[norm2_cis]);
26480   ASM_MESON_TAC[REAL_ARITH `~(&1= &0)`;norm2_0;];
26481   ]);;
26482   (* }}} *)
26483
26484 let polar_nz = prove_by_refinement(
26485   `!r t. ~(r = &0) ==> ~(r *# cis(t) =euclid0)`,
26486   (* {{{ proof *)
26487   [
26488   REP_BASIC_TAC;
26489   USE 0 (AP_TERM `norm2`);
26490   RULE_ASSUM_TAC (REWRITE_RULE[norm2_scale_cis]);
26491   ASM_MESON_TAC[REAL_ARITH `(abs  r = &0) ==> (r = &0)`;norm2_0];
26492   ]);;
26493   (* }}} *)
26494
26495 let polar_euclid = prove_by_refinement(
26496   `!r t. euclid 2 (r *# (cis t))`,
26497   (* {{{ proof *)
26498   [
26499   REWRITE_TAC[cis;point_scale;euclid_point];
26500   ]);;
26501   (* }}} *)
26502
26503 let d_euclidpq = prove_by_refinement(
26504   `!n p q . (euclid n p) /\ (euclid n q) ==> (d_euclid p (p+q) =
26505       d_euclid q euclid0)`,
26506   (* {{{ proof *)
26507   [
26508   REP_BASIC_TAC;
26509   TYPE_THEN `!z. d_euclid p z = d_euclid (p + euclid0) z` SUBGOAL_TAC;
26510   REWRITE_TAC[euclid_rzero];
26511   DISCH_THEN (fun t->ONCE_REWRITE_TAC[t]);
26512   TYPE_THEN `d_euclid (euclid_plus p euclid0) (euclid_plus p q) = d_euclid euclid0 q` SUBGOAL_TAC;
26513   IMATCH_MP_TAC  metric_translate_LEFT;
26514   TYPE_THEN `n` EXISTS_TAC;
26515   ASM_REWRITE_TAC[euclid_euclid0;polar_euclid;];
26516   DISCH_THEN_REWRITE;
26517   IMATCH_MP_TAC metric_space_symm;
26518   TYPE_THEN `euclid n` EXISTS_TAC ;
26519   ASM_REWRITE_TAC[metric_euclid;euclid_euclid0;polar_euclid];
26520   ]);;
26521   (* }}} *)
26522
26523 let degree4_vertex_hv = prove_by_refinement(
26524   `!r p. (&0 < r) /\ (euclid 2 p) ==>
26525     (?C.
26526         (!i. (i< 4) ==>
26527            simple_arc_end (C i) p (p + r*# (cis(&i * pi/(&2))))) /\
26528         (!i. (i < 4) ==>
26529            (C i = mk_segment p (p + r*# (cis(&i * pi/(&2)))))) /\
26530         (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==>
26531            (C i INTER C j = {p})) /\
26532         (!i. (i < 4) ==>
26533           (C i INTER {x | r <= d_euclid p x } =
26534                { (p + r *# (cis(&i* pi/(&2)))) })) /\
26535         (!i. (i< 4) ==>
26536            C i SUBSET (closed_ball (euclid 2,d_euclid) p r)) /\
26537         (!i. (i< 4) ==>
26538            C i SUBSET (hyperplane 2 e2 (p 1) UNION
26539                      hyperplane 2 e1 (p 0))))   `,
26540   (* {{{ proof *)
26541   [
26542   REP_BASIC_TAC;
26543   TYPE_THEN `(\i. mk_segment p (euclid_plus p (r *# cis (&i * pi / &2))))` EXISTS_TAC;
26544   BETA_TAC;
26545   ASM_REWRITE_TAC[];
26546   (* -- *)
26547   TYPE_THEN `!i. ~(r *# cis (&i * pi/(&2)) = euclid0)` SUBGOAL_TAC;
26548   REP_BASIC_TAC;
26549   ASM_MESON_TAC[polar_nz;REAL_ARITH `&0 < r ==> ~( r= &0)`];
26550   DISCH_TAC;
26551   (* -- *)
26552   TYPE_THEN `!i . euclid 2 (r *# cis (&i * pi/(&2)))` SUBGOAL_TAC;
26553   GEN_TAC;
26554   REWRITE_TAC[polar_euclid];
26555   DISCH_TAC;
26556   (* -- *)
26557   CONJ_TAC;
26558   REP_BASIC_TAC;
26559   IMATCH_MP_TAC   mk_segment_simple_arc_end;
26560   ASM_REWRITE_TAC[];
26561   CONJ_TAC;
26562   ASM_SIMP_TAC[euclid_add_closure];
26563   DISCH_TAC;
26564   TSPEC `i` 2;
26565   UND 2;
26566   TYPE_THEN `z =r *# cis(&i *pi/(&2))` ABBREV_TAC ;
26567   REWRITE_TAC[euclid0];
26568   IMATCH_MP_TAC  EQ_EXT;
26569   GEN_TAC;
26570   USE 5 (REWRITE_RULE[FUN_EQ_THM ]);
26571   TSPEC `x` 5;
26572   UND 5;
26573   REWRITE_TAC[euclid_plus];
26574   REAL_ARITH_TAC;
26575   (* -- *)
26576   CONJ_TAC;
26577   REP_BASIC_TAC;
26578   IMATCH_MP_TAC  mk_segment_endpoint;
26579   TYPE_THEN `2` EXISTS_TAC;
26580   ASM_REWRITE_TAC[];
26581   CONJ_TAC;
26582   TYPE_THEN `!i. d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi / &2)) euclid0` SUBGOAL_TAC;
26583   GEN_TAC;
26584   IMATCH_MP_TAC  d_euclidpq;
26585   TYPE_THEN `2` EXISTS_TAC;
26586   ASM_REWRITE_TAC[polar_euclid];
26587   DISCH_THEN_REWRITE;
26588   REWRITE_TAC[GSYM norm2];
26589   REWRITE_TAC[norm2_scale_cis];
26590   CONJ_TAC;
26591   IMATCH_MP_TAC  cis_distinct;
26592   ASM_REWRITE_TAC[];
26593   ASM_MESON_TAC[polar_euclid;euclid_add_closure];
26594   (* [B] *)
26595   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;
26596   REP_BASIC_TAC;
26597   IMATCH_MP_TAC  d_euclid_mk_segment;
26598   TYPE_THEN `2` EXISTS_TAC;
26599   ASM_REWRITE_TAC[];
26600   ASM_MESON_TAC[euclid_add_closure];
26601   DISCH_TAC;
26602   (* -- *)
26603   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;
26604   REP_BASIC_TAC;
26605   TYPE_THEN `d_euclid p (p + r *# (cis (&i * pi/(&2)))) = norm2 ( r *# (cis (&i * pi/(&2))))` SUBGOAL_TAC;
26606   REWRITE_TAC[norm2];
26607   IMATCH_MP_TAC  d_euclidpq;
26608   TYPE_THEN `2` EXISTS_TAC;
26609   ASM_REWRITE_TAC[polar_euclid];
26610   REWRITE_TAC[norm2_scale_cis];
26611   TYPE_THEN `abs  r = r` SUBGOAL_TAC;
26612   UND 1;
26613   REAL_ARITH_TAC;
26614   DISCH_THEN_REWRITE;
26615   TYPEL_THEN [`2`;`a`;`p`;`p + (r *# cis (&i * pi / &2))`] (fun t-> ANT_TAC (ISPECL t d_euclid_mk_segment));
26616   ASM_REWRITE_TAC[];
26617   ASM_SIMP_TAC[euclid_add_closure;polar_euclid];
26618   DISCH_THEN_REWRITE;
26619   DISCH_THEN_REWRITE;
26620   REP_BASIC_TAC;
26621   (* -- *)
26622   CONJ_TAC;
26623   REP_BASIC_TAC ;
26624   IMATCH_MP_TAC  EQ_EXT;
26625   GEN_TAC;
26626   REWRITE_TAC[mk_segment;INTER;INR IN_SING];
26627   EQ_TAC;
26628   REP_BASIC_TAC;
26629   UND 8;
26630   DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
26631   TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL);
26632   REWR 5;
26633   ASM_REWRITE_TAC[];
26634   REWR 7;
26635   TYPE_THEN `&1 * r <= (&1 - a) * r` SUBGOAL_TAC;
26636   REDUCE_TAC;
26637   ASM_REWRITE_TAC[];
26638   ASM_SIMP_TAC[REAL_LE_RMUL_EQ];
26639   DISCH_TAC;
26640   TYPE_THEN `a = &0` SUBGOAL_TAC;
26641   UND 10;
26642   UND 8;
26643   REAL_ARITH_TAC;
26644   DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
26645   REDUCE_TAC;
26646   REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero];
26647   DISCH_THEN_REWRITE;
26648   CONJ_TAC;
26649   TYPE_THEN `&0` EXISTS_TAC;
26650   REWRITE_TAC [REAL_ARITH `&0 <= &0 /\ &0 <= &1`];
26651   REDUCE_TAC;
26652   REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero];
26653   TYPE_THEN `d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi/(&2))) euclid0` SUBGOAL_TAC;
26654   IMATCH_MP_TAC  d_euclidpq;
26655   TYPE_THEN `2` EXISTS_TAC;
26656   ASM_REWRITE_TAC[polar_euclid];
26657   DISCH_THEN_REWRITE;
26658   REWRITE_TAC[GSYM norm2;norm2_scale_cis];
26659   UND 1;
26660   REAL_ARITH_TAC;
26661   (* C-- *)
26662   CONJ_TAC;
26663   REP_BASIC_TAC ;
26664   REWRITE_TAC[SUBSET];
26665   GEN_TAC;
26666   REWRITE_TAC[mk_segment;closed_ball];
26667   REP_BASIC_TAC;
26668   UND 7;
26669   DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
26670   TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL);
26671   REWR 5;
26672   ASM_REWRITE_TAC[];
26673   ASM_SIMP_TAC[euclid_add_closure;polar_euclid;euclid_scale_closure];
26674   ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1*y`];
26675   IMATCH_MP_TAC  REAL_PROP_LE_RMUL;
26676   UND 1;
26677   UND 9;
26678   REAL_ARITH_TAC;
26679   (* D-- *)
26680   REP_BASIC_TAC;
26681   IMATCH_MP_TAC  mk_segment_hyperplane;
26682   ASM_REWRITE_TAC[];
26683   (* Tue Aug 17 17:02:28 EDT 2004 *)
26684
26685   ]);;
26686   (* }}} *)
26687
26688 let diff_pow1 = prove_by_refinement(
26689   `!t x. (( \ x. (t*x)) diffl t) x`,
26690   (* {{{ proof *)
26691   [
26692   REP_BASIC_TAC;
26693   TYPE_THEN `(\ x. (t * x)) = (\x. (t * (\u. (u pow 1)) x))` SUBGOAL_TAC;
26694   IMATCH_MP_TAC  EQ_EXT;
26695   GEN_TAC;
26696   BETA_TAC;
26697   REWRITE_TAC[POW_1];
26698   DISCH_THEN_REWRITE;
26699   TYPE_THEN `((\x. (t * (\u. (u pow 1)) x)) diffl (t* &1)) x ` SUBGOAL_TAC;
26700   IMATCH_MP_TAC  DIFF_CMUL;
26701   TYPEL_THEN[`1`;`x`] (fun t-> ASSUME_TAC  (ISPECL t DIFF_POW));
26702   UND 0;
26703   REWRITE_TAC[ARITH_RULE `1-1 = 0`;pow];
26704   REDUCE_TAC;
26705   BETA_TAC;
26706   REDUCE_TAC;
26707   ]);;
26708   (* }}} *)
26709
26710 let pi_bounds = prove_by_refinement(
26711   `&3 < pi /\ pi < &22/ (&7)`,
26712   (* {{{ proof *)
26713   let tpi = recompute_pi 12 in
26714   let t3 = INTERVAL_OF_TERM 12 `&3` in
26715   let t227 = INTERVAL_OF_TERM 12 `&22/(&7)` in
26716   let th1 = INTERVAL_TO_LESS_CONV t3 tpi in
26717   let th2 = INTERVAL_TO_LESS_CONV tpi t227 in
26718   (
26719   [
26720   REP_BASIC_TAC;
26721   ASSUME_TAC th2;
26722   ASSUME_TAC th1;
26723   ASM_REWRITE_TAC[];
26724   ]));;
26725   (* }}} *)
26726
26727 let sinx_le_x = prove_by_refinement(
26728   `!x. (&0 <=x) ==> (sin x <= x)`,
26729   (* {{{ proof *)
26730   [
26731   REP_BASIC_TAC;
26732   TYPE_THEN `x = &0` ASM_CASES_TAC;
26733   ASM_REWRITE_TAC[];
26734   REWRITE_TAC[SIN_0;];
26735   REAL_ARITH_TAC;
26736   TYPE_THEN `&0 < x` SUBGOAL_TAC;
26737   UND 0;
26738   UND 1;
26739   REAL_ARITH_TAC;
26740   POP_ASSUM_LIST (fun t-> ALL_TAC);
26741   DISCH_TAC;
26742   (* -- *)
26743   TYPE_THEN `f = ( \ t x. t * x - sin(x))` ABBREV_TAC ;
26744   TYPE_THEN `!t. (&1 < t) ==> (!x. (&0 < x) ==> (&0 < f t x))` SUBGOAL_TAC;
26745   REP_BASIC_TAC;
26746   PROOF_BY_CONTR_TAC;
26747   (* --- *)
26748   TYPE_THEN `!x. (f t diffl (t - cos x)) x` SUBGOAL_TAC;
26749   EXPAND_TAC "f";
26750   GEN_TAC;
26751   IMATCH_MP_TAC  DIFF_SUB;
26752   REWRITE_TAC[DIFF_SIN;diff_pow1;];
26753   DISCH_TAC;
26754   TYPEL_THEN [`f t`;`&0`;`x'`] (fun t-> ANT_TAC (ISPECL t MVT));
26755   ASM_REWRITE_TAC[];
26756   CONJ_TAC;
26757   REP_BASIC_TAC;
26758   ASM_MESON_TAC[DIFF_CONT];
26759   REWRITE_TAC[differentiable];
26760   REP_BASIC_TAC;
26761   ASM_MESON_TAC[];
26762   REP_BASIC_TAC;
26763   UND 6;
26764   TYPE_THEN `f t (&0) = &0` SUBGOAL_TAC;
26765   EXPAND_TAC "f";
26766   REWRITE_TAC[SIN_0];
26767   REDUCE_TAC;
26768   DISCH_THEN_REWRITE;
26769   REDUCE_TAC;
26770   DISCH_TAC;
26771   UND 4;
26772   REWRITE_TAC[];
26773   ASM_REWRITE_TAC[];
26774   IMATCH_MP_TAC  REAL_LT_MUL;
26775   ASM_REWRITE_TAC[];
26776   TSPEC `z` 5;
26777   TYPE_THEN `l = t - cos z` SUBGOAL_TAC;
26778   IMATCH_MP_TAC  DIFF_UNIQ;
26779   ASM_MESON_TAC[];
26780   DISCH_THEN_REWRITE;
26781   UND 3;
26782   MP_TAC COS_BOUNDS;
26783   DISCH_TAC;
26784   TSPEC `z` 3;
26785   REP_BASIC_TAC;
26786   UND 5;
26787   UND 3;
26788   REAL_ARITH_TAC;
26789   (* -- *)
26790   DISCH_TAC;
26791   IMATCH_MP_TAC  (REAL_ARITH  `~(x < sin x) ==> (sin x <= x)`) ;
26792   DISCH_TAC;
26793   TYPE_THEN `&1 < sin x/x` SUBGOAL_TAC;
26794   ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
26795   REDUCE_TAC;
26796   ASM_REWRITE_TAC[];
26797   DISCH_TAC;
26798   TSPEC  `(sin x)/x` 2;
26799   REWR 2;
26800   TSPEC `x` 2;
26801   REWR 2;
26802   UND 2;
26803   EXPAND_TAC "f";
26804   (* -- *)
26805   ASM_SIMP_TAC[REAL_DIV_RMUL;REAL_ARITH `&0 < x ==> ~(x = &0)`];
26806   REDUCE_TAC;
26807   (* Tue Aug 17 19:35:13 EDT 2004 *)
26808
26809   ]);;
26810   (* }}} *)
26811
26812 let abssinx_lemma = prove_by_refinement(
26813   `!x. (&0 <= x) ==> ((abs  (sin x)) <= abs  x)`,
26814   (* {{{ proof *)
26815   [
26816   GEN_TAC;
26817   REP_BASIC_TAC;
26818   TYPE_THEN `abs  x = x` SUBGOAL_TAC;
26819   UND 0;
26820   REAL_ARITH_TAC;
26821   DISCH_THEN_REWRITE;
26822   TYPE_THEN `x <= pi` ASM_CASES_TAC;
26823   TYPE_THEN `&0 <= sin x` SUBGOAL_TAC;
26824   IMATCH_MP_TAC  SIN_POS_PI_LE;
26825   ASM_REWRITE_TAC[];
26826   DISCH_TAC;
26827   TYPE_THEN `abs  (sin x) = sin x` SUBGOAL_TAC;
26828   UND 2;
26829   REAL_ARITH_TAC;
26830   DISCH_THEN_REWRITE;
26831   ASM_MESON_TAC[sinx_le_x];
26832   IMATCH_MP_TAC  REAL_LE_TRANS;
26833   TYPE_THEN `&1` EXISTS_TAC;
26834   CONJ_TAC;
26835   ASSUME_TAC SIN_BOUNDS;
26836   TSPEC `x` 2;
26837   UND 2;
26838   REAL_ARITH_TAC;
26839   UND 1;
26840   TYPE_THEN `&3 < pi` SUBGOAL_TAC;
26841   REWRITE_TAC[pi_bounds];
26842   REAL_ARITH_TAC;
26843   (* Tue Aug 17 22:54:49 EDT 2004 *)
26844
26845   ]);;
26846   (* }}} *)
26847
26848 let abssinx_le = prove_by_refinement(
26849   `!x. abs  (sin x) <= abs  x`,
26850   (* {{{ proof *)
26851   [
26852   GEN_TAC;
26853   TYPE_THEN `(&0 <= x) \/ (&0 <= -- x)` SUBGOAL_TAC;
26854   REAL_ARITH_TAC;
26855   DISCH_THEN DISJ_CASES_TAC;
26856   ASM_MESON_TAC[abssinx_lemma];
26857   TYPE_THEN `y = --x` ABBREV_TAC ;
26858   TYPE_THEN `x = --y` SUBGOAL_TAC;
26859   UND 1;
26860   REAL_ARITH_TAC;
26861   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
26862   REWRITE_TAC[SIN_NEG;REAL_ABS_NEG];
26863   ASM_MESON_TAC[abssinx_lemma];
26864   (* Tue Aug 17 22:59:20 EDT 2004 *)
26865
26866   ]);;
26867   (* }}} *)
26868
26869 let cos_double2 = prove_by_refinement(
26870   `!x. cos (&2 * x) = &1 - &2 * (sin x pow 2)`,
26871   (* {{{ proof *)
26872   [
26873   GEN_TAC;
26874   REWRITE_TAC[COS_DOUBLE;GSYM SIN_CIRCLE ];
26875   REAL_ARITH_TAC;
26876   ]);;
26877   (* }}} *)
26878
26879 let sin_half = prove_by_refinement(
26880   `!x. &2 * (sin (x/(&2)) pow 2) = &1 - cos (x)`,
26881   (* {{{ proof *)
26882   [
26883   GEN_TAC;
26884   ASSUME_TAC cos_double2;
26885   TSPEC `x/ &2` 0;
26886   TYPE_THEN `&2 *(x/(&2)) = x` SUBGOAL_TAC;
26887   REWRITE_TAC[REAL_MUL_2;];
26888   REDUCE_TAC;
26889   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
26890   ASM_REWRITE_TAC[];
26891   REAL_ARITH_TAC;
26892   ]);;
26893   (* }}} *)
26894
26895 let x_diff_y2 = prove_by_refinement(
26896   `!x y. (x - y) pow 2 = x*x - &2*x*y + y*y`,
26897   (* {{{ proof *)
26898   [
26899   REWRITE_TAC[REAL_POW_2];
26900   real_poly_tac;
26901   ]);;
26902   (* }}} *)
26903
26904 let cosdiff2 = prove_by_refinement(
26905   `!x y. (cos x - cos y) pow 2 + (sin x - sin y) pow 2 =
26906          (&2 * sin ((x - y)/(&2))) pow 2`,
26907   (* {{{ proof *)
26908   [
26909   REP_GEN_TAC;
26910   REWRITE_TAC[POW_MUL];
26911   TYPE_THEN  `!z. &2 pow 2 * z = &2 *(&2 *z)` SUBGOAL_TAC ;
26912   REWRITE_TAC[POW_2];
26913   REAL_ARITH_TAC;
26914   DISCH_THEN_REWRITE;
26915   REWRITE_TAC[sin_half];
26916
26917   TYPE_THEN `cos (x - y) = cos (x + (--y))` SUBGOAL_TAC;
26918   AP_TERM_TAC;
26919   REAL_ARITH_TAC;
26920   DISCH_THEN_REWRITE;
26921   REWRITE_TAC[COS_ADD ];
26922   REWRITE_TAC[SIN_NEG;COS_NEG;REAL_ARITH `x - u*(-- v) = x + u*v`];
26923   REWRITE_TAC[x_diff_y2];
26924   REWRITE_TAC[POW_2];
26925   TYPE_THEN `a = cos x` ABBREV_TAC ;
26926   TYPE_THEN `b = sin x` ABBREV_TAC ;
26927   TYPE_THEN `a' = cos y` ABBREV_TAC ;
26928   TYPE_THEN `b' = sin y` ABBREV_TAC ;
26929   REWRITE_TAC[REAL_ARITH `x*(y-z) = x*y - x*z`];
26930   TYPE_THEN `&2 * &1 = ((b pow 2) + (a pow 2)) + ((b' pow 2) + (a' pow 2))` SUBGOAL_TAC;
26931   EXPAND_TAC "a";
26932   EXPAND_TAC "b";
26933   EXPAND_TAC "a'";
26934   EXPAND_TAC "b'";
26935   REWRITE_TAC[SIN_CIRCLE];
26936   REAL_ARITH_TAC;
26937   DISCH_THEN_REWRITE;
26938   REWRITE_TAC[POW_2];
26939   real_poly_tac;
26940   (* Tue Aug 17 23:38:27 EDT 2004 *)
26941
26942   ]);;
26943   (* }}} *)
26944
26945 let d_euclid_cis = prove_by_refinement(
26946   `!x y. d_euclid (cis x) (cis y) = &2 * (abs  (sin ((x-y)/(&2))))`,
26947   (* {{{ proof *)
26948   [
26949   REP_BASIC_TAC;
26950   REWRITE_TAC[cis;d_euclid_point;cosdiff2;POW_2_SQRT_ABS;ABS_MUL;];
26951   REWRITE_TAC[REAL_ARITH `abs  (&2) = &2`];
26952   (* Tue Aug 17 23:41:30 EDT 2004 *)
26953   ]);;
26954   (* }}} *)
26955
26956 let d_euclid_cis_ineq = prove_by_refinement(
26957   `!x y. d_euclid (cis x) (cis y) <= abs  (x - y)`,
26958   (* {{{ proof *)
26959   [
26960   REWRITE_TAC[d_euclid_cis];
26961   REP_GEN_TAC;
26962   IMATCH_MP_TAC  REAL_LE_TRANS;
26963   TYPE_THEN `&2 * (abs  ((x-y)/(&2)))` EXISTS_TAC;
26964   CONJ_TAC;
26965   IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
26966   ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`;abssinx_le];
26967   REWRITE_TAC[REAL_ARITH `!z. &2*(abs  z) = abs  (&2 *z)`];
26968   TYPE_THEN `&2 * ((x - y)/(&2)) = (x - y)` SUBGOAL_TAC;
26969   IMATCH_MP_TAC  REAL_DIV_LMUL;
26970   REAL_ARITH_TAC;
26971   DISCH_THEN_REWRITE;
26972   REAL_ARITH_TAC;
26973   (* Wed Aug 18 06:42:28 EDT 2004 *)
26974
26975   ]);;
26976   (* }}} *)
26977
26978 let polar_fg_inj = prove_by_refinement(
26979   `!f g p. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\
26980     (!x. (&0 <= x /\ x <= &1) ==> (&0 <= f x)) /\ (euclid 2 p) ==>
26981    INJ (\t. p + (f t)*# (cis (g t))) {x | &0 <= x /\ x <= &1} (euclid 2)`,
26982   (* {{{ proof *)
26983   [
26984   REP_BASIC_TAC;
26985   REWRITE_TAC[INJ;polar_euclid];
26986   ASM_SIMP_TAC[euclid_add_closure;polar_euclid];
26987   REP_BASIC_TAC;
26988   (* INSERT *)
26989   TYPE_THEN `(f x *# cis (g x)) = (f y *# cis (g y))` SUBGOAL_TAC;
26990   IMATCH_MP_TAC  EQ_EXT;
26991   GEN_TAC;
26992   USE 3 (REWRITE_RULE[FUN_EQ_THM]);
26993   TSPEC `x'` 3;
26994   USE 3(REWRITE_RULE[euclid_plus]);
26995   UND 3;
26996   REAL_ARITH_TAC;
26997   KILL 3;
26998   DISCH_TAC;
26999   (* end ins *)
27000   USE 3 (AP_TERM `norm2`);
27001   USE 3 (REWRITE_RULE[norm2_scale_cis]);
27002   TYPE_THEN `&0 <= f x /\ &0 <= f y` SUBGOAL_TAC;
27003   ASM_MESON_TAC[];
27004   REP_BASIC_TAC;
27005   RULE_ASSUM_TAC  (REWRITE_RULE[GSYM REAL_ABS_REFL]);
27006   REWR 3;
27007   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
27008   FIRST_ASSUM IMATCH_MP_TAC ;
27009   ASM_REWRITE_TAC[];
27010
27011   ]);;
27012   (* }}} *)
27013
27014 let polar_distinct = prove_by_refinement(
27015   `!f g g'. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\
27016     (!x. (&0 <= x /\ x <= &1) ==> (&0 < f x)) /\
27017     (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g x /\ g x < &2 * pi)) /\
27018     (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g' x /\ g' x < &2 * pi))
27019     ==>
27020     (!x y. (&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 /\
27021       ((f x)*# (cis (g x)) = (f y)*# (cis (g' y)))) ==>
27022       (x = y) /\ (g x = g' y)) `,
27023   (* {{{ proof *)
27024   [
27025   REP_BASIC_TAC;
27026   COPY 0;
27027   USE 0 (AP_TERM `norm2`);
27028   USE 0 (REWRITE_RULE[norm2_scale_cis]);
27029   TYPE_THEN `&0 < f x /\ &0 < f y` SUBGOAL_TAC;
27030   ASM_MESON_TAC[];
27031   REP_BASIC_TAC;
27032   TYPE_THEN `f x = f y` SUBGOAL_TAC;
27033   UND 0;
27034   UND 10;
27035   UND 11;
27036   REAL_ARITH_TAC;
27037   DISCH_TAC;
27038   (* -- *)
27039   SUBCONJ_TAC;
27040   RULE_ASSUM_TAC (REWRITE_RULE [INJ]);
27041   REP_BASIC_TAC;
27042   FIRST_ASSUM IMATCH_MP_TAC ;
27043   ASM_REWRITE_TAC[];
27044   DISCH_THEN  (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
27045   TYPEL_THEN [`g y`;`g' y`;`f y`;`f y`] (fun t-> ANT_TAC (ISPECL t polar_inj));
27046   ASM_REWRITE_TAC[];
27047   ASM_MESON_TAC[REAL_ARITH `&0 < t ==> &0 <= t`];
27048   DISCH_THEN DISJ_CASES_TAC;
27049   PROOF_BY_CONTR_TAC;
27050   REP_BASIC_TAC;
27051   UND 13;
27052   UND 10;
27053   REAL_ARITH_TAC;
27054   ASM_REWRITE_TAC[];
27055   (* Wed Aug 18 07:42:54 EDT 2004 *)
27056
27057   ]);;
27058   (* }}} *)
27059
27060 let d_euclid_eq_arg = prove_by_refinement(
27061   `!r r' x. (d_euclid (r *# (cis x)) (r' *# (cis x)) = abs  (r - r'))`,
27062   (* {{{ proof *)
27063   [
27064   REP_BASIC_TAC;
27065   REWRITE_TAC[cis;point_scale;d_euclid_point];
27066   REWRITE_TAC[GSYM REAL_SUB_RDISTRIB;POW_MUL;GSYM REAL_ADD_LDISTRIB];
27067   ONCE_REWRITE_TAC [REAL_ARITH `x + y = y + x`];
27068   REWRITE_TAC[SIN_CIRCLE];
27069   REDUCE_TAC;
27070   REWRITE_TAC[POW_2_SQRT_ABS];
27071   (* Wed Aug 18 08:15:39 EDT 2004 *)
27072   ]);;
27073   (* }}} *)
27074
27075 (* not used *)
27076 let one_over_plus1 = prove_by_refinement(
27077   `!t. (&0 <= t) ==> (t / (&1 + t) <= &1)`,
27078   (* {{{ proof *)
27079   [
27080   REP_BASIC_TAC;
27081   IMATCH_MP_TAC  REAL_LE_LDIV;
27082   UND 0;
27083   REAL_ARITH_TAC;
27084   (* Wed Aug 18 08:17:46 EDT 2004 *)
27085
27086   ]);;
27087   (* }}} *)
27088
27089 let polar_cont = prove_by_refinement(
27090   `!p f g. continuous f (top_of_metric(UNIV,d_real))
27091         (top_of_metric(UNIV,d_real)) /\
27092      continuous g (top_of_metric(UNIV,d_real))
27093         (top_of_metric(UNIV,d_real)) /\ (euclid 2 p)  ==>
27094      continuous (\t. p + (f t) *# cis(g t)) (top_of_metric(UNIV,d_real))
27095         (top2)`,
27096   (* {{{ proof *)
27097   [
27098   REP_GEN_TAC;
27099   DISCH_TAC;
27100   TYPE_THEN `IMAGE (\t. p + (f t) *# cis(g t)) UNIV SUBSET (euclid 2)` SUBGOAL_TAC;
27101   REWRITE_TAC[SUBSET;IMAGE ];
27102   ASM_MESON_TAC[euclid_add_closure;polar_euclid];
27103   REWRITE_TAC[top2];
27104   UND 0;
27105   ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_euclid;metric_real];
27106   REWRITE_TAC[metric_continuous;metric_continuous_pt];
27107   REP_BASIC_TAC;
27108   RIGHT_TAC "delta";
27109   DISCH_TAC;
27110   TYPEL_THEN [`x`;`epsilon/(&2)`] (USE 3 o ISPECL);
27111   TYPEL_THEN [`x`;`(&1/(&1 + abs  (f x)))*(epsilon/(&2))`] (USE 2 o ISPECL);
27112   REP_BASIC_TAC;
27113   TYPE_THEN `&0 < epsilon/(&2)` SUBGOAL_TAC;
27114   ASM_REWRITE_TAC[REAL_LT_HALF1];
27115   DISCH_TAC;
27116   TYPE_THEN `&0 < &1 / (&1 + abs (f x)) * epsilon / &2` SUBGOAL_TAC;
27117   IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
27118   ASM_REWRITE_TAC[];
27119   IMATCH_MP_TAC  REAL_LT_DIV;
27120   REAL_ARITH_TAC;
27121   DISCH_TAC;
27122   REWR 3;
27123   REWR 2;
27124   REP_BASIC_TAC;
27125   TYPE_THEN `min_real delta delta'` EXISTS_TAC;
27126   CONJ_TAC;
27127   REWRITE_TAC[min_real];
27128   UND 3;
27129   UND 8;
27130   COND_CASES_TAC;
27131   REAL_ARITH_TAC;
27132   REAL_ARITH_TAC;
27133   REP_BASIC_TAC;
27134   TYPE_THEN `d_real x y < delta /\ d_real x y < delta'` SUBGOAL_TAC ;
27135   UND 9;
27136   REWRITE_TAC[min_real];
27137   COND_CASES_TAC;
27138   UND 9;
27139   REAL_ARITH_TAC;
27140   UND 9;
27141   REAL_ARITH_TAC;
27142   REP_BASIC_TAC;
27143   TSPEC `y` 2;
27144   TSPEC `y` 7;
27145   REWR 2;
27146   REWR 7;
27147   (* A-- *)
27148   IMATCH_MP_TAC  REAL_LET_TRANS;
27149   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;
27150   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;
27151   REP_BASIC_TAC;
27152   IMATCH_MP_TAC  metric_translate_LEFT;
27153   TYPE_THEN `2` EXISTS_TAC;
27154   ASM_REWRITE_TAC[polar_euclid];
27155   DISCH_THEN_REWRITE;
27156   (* end of add-on *)
27157   CONJ_TAC;
27158   IMATCH_MP_TAC  metric_space_triangle;
27159   TYPE_THEN `euclid 2` EXISTS_TAC;
27160   ASM_SIMP_TAC[polar_euclid;metric_euclid];
27161   REWRITE_TAC[d_euclid_eq_arg];
27162   TYPEL_THEN[`2`;`f x`;`cis (g x)`;`cis (g y)`] (fun t-> ANT_TAC (ISPECL t norm_scale_vec));
27163   REWRITE_TAC[cis;euclid_point];
27164   DISCH_THEN_REWRITE;
27165   TYPE_THEN `!x y z. (x <= z/ &2 /\ y < z/ &2 ==> x + y < z/ &2 + z/ &2)` SUBGOAL_TAC;
27166   REAL_ARITH_TAC;
27167   REWRITE_TAC[REAL_HALF_DOUBLE];
27168   DISCH_THEN IMATCH_MP_TAC ;
27169   USE 2 (REWRITE_RULE[d_real]);
27170   ASM_REWRITE_TAC[];
27171   IMATCH_MP_TAC  REAL_LE_TRANS;
27172   TYPE_THEN `abs  (f x) * (&1 / (&1 + abs (f x)) * epsilon / &2)` EXISTS_TAC;
27173   (* B-- *)
27174   CONJ_TAC;
27175   IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
27176   REWRITE_TAC[REAL_MK_NN_ABS];
27177   IMATCH_MP_TAC (REAL_ARITH `!y. (x <= y /\ y < z) ==> (x <= z)`);
27178   TYPE_THEN `abs  (g x - g y)` EXISTS_TAC;
27179   CONJ_TAC;
27180   REWRITE_TAC[d_euclid_cis_ineq];
27181   USE 7 (REWRITE_RULE[d_real]);
27182   ASM_REWRITE_TAC[];
27183   REWRITE_TAC[REAL_ARITH `(x*y*z <= z) <=> ((x*y)*(z) <= &1 * (z))`];
27184   IMATCH_MP_TAC  REAL_PROP_LE_RMUL;
27185   CONJ_TAC;
27186   REWRITE_TAC[real_div];
27187   REDUCE_TAC;
27188   REWRITE_TAC[GSYM real_div];
27189   IMATCH_MP_TAC  REAL_LE_LDIV;
27190   REAL_ARITH_TAC;
27191   UND 5;
27192   REAL_ARITH_TAC;
27193
27194   ]);;
27195   (* }}} *)
27196
27197 let lc_bounds = prove_by_refinement(
27198   `!a b x. (&0 <= x /\ x <= &1) ==> (min_real a b <= x*a + (&1- x)*b) /\
27199        (x*a + (&1 - x)*b <= max_real a b)`,
27200   (* {{{ proof *)
27201   [
27202   REP_BASIC_TAC;
27203   CONJ_TAC;
27204   REWRITE_TAC[min_real];
27205   COND_CASES_TAC;
27206   ineq_le_tac `a + (&1 - x)*(b - a) = (x*a + (&1- x)*b)`;
27207   ineq_le_tac `b + x*(a - b) = x*a + (&1- x)*b`;
27208   REWRITE_TAC[max_real];
27209   COND_CASES_TAC;
27210   ineq_le_tac `(x*a + (&1 - x)*b) + (&1 - x)*(a - b) = a`;
27211   ineq_le_tac `(x*a + (&1 - x)*b) + (x*(b - a)) = b`;
27212   (* Wed Aug 18 11:52:54 EDT 2004 *)
27213
27214   ]);;
27215   (* }}} *)
27216
27217 let min_real_symm = prove_by_refinement(
27218   `!a b. min_real a b = min_real b a`,
27219   (* {{{ proof *)
27220   [
27221   REP_GEN_TAC;
27222   REWRITE_TAC[min_real];
27223   COND_CASES_TAC;
27224   USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`));
27225   ASM_REWRITE_TAC[];
27226   COND_CASES_TAC;
27227   ASM_REWRITE_TAC[];
27228   UND 0;
27229   UND 1;
27230   REAL_ARITH_TAC;
27231   ]);;
27232   (* }}} *)
27233
27234 let max_real_symm = prove_by_refinement(
27235   `!a b. max_real a b = max_real b a`,
27236   (* {{{ proof *)
27237   [
27238   REP_GEN_TAC;
27239   REWRITE_TAC[max_real];
27240   COND_CASES_TAC;
27241   USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`));
27242   ASM_REWRITE_TAC[];
27243   COND_CASES_TAC;
27244   ASM_REWRITE_TAC[];
27245   UND 0;
27246   UND 1;
27247   REAL_ARITH_TAC;
27248   ]);;
27249   (* }}} *)
27250
27251 let curve_annulus_lemma = prove_by_refinement(
27252   `!r g p. (&0 < r) /\ (euclid 2 p) ==>
27253       (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
27254            {x | &0 <= x /\ x <= &1})
27255          SUBSET ({ x | (r/(&2) <= d_euclid p x /\
27256                              d_euclid p x <= r)} )`,
27257   (* {{{ proof *)
27258
27259   [
27260   REP_BASIC_TAC;
27261   REWRITE_TAC[IMAGE;SUBSET];
27262   REP_BASIC_TAC;
27263   UND 2;
27264   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
27265   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;
27266   IMATCH_MP_TAC  d_euclidpq;
27267   TYPE_THEN `2` EXISTS_TAC;
27268   ASM_REWRITE_TAC[polar_euclid];
27269   DISCH_THEN_REWRITE;
27270   REWRITE_TAC[GSYM norm2;norm2_scale_cis];
27271   TYPE_THEN `r/(&2) < r` SUBGOAL_TAC;
27272   ASM_MESON_TAC[half_pos];
27273   DISCH_TAC;
27274   TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC;
27275   REWRITE_TAC[min_real;max_real];
27276   ASM_REWRITE_TAC[];
27277   COND_CASES_TAC;
27278   UND 2;
27279   UND 5;
27280   REAL_ARITH_TAC;
27281   REWRITE_TAC[];
27282   DISCH_TAC;
27283   TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC;
27284   IMATCH_MP_TAC  REAL_LE_TRANS;
27285   TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ;
27286   CONJ_TAC;
27287   ASM_REWRITE_TAC[];
27288   IMATCH_MP_TAC  (REAL_ARITH `&0 < x ==> &0 <= x`);
27289   ASM_REWRITE_TAC[REAL_LT_HALF1];
27290   ONCE_REWRITE_TAC [min_real_symm];
27291   ASM_MESON_TAC[lc_bounds];
27292   REWRITE_TAC[GSYM ABS_REFL];
27293   DISCH_THEN_REWRITE;
27294   ASM_MESON_TAC[lc_bounds;min_real_symm;max_real_symm];
27295   (* Wed Aug 18 12:13:50 EDT 2004 *)
27296
27297   ]);;
27298
27299   (* }}} *)
27300
27301 let curve_circle_lemma = prove_by_refinement(
27302   `!r g p. (&0 < r) /\ (euclid 2 p) ==>
27303       (((IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
27304            {x | &0 <= x /\ x <= &1})
27305      INTER ({ x |  d_euclid p x <= (r/(&2))})) =
27306                           { ( p + (r/(&2)) *# (cis (g (&0) ))) })
27307      `,
27308   (* {{{ proof *)
27309   [
27310   REP_BASIC_TAC;
27311   REWRITE_TAC[IMAGE;SUBSET;INTER;];
27312   IMATCH_MP_TAC  EQ_EXT;
27313   REWRITE_TAC[INR IN_SING];
27314   ONCE_REWRITE_TAC [EQ_SYM_EQ];
27315   GEN_TAC;
27316   (* A *)
27317   EQ_TAC;
27318   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
27319   REP_BASIC_TAC;
27320   CONJ_TAC;
27321   TYPE_THEN `&0` EXISTS_TAC;
27322   REDUCE_TAC;
27323   TYPEL_THEN [`2`;`p`;`(r / &2 *# cis (g (&0)))`] (fun t-> ANT_TAC (ISPECL t d_euclidpq));
27324   ASM_REWRITE_TAC[polar_euclid];
27325   DISCH_THEN_REWRITE;
27326   REWRITE_TAC[GSYM norm2;norm2_scale_cis;];
27327   IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
27328   REWRITE_TAC[ABS_REFL];
27329   IMATCH_MP_TAC  (REAL_ARITH `(&0 < x) ==> (&0 <= x)`);
27330   ASM_REWRITE_TAC[REAL_LT_HALF1];
27331   REP_BASIC_TAC;
27332   (* B other direction *)
27333   UND 3;
27334   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
27335   PROOF_BY_CONTR_TAC;
27336   UND 2;
27337   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;
27338   IMATCH_MP_TAC  d_euclidpq;
27339   TYPE_THEN `2` EXISTS_TAC;
27340   ASM_REWRITE_TAC[polar_euclid];
27341   DISCH_THEN_REWRITE;
27342   REWRITE_TAC[GSYM norm2;norm2_scale_cis];
27343   TYPE_THEN `r/(&2) < r` SUBGOAL_TAC;
27344   ASM_MESON_TAC[half_pos];
27345   DISCH_TAC;
27346   TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC;
27347   REWRITE_TAC[min_real;max_real];
27348   ASM_REWRITE_TAC[];
27349   COND_CASES_TAC;
27350   UND 2;
27351   UND 6;
27352   REAL_ARITH_TAC;
27353   REWRITE_TAC[];
27354   DISCH_TAC;
27355   TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC;
27356   IMATCH_MP_TAC  REAL_LE_TRANS;
27357   TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ;
27358   CONJ_TAC;
27359   ASM_REWRITE_TAC[];
27360   IMATCH_MP_TAC  (REAL_ARITH `&0 < x ==> &0 <= x`);
27361   ASM_REWRITE_TAC[REAL_LT_HALF1];
27362   ONCE_REWRITE_TAC [min_real_symm];
27363   ASM_MESON_TAC[lc_bounds];
27364   REWRITE_TAC[GSYM ABS_REFL];
27365   DISCH_THEN_REWRITE;
27366   TYPE_THEN `~(x'  = &0)` SUBGOAL_TAC;
27367   DISCH_TAC;
27368   UND 7;
27369   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
27370   UND 3;
27371   REDUCE_TAC;
27372   DISCH_TAC;
27373   TYPE_THEN `&0 < x'` SUBGOAL_TAC;
27374   UND 7;
27375   UND 5;
27376   REAL_ARITH_TAC;
27377   DISCH_TAC;
27378   IMATCH_MP_TAC  (REAL_ARITH `a < b ==> ~(b <= a)`);
27379   ineq_lt_tac `(r/ &2) + x'* (r - (r/(&2))) = (x' * r + (&1 - x') * r / &2)`;
27380   (* Wed Aug 18 12:41:16 EDT 2004 *)
27381
27382   ]);;
27383   (* }}} *)
27384
27385 let curve_simple_lemma = prove_by_refinement(
27386   `!r g p. (&0 < r) /\ (euclid 2 p) /\
27387     (continuous g (top_of_metric(UNIV,d_real))
27388        (top_of_metric(UNIV,d_real))) ==>
27389    (simple_arc_end
27390       (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
27391            {x | &0 <= x /\ x <= &1}) (p + (r/(&2))*# (cis (g (&0))))
27392              (p + (r)*# (cis (g (&1)))))`,
27393   (* {{{ proof *)
27394   [
27395   REWRITE_TAC[simple_arc_end];
27396   REP_BASIC_TAC;
27397   TYPE_THEN `(\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))` EXISTS_TAC;
27398   ASM_REWRITE_TAC[];
27399   REDUCE_TAC;
27400   CONJ_TAC;
27401   IMATCH_MP_TAC  polar_cont;
27402   ASM_REWRITE_TAC[];
27403   ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
27404   REWRITE_TAC[linear_cont];
27405   IMATCH_MP_TAC  polar_fg_inj;
27406   ASM_REWRITE_TAC[INJ;SUBSET_UNIV ];
27407   (* -- *)
27408   CONJ_TAC;
27409   REP_BASIC_TAC;
27410   USE 3 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]);
27411   TYPE_THEN `(x * r + (&1 - x) * r / &2) - (y * r + (&1 - y) * r / &2) = (x - y)*(r - r/(&2)) ` SUBGOAL_TAC;
27412   real_poly_tac;
27413   DISCH_TAC;
27414   REWR 3;
27415   USE 3(REWRITE_RULE[REAL_ENTIRE]);
27416   UND 3;
27417   DISCH_THEN DISJ_CASES_TAC;
27418   UND 3;
27419   REAL_ARITH_TAC;
27420   PROOF_BY_CONTR_TAC;
27421   UND 3;
27422   TYPE_THEN `r - r/(&2) = (r/ &2 + r/ &2) - r/ &2` SUBGOAL_TAC;
27423   REWRITE_TAC[REAL_HALF_DOUBLE];
27424   DISCH_THEN_REWRITE;
27425   REWRITE_TAC[REAL_ARITH `(x + x) - x = x`];
27426   USE 2 (ONCE_REWRITE_RULE  [GSYM REAL_HALF_DOUBLE]);
27427   USE 2 (REWRITE_RULE[REAL_DIV_LZERO]);
27428   UND 2;
27429   REAL_ARITH_TAC;
27430   (* -- *)
27431   GEN_TAC;
27432   DISCH_TAC;
27433   WITH 3 (MATCH_MP lc_bounds);
27434   TYPEL_THEN [`r`;`r/ &2`] (USE 4 o ISPECL);
27435   IMATCH_MP_TAC  REAL_LE_TRANS;
27436   TYPE_THEN `min_real r (r/ &2)` EXISTS_TAC;
27437   ASM_REWRITE_TAC[];
27438   TYPE_THEN `r / &2 < r` SUBGOAL_TAC;
27439   UND 2;
27440   MESON_TAC [half_pos];
27441   TYPE_THEN `&0 < r/ (&2)` SUBGOAL_TAC;
27442   ASM_MESON_TAC[half_pos];
27443   TYPE_THEN `a = r/ &2` ABBREV_TAC ;
27444   REWRITE_TAC[min_real];
27445   COND_CASES_TAC;
27446   REAL_ARITH_TAC;
27447   REAL_ARITH_TAC;
27448   (* Wed Aug 18 14:02:54 EDT 2004 *)
27449
27450   ]);;
27451   (* }}} *)
27452
27453 let segpath = jordan_def
27454   `segpath x y t = t* x + (&1 - t)*y` ;;
27455
27456 let segpathxy = prove_by_refinement(
27457   `!x y. segpath x y = (\ t. t*x + (&1 - t)*y)`,
27458   (* {{{ proof *)
27459   [
27460   REP_BASIC_TAC;
27461   IMATCH_MP_TAC  EQ_EXT;
27462   REWRITE_TAC[segpath];
27463   ]);;
27464   (* }}} *)
27465
27466 let segpath_lemma = prove_by_refinement(
27467   `(!x y . (continuous (segpath x y) (top_of_metric(UNIV,d_real))
27468        (top_of_metric(UNIV,d_real)))) /\
27469    (!x y b. (&0 <= x /\ x < b /\ &0 <= y /\ y < b ==>
27470      (!t. &0 <= t /\ t <= &1 ==> &0 <= segpath x y t /\
27471        segpath x y t < b))) /\
27472    (!x y x' y' t. (x < x' /\ y < y' /\ &0 <= t /\ t <= &1)
27473         ==> ~(segpath x y t = segpath x' y' t))`,
27474   (* {{{ proof *)
27475
27476   [
27477   REP_BASIC_TAC;
27478   CONJ_TAC;
27479   REP_BASIC_TAC;
27480   ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_real];
27481   REWRITE_TAC[segpathxy;linear_cont];
27482   (* -- *)
27483   CONJ_TAC;
27484   REP_BASIC_TAC;
27485   REWRITE_TAC[segpath];
27486   CONJ_TAC;
27487   IMATCH_MP_TAC  REAL_LE_TRANS;
27488   TYPE_THEN `min_real x y` EXISTS_TAC;
27489   CONJ_TAC;
27490   REWRITE_TAC[min_real];
27491   COND_CASES_TAC;
27492   ASM_REWRITE_TAC[];
27493   ASM_REWRITE_TAC[];
27494   ASM_MESON_TAC[lc_bounds];
27495   IMATCH_MP_TAC  REAL_LET_TRANS;
27496   TYPE_THEN `max_real x y` EXISTS_TAC;
27497   CONJ_TAC;
27498   ASM_MESON_TAC[lc_bounds];
27499   REWRITE_TAC[max_real];
27500   COND_CASES_TAC;
27501   ASM_REWRITE_TAC[];
27502   ASM_REWRITE_TAC[];
27503   (* -- *)
27504   REWRITE_TAC[segpath];
27505   REP_BASIC_TAC;
27506   UND 0;
27507   REWRITE_TAC[REAL_ARITH `(u + v = u' + v') <=> ((u' - u) + (v' - v) = &0)`];
27508   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB];
27509   TYPE_THEN `t = &0` ASM_CASES_TAC;
27510   ASM_REWRITE_TAC[];
27511   REDUCE_TAC;
27512   UND 3;
27513   REAL_ARITH_TAC;
27514   TYPE_THEN `t = &1` ASM_CASES_TAC;
27515   ASM_REWRITE_TAC[];
27516   REDUCE_TAC;
27517   UND 4;
27518   REAL_ARITH_TAC;
27519   (* -- *)
27520   TYPE_THEN `&0 < t * (x' - x) + (&1 - t)*(y' - y)` SUBGOAL_TAC;
27521   ineq_lt_tac `&0 + t * (x' - x) + (&1 - t)*(y' - y) = (t*(x' - x) + (&1- t)*(y' - y))` ;
27522   UND 5;
27523   UND 1;
27524   REAL_ARITH_TAC;
27525   REAL_ARITH_TAC;
27526   (* Wed Aug 18 14:48:37 EDT 2004 *)
27527
27528   ]);;
27529
27530   (* }}} *)
27531
27532 let segpath_end = prove_by_refinement(
27533   `!x y. ( segpath x y (&0) = y) /\ (segpath x y (&1) = x)`,
27534   (* {{{ proof *)
27535   [
27536   REWRITE_TAC[segpath];
27537   REAL_ARITH_TAC;
27538   ]);;
27539   (* }}} *)
27540
27541 let segpath_inj = prove_by_refinement(
27542   `!x y. ~(x = y) ==> INJ (segpath x y) {t | &0 <= t /\ t <= &1} UNIV`,
27543   (* {{{ proof *)
27544
27545   [
27546   REWRITE_TAC[segpath;INJ;SUBSET_UNIV];
27547   REP_BASIC_TAC;
27548   USE 0 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]);
27549   TYPE_THEN `(x' * x + (&1 - x') * y) - (y' * x + (&1 - y') * y) = (x' - y')*(x - y) ` SUBGOAL_TAC;
27550   real_poly_tac;
27551   DISCH_TAC;
27552   REWR 0;
27553   USE 0(REWRITE_RULE[REAL_ENTIRE]);
27554   UND 0;
27555   DISCH_THEN DISJ_CASES_TAC;
27556   UND 0;
27557   REAL_ARITH_TAC;
27558   PROOF_BY_CONTR_TAC;
27559   UND 0;
27560   UND 5;
27561   REAL_ARITH_TAC;
27562   (* Wed Aug 18 15:15:11 EDT 2004 *)
27563
27564   ]);;
27565
27566   (* }}} *)
27567
27568 let degree_vertex_annulus = prove_by_refinement(
27569   `!n r p xx zz. (&0 < r) /\ (euclid 2 p) /\
27570     (!j. j < n ==> (&0 <= xx j /\ xx j < &2 * pi)) /\
27571    (!j. j < n ==> (&0 <= zz j /\ zz j < &2 * pi)) /\
27572     (!i j. (i < j) /\ (j <| n) ==> (xx i < xx j)) /\
27573        (!i j. (i < j) /\ (j < n) ==> (zz i < zz j))  ==>
27574     (?C.
27575        (!i. (i < n) ==>
27576           simple_arc_end (C i ) (p + (r/ &2)*# (cis(zz i)))
27577                                 (p + r*# (cis(xx i)))) /\
27578        (!i j. (i < n) /\ (j < n) /\ (~(i=j)) ==>
27579            (C i INTER C j = EMPTY )) /\
27580        (!i. (i< n) ==>
27581            C i SUBSET ({ x | (r/(&2) <= d_euclid p x /\
27582                              d_euclid p x <= r)} )) /\
27583        (!i. (i< n) ==>
27584            (C i INTER  ({ x |  d_euclid p x <= (r/(&2))}) =
27585                           { ( p + (r/(&2)) *# (cis (zz i ))) }))
27586        )
27587     `,
27588   (* {{{ proof *)
27589   [
27590   REP_BASIC_TAC;
27591   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 ;
27592   TYPE_THEN `C` EXISTS_TAC;
27593   (* -- *)
27594   CONJ_TAC;
27595   REP_BASIC_TAC;
27596   EXPAND_TAC "C";
27597   TYPEL_THEN [`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> (ANT_TAC(ISPECL t curve_simple_lemma)));
27598   ASM_REWRITE_TAC[segpath_lemma];
27599   REWRITE_TAC[segpath_end];
27600   (* -- *)
27601   TYPE_THEN `&0 < r/ &2 /\ r / &2 < r` SUBGOAL_TAC;
27602   IMATCH_MP_TAC  half_pos;
27603   ASM_REWRITE_TAC[];
27604   DISCH_TAC;
27605   CONJ_TAC;
27606   REP_BASIC_TAC;
27607   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));
27608   ASM_REWRITE_TAC[];
27609   (* --- *)
27610   CONJ_TAC;
27611   TYPEL_THEN [`r`;`r / &2`] (fun t-> ANT_TAC(ISPECL t segpath_inj));
27612   UND 10;
27613   REAL_ARITH_TAC;
27614   REWRITE_TAC[segpathxy];
27615   (* --- *)
27616   CONJ_TAC;
27617   REP_BASIC_TAC;
27618   ineq_lt_tac `&0 + (x* (r - r/(&2))) + (r/ &2) = x*r + (&1 - x)*(r/ &2)`;
27619   (* --- *)
27620   ASM_MESON_TAC[segpath_lemma];
27621   (* -- *)
27622   DISCH_TAC;
27623   EXPAND_TAC "C";
27624   REWRITE_TAC[EQ_EMPTY];
27625   GEN_TAC;
27626   REWRITE_TAC[IMAGE;INTER];
27627   REP_BASIC_TAC;
27628   UND 13;
27629   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t]));
27630   TYPEL_THEN[`x'`;`x''`] (USE 12 o ISPECL);
27631   REWR 12;
27632   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;
27633   IMATCH_MP_TAC  EQ_EXT;
27634   GEN_TAC;
27635   USE 16 ( (REWRITE_RULE[FUN_EQ_THM]));
27636   TSPEC `x'''` 13;
27637   UND 13;
27638   REWRITE_TAC[euclid_plus];
27639   REAL_ARITH_TAC;
27640   DISCH_TAC;
27641   KILL 16;
27642   USE 13 (ONCE_REWRITE_RULE [EQ_SYM_EQ]);
27643   REWR 12;
27644   REP_BASIC_TAC;
27645   USE 16 GSYM;
27646   UND 16;
27647     DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t]));
27648   TYPE_THEN `(i <| j) \/ (j < i)` SUBGOAL_TAC;
27649   UND 7;
27650   ARITH_TAC;
27651   (* ---- *)
27652   DISCH_THEN DISJ_CASES_TAC;
27653   TYPEL_THEN [`i`;`j`] (USE 0 o ISPECL);
27654   TYPEL_THEN [`i`;`j`] (USE 1 o ISPECL);
27655   KILL  2;
27656   KILL  3;
27657   KILL 6;
27658   KILL 13;
27659   ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)];
27660   TYPEL_THEN [`j`;`i`] (USE 0 o ISPECL);
27661   TYPEL_THEN [`j`;`i`] (USE 1 o ISPECL);
27662   KILL  2;
27663   KILL  3;
27664   KILL 6;
27665   KILL 13;
27666   ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)];
27667   (* B-- *)
27668   CONJ_TAC;
27669   REP_BASIC_TAC;
27670   EXPAND_TAC "C";
27671   IMATCH_MP_TAC  curve_annulus_lemma;
27672   ASM_REWRITE_TAC[];
27673   (* -- *)
27674   REP_BASIC_TAC;
27675   EXPAND_TAC "C";
27676   TYPEL_THEN[`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> ANT_TAC(ISPECL t curve_circle_lemma));
27677   ASM_REWRITE_TAC[];
27678   REWRITE_TAC[segpath_end];
27679   (* Wed Aug 18 15:57:53 EDT 2004 *)
27680   ]);;
27681   (* }}} *)
27682
27683 let closed_ball2_center = prove_by_refinement(
27684   `!p r. closed_ball (euclid 2,d_euclid) p r p <=> (euclid 2 p) /\ (&0 <= r)`,
27685   (* {{{ proof *)
27686   [
27687   REWRITE_TAC[closed_ball];
27688   TYPE_THEN `!p. (euclid 2 p) ==> (d_euclid p p = &0)` SUBGOAL_TAC;
27689   DISCH_ALL_TAC;
27690   IMATCH_MP_TAC  metric_space_zero;
27691   TYPE_THEN `euclid 2` EXISTS_TAC;
27692   ASM_REWRITE_TAC[metric_euclid];
27693   ASM_MESON_TAC[];
27694   ]);;
27695   (* }}} *)
27696
27697 let degree_vertex_disk = prove_by_refinement(
27698   `!r p xx . (&0 < r) /\ (euclid 2 p) /\
27699   (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\
27700     (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j))
27701   ==>
27702       (?C.
27703        (!i. (i< 4) ==> (?C' C'' v.
27704            simple_arc_end C' p v /\
27705            simple_arc_end C'' v (p + r*# (cis(xx i )))  /\
27706            C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\
27707            (C' INTER C'' = {v}) /\
27708            (C' UNION C'' = C i )) /\
27709           simple_arc_end (C i ) p  (p + r*# (cis(xx i))) /\
27710            C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\
27711            C i  INTER (closed_ball(euclid 2,d_euclid) p (r / &2))
27712            SUBSET (hyperplane 2 e2 (p 1) UNION
27713                      hyperplane 2 e1 (p 0))) /\
27714        (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==>
27715            (C i INTER C j = {p} )))
27716        `,
27717   (* {{{ proof *)
27718   [
27719   REP_BASIC_TAC;
27720   TYPE_THEN `(&0 < (r /(&2))) /\ (euclid 2 p)` SUBGOAL_TAC;
27721   ASM_REWRITE_TAC[REAL_LT_HALF1];
27722   DISCH_THEN (fun t-> MP_TAC (MATCH_MP   degree4_vertex_hv t));
27723   REP_BASIC_TAC;
27724   TYPE_THEN `C' = C` ABBREV_TAC ;
27725   KILL 10;
27726   TYPE_THEN `zz = (\j. (&j) * pi/(&2))` ABBREV_TAC ;
27727   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;
27728   ASM_REWRITE_TAC[];
27729   CONJ_TAC;
27730   EXPAND_TAC "zz";
27731   REP_BASIC_TAC;
27732   CONJ_TAC;
27733   IMATCH_MP_TAC  REAL_LE_MUL;
27734   CONJ_TAC;
27735   REDUCE_TAC;
27736   IMATCH_MP_TAC  REAL_LE_DIV;
27737   MP_TAC PI_POS;
27738   REAL_ARITH_TAC;
27739   REWRITE_TAC[real_div;REAL_ARITH `pi*x = x*pi`];
27740   REWRITE_TAC[REAL_ARITH `x*y*z = (x*y)*z`];
27741   IMATCH_MP_TAC  REAL_PROP_LT_RMUL;
27742   ASM_REWRITE_TAC[PI_POS;GSYM real_div;];
27743   ASM_SIMP_TAC[REAL_LT_LDIV_EQ;REAL_ARITH `&0 < &2`];
27744   REDUCE_TAC;
27745   UND 11;
27746   ARITH_TAC;
27747   REP_BASIC_TAC;
27748   EXPAND_TAC "zz";
27749   ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> (&0 < y - x)`];
27750   REWRITE_TAC[REAL_ARITH `x*y - z*y = (x - z)*y`];
27751   IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
27752   REWRITE_TAC[PI2_BOUNDS];
27753   REDUCE_TAC;
27754   UND 12;
27755   REWRITE_TAC[REAL_ARITH `&0 < &j - &i <=> &i < &j`];
27756   REDUCE_TAC;
27757   DISCH_THEN (fun t-> MP_TAC (MATCH_MP degree_vertex_annulus t));
27758   REP_BASIC_TAC;
27759   (* A *)
27760   TYPE_THEN `(\j. C' j UNION C'' j)` EXISTS_TAC;
27761   BETA_TAC;
27762   (* B 1st conjunct *)
27763   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;
27764   REP_BASIC_TAC;
27765   SUBCONJ_TAC;
27766   ASM_MESON_TAC[];
27767   DISCH_TAC;
27768   SUBCONJ_TAC;
27769   ASM_MESON_TAC[];
27770   DISCH_TAC;
27771   SUBCONJ_TAC;
27772   ASM_MESON_TAC[];
27773   DISCH_TAC;
27774   REWRITE_TAC[];
27775   IMATCH_MP_TAC  EQ_EXT;
27776   GEN_TAC;
27777   REWRITE_TAC[INR IN_SING;INTER ];
27778   EQ_TAC;
27779   DISCH_TAC;
27780   TYPE_THEN `closed_ball (euclid 2,d_euclid) p (r / &2) x` SUBGOAL_TAC;
27781   UND 18;
27782   REWRITE_TAC[SUBSET];
27783   UND 19;
27784   MESON_TAC[];
27785   TSPEC `i` 11;
27786   REWR 11;
27787   REWRITE_TAC[closed_ball];
27788   FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
27789   UND 19;
27790   REWRITE_TAC[INTER;INR IN_SING;];
27791   DISCH_THEN_REWRITE;
27792   DISCH_THEN_REWRITE;
27793   EXPAND_TAC "zz";
27794   DISCH_THEN_REWRITE;
27795   DISCH_THEN_REWRITE;
27796   UND 17;
27797   UND 16;
27798   MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
27799   DISCH_TAC;
27800   ASM_REWRITE_TAC[];
27801   (* [C] 1nd conjunct. simple-arc-end; *)
27802   TYPE_THEN `D = closed_ball (euclid 2,d_euclid) p (r /(&2))` ABBREV_TAC ;
27803   TYPE_THEN `!i x. (i <| 4) /\ (D x) ==> ((C' i UNION C'' i) x = C' i x)` SUBGOAL_TAC;
27804   REP_BASIC_TAC;
27805   REWRITE_TAC[UNION];
27806   IMATCH_MP_TAC  (TAUT `(b ==> a) ==> (a \/ b <=> a)`);
27807   TSPEC `i` 11;
27808   REWR 11;
27809   FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
27810   UND 17;
27811   EXPAND_TAC"D";
27812   REWRITE_TAC[closed_ball];
27813   REWRITE_TAC[INTER;INR IN_SING];
27814   DISCH_THEN_REWRITE;
27815   DISCH_THEN_REWRITE;
27816   DISCH_THEN_REWRITE;
27817   ASM_MESON_TAC[simple_arc_end_end2];
27818   DISCH_TAC;
27819   (* -- *)
27820   TYPE_THEN `!i x. (i <| 4) /\ ~(D x) ==> ((C' i UNION C'' i) x = C'' i x)` SUBGOAL_TAC;
27821   REP_BASIC_TAC;
27822   REWRITE_TAC[UNION];
27823   IMATCH_MP_TAC  (TAUT `(a ==> b) ==> (a \/ b <=> b)`);
27824   TSPEC `i` 5;
27825   REWR 5;
27826   USE 5 (REWRITE_RULE[SUBSET]);
27827   TSPEC `x` 5;
27828   UND 5;
27829   UND 18;
27830   MESON_TAC[];
27831   DISCH_TAC;
27832   ONCE_REWRITE_TAC [TAUT `(x /\ y) <=> (y /\ x)`];
27833   (* D-- *)
27834   CONJ_TAC;
27835   REP_BASIC_TAC;
27836   IMATCH_MP_TAC  EQ_EXT;
27837   GEN_TAC;
27838   REWRITE_TAC[INTER;INR IN_SING];
27839   TYPE_THEN `D x` ASM_CASES_TAC;
27840   TYPEL_THEN [`i`;`x`] (WITH 17 o ISPECL);
27841   TYPEL_THEN [`j`;`x`] (WITH 17 o ISPECL);
27842   UND 23;
27843   UND 24;
27844   KILL 17;
27845   ASM_REWRITE_TAC[];
27846   DISCH_THEN_REWRITE;
27847   DISCH_THEN_REWRITE;
27848   TYPEL_THEN [`i`;`j`;] (USE 7 o ISPECL);
27849   REWR 7;
27850   FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
27851   REWRITE_TAC[INTER;INR IN_SING];
27852   (* --2-- *)
27853   TYPEL_THEN [`i`;`x`] (WITH 18 o ISPECL);
27854   TYPEL_THEN [`j`;`x`] (WITH 18 o ISPECL);
27855   UND 23;
27856   UND 24;
27857   KILL 18;
27858   ASM_REWRITE_TAC[];
27859   DISCH_THEN_REWRITE;
27860   DISCH_THEN_REWRITE;
27861   TYPEL_THEN [`i`;`j`;] (USE 13 o ISPECL);
27862   REWR 13;
27863   USE 13 (REWRITE_RULE[EQ_EMPTY;INTER ]);
27864   ASM_REWRITE_TAC[];
27865   PROOF_BY_CONTR_TAC;
27866   USE 18(REWRITE_RULE[]);
27867   UND 18;
27868   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
27869   UND 22;
27870   REWRITE_TAC[];
27871   EXPAND_TAC "D";
27872   REWRITE_TAC[closed_ball2_center];
27873   ASM_REWRITE_TAC[];
27874   IMATCH_MP_TAC  (REAL_ARITH `&0 <x ==> &0 <= x`);
27875   ASM_REWRITE_TAC[REAL_LT_HALF1];
27876   (* E *)
27877   REP_BASIC_TAC;
27878   CONJ_TAC;
27879   TYPE_THEN `C' i` EXISTS_TAC;
27880   TYPE_THEN `C'' i` EXISTS_TAC;
27881   TYPE_THEN `p + (r / &2 *# cis (&i * pi / &2))` EXISTS_TAC;
27882   ASM_MESON_TAC[];
27883   (* -- *)
27884   CONJ_TAC;
27885   IMATCH_MP_TAC  simple_arc_end_trans;
27886   ASM_MESON_TAC[];
27887   (* -- *)
27888   CONJ_TAC;
27889   REWRITE_TAC[union_subset];
27890   CONJ_TAC;
27891   TSPEC `i` 5;
27892   UND 5;
27893   ASM_REWRITE_TAC[];
27894   EXPAND_TAC "D";
27895   REWRITE_TAC[SUBSET;closed_ball;];
27896   TYPE_THEN `r / &2 < r` SUBGOAL_TAC;
27897   UND 3;
27898   MESON_TAC[half_pos];
27899   MESON_TAC[REAL_ARITH `(x <= y) /\ (y < z) ==> (x <= z)`];
27900   TSPEC `i` 12;
27901   UND 12;
27902   ASM_REWRITE_TAC[];
27903   REWRITE_TAC[SUBSET;closed_ball];
27904   ASM_REWRITE_TAC[];
27905   TSPEC `i` 14;
27906   REWR 12;
27907   TYPE_THEN `C'' i SUBSET (euclid 2)` SUBGOAL_TAC;
27908   IMATCH_MP_TAC  simple_arc_euclid;
27909   IMATCH_MP_TAC  simple_arc_end_simple;
27910   UND 12;
27911   MESON_TAC[];
27912   REWRITE_TAC[SUBSET];
27913   MESON_TAC[];
27914   (* -- *)
27915   KILL 15;
27916   KILL 9;
27917   KILL 8;
27918   KILL 11;
27919   KILL 12;
27920   TYPE_THEN `(C' i UNION C'' i) INTER D = (C' i INTER D)` SUBGOAL_TAC;
27921   REWRITE_TAC[INTER];
27922   IMATCH_MP_TAC  EQ_EXT;
27923   REWRITE_TAC[];
27924   UND 17;
27925   ASM_MESON_TAC[];
27926   DISCH_THEN_REWRITE;
27927   TSPEC `i` 4;
27928   REWR 4;
27929   IMATCH_MP_TAC  SUBSET_TRANS;
27930   TYPE_THEN `C' i` EXISTS_TAC;
27931   ASM_REWRITE_TAC[];
27932   REWRITE_TAC[INTER;SUBSET];
27933   MESON_TAC[];
27934   (* Thu Aug 19 07:36:47 EDT 2004 *)
27935
27936    ]);;
27937   (* }}} *)
27938
27939 let euclid_cancel1 = prove_by_refinement(
27940   `!x y z. (x = euclid_plus y z) <=> (x - y = z)`,
27941   (* {{{ proof *)
27942   [
27943   REP_BASIC_TAC;
27944   EQ_TAC;
27945   DISCH_THEN_REWRITE;
27946   IMATCH_MP_TAC  EQ_EXT;
27947   REWRITE_TAC[euclid_plus;euclid_minus];
27948   REAL_ARITH_TAC;
27949   DISCH_TAC;
27950   USE 0 SYM;
27951   ASM_REWRITE_TAC[];
27952     IMATCH_MP_TAC  EQ_EXT;
27953   REWRITE_TAC[euclid_plus;euclid_minus];
27954   REAL_ARITH_TAC;
27955   ]);;
27956   (* }}} *)
27957
27958 let infinite_subset = prove_by_refinement(
27959   `!(X:A->bool) Y. INFINITE X /\ X SUBSET Y ==> INFINITE Y`,
27960   (* {{{ proof *)
27961   [
27962   REWRITE_TAC[INFINITE];
27963   MESON_TAC[FINITE_SUBSET];
27964   ]);;
27965   (* }}} *)
27966
27967 let EXPinj = prove_by_refinement(
27968   `!x y n. (1 < n) /\ (n **| x = n **| y) ==> (x = y)`,
27969   (* {{{ proof *)
27970   [
27971   TYPE_THEN `! x y n. (x <| y) /\ (n **| x = n **| y) ==> ~(1 <| n)` SUBGOAL_TAC;
27972   REP_BASIC_TAC;
27973   TYPE_THEN `n **| y <= n **| x` SUBGOAL_TAC;
27974   UND 1;
27975   ARITH_TAC;
27976   REWRITE_TAC[LE_EXP];
27977   TYPE_THEN `~(n = 0)` SUBGOAL_TAC;
27978   UND 0;
27979   ARITH_TAC;
27980   DISCH_THEN_REWRITE;
27981   REWRITE_TAC[DE_MORGAN_THM];
27982   CONJ_TAC;
27983   UND 0;
27984   ARITH_TAC;
27985   UND 2;
27986   ARITH_TAC;
27987   DISCH_TAC;
27988   REP_BASIC_TAC;
27989   PROOF_BY_CONTR_TAC;
27990   TYPE_THEN `x < y \/ y <| x` SUBGOAL_TAC;
27991   UND 3;
27992   ARITH_TAC;
27993   DISCH_THEN DISJ_CASES_TAC;
27994   TYPEL_THEN[`x`;`y`;`n`] (USE 0 o ISPECL);
27995   ASM_MESON_TAC[];
27996   TYPEL_THEN[`y`;`x`;`n`] (USE 0 o ISPECL);
27997   ASM_MESON_TAC[];
27998   ]);;
27999   (* }}} *)
28000
28001 let infinite_interval = prove_by_refinement(
28002   `!a b. a < b ==> (INFINITE {x | a < x /\ x < b})`,
28003   (* {{{ proof *)
28004   [
28005   REP_BASIC_TAC;
28006   IMATCH_MP_TAC  infinite_subset;
28007   TYPE_THEN `f = (\ n. a + (b-a)/((&2) pow (SUC n)))` ABBREV_TAC ;
28008   TYPE_THEN `IMAGE f  UNIV` EXISTS_TAC ;
28009   CONJ_TAC;
28010   TYPE_THEN `(! x y. (f x = f y) ==> (x = y))` SUBGOAL_TAC;
28011   EXPAND_TAC "f";
28012   REP_BASIC_TAC;
28013   USE 2 (REWRITE_RULE[REAL_ARITH `(a + d = a + d') <=> (d = d')`;real_div;REAL_PROP_EQ_RMUL_';]);
28014   TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC;
28015   UND 0;
28016   REAL_ARITH_TAC;
28017   DISCH_TAC;
28018   REWR 2;
28019   USE 2 (REWRITE_RULE[GSYM REAL_EQ_INV]);
28020   UND 2;
28021   REDUCE_TAC;
28022   DISCH_TAC;
28023   ONCE_REWRITE_TAC[GSYM SUC_INJ];
28024   IMATCH_MP_TAC  EXPinj;
28025   TYPE_THEN `2` EXISTS_TAC;
28026   ASM_REWRITE_TAC[];
28027   ARITH_TAC;
28028   DISCH_TAC;
28029   TYPE_THEN `INFINITE (UNIV:num->bool) ==> INFINITE (IMAGE f UNIV)` SUBGOAL_TAC;
28030   ASM_MESON_TAC[INFINITE_IMAGE_INJ];
28031   REWRITE_TAC[num_INFINITE];
28032   (* -- *)
28033   REWRITE_TAC[IMAGE;SUBSET];
28034   GEN_TAC;
28035   REP_BASIC_TAC;
28036   UND 2;
28037   DISCH_THEN_REWRITE;
28038   EXPAND_TAC "f";
28039   CONJ_TAC;
28040   ONCE_REWRITE_TAC[REAL_ARITH `a < a + x <=> &0 < x`];
28041   REWRITE_TAC[real_div];
28042   IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
28043   CONJ_TAC;
28044   UND 0;
28045   REAL_ARITH_TAC;
28046   IMATCH_MP_TAC  REAL_PROP_POS_INV;
28047   REDUCE_TAC;
28048   ARITH_TAC;
28049   ONCE_REWRITE_TAC [REAL_ARITH `a + x < b <=> x < (b - a)*(&1)`];
28050   REWRITE_TAC[real_div];
28051   IMATCH_MP_TAC  REAL_PROP_LT_LMUL;
28052   CONJ_TAC;
28053   UND 0;
28054   REAL_ARITH_TAC;
28055   ONCE_REWRITE_TAC[GSYM REAL_INV_1];
28056   IMATCH_MP_TAC  REAL_LT_INV2;
28057   REDUCE_TAC;
28058   IMATCH_MP_TAC  exp_gt1;
28059   ARITH_TAC;
28060   (* Thu Aug 19 14:59:58 EDT 2004 *)
28061   ]);;
28062   (* }}} *)
28063
28064 let finite_augment1 = prove_by_refinement(
28065   `!n (X:A->bool) . (INFINITE X) ==> (?Z. Z SUBSET X /\ Z HAS_SIZE n)`,
28066   (* {{{ proof *)
28067   [
28068   INDUCT_TAC;
28069   REP_BASIC_TAC;
28070   TYPE_THEN `EMPTY:A->bool` EXISTS_TAC  ;
28071   REWRITE_TAC[HAS_SIZE_0];
28072   REP_BASIC_TAC;
28073   TSPEC `X` 0;
28074   REWR 0;
28075   REP_BASIC_TAC;
28076   TYPE_THEN `INFINITE (X DIFF Z)` SUBGOAL_TAC;
28077   IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
28078   ASM_REWRITE_TAC[];
28079   ASM_MESON_TAC[HAS_SIZE];
28080   DISCH_TAC;
28081   USE 3 (MATCH_MP INFINITE_NONEMPTY);
28082   USE 3 (REWRITE_RULE[EMPTY_EXISTS]);
28083   REP_BASIC_TAC;
28084   TYPE_THEN `u INSERT Z` EXISTS_TAC;
28085   CONJ_TAC;
28086   UND 2;
28087   UND 3;
28088   REWRITE_TAC[DIFF;SUBSET;INSERT];
28089   ASM_MESON_TAC[];
28090   (* -- *)
28091   USE 0 (REWRITE_RULE[HAS_SIZE]);
28092   ASM_SIMP_TAC [HAS_SIZE;FINITE_INSERT;CARD_CLAUSES;];
28093   UND 3;
28094   REWRITE_TAC[DIFF];
28095   DISCH_THEN_REWRITE;
28096   ]);;
28097   (* }}} *)
28098
28099 let finite_augment = prove_by_refinement(
28100   `!(X:A->bool) Y n m . (n <= m) /\ (X HAS_SIZE n) /\ (INFINITE Y) /\
28101    (X SUBSET Y) ==> (?Z. (X SUBSET Z /\ Z SUBSET Y /\ Z HAS_SIZE m))`,
28102   (* {{{ proof *)
28103   [
28104   REP_BASIC_TAC;
28105   TYPE_THEN `INFINITE (Y DIFF X)` SUBGOAL_TAC;
28106   IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
28107   ASM_MESON_TAC[HAS_SIZE];
28108   DISCH_TAC;
28109   USE 4(MATCH_MP finite_augment1);
28110   USE 3(REWRITE_RULE[LE_EXISTS]);
28111   REP_BASIC_TAC;
28112   TSPEC `d` 4;
28113   REP_BASIC_TAC;
28114   TYPE_THEN `X UNION Z` EXISTS_TAC;
28115   CONJ_TAC;
28116   REWRITE_TAC[SUBSET;UNION];
28117   MESON_TAC[];
28118   REWRITE_TAC[union_subset];
28119   ASM_REWRITE_TAC[];
28120   CONJ_TAC;
28121   UND 5;
28122   SET_TAC[SUBSET;DIFF];
28123   REWRITE_TAC[HAS_SIZE];
28124   CONJ_TAC;
28125   ASM_REWRITE_TAC[FINITE_UNION];
28126   ASM_MESON_TAC[HAS_SIZE];
28127   RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
28128   REP_BASIC_TAC;
28129   EXPAND_TAC "d";
28130   EXPAND_TAC "n";
28131   IMATCH_MP_TAC  CARD_UNION;
28132   ASM_REWRITE_TAC[];
28133   UND 5;
28134   REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY ];
28135   MESON_TAC[];
28136   (* Thu Aug 19 15:29:05 EDT 2004 *)
28137
28138   ]);;
28139   (* }}} *)
28140
28141 let euclid_add_cancel = prove_by_refinement(
28142   `!p q q'. (euclid_plus p q = euclid_plus p q') <=> (q = q')`,
28143   (* {{{ proof *)
28144   [
28145   REP_BASIC_TAC;
28146   REWRITE_TAC[FUN_EQ_THM];
28147   REWRITE_TAC [euclid_plus;];
28148   REWRITE_TAC[REAL_ARITH `(x + a = x + b) <=> (a = b)`];
28149   ]);;
28150   (* }}} *)
28151
28152
28153 let degree_vertex_disk_ver2 = prove_by_refinement(
28154   `!r p X. (&0 < r) /\ (euclid 2 p) /\ (FINITE X) /\ (CARD X <= 4) /\
28155      (X SUBSET {x | (euclid 2 x) /\ (d_euclid p x = r)}) ==>
28156     (?C. (!i. (X i) ==> (?C' C'' v.
28157            simple_arc_end C' p v /\
28158            simple_arc_end C'' v i  /\
28159            C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\
28160            (C' INTER C'' = {v}) /\
28161            (C' UNION C'' = C i )) /\
28162           simple_arc_end (C i ) p  i /\
28163            C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\
28164            C i  INTER (closed_ball(euclid 2,d_euclid) p (r / &2))
28165            SUBSET (hyperplane 2 e2 (p 1) UNION
28166                      hyperplane 2 e1 (p 0))) /\
28167        (!i j. (X i ) /\ (X j) /\ (~(i=j)) ==>
28168            (C i INTER C j = {p} )))`,
28169   (* {{{ proof *)
28170   [
28171   REP_BASIC_TAC;
28172   TYPE_THEN `!x. (X x) ==> (?r t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC;
28173   REP_BASIC_TAC;
28174   REWRITE_TAC[euclid_cancel1];
28175   IMATCH_MP_TAC  polar_exist;
28176   USE 0(REWRITE_RULE[SUBSET]);
28177   ASM_MESON_TAC[euclid_sub_closure];
28178   DISCH_TAC;
28179   (* -- *)
28180   TYPE_THEN `!x. (X x) ==> (?t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC;
28181   REP_BASIC_TAC;
28182   TSPEC `x` 5;
28183   REWR 5;
28184   REP_BASIC_TAC;
28185   UND 5;
28186   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
28187   TYPE_THEN `t` EXISTS_TAC;
28188   ASM_REWRITE_TAC[];
28189   CONJ_TAC;
28190   UND 4;
28191   REAL_ARITH_TAC;
28192   USE 0 (REWRITE_RULE[SUBSET]);
28193   TSPEC `euclid_plus p (r' *# cis t)` 0;
28194   REWR 0;
28195   REP_BASIC_TAC;
28196   UND 0;
28197   TYPEL_THEN[`2`;`p`;`r' *# cis t`] (fun t-> ANT_TAC (ISPECL t d_euclidpq));
28198   ASM_REWRITE_TAC[polar_euclid];
28199   DISCH_THEN_REWRITE;
28200   REWRITE_TAC[GSYM norm2;norm2_scale_cis];
28201   DISCH_TAC;
28202   TYPE_THEN `abs  r' = r'` SUBGOAL_TAC;
28203   UND 7;
28204   REAL_ARITH_TAC;
28205   DISCH_TAC;
28206   REWR 0;
28207   ASM_REWRITE_TAC[];
28208   DISCH_TAC;
28209   KILL 5;
28210   (* -- *)
28211   TYPE_THEN `TX = {t | (&0 <= t /\ t < &2 *pi /\ (X( p + (r *# (cis t))))) }` ABBREV_TAC ;
28212   TYPE_THEN `BIJ ( \ t. p + r *# cis t) TX X` SUBGOAL_TAC;
28213   REWRITE_TAC[BIJ;INJ;SURJ];
28214   SUBCONJ_TAC;
28215   CONJ_TAC;
28216   EXPAND_TAC "TX";
28217   REWRITE_TAC[];
28218   MESON_TAC[];
28219   EXPAND_TAC "TX";
28220   REWRITE_TAC[];
28221   REP_BASIC_TAC;
28222   USE 7 (REWRITE_RULE[euclid_add_cancel]);
28223   PROOF_BY_CONTR_TAC;
28224   TYPEL_THEN[`x`;`y`;`r`;`r`] (fun t-> ANT_TAC(ISPECL t polar_inj));
28225   ASM_REWRITE_TAC[];
28226   UND 4;
28227   REAL_ARITH_TAC;
28228   ASM_REWRITE_TAC[];
28229   UND 4;
28230   REAL_ARITH_TAC;
28231   DISCH_THEN_REWRITE;
28232   REP_BASIC_TAC;
28233   EXPAND_TAC "TX";
28234   REWRITE_TAC[];
28235   ASM_MESON_TAC[];
28236   DISCH_TAC;
28237   (* -- *)
28238   TYPE_THEN `INFINITE {x | &0 <= x /\ x < &2* pi}` SUBGOAL_TAC;
28239   IMATCH_MP_TAC  infinite_subset;
28240   TYPE_THEN `{x | &0 < x /\ x < &2 * pi}` EXISTS_TAC;
28241   CONJ_TAC;
28242   IMATCH_MP_TAC  infinite_interval;
28243   IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
28244   REWRITE_TAC[PI_POS];
28245   REAL_ARITH_TAC;
28246   REWRITE_TAC[SUBSET];
28247   MESON_TAC[REAL_ARITH `&0 < x ==> &0 <= x`];
28248   DISCH_TAC;
28249   (* A -- *)
28250   TYPE_THEN `TX HAS_SIZE CARD X` SUBGOAL_TAC;
28251   REWRITE_TAC[HAS_SIZE];
28252   SUBCONJ_TAC;
28253   COPY 7;
28254   JOIN 2 7;
28255   USE 2 (MATCH_MP FINITE_BIJ2);
28256   ASM_REWRITE_TAC[];
28257   DISCH_TAC;
28258   IMATCH_MP_TAC BIJ_CARD;
28259   ASM_REWRITE_TAC [];
28260   ASM_MESON_TAC[];
28261   DISCH_TAC;
28262   (* -- *)
28263   TYPE_THEN `(?Z. (TX SUBSET Z /\ Z SUBSET {x | &0 <= x /\ x < &2 *pi}  /\ Z HAS_SIZE 4))` SUBGOAL_TAC;
28264   IMATCH_MP_TAC  finite_augment;
28265   TYPE_THEN `CARD X` EXISTS_TAC;
28266   ASM_REWRITE_TAC[];
28267   EXPAND_TAC"TX";
28268   REWRITE_TAC[SUBSET];
28269   REAL_ARITH_TAC;
28270   REP_BASIC_TAC;
28271   (* B -- order points *)
28272   TYPE_THEN `FINITE Z` SUBGOAL_TAC;
28273   ASM_MESON_TAC[HAS_SIZE];
28274   DISCH_TAC;
28275   USE 13 (MATCH_MP real_finite_increase);
28276   REP_BASIC_TAC;
28277   USE 10(REWRITE_RULE[HAS_SIZE]);
28278   REP_BASIC_TAC;
28279   REWR 13;
28280   REWR 14;
28281   (* -- *)
28282   TYPEL_THEN [`r`;`p`;`u`] (fun t-> ANT_TAC (ISPECL t degree_vertex_disk));
28283   ASM_REWRITE_TAC[];
28284   CONJ_TAC;
28285   UND 14;
28286   REWRITE_TAC[BIJ;SURJ];
28287   REP_BASIC_TAC;
28288   USE 11(REWRITE_RULE[SUBSET]);
28289   ASM_MESON_TAC[];
28290   REP_BASIC_TAC;
28291   FIRST_ASSUM IMATCH_MP_TAC ;
28292   ASM_REWRITE_TAC[];
28293   UND 16;
28294   UND 17;
28295   ARITH_TAC;
28296   REP_BASIC_TAC;
28297   (* [C] -- create C *)
28298   TYPE_THEN `f = (\t. euclid_plus p (r *# cis t))` ABBREV_TAC ;
28299   TYPE_THEN `g = INV f TX X` ABBREV_TAC ;
28300   TYPE_THEN `u' = INV u {x | x <| 4} Z` ABBREV_TAC ;
28301   TYPE_THEN `BIJ g X TX` SUBGOAL_TAC;
28302   EXPAND_TAC "g";
28303   IMATCH_MP_TAC  INVERSE_BIJ;
28304   ASM_REWRITE_TAC[];
28305   DISCH_TAC;
28306   (* -- *)
28307   TYPE_THEN `BIJ u' Z {x | x <| 4}` SUBGOAL_TAC;
28308   EXPAND_TAC "u'";
28309   IMATCH_MP_TAC  INVERSE_BIJ;
28310   ASM_REWRITE_TAC[];
28311   DISCH_TAC;
28312   (* -- *)
28313   TYPE_THEN `INJ (compose u'  g) X { x | x <| 4}` SUBGOAL_TAC;
28314   IMATCH_MP_TAC  COMP_INJ;
28315   TYPE_THEN `TX` EXISTS_TAC;
28316   CONJ_TAC;
28317   UND 21;
28318   REWRITE_TAC[BIJ];
28319   MESON_TAC[];
28320   IMATCH_MP_TAC  inj_subset_domain;
28321   TYPE_THEN `Z` EXISTS_TAC;
28322   ASM_REWRITE_TAC[];
28323   UND 22;
28324   REWRITE_TAC [BIJ];
28325   DISCH_THEN_REWRITE;
28326   DISCH_TAC;
28327   TYPE_THEN `(\ j. C ((compose u' g) j))` EXISTS_TAC;
28328   REWRITE_TAC[];
28329   (* D -- check properties *)
28330   CONJ_TAC;
28331   REP_BASIC_TAC;
28332   TYPE_THEN   `j = compose u' g i` ABBREV_TAC ;
28333   TSPEC `j` 17;
28334   TYPE_THEN `j <| 4` SUBGOAL_TAC;
28335   USE 23 (REWRITE_RULE[INJ]);
28336   REP_BASIC_TAC;
28337   EXPAND_TAC "j";
28338   FIRST_ASSUM IMATCH_MP_TAC ;
28339   ASM_REWRITE_TAC[];
28340   DISCH_TAC;
28341   REWR 17;
28342   ASM_REWRITE_TAC[];
28343   (* --2-- *)
28344   TYPE_THEN `i = f (u j)` SUBGOAL_TAC;
28345   EXPAND_TAC "j";
28346   EXPAND_TAC "f";
28347   EXPAND_TAC "u'";
28348   REWRITE_TAC[compose];
28349   ONCE_REWRITE_TAC [EQ_SYM_EQ];
28350   TYPE_THEN `u (INV u {x | x <| 4} Z (g i)) = (g i)` SUBGOAL_TAC;
28351   IMATCH_MP_TAC  inv_comp_right;
28352   ASM_REWRITE_TAC[];
28353   UND 21;
28354   UND 12;
28355   REWRITE_TAC[SUBSET;BIJ;SURJ;];
28356   UND 24;
28357   MESON_TAC[];
28358   DISCH_THEN_REWRITE;
28359   TYPE_THEN `f (g i) = i` SUBGOAL_TAC;
28360   EXPAND_TAC "g";
28361   IMATCH_MP_TAC  inv_comp_right;
28362   ASM_REWRITE_TAC[];
28363   EXPAND_TAC "f";
28364   DISCH_THEN_REWRITE;
28365   EXPAND_TAC "f";
28366   DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[GSYM t]));
28367   ASM_REWRITE_TAC[];
28368   (* E *)
28369   REP_BASIC_TAC;
28370   TYPE_THEN `i' = compose u' g i` ABBREV_TAC ;
28371   TYPE_THEN `j' = compose u' g j` ABBREV_TAC ;
28372   KILL 17;
28373   TYPE_THEN `~(i' = j')` SUBGOAL_TAC;
28374   DISCH_TAC;
28375   UND 24;
28376   REWRITE_TAC[];
28377   USE 23 (REWRITE_RULE[INJ]);
28378   REP_BASIC_TAC;
28379   FIRST_ASSUM IMATCH_MP_TAC ;
28380   ASM_MESON_TAC[];
28381   DISCH_TAC;
28382   TYPE_THEN `(i' <| 4) /\ (j' <| 4) ` SUBGOAL_TAC;
28383   EXPAND_TAC "i'";
28384   EXPAND_TAC "j'";
28385   USE 23 (REWRITE_RULE[INJ]);
28386   REP_BASIC_TAC;
28387   ASM_MESON_TAC[];
28388   REP_BASIC_TAC;
28389   TYPEL_THEN [`i'`;`j'`] (USE 16 o ISPECL);
28390   FIRST_ASSUM IMATCH_MP_TAC ;
28391   ASM_REWRITE_TAC[];
28392   (* Thu Aug 19 18:06:33 EDT 2004 *)
28393
28394   ]);;
28395   (* }}} *)
28396
28397 (* ------------------------------------------------------------------ *)
28398 (* SECTION O *)
28399 (* ------------------------------------------------------------------ *)
28400
28401
28402 let simple_arc_connected = prove_by_refinement(
28403   `!C. simple_arc top2 C ==> connected top2 C`,
28404   (* {{{ proof *)
28405
28406   [
28407   REWRITE_TAC[simple_arc;];
28408   REP_BASIC_TAC;
28409   ASM_REWRITE_TAC[];
28410   IMATCH_MP_TAC  connect_image;
28411   TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
28412   ASM_REWRITE_TAC[connect_real];
28413   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
28414   REWRITE_TAC[IMAGE;SUBSET];
28415   REP_BASIC_TAC;
28416   ASM_SIMP_TAC[];
28417   (* Fri Aug 20 08:32:31 EDT 2004 *)
28418   ]);;
28419
28420   (* }}} *)
28421
28422 let disk_endpoint = prove_by_refinement(
28423   `!C r p v v'. simple_arc_end C v v' /\ (&0 < r) /\ (euclid 2 p) /\
28424        (C INTER (closed_ball(euclid 2,d_euclid) p r) = {v}) ==>
28425       (d_euclid p v = r)`,
28426   (* {{{ proof *)
28427   [
28428   REP_BASIC_TAC;
28429   PROOF_BY_CONTR_TAC;
28430   TYPE_THEN `connected top2 C` SUBGOAL_TAC;
28431   IMATCH_MP_TAC  simple_arc_connected;
28432   IMATCH_MP_TAC  simple_arc_end_simple;
28433   ASM_MESON_TAC[];
28434   DISCH_TAC;
28435   (* - *)
28436   TYPE_THEN `A = euclid 2 DIFF (closed_ball (euclid 2, d_euclid) p r)` ABBREV_TAC ;
28437   TYPE_THEN `B = closed_ball(euclid 2, d_euclid) p r` ABBREV_TAC ;
28438   TYPE_THEN `closed_ top2 B` SUBGOAL_TAC;
28439   EXPAND_TAC "B";
28440   REWRITE_TAC[top2];
28441   IMATCH_MP_TAC  closed_ball_closed;
28442   REWRITE_TAC[metric_euclid];
28443   DISCH_TAC;
28444   (* - *)
28445   TYPE_THEN `top2 A` SUBGOAL_TAC;
28446   UND 8;
28447   EXPAND_TAC "A";
28448   EXPAND_TAC "B";
28449   REWRITE_TAC[closed;top2_unions;open_DEF ;];
28450   DISCH_THEN_REWRITE;
28451   DISCH_TAC;
28452   (* - *)
28453   TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
28454   IMATCH_MP_TAC  simple_arc_euclid;
28455   IMATCH_MP_TAC  simple_arc_end_simple;
28456   ASM_MESON_TAC[];
28457   DISCH_TAC;
28458   (* - *)
28459   TYPE_THEN `B' = open_ball(euclid 2,d_euclid) p r` ABBREV_TAC ;
28460   TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC;
28461   EXPAND_TAC "A";
28462   EXPAND_TAC "B'";
28463   EXPAND_TAC "B";
28464   REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION];
28465   USE 10 (REWRITE_RULE[SUBSET]);
28466   ASM_REWRITE_TAC[];
28467   REP_BASIC_TAC;
28468   TSPEC `x` 10;
28469   REWR 10;
28470   ASM_REWRITE_TAC[];
28471   PROOF_BY_CONTR_TAC;
28472   USE 13 (REWRITE_RULE[DE_MORGAN_THM]);
28473   REP_BASIC_TAC;
28474   TYPE_THEN `B x` SUBGOAL_TAC;
28475   EXPAND_TAC "B";
28476   REWRITE_TAC[closed_ball];
28477   ASM_REWRITE_TAC[];
28478   USE 0 (REWRITE_RULE[FUN_EQ_THM]);
28479   USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
28480   ASM_MESON_TAC[REAL_ARITH `u <= v /\ ~(u = v) ==> (u < v)`];
28481   (* - *)
28482   USE 5 (REWRITE_RULE[connected;top2_unions]);
28483   REP_BASIC_TAC;
28484   TYPEL_THEN[`B'`;`A`] (USE 12 o ISPECL);
28485   REWR 12;
28486   TYPE_THEN `top2 B'` SUBGOAL_TAC;
28487   EXPAND_TAC "B'";
28488   REWRITE_TAC[top2];
28489   IMATCH_MP_TAC  open_ball_open;
28490   REWRITE_TAC[metric_euclid];
28491   DISCH_THEN_FULL_REWRITE;
28492   (* - *)
28493   TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC;
28494   EXPAND_TAC "A";
28495   EXPAND_TAC "B'";
28496   EXPAND_TAC "B";
28497   REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;];
28498   REP_BASIC_TAC;
28499   UND 14;
28500   ASM_REWRITE_TAC[];
28501   UND 16;
28502   REAL_ARITH_TAC;
28503   DISCH_THEN_FULL_REWRITE;
28504   (* - *)
28505   FIRST_ASSUM DISJ_CASES_TAC;
28506   TYPE_THEN `C SUBSET B` SUBGOAL_TAC;
28507   IMATCH_MP_TAC  SUBSET_TRANS;
28508   TYPE_THEN `B'` EXISTS_TAC;
28509   ASM_REWRITE_TAC[];
28510   EXPAND_TAC "B";
28511   EXPAND_TAC "B'";
28512   REWRITE_TAC[SUBSET;open_ball;closed_ball];
28513   MESON_TAC[REAL_ARITH `x < y ==> x <= y`];
28514   DISCH_TAC;
28515   (* -- *)
28516   TYPE_THEN `~(v = v')` SUBGOAL_TAC;
28517   IMATCH_MP_TAC  simple_arc_end_distinct;
28518   ASM_MESON_TAC[];
28519   REWRITE_TAC[];
28520   TYPE_THEN `C v'` SUBGOAL_TAC;
28521   ASM_MESON_TAC[simple_arc_end_end2];
28522   DISCH_TAC;
28523   TYPE_THEN `B v'` SUBGOAL_TAC;
28524   UND 15;
28525   UND 16;
28526   MESON_TAC[ISUBSET];
28527   UND 16;
28528   UND 0;
28529   REWRITE_TAC[INTER;eq_sing];
28530   MESON_TAC[];
28531   (* - *)
28532   TYPE_THEN `C v` SUBGOAL_TAC;
28533   ASM_MESON_TAC[simple_arc_end_end];
28534   DISCH_TAC;
28535   TYPE_THEN `A v` SUBGOAL_TAC;
28536   ASM_MESON_TAC[ISUBSET];
28537   TYPE_THEN `B v` SUBGOAL_TAC;
28538   UND 0;
28539   REWRITE_TAC[INTER;eq_sing];
28540   DISCH_THEN_REWRITE;
28541   EXPAND_TAC "A";
28542   REWRITE_TAC[DIFF];
28543   DISCH_THEN_REWRITE;
28544   (* Fri Aug 20 09:12:44 EDT 2004 *)
28545
28546   ]);;
28547   (* }}} *)
28548
28549 let disk_endpoint_gen = prove_by_refinement(
28550   `!C B' B v v'. simple_arc_end C v v'  /\
28551       (top2 B') /\ (closed_ top2 B) /\ (B' SUBSET B) /\
28552        (C INTER B = {v}) ==>
28553       (~(B' v))`,
28554   (* {{{ proof *)
28555   [
28556   REP_BASIC_TAC;
28557   TYPE_THEN `connected top2 C` SUBGOAL_TAC;
28558   IMATCH_MP_TAC  simple_arc_connected;
28559   IMATCH_MP_TAC  simple_arc_end_simple;
28560   ASM_MESON_TAC[];
28561   DISCH_TAC;
28562   (* - *)
28563   TYPE_THEN `A = euclid 2 DIFF B` ABBREV_TAC ;
28564   (* - *)
28565   TYPE_THEN `top2 A` SUBGOAL_TAC;
28566   EXPAND_TAC "A";
28567   UND 3;
28568   REWRITE_TAC[closed;top2_unions;open_DEF ;];
28569   DISCH_THEN_REWRITE;
28570   DISCH_TAC;
28571   (* - *)
28572   TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
28573   IMATCH_MP_TAC  simple_arc_euclid;
28574   IMATCH_MP_TAC  simple_arc_end_simple;
28575   ASM_MESON_TAC[];
28576   DISCH_TAC;
28577   (* - *)
28578   TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC;
28579   EXPAND_TAC "A";
28580   REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION];
28581   USE 9 (REWRITE_RULE[SUBSET]);
28582   ASM_REWRITE_TAC[];
28583   REP_BASIC_TAC;
28584   TYPE_THEN `B x` ASM_CASES_TAC;
28585   ASM_REWRITE_TAC[];
28586   USE 1(REWRITE_RULE[INTER;eq_sing]);
28587   REP_BASIC_TAC;
28588   TYPE_THEN `(x = v)` SUBGOAL_TAC;
28589   FIRST_ASSUM IMATCH_MP_TAC ;
28590   ASM_REWRITE_TAC[];
28591   DISCH_THEN_FULL_REWRITE;
28592   ASM_REWRITE_TAC[];
28593   ASM_REWRITE_TAC[];
28594   DISJ2_TAC;
28595   FIRST_ASSUM IMATCH_MP_TAC ;
28596   ASM_REWRITE_TAC[];
28597   (* - *)
28598   DISCH_TAC;
28599   USE 6 (REWRITE_RULE[connected;top2_unions]);
28600   REP_BASIC_TAC;
28601   TYPEL_THEN[`B'`;`A`] (USE 6 o ISPECL);
28602   REWR 6;
28603   (* - *)
28604   TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC;
28605   EXPAND_TAC "A";
28606   REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;];
28607   REP_BASIC_TAC;
28608   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
28609   ASM_MESON_TAC[];
28610   DISCH_THEN_FULL_REWRITE;
28611   (* - *)
28612   FIRST_ASSUM DISJ_CASES_TAC;
28613   TYPE_THEN `C SUBSET B` SUBGOAL_TAC;
28614   IMATCH_MP_TAC  SUBSET_TRANS;
28615   TYPE_THEN `B'` EXISTS_TAC;
28616   ASM_REWRITE_TAC[];
28617   DISCH_TAC;
28618   (* -- *)
28619   TYPE_THEN `~(v = v')` SUBGOAL_TAC;
28620   IMATCH_MP_TAC  simple_arc_end_distinct;
28621   ASM_MESON_TAC[];
28622   REWRITE_TAC[];
28623   TYPE_THEN `C v'` SUBGOAL_TAC;
28624   ASM_MESON_TAC[simple_arc_end_end2];
28625   DISCH_TAC;
28626   TYPE_THEN `B v'` SUBGOAL_TAC;
28627   UND 13;
28628   UND 14;
28629   MESON_TAC[ISUBSET];
28630   UND 14;
28631   UND 1;
28632   REWRITE_TAC[INTER;eq_sing];
28633   MESON_TAC[];
28634   (* - *)
28635   TYPE_THEN `C v` SUBGOAL_TAC;
28636   ASM_MESON_TAC[simple_arc_end_end];
28637   DISCH_TAC;
28638   TYPE_THEN `A v` SUBGOAL_TAC;
28639   ASM_MESON_TAC[ISUBSET];
28640   TYPE_THEN `B v` SUBGOAL_TAC;
28641   UND 1;
28642   REWRITE_TAC[INTER;eq_sing];
28643   DISCH_THEN_REWRITE;
28644   EXPAND_TAC "A";
28645   REWRITE_TAC[DIFF];
28646   DISCH_THEN_REWRITE;
28647   ]);;
28648   (* }}} *)
28649
28650 let disk_endpoint_outer = prove_by_refinement(
28651   `!C r p v v'. simple_arc_end C v v'  /\ (&0 < r) /\ (euclid 2 p) /\
28652       (C INTER (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r)) = {v})
28653      ==>
28654       (d_euclid p v = r)`,
28655   (* {{{ proof *)
28656   [
28657   REP_BASIC_TAC;
28658   TYPE_THEN `B = (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ;
28659   TYPE_THEN `B' = (euclid 2 DIFF (closed_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ;
28660   (* - *)
28661   TYPE_THEN `B' SUBSET B` SUBGOAL_TAC;
28662   EXPAND_TAC "B'";
28663   EXPAND_TAC "B";
28664   REWRITE_TAC[closed_ball;open_ball;SUBSET;DIFF];
28665   MESON_TAC[REAL_ARITH `x < u ==> x <= u`];
28666   DISCH_TAC;
28667   (* - *)
28668   TYPE_THEN `closed_ top2 B` SUBGOAL_TAC;
28669   EXPAND_TAC "B";
28670   REWRITE_TAC[closed;top2_unions;open_DEF ;SUBSET_DIFF];
28671   TYPE_THEN `open_ball (euclid 2,d_euclid) p r SUBSET (euclid 2)` SUBGOAL_TAC;
28672   REWRITE_TAC[open_ball;SUBSET];
28673   MESON_TAC[];
28674   ASM_SIMP_TAC[DIFF_DIFF2];
28675   ASM_SIMP_TAC [open_ball_open;top2;metric_euclid];
28676   DISCH_TAC;
28677   (* - *)
28678   TYPE_THEN `top2 B'` SUBGOAL_TAC;
28679   EXPAND_TAC "B'";
28680   TH_INTRO_TAC [`top2`;`closed_ball (euclid 2,d_euclid) p r`] closed_open;
28681   REWRITE_TAC[metric_euclid;top2];
28682   IMATCH_MP_TAC  closed_ball_closed;
28683   REWRITE_TAC[metric_euclid];
28684   REWRITE_TAC[open_DEF;top2_unions;];
28685   DISCH_TAC;
28686   (* - *)
28687   TH_INTRO_TAC [`C`;`B'`;`B`;`v`;`v'`] disk_endpoint_gen;
28688   ASM_REWRITE_TAC[];
28689   DISCH_TAC;
28690   (* - *)
28691   TYPE_THEN `B v` SUBGOAL_TAC;
28692   UND 0;
28693   REWRITE_TAC[INTER;eq_sing];
28694   DISCH_THEN_REWRITE;
28695   DISCH_TAC;
28696   (* - *)
28697   TYPE_THEN `B v /\ ~B' v ==> (d_euclid p v = r)` SUBGOAL_TAC;
28698   EXPAND_TAC "B";
28699   EXPAND_TAC "B'";
28700   REWRITE_TAC[DIFF;open_ball;closed_ball;];
28701   MESON_TAC[REAL_ARITH `x <= y /\ ~(x < y) ==> (x = y)`];
28702   DISCH_THEN IMATCH_MP_TAC ;
28703   ASM_REWRITE_TAC[];
28704   ]);;
28705   (* }}} *)
28706
28707 let graph_edge_around = jordan_def
28708   `graph_edge_around (G:(A,B)graph_t) v =
28709    { e | graph_edge G e /\ graph_inc G e v}`;;
28710
28711 let graph_edge_around_empty = prove_by_refinement(
28712   `!(G:(A,B)graph_t) v. (graph G) /\ ~(graph_vertex G v) ==>
28713       (graph_edge_around G v = EMPTY)`,
28714   (* {{{ proof *)
28715
28716   [
28717   REWRITE_TAC[graph_edge_around;EQ_EMPTY;];
28718   REP_BASIC_TAC;
28719   TH_INTRO_TAC [`G`;`x`] graph_inc_subset;
28720   ASM_REWRITE_TAC[];
28721   REWRITE_TAC[SUBSET];
28722   ASM_MESON_TAC[];
28723   (* Fri Aug 20 09:25:57 EDT 2004 *)
28724
28725   ]);;
28726
28727   (* }}} *)
28728
28729 let graph_disk_hv_preliminaries = prove_by_refinement(
28730   `!G. plane_graph G /\
28731       FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
28732       ~(graph_edge G = EMPTY) /\
28733      (!v. (CARD (graph_edge_around G v) <=| 4))
28734    ==>
28735   (?NC D short_end hyper r d f. ((!e p. graph_edge G e /\ (!v. ~D v p) ==> (f e p = d e p)) /\
28736   (!e v p.
28737            graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v /\ D v p
28738            ==> ~f e p) /\
28739   (!e v p.
28740            (graph_edge G e /\ graph_inc G e v) /\ D v p
28741            ==> (f e p = NC e v p)) /\
28742   (!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}) /\
28743   (!v e e'.
28744            graph_edge G e /\
28745            graph_edge G e' /\
28746            graph_inc G e v /\
28747            graph_inc G e' v /\
28748            ~(e = e')
28749            ==> (NC e v INTER NC e' v = {v})) /\
28750   (!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)) /\
28751   (!e e'.
28752            graph_edge G e /\ graph_edge G e' /\ ~(e = e')
28753            ==> (d e INTER d e' = {})) /\
28754   (!e v.
28755            graph_edge G e /\ graph_inc G e v
28756            ==> ~graph_vertex G (short_end e v)) /\
28757   (!v v'.
28758            graph_vertex G v /\ graph_vertex G v' /\ ~(v = v')
28759            ==> (D v INTER D v' = {})) /\
28760   (!e v.
28761            graph_edge G e /\ graph_inc G e v
28762            ==> simple_arc_end (NC e v) v (short_end e v) /\
28763                NC e v SUBSET D v /\
28764                hyper (NC e v) v) /\
28765   ((\ B v.
28766             B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET
28767             hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) =
28768        hyper) /\
28769   (!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v) /\
28770   (!e v.
28771            graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v
28772            ==> (d e INTER D v = {})) /\
28773   (!e. graph_edge G e ==> d e SUBSET e) /\
28774   (!e v.
28775            graph_edge G e /\ graph_inc G e v
28776            ==> (d e INTER D v = {(short_end e v)}) /\
28777                (d_euclid v (short_end e v) = r) /\
28778                (!v'. graph_inc G e v' /\ ~(v = v')
28779                      ==> simple_arc_end (d e) (short_end e v)
28780                          (short_end e v'))) /\
28781   (!v. euclid 2 v ==> D v v) /\
28782   (!u. closed_ top2 (D u)) /\
28783   (( \ u. closed_ball (euclid 2,d_euclid) u r) = D) /\
28784   (&0 < r) /\
28785   (plane_graph G)))
28786      `,
28787   (* {{{ proof *)
28788
28789   [
28790   REP_BASIC_TAC;
28791   TH_INTRO_TAC [`G`] graph_disk;
28792   ASM_REWRITE_TAC[];
28793   REP_BASIC_TAC;
28794   (* TYPE_THEN `r /(&2)` EXISTS_TAC; *)
28795   (* - *)
28796   TYPE_THEN `D = (\u. (closed_ball (euclid 2,d_euclid ) u r))` ABBREV_TAC ;
28797   TYPE_THEN `!u. closed_ top2 (D u)` SUBGOAL_TAC;
28798   EXPAND_TAC "D";
28799   GEN_TAC;
28800   REWRITE_TAC[top2];
28801   IMATCH_MP_TAC  closed_ball_closed;
28802   REWRITE_TAC[metric_euclid];
28803   DISCH_TAC;
28804   (* - *)
28805   TYPE_THEN `!v. (euclid 2 v) ==> D v v` SUBGOAL_TAC;
28806   EXPAND_TAC "D";
28807   REWRITE_TAC[closed_ball2_center];
28808   GEN_TAC;
28809   DISCH_THEN_REWRITE;
28810   UND 7;
28811   REAL_ARITH_TAC;
28812   DISCH_TAC;
28813   (* - *)
28814   (* [A]- Pick middle arcs *)
28815   (* {{{ *)
28816
28817   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 ;
28818   GEN_TAC;
28819   RIGHT_TAC "d";
28820   DISCH_TAC;
28821   TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
28822   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);  (* -xx- *)
28823   ASM_REWRITE_TAC[];
28824   REP_BASIC_TAC;
28825   TH_INTRO_TAC [`e`;`D v`;`D v'`] simple_arc_end_restriction;
28826   ASM_REWRITE_TAC[GSYM top2];
28827   CONJ_TAC;
28828   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
28829   REP_BASIC_TAC;
28830   USE 16 (REWRITE_RULE[SUBSET ]);
28831   ASM_MESON_TAC[];
28832   UND 6;
28833   DISCH_THEN (TH_INTRO_TAC [`v`;`v'`] );
28834   ASM_REWRITE_TAC[];
28835   RULE_ASSUM_TAC (REWRITE_RULE [plane_graph;]);
28836   ASM_MESON_TAC[REWRITE_RULE[SUBSET] graph_inc_subset];
28837   DISCH_TAC;
28838   CONJ_TAC;
28839   EXPAND_TAC "D";
28840   UND 6;
28841   REWRITE_TAC[INTER;EQ_EMPTY];
28842   MESON_TAC[];
28843   REWRITE_TAC[EMPTY_EXISTS ];
28844   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
28845   REP_BASIC_TAC;
28846   TSPEC `e` 15;
28847   REWR 15;
28848   REWR 13;
28849   REWR 14;
28850   UND 18;
28851   REWRITE_TAC[SUBSET];
28852   UND 13;
28853   UND 14;
28854   REWRITE_TAC[INTER];
28855   UND 10;
28856   MESON_TAC[];
28857   REP_BASIC_TAC;
28858   TYPE_THEN `C'` EXISTS_TAC;
28859   TYPE_THEN `v''` EXISTS_TAC;
28860   TYPE_THEN `v'''` EXISTS_TAC;
28861   TYPE_THEN `v` EXISTS_TAC;
28862   TYPE_THEN `v'` EXISTS_TAC;
28863   ASM_REWRITE_TAC[];
28864   (* -- *)
28865   CONJ_TAC;
28866   IMATCH_MP_TAC  disk_endpoint;
28867   TYPE_THEN `C'` EXISTS_TAC;
28868   TYPE_THEN `v'''` EXISTS_TAC;
28869   ASM_REWRITE_TAC[];
28870   UND 16;
28871   EXPAND_TAC "D";
28872   DISCH_THEN_REWRITE;
28873   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
28874   REP_BASIC_TAC;
28875   USE 21 (REWRITE_RULE[SUBSET]);
28876   FIRST_ASSUM IMATCH_MP_TAC ;
28877   ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset];
28878   (* -- *)
28879   IMATCH_MP_TAC  disk_endpoint;
28880   TYPE_THEN `C'` EXISTS_TAC;
28881   TYPE_THEN `v''` EXISTS_TAC;
28882   ASM_REWRITE_TAC[];
28883   UND 15;
28884   EXPAND_TAC "D";
28885   DISCH_THEN_REWRITE;
28886   CONJ_TAC;
28887   IMATCH_MP_TAC  simple_arc_end_symm;
28888   ASM_REWRITE_TAC[];
28889   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
28890   REP_BASIC_TAC;
28891   USE 21 (REWRITE_RULE[SUBSET]);
28892   FIRST_ASSUM IMATCH_MP_TAC ;
28893   ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset];
28894   DISCH_TAC;
28895   RIGHT  11 "e";
28896   REP_BASIC_TAC;
28897   (* B-  short_end *)
28898   TYPE_THEN `short_end = ( \ e v. @s. (d e INTER (D v)) s)` ABBREV_TAC ;
28899   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;
28900   REP_BASIC_TAC;
28901   TSPEC `e` 11;
28902   REWR 11;
28903   REP_BASIC_TAC;
28904   TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
28905   IMATCH_MP_TAC graph_edge2;
28906   UND 4;
28907   REWRITE_TAC[plane_graph];
28908   DISCH_THEN_REWRITE;
28909   ASM_REWRITE_TAC[];
28910   DISCH_TAC;
28911   TYPE_THEN `!u. graph_inc G e u ==> (u = v') \/ (u = v'')` SUBGOAL_TAC;
28912   ASM_MESON_TAC[two_exclusion];
28913   DISCH_TAC;
28914   TYPE_THEN `?s. (d e INTER D v) s` SUBGOAL_TAC;
28915   TSPEC `v` 24;
28916   REWR 24;
28917   FIRST_ASSUM DISJ_CASES_TAC;
28918   ASM_REWRITE_TAC[INR IN_SING ];
28919   MESON_TAC[];
28920   ASM_REWRITE_TAC[INR IN_SING ];
28921   MESON_TAC[];
28922   DISCH_TAC;
28923   (* -- *)
28924   TYPE_THEN `(d e INTER D v) (short_end e v)` SUBGOAL_TAC;
28925   EXPAND_TAC "short_end";
28926   SELECT_TAC;
28927   DISCH_THEN_REWRITE ;
28928   ASM_MESON_TAC[];
28929   DISCH_TAC;
28930   LEFT_TAC "v'";
28931   LEFT_TAC "v'";
28932   GEN_TAC;
28933   TYPE_THEN `(v = v') \/ (v = v'')` SUBGOAL_TAC;
28934   FIRST_ASSUM IMATCH_MP_TAC ;
28935   ASM_REWRITE_TAC[];
28936   TYPE_THEN `(graph_inc G e v''') ==> (v''' = v') \/ (v''' = v'')` SUBGOAL_TAC;
28937   DISCH_TAC;
28938   FIRST_ASSUM IMATCH_MP_TAC ;
28939   ASM_REWRITE_TAC[];
28940   DISCH_TAC;
28941   (* --- *)
28942   DISCH_THEN DISJ_CASES_TAC;
28943   FIRST_ASSUM MP_TAC;
28944   DISCH_THEN_FULL_REWRITE;
28945   ASM_REWRITE_TAC[];
28946   TYPE_THEN `short_end e v' = u` SUBGOAL_TAC;
28947   REWR 26;
28948   USE 26 (REWRITE_RULE[INR IN_SING]);
28949   ASM_REWRITE_TAC[];
28950   DISCH_THEN_FULL_REWRITE;
28951   ASM_REWRITE_TAC[];
28952   REP_BASIC_TAC;
28953   KILL 24;
28954   REWR 27;
28955   UND 24;
28956   DISCH_THEN_FULL_REWRITE;
28957   TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC;
28958   TYPE_THEN `?s. (d e INTER D v'') s` SUBGOAL_TAC;
28959   ASM_REWRITE_TAC[INR IN_SING ];
28960   MESON_TAC[];
28961   EXPAND_TAC "short_end";
28962   SELECT_TAC;
28963   ASM_REWRITE_TAC[INR IN_SING ];
28964   DISCH_THEN_REWRITE;
28965   UND 24;
28966   MESON_TAC[];
28967   DISCH_THEN_REWRITE;
28968   ASM_REWRITE_TAC[];
28969   (* -- *)
28970   FIRST_ASSUM MP_TAC;
28971   DISCH_THEN_FULL_REWRITE;
28972   ASM_REWRITE_TAC[];
28973   TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC;
28974   REWR 26;
28975   USE 26 (REWRITE_RULE[INR IN_SING]);
28976   ASM_REWRITE_TAC[];
28977   DISCH_THEN_FULL_REWRITE;
28978   ASM_REWRITE_TAC[];
28979   REP_BASIC_TAC;
28980   KILL 24;
28981   REWR 27;
28982   UND 24;
28983   DISCH_THEN_FULL_REWRITE;
28984   TYPE_THEN `short_end e v' = u` SUBGOAL_TAC;
28985   TYPE_THEN `?s. (d e INTER D v') s` SUBGOAL_TAC;
28986   ASM_REWRITE_TAC[INR IN_SING ];
28987   MESON_TAC[];
28988   EXPAND_TAC "short_end";
28989   SELECT_TAC;
28990   ASM_REWRITE_TAC[INR IN_SING ];
28991   DISCH_THEN_REWRITE;
28992   UND 24;
28993   MESON_TAC[];
28994   DISCH_THEN_REWRITE;
28995   IMATCH_MP_TAC  simple_arc_end_symm;
28996   ASM_REWRITE_TAC[];
28997   DISCH_TAC;
28998
28999   (* }}} *)
29000   (* [C]- *)
29001   TYPE_THEN `X = (\ v. (IMAGE (\ e. short_end e v) (graph_edge_around G v)))` ABBREV_TAC ;
29002   TYPE_THEN `!v. FINITE (graph_edge_around G v)` SUBGOAL_TAC;
29003   REP_BASIC_TAC;
29004   REWRITE_TAC[graph_edge_around];
29005   IMATCH_MP_TAC  FINITE_SUBSET;
29006   TYPE_THEN `graph_edge G ` EXISTS_TAC;
29007   ASM_REWRITE_TAC[SUBSET];
29008   MESON_TAC[];
29009   DISCH_TAC;
29010   (* - *)
29011   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;
29012   REP_BASIC_TAC;
29013   EXPAND_TAC "X";
29014   SUBCONJ_TAC;
29015   IMATCH_MP_TAC  FINITE_IMAGE;
29016   ASM_REWRITE_TAC[];
29017   DISCH_TAC;
29018   CONJ_TAC;
29019   IMATCH_MP_TAC  LE_TRANS;
29020   TYPE_THEN `CARD (graph_edge_around G v)` EXISTS_TAC;
29021   ASM_REWRITE_TAC[];
29022   IMATCH_MP_TAC  CARD_IMAGE_LE;
29023   ASM_REWRITE_TAC[];
29024   REWRITE_TAC[SUBSET;IMAGE];
29025   REP_BASIC_TAC;
29026   UND 18;
29027   DISCH_THEN_FULL_REWRITE;
29028   USE 19 (REWRITE_RULE[graph_edge_around]);
29029   TSPEC `x'` 13;
29030   TSPEC `v` 13;
29031   REWR 13;
29032   REP_BASIC_TAC;
29033   ASM_REWRITE_TAC[];
29034   UND 19;
29035   EXPAND_TAC "D";
29036   REWRITE_TAC[INTER;eq_sing;closed_ball];
29037   DISCH_THEN_REWRITE;
29038   DISCH_TAC;
29039   (* -D now generate curves C in disk.  *)
29040   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;
29041   REP_BASIC_TAC;
29042   IMATCH_MP_TAC  degree_vertex_disk_ver2;
29043   ASM_REWRITE_TAC[];
29044   TYPE_THEN `(\j. X v j) = X v` SUBGOAL_TAC;
29045   IMATCH_MP_TAC  EQ_EXT;
29046   BETA_TAC;
29047   MESON_TAC[];
29048   DISCH_THEN_REWRITE;
29049   ASM_REWRITE_TAC[];
29050   TSPEC `v` 16;
29051   REWR 16;
29052   ASM_REWRITE_TAC[];
29053   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29054   REP_BASIC_TAC;
29055   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
29056   FIRST_ASSUM IMATCH_MP_TAC ;
29057   ASM_REWRITE_TAC[];
29058   DISCH_TAC;
29059   LEFT 17 "C";
29060   LEFT 17 "C";
29061   REP_BASIC_TAC;
29062   TYPE_THEN `f = (\ e. { x | d e x \/ (?v. graph_inc G e v /\ C v (short_end e v) x)})` ABBREV_TAC ;
29063   (* -[E] lets try to flatten some hypotheses *)
29064   TYPE_THEN `NC  = (\ e v. (C v (short_end e v)))` ABBREV_TAC ;
29065   KILL 1;
29066   KILL 2;
29067   KILL 3;
29068   KILL 0;
29069   (* rework 5 *)
29070   TYPE_THEN `!e . graph_edge G e ==> (d e SUBSET e)` SUBGOAL_TAC;
29071   UND 11;
29072   MESON_TAC[];
29073   DISCH_TAC;
29074   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;
29075   REP_BASIC_TAC;
29076   TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
29077   REWR 5;
29078   UND 5;
29079   UND 0;
29080   REWRITE_TAC[SUBSET;EQ_EMPTY];
29081   UND 3;
29082   EXPAND_TAC "D";
29083   REWRITE_TAC[INTER];
29084   MESON_TAC[];
29085   DISCH_TAC;
29086   KILL 5;
29087   KILL 11;
29088   KILL 12;
29089   (* rework 16 *)
29090   TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC;
29091   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29092   REP_BASIC_TAC;
29093   TH_INTRO_TAC  [`G`;`e`] graph_inc_subset;
29094   ASM_REWRITE_TAC[];
29095   REWRITE_TAC[SUBSET];
29096   DISCH_THEN IMATCH_MP_TAC ;
29097   ASM_REWRITE_TAC[];
29098   DISCH_TAC;
29099   (* - *)
29100   TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> X v (short_end e v))` SUBGOAL_TAC;
29101   REP_BASIC_TAC;
29102   EXPAND_TAC "X";
29103   REWRITE_TAC[IMAGE];
29104   TYPE_THEN `e` EXISTS_TAC;
29105   ASM_REWRITE_TAC[graph_edge_around];
29106   DISCH_TAC;
29107   KILL 16;
29108   KILL 14;
29109   (* rework 17 *)
29110   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 ;
29111   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;
29112   EXPAND_TAC "hyper";
29113   EXPAND_TAC "NC";
29114   REP_BASIC_TAC;
29115   TSPEC `v` 17;
29116   TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
29117   FIRST_ASSUM IMATCH_MP_TAC ;
29118   TYPE_THEN `e` EXISTS_TAC;
29119   ASM_REWRITE_TAC[];
29120   DISCH_THEN_FULL_REWRITE;
29121   REP_BASIC_TAC;
29122   TSPEC `short_end e v` 16;
29123   TYPE_THEN `X v (short_end e v)` SUBGOAL_TAC;
29124   FIRST_ASSUM IMATCH_MP_TAC ;
29125   ASM_REWRITE_TAC[];
29126   DISCH_THEN_FULL_REWRITE;
29127   ASM_REWRITE_TAC[];
29128   EXPAND_TAC "D";
29129   ASM_REWRITE_TAC[];
29130   DISCH_TAC;
29131   (* F- continue simplification *)
29132   TYPE_THEN `!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (D v INTER D v' = EMPTY)` SUBGOAL_TAC;
29133   EXPAND_TAC "D";
29134   ASM_REWRITE_TAC[];
29135   DISCH_TAC;
29136   KILL 6;
29137   (* - *)
29138   TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> ~(graph_vertex G (short_end e v)))` SUBGOAL_TAC;
29139   REP_BASIC_TAC;
29140   TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
29141   REWR 13;
29142   REP_BASIC_TAC;
29143   USE 21 (REWRITE_RULE[eq_sing;INTER]);
29144   REP_BASIC_TAC;
29145   TYPE_THEN `D (short_end e v) (short_end e v)` SUBGOAL_TAC;
29146   FIRST_ASSUM IMATCH_MP_TAC ;
29147   RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]);
29148   REP_BASIC_TAC;
29149   USE 27 (REWRITE_RULE[SUBSET]);
29150   FIRST_ASSUM IMATCH_MP_TAC ;
29151   ASM_REWRITE_TAC[];
29152   DISCH_TAC;
29153   TYPE_THEN `~(D (short_end e v) INTER D v = EMPTY)` SUBGOAL_TAC;
29154   REWRITE_TAC[EMPTY_EXISTS];
29155   TYPE_THEN `short_end e v` EXISTS_TAC;
29156   ASM_REWRITE_TAC[INTER];
29157   REWRITE_TAC[];
29158   FIRST_ASSUM IMATCH_MP_TAC ;
29159   ASM_REWRITE_TAC[];
29160   CONJ_TAC;
29161   FIRST_ASSUM IMATCH_MP_TAC ;
29162   TYPE_THEN `e` EXISTS_TAC;
29163   ASM_REWRITE_TAC[];
29164   PROOF_BY_CONTR_TAC;
29165   USE 25 (REWRITE_RULE[]);
29166   UND 25;
29167   DISCH_THEN_FULL_REWRITE;
29168   TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
29169   IMATCH_MP_TAC  metric_space_zero;
29170   TYPE_THEN `euclid 2` EXISTS_TAC;
29171   ASM_REWRITE_TAC[metric_euclid];
29172   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29173   REP_BASIC_TAC;
29174   USE 28 (REWRITE_RULE[SUBSET]);
29175   FIRST_ASSUM IMATCH_MP_TAC ;
29176   ASM_REWRITE_TAC[];
29177   DISCH_THEN_FULL_REWRITE;
29178   UND 20;
29179   UND 7;
29180   REAL_ARITH_TAC;
29181   DISCH_TAC;
29182   (* - *)
29183   TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (d e INTER d e' = EMPTY)` SUBGOAL_TAC;
29184   REP_BASIC_TAC;
29185   PROOF_BY_CONTR_TAC;
29186   USE 21 (REWRITE_RULE[EMPTY_EXISTS]);
29187   REP_BASIC_TAC;
29188   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29189   REP_BASIC_TAC;
29190   TYPEL_THEN [`e`;`e'`] (USE 4 o ISPECL);
29191   REWR 4;
29192   TYPE_THEN `d e INTER d e' SUBSET graph_vertex G` SUBGOAL_TAC;
29193   IMATCH_MP_TAC  SUBSET_TRANS;
29194   TYPE_THEN `e INTER e'` EXISTS_TAC;
29195   ASM_REWRITE_TAC[];
29196   IMATCH_MP_TAC  subset_inter_pair;
29197   UND 0;
29198   UND 20;
29199   UND 16;
29200   MESON_TAC[];
29201   DISCH_TAC;
29202   TYPE_THEN `graph_vertex G u` SUBGOAL_TAC;
29203   USE 26 (REWRITE_RULE[SUBSET]);
29204   FIRST_ASSUM IMATCH_MP_TAC ;
29205   ASM_REWRITE_TAC[];
29206   USE 21(REWRITE_RULE[INTER]);
29207   TYPE_THEN `graph_inc G e u` ASM_CASES_TAC;
29208   TYPEL_THEN [`e`;`u`] (USE 13 o ISPECL);
29209   REWR 13;
29210   TYPE_THEN `(d e INTER D u) u` SUBGOAL_TAC;
29211   REP_BASIC_TAC;
29212   USE 28 GSYM;
29213   ASM_REWRITE_TAC[INTER];
29214   FIRST_ASSUM IMATCH_MP_TAC ;
29215   USE 25 (REWRITE_RULE[SUBSET]);
29216   FIRST_ASSUM IMATCH_MP_TAC ;
29217   ASM_REWRITE_TAC[];
29218   FIRST_ASSUM IMATCH_MP_TAC ;
29219   TYPE_THEN `e` EXISTS_TAC;
29220   ASM_REWRITE_TAC[];
29221   DISCH_TAC;
29222   USE 28 GSYM;
29223   REWR 28;
29224   USE 28 (REWRITE_RULE[INR IN_SING]);
29225   UND 28;
29226   DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
29227   FIRST_ASSUM IMATCH_MP_TAC ;
29228   ASM_REWRITE_TAC[];
29229   TYPE_THEN `d e INTER D u = EMPTY ` SUBGOAL_TAC;
29230   FIRST_ASSUM IMATCH_MP_TAC ;
29231   ASM_REWRITE_TAC [];
29232   USE 26 (REWRITE_RULE[SUBSET]);
29233   FIRST_ASSUM IMATCH_MP_TAC ;
29234   ASM_REWRITE_TAC[INTER];
29235   DISCH_TAC;
29236   USE 28(REWRITE_RULE[EQ_EMPTY]);
29237   TSPEC `u` 28;
29238   DISCH_TAC;
29239   USE 28(REWRITE_RULE[INTER]);
29240   UND 28;
29241   ASM_REWRITE_TAC[];
29242   FIRST_ASSUM IMATCH_MP_TAC ;
29243   USE 25 (REWRITE_RULE[SUBSET]);
29244   FIRST_ASSUM IMATCH_MP_TAC ;
29245   ASM_REWRITE_TAC[];
29246   DISCH_TAC;
29247   (* -G continue to simplify *)
29248   TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)` SUBGOAL_TAC;
29249   REP_BASIC_TAC;
29250   TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
29251   REWR 13;
29252   REP_BASIC_TAC;
29253   USE 22(REWRITE_RULE[eq_sing;INTER]);
29254   ASM_REWRITE_TAC[];
29255  DISCH_TAC;
29256   (* - *)
29257   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;
29258   EXPAND_TAC "NC";
29259   REP_BASIC_TAC;
29260   TSPEC `v` 17;
29261   TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
29262   FIRST_ASSUM IMATCH_MP_TAC ;
29263   TYPE_THEN `e` EXISTS_TAC;
29264   ASM_REWRITE_TAC[];
29265   DISCH_THEN_FULL_REWRITE;
29266   REP_BASIC_TAC;
29267   TYPEL_THEN  [`short_end e v`;`short_end e' v`](USE 17 o ISPECL);
29268   KILL 25;
29269   FIRST_ASSUM IMATCH_MP_TAC ;
29270   CONJ_TAC;
29271   FIRST_ASSUM IMATCH_MP_TAC ;
29272   ASM_REWRITE_TAC[];
29273   CONJ_TAC;
29274   FIRST_ASSUM IMATCH_MP_TAC ;
29275   ASM_REWRITE_TAC[];
29276   KILL 17;
29277   DISCH_TAC;
29278   TYPE_THEN `d e (short_end e v)` SUBGOAL_TAC;
29279   FIRST_ASSUM IMATCH_MP_TAC ;
29280   ASM_REWRITE_TAC[];
29281   TYPE_THEN `d e' (short_end e' v)` SUBGOAL_TAC;
29282   FIRST_ASSUM IMATCH_MP_TAC ;
29283   ASM_REWRITE_TAC[];
29284   TYPE_THEN `d e INTER d e' = EMPTY ` SUBGOAL_TAC;
29285   FIRST_ASSUM IMATCH_MP_TAC ;
29286   ASM_REWRITE_TAC[];
29287   REWRITE_TAC[EQ_EMPTY;INTER];
29288   UND 17;
29289   MESON_TAC[];
29290   DISCH_TAC;
29291   KILL 17;
29292   KILL 3;
29293   KILL 15;
29294   (* H- *)
29295   TYPE_THEN `!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}` SUBGOAL_TAC;
29296   REP_BASIC_TAC;
29297   EXPAND_TAC "f";
29298   EXPAND_TAC "NC";
29299   REWRITE_TAC[];
29300   DISCH_TAC;
29301   KILL 18;
29302   KILL 19;
29303   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  ;
29304   REP_BASIC_TAC;
29305   ASM_REWRITE_TAC[];
29306   ONCE_REWRITE_TAC [EQ_SYM_EQ];
29307   EQ_TAC;
29308   UND 17;
29309   MESON_TAC[];
29310   DISCH_THEN DISJ_CASES_TAC;
29311   TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
29312   REWR 13;
29313   REP_BASIC_TAC;
29314   USE 22 (REWRITE_RULE[eq_sing;INTER ]);
29315   REP_BASIC_TAC;
29316   TSPEC `p` 22;
29317   REWR 22;
29318   UND 22;
29319   DISCH_THEN_FULL_REWRITE;
29320   TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL);
29321   REWR 11;
29322   REP_BASIC_TAC;
29323   UND 25;
29324   MESON_TAC[simple_arc_end_end2];
29325   REP_BASIC_TAC;
29326   TYPE_THEN `v' = v` ASM_CASES_TAC;
29327   UND 19;
29328   ASM_REWRITE_TAC[];
29329   PROOF_BY_CONTR_TAC;
29330   TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
29331   FIRST_ASSUM IMATCH_MP_TAC ;
29332   ASM_REWRITE_TAC[];
29333   CONJ_TAC;
29334   FIRST_ASSUM IMATCH_MP_TAC ;
29335   TYPE_THEN `e` EXISTS_TAC;
29336   ASM_REWRITE_TAC[];
29337   FIRST_ASSUM IMATCH_MP_TAC ;
29338   TYPE_THEN `e` EXISTS_TAC;
29339   ASM_REWRITE_TAC[];
29340   REWRITE_TAC[EMPTY_EXISTS];
29341   TYPE_THEN `p` EXISTS_TAC;
29342   REWRITE_TAC[INTER];
29343   ASM_REWRITE_TAC[];
29344   TYPEL_THEN[`e`;`v'`] (USE 11 o ISPECL);
29345   REWR 11;
29346   REP_BASIC_TAC;
29347   USE 24 (REWRITE_RULE[SUBSET]);
29348   FIRST_ASSUM IMATCH_MP_TAC ;
29349   ASM_REWRITE_TAC[];
29350   DISCH_TAC;
29351   (* - *)
29352   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;
29353   ASM_REWRITE_TAC[DE_MORGAN_THM ];
29354   REP_BASIC_TAC;
29355   CONJ_TAC;
29356   DISCH_TAC;
29357   TYPE_THEN `d e INTER D v = EMPTY` SUBGOAL_TAC;
29358   FIRST_ASSUM IMATCH_MP_TAC ;
29359   ASM_REWRITE_TAC[];
29360   REWRITE_TAC[EMPTY_EXISTS;INTER  ];
29361   TYPE_THEN `p` EXISTS_TAC;
29362   ASM_REWRITE_TAC[];
29363   LEFT_TAC "v";
29364   GEN_TAC;
29365   DISCH_TAC;
29366   REP_BASIC_TAC;
29367   TYPE_THEN `~(v = v')` SUBGOAL_TAC;
29368   DISCH_TAC;
29369   UND 23;
29370   UND 18;
29371   ASM_REWRITE_TAC[];
29372   DISCH_TAC;
29373   TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
29374   FIRST_ASSUM IMATCH_MP_TAC ;
29375   ASM_REWRITE_TAC[];
29376   FIRST_ASSUM IMATCH_MP_TAC ;
29377   TYPE_THEN `e` EXISTS_TAC;
29378   ASM_REWRITE_TAC[];
29379   REWRITE_TAC[EMPTY_EXISTS;INTER];
29380   TYPE_THEN `p` EXISTS_TAC;
29381   ASM_REWRITE_TAC[];
29382   TYPEL_THEN [`e`;`v'`] (USE 11 o ISPECL);
29383   REP_BASIC_TAC;
29384   REWR 11;
29385   REP_BASIC_TAC;
29386   USE 25 (REWRITE_RULE[SUBSET]);
29387   FIRST_ASSUM IMATCH_MP_TAC ;
29388   ASM_REWRITE_TAC[];
29389   DISCH_TAC;
29390   (* - *)
29391   TYPE_THEN `!e p.  graph_edge G e /\ (!v. ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC ;
29392   ASM_REWRITE_TAC[];
29393   REP_BASIC_TAC;
29394   IMATCH_MP_TAC  (TAUT `~B ==> (A \/ B <=> A)`);
29395   DISCH_TAC;
29396   REP_BASIC_TAC;
29397   TSPEC `v` 18;
29398   UND 18;
29399   REWRITE_TAC[];
29400   TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL);
29401   REWR 11;
29402   REP_BASIC_TAC;
29403   USE 18(REWRITE_RULE[SUBSET]);
29404   FIRST_ASSUM IMATCH_MP_TAC ;
29405   ASM_REWRITE_TAC[];
29406   DISCH_TAC;
29407   (* I- *)
29408   TYPE_THEN `NC` EXISTS_TAC;
29409   TYPE_THEN `D` EXISTS_TAC;
29410   TYPE_THEN `short_end` EXISTS_TAC;
29411   TYPE_THEN `hyper` EXISTS_TAC;
29412   TYPE_THEN `r` EXISTS_TAC;
29413   TYPE_THEN `d` EXISTS_TAC;
29414   TYPE_THEN `f` EXISTS_TAC;
29415   ASM_REWRITE_TAC[];
29416   (* Sat Aug 21 08:06:22 EDT 2004 *)
29417
29418   ]);;
29419
29420   (* }}} *)
29421
29422
29423 let graph_vertex_exhaust = prove_by_refinement(
29424   `!(G:(A,B)graph_t) e v v'.
29425   (graph G /\ (graph_edge G e) /\ (graph_inc G e v) /\
29426      (graph_inc G e v') /\ ~(v = v') ==> (graph_inc G e = {v,v'}))`,
29427   (* {{{ proof *)
29428   [
29429   REP_BASIC_TAC;
29430   TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
29431   IMATCH_MP_TAC  graph_edge2;
29432   ASM_REWRITE_TAC[];
29433   REWRITE_TAC[has_size2];
29434   REP_BASIC_TAC;
29435   UND 6;
29436   DISCH_THEN_FULL_REWRITE;
29437   IMATCH_MP_TAC  EQ_EXT;
29438   REWRITE_TAC[in_pair];
29439   KILL 3;
29440   KILL 4;
29441   RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
29442   ASM_MESON_TAC[];
29443   ]);;
29444   (* }}} *)
29445
29446
29447 let graph_disk_hv = prove_by_refinement(
29448   `!G. plane_graph G /\
29449       FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
29450       ~(graph_edge G = EMPTY) /\
29451      (!v. (CARD (graph_edge_around G v) <=| 4))
29452    ==>
29453     (?r H . graph_isomorphic G H /\ good_plane_graph H /\
29454       (&0 < r) /\
29455       (!v v'.
29456          graph_vertex H v /\ graph_vertex H v' /\ ~(v = v')
29457          ==> (closed_ball (euclid 2,d_euclid) v r INTER
29458                 closed_ball (euclid 2,d_euclid) v' r =
29459                 {})) /\
29460       (!e v.
29461          graph_edge H e /\ graph_vertex H v /\ ~graph_inc H e v
29462          ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\
29463       (!e v.
29464          graph_edge H e /\  graph_inc H e v
29465          ==> (e INTER closed_ball (euclid 2, d_euclid) v r SUBSET
29466             (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))))
29467     )`,
29468   (* {{{ proof *)
29469
29470   [
29471   REP_BASIC_TAC;
29472   TH_INTRO_TAC [`G`] graph_disk_hv_preliminaries;
29473   ASM_REWRITE_TAC[];
29474   POP_ASSUM_LIST (fun t-> ALL_TAC);
29475   REP_BASIC_TAC;
29476   (* - *) (* redo 19 *)
29477   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;
29478   REP_BASIC_TAC;
29479   ASM_REWRITE_TAC[];
29480   IMATCH_MP_TAC  (TAUT  `~B ==> (A \/ B <=> A)`);
29481   DISCH_TAC;
29482   REP_BASIC_TAC;
29483   TSPEC `v` 20;
29484   UND 20;
29485   ASM_REWRITE_TAC[];
29486   TYPEL_THEN[`e`;`v`] (USE 10 o ISPECL);
29487   REWR 10;
29488   REP_BASIC_TAC;
29489   USE 20 (REWRITE_RULE[SUBSET]);
29490   FIRST_ASSUM IMATCH_MP_TAC ;
29491   ASM_REWRITE_TAC[];
29492   DISCH_TAC;
29493   KILL 19;
29494   (* - *)
29495   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;
29496   REP_BASIC_TAC;
29497   REWRITE_TAC[SUBSET;INTER ];
29498   REP_BASIC_TAC;
29499   TYPE_THEN `?v. (graph_inc G e v /\ D v x)` ASM_CASES_TAC;
29500   REP_BASIC_TAC;
29501   TYPE_THEN `f e x = NC e v x` SUBGOAL_TAC;
29502   FIRST_ASSUM IMATCH_MP_TAC ;
29503   ASM_REWRITE_TAC[];
29504   DISCH_THEN_FULL_REWRITE;
29505   TYPE_THEN `graph_inc G e' v` ASM_CASES_TAC;
29506   TYPE_THEN `f e' x = NC e' v x` SUBGOAL_TAC;
29507   FIRST_ASSUM IMATCH_MP_TAC ;
29508   ASM_REWRITE_TAC[];
29509   DISCH_THEN_FULL_REWRITE;
29510   TYPE_THEN `(NC e v INTER NC e' v = {v})` SUBGOAL_TAC;
29511   FIRST_ASSUM IMATCH_MP_TAC ;
29512   ASM_REWRITE_TAC[];
29513   REWRITE_TAC[FUN_EQ_THM];
29514   REWRITE_TAC[INR IN_SING;INTER];
29515   DISCH_TAC;
29516   TSPEC `x` 28;
29517   REWR 28;
29518   UND 28;
29519   DISCH_THEN_FULL_REWRITE;
29520   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29521   REP_BASIC_TAC;
29522   TYPE_THEN `e` (WITH 28 o ISPEC);
29523   TSPEC `e'` 28;
29524   UND 28;
29525   UND 32;
29526   ASM_REWRITE_TAC[];
29527   DISCH_THEN_FULL_REWRITE;
29528   DISCH_THEN_FULL_REWRITE;
29529   UND 26;
29530   UND 27;
29531   REWRITE_TAC[INTER];
29532   DISCH_THEN_REWRITE;
29533   PROOF_BY_CONTR_TAC;
29534   UND 23;
29535   REWRITE_TAC[];
29536   FIRST_ASSUM IMATCH_MP_TAC ;
29537   TYPE_THEN `v` EXISTS_TAC;
29538   ASM_REWRITE_TAC[];
29539   FIRST_ASSUM IMATCH_MP_TAC ;
29540   TYPE_THEN `e` EXISTS_TAC;
29541   ASM_REWRITE_TAC[];
29542   (* -- *)
29543   TYPE_THEN `(f e x = d e x)` SUBGOAL_TAC;
29544   FIRST_ASSUM IMATCH_MP_TAC ;
29545   ASM_REWRITE_TAC[];
29546   GEN_TAC;
29547   UND 25;
29548   MESON_TAC[];
29549   DISCH_THEN_FULL_REWRITE;
29550   TYPE_THEN `(?v. graph_inc G e' v /\ D v x)` ASM_CASES_TAC;
29551   REP_BASIC_TAC;
29552   PROOF_BY_CONTR_TAC;
29553   TYPE_THEN `d e INTER D v = {}` SUBGOAL_TAC;
29554   FIRST_ASSUM IMATCH_MP_TAC ;
29555   ASM_REWRITE_TAC[];
29556   LEFT 25 "v";
29557   TSPEC `v` 25;
29558   UND 25;
29559   ASM_REWRITE_TAC[];
29560   DISCH_THEN_REWRITE;
29561   FIRST_ASSUM IMATCH_MP_TAC ;
29562   TYPE_THEN `e'` EXISTS_TAC;
29563   ASM_REWRITE_TAC[];
29564   REWRITE_TAC[EMPTY_EXISTS;INTER ];
29565   TYPE_THEN `x` EXISTS_TAC;
29566   ASM_REWRITE_TAC[];
29567   TYPE_THEN `f e' x = d e' x` SUBGOAL_TAC;
29568   FIRST_ASSUM IMATCH_MP_TAC ;
29569   ASM_REWRITE_TAC[];
29570   GEN_TAC;
29571   UND 26;
29572   MESON_TAC[];
29573   DISCH_THEN_FULL_REWRITE;
29574   PROOF_BY_CONTR_TAC;
29575   TYPE_THEN `d e INTER d e' = EMPTY` SUBGOAL_TAC;
29576   FIRST_ASSUM IMATCH_MP_TAC ;
29577   ASM_REWRITE_TAC[];
29578   REWRITE_TAC[EMPTY_EXISTS ;INTER];
29579   TYPE_THEN `x` EXISTS_TAC;
29580   ASM_REWRITE_TAC[];
29581   DISCH_TAC;
29582   (* A injective *)
29583   TYPE_THEN `INJ f (graph_edge G) UNIV` SUBGOAL_TAC;
29584   REWRITE_TAC[INJ];
29585   REP_BASIC_TAC;
29586   TYPE_THEN ` (graph_inc G x ) HAS_SIZE 2` SUBGOAL_TAC;
29587   IMATCH_MP_TAC  graph_edge2;
29588   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29589   ASM_REWRITE_TAC[];
29590   REWRITE_TAC[has_size2];
29591   REP_BASIC_TAC;
29592   TYPE_THEN `graph_inc G x a` SUBGOAL_TAC;
29593   ASM_REWRITE_TAC[in_pair];
29594   DISCH_TAC;
29595   TYPE_THEN `d x SUBSET f x` SUBGOAL_TAC;
29596   KILL 21;
29597   ASM_REWRITE_TAC[];
29598   REWRITE_TAC[SUBSET];
29599   MESON_TAC[];
29600   DISCH_TAC;
29601   TYPE_THEN `d x (short_end x a)` SUBGOAL_TAC;
29602   FIRST_ASSUM IMATCH_MP_TAC ;
29603   ASM_REWRITE_TAC[];
29604   DISCH_TAC;
29605   TYPE_THEN `f x (short_end x a)` SUBGOAL_TAC;
29606   UND 28;
29607   UND 27;
29608   REWRITE_TAC[SUBSET];
29609   MESON_TAC[];
29610   DISCH_TAC;
29611   PROOF_BY_CONTR_TAC;
29612   TYPE_THEN `f x INTER f y SUBSET  x INTER y` SUBGOAL_TAC;
29613   FIRST_ASSUM IMATCH_MP_TAC ;
29614   ASM_REWRITE_TAC[];
29615   DISCH_TAC;
29616   TYPE_THEN `(x INTER y) (short_end x a)` SUBGOAL_TAC;
29617   USE 31 (REWRITE_RULE[SUBSET]);
29618   FIRST_ASSUM IMATCH_MP_TAC ;
29619   USE 21 GSYM;
29620   KILL 16;
29621   ASM_REWRITE_TAC[INTER_IDEMPOT];
29622   TYPE_THEN `(x INTER y) SUBSET (graph_vertex G)` SUBGOAL_TAC;
29623   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29624   REP_BASIC_TAC;
29625   FIRST_ASSUM IMATCH_MP_TAC ;
29626   ASM_REWRITE_TAC[];
29627   REP_BASIC_TAC;
29628   TYPE_THEN `(graph_vertex G (short_end x a))` SUBGOAL_TAC;
29629   USE 33(REWRITE_RULE[SUBSET]);
29630   FIRST_ASSUM IMATCH_MP_TAC ;
29631   ASM_REWRITE_TAC[];
29632   REWRITE_TAC[];
29633   FIRST_ASSUM IMATCH_MP_TAC ;
29634   ASM_REWRITE_TAC[];
29635   DISCH_TAC;
29636   (* B now simple arc -- ugh *)
29637   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;
29638   REP_BASIC_TAC;
29639   TYPE_THEN `f e = (NC e v UNION d e) UNION NC e v'` SUBGOAL_TAC;
29640   ASM_REWRITE_TAC[];
29641   IMATCH_MP_TAC  EQ_EXT;
29642   GEN_TAC;
29643   REWRITE_TAC[UNION];
29644   ONCE_REWRITE_TAC [EQ_SYM_EQ;];
29645   REWRITE_TAC[GSYM DISJ_ASSOC];
29646   EQ_TAC;
29647   REP_CASES_TAC;
29648   DISJ2_TAC;
29649   TYPE_THEN `v` EXISTS_TAC;
29650   ASM_REWRITE_TAC[];
29651   ASM_REWRITE_TAC[];
29652   DISJ2_TAC;
29653   TYPE_THEN `v'` EXISTS_TAC;
29654   ASM_REWRITE_TAC[];
29655   REP_CASES_TAC;
29656   ASM_REWRITE_TAC[];
29657   REP_BASIC_TAC;
29658   TYPE_THEN `graph_inc G e = {v , v'}` SUBGOAL_TAC;
29659   IMATCH_MP_TAC  graph_vertex_exhaust;
29660   ASM_REWRITE_TAC[];
29661   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29662   ASM_REWRITE_TAC[];
29663   DISCH_TAC;
29664   REWR 27;
29665   USE 27 (REWRITE_RULE[in_pair]);
29666   UND 27;
29667   REP_CASES_TAC;
29668   UND 27;
29669   DISCH_THEN_FULL_REWRITE;
29670   ASM_REWRITE_TAC[];
29671   UND 27;
29672   DISCH_THEN_FULL_REWRITE;
29673   ASM_REWRITE_TAC[];
29674   DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN ASSUME_TAC t);
29675   (* -- *)
29676   TYPE_THEN `simple_arc_end (NC e v UNION d e) v (short_end e v')` SUBGOAL_TAC;
29677   IMATCH_MP_TAC  simple_arc_end_trans;
29678   TYPE_THEN `short_end e v` EXISTS_TAC;
29679   CONJ_TAC;
29680   TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
29681   REWR 10;
29682   REP_BASIC_TAC;
29683   ASM_REWRITE_TAC[];
29684   CONJ_TAC;
29685   TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
29686   REWR 5;
29687   REP_BASIC_TAC;
29688   TSPEC `v'` 5;
29689   REWR 5;
29690   (* --- *)
29691   IMATCH_MP_TAC  EQ_EXT;
29692   REWRITE_TAC[INR IN_SING;INTER ];
29693   ONCE_REWRITE_TAC [EQ_SYM_EQ];
29694   GEN_TAC;
29695   EQ_TAC;
29696   DISCH_THEN_FULL_REWRITE;
29697   CONJ_TAC;
29698   TYPE_THEN `simple_arc_end (NC e v) v (short_end e v)` SUBGOAL_TAC;
29699   TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
29700   REWR 10;
29701   REP_BASIC_TAC;
29702   ASM_REWRITE_TAC[];
29703   MESON_TAC[simple_arc_end_end2];
29704   FIRST_ASSUM IMATCH_MP_TAC ;
29705   ASM_REWRITE_TAC[];
29706   (* --- *)
29707   DISCH_TAC;
29708   REP_BASIC_TAC;
29709   TYPE_THEN `D v x` SUBGOAL_TAC;
29710   TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
29711   REWR 10;
29712   REP_BASIC_TAC;
29713   USE 29 (REWRITE_RULE[SUBSET]);
29714   FIRST_ASSUM IMATCH_MP_TAC ;
29715   ASM_REWRITE_TAC[];
29716   DISCH_TAC;
29717   TYPE_THEN `d e INTER D v = {(short_end e v)}` SUBGOAL_TAC;
29718   TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
29719   REWR 5;
29720   REP_BASIC_TAC;
29721   ASM_REWRITE_TAC[];
29722   REWRITE_TAC[eq_sing];
29723   REP_BASIC_TAC;
29724   FIRST_ASSUM IMATCH_MP_TAC ;
29725   REWRITE_TAC[INTER];
29726   ASM_REWRITE_TAC[];
29727   DISCH_TAC;
29728   (* -- *)
29729   IMATCH_MP_TAC  simple_arc_end_trans;
29730   TYPE_THEN `(short_end e v')` EXISTS_TAC;
29731   ASM_REWRITE_TAC[];
29732   CONJ_TAC;
29733   IMATCH_MP_TAC  simple_arc_end_symm;
29734   TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
29735   REWR 10;
29736   REP_BASIC_TAC;
29737   ASM_REWRITE_TAC[];
29738   REWRITE_TAC[INTER];
29739   IMATCH_MP_TAC  EQ_EXT;
29740   REWRITE_TAC[INR IN_SING];
29741   GEN_TAC;
29742   ONCE_REWRITE_TAC [EQ_SYM_EQ];
29743   EQ_TAC;
29744   DISCH_THEN_FULL_REWRITE;
29745   CONJ_TAC;
29746   UND 27;
29747   MESON_TAC[simple_arc_end_end2];
29748   TYPEL_THEN[`e`;`v'`] (USE 10 o ISPECL);
29749   REWR 10;
29750   REP_BASIC_TAC;
29751   UND 29;
29752   MESON_TAC[simple_arc_end_end2];
29753   REP_BASIC_TAC;
29754   UND 29;
29755   REWRITE_TAC[UNION];
29756   REP_CASES_TAC ;
29757   PROOF_BY_CONTR_TAC;
29758   TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
29759   FIRST_ASSUM IMATCH_MP_TAC ;
29760   ASM_REWRITE_TAC[];
29761   CONJ_TAC;
29762   FIRST_ASSUM IMATCH_MP_TAC ;
29763   TYPE_THEN `e` EXISTS_TAC;
29764   ASM_REWRITE_TAC[];
29765   FIRST_ASSUM IMATCH_MP_TAC ;
29766   TYPE_THEN `e` EXISTS_TAC;
29767   ASM_REWRITE_TAC[];
29768   REWRITE_TAC[EMPTY_EXISTS;INTER];
29769   TYPE_THEN `x` EXISTS_TAC;
29770   CONJ_TAC;
29771   TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
29772   REWR 10;
29773   REP_BASIC_TAC;
29774   USE 31 (REWRITE_RULE[SUBSET]);
29775   FIRST_ASSUM IMATCH_MP_TAC ;
29776   ASM_REWRITE_TAC[];
29777   TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
29778   REWR 10;
29779   REP_BASIC_TAC;
29780   USE 31 (REWRITE_RULE[SUBSET]);
29781   FIRST_ASSUM IMATCH_MP_TAC ;
29782   ASM_REWRITE_TAC[];
29783   TYPE_THEN `D v' x` SUBGOAL_TAC;
29784   TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
29785   REWR 10;
29786   REP_BASIC_TAC;
29787   USE 30 (REWRITE_RULE[SUBSET]);
29788   FIRST_ASSUM IMATCH_MP_TAC ;
29789   ASM_REWRITE_TAC[];
29790   DISCH_TAC;
29791   TYPE_THEN `d e INTER D v' = {(short_end e v')}` SUBGOAL_TAC;
29792   TYPEL_THEN [`e`;`v'`] (USE 5 o ISPECL);
29793   REWR 5;
29794   REP_BASIC_TAC;
29795   ASM_REWRITE_TAC[];
29796   REWRITE_TAC[INTER;eq_sing];
29797   REP_BASIC_TAC;
29798   FIRST_ASSUM IMATCH_MP_TAC ;
29799   ASM_REWRITE_TAC[];
29800   DISCH_TAC;
29801   (* C - *)
29802   TYPE_THEN `!e v. (graph_edge G e) ==> ( e INTER graph_vertex G = (f e) INTER (graph_vertex G))` SUBGOAL_TAC;
29803   REP_BASIC_TAC;
29804   IMATCH_MP_TAC  EQ_EXT;
29805   REWRITE_TAC[INTER];
29806   GEN_TAC;
29807   IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`);
29808   DISCH_TAC;
29809   TYPE_THEN `D x x` SUBGOAL_TAC;
29810   FIRST_ASSUM IMATCH_MP_TAC ;
29811   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]);
29812   REP_BASIC_TAC;
29813   FIRST_ASSUM IMATCH_MP_TAC ;
29814   ASM_REWRITE_TAC[];
29815   DISCH_TAC;
29816   TYPE_THEN `graph_inc G e x` ASM_CASES_TAC;
29817   TYPE_THEN `f e x = NC e x x` SUBGOAL_TAC;
29818   FIRST_ASSUM IMATCH_MP_TAC ;
29819   ASM_REWRITE_TAC[];
29820   DISCH_THEN_REWRITE;
29821   TYPE_THEN `NC e x x` SUBGOAL_TAC;
29822   TYPEL_THEN[`e`;`x`] (USE 10 o ISPECL);
29823   REWR 10;
29824   REP_BASIC_TAC;
29825   UND 28;
29826   MESON_TAC[simple_arc_end_end];
29827   DISCH_THEN_REWRITE;
29828   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29829   REP_BASIC_TAC;
29830   TSPEC `e` 27;
29831   REWR 27;
29832   REWR 26;
29833   UND 26;
29834   REWRITE_TAC[INTER];
29835   DISCH_THEN_REWRITE;
29836   TYPE_THEN `~f e x` SUBGOAL_TAC;
29837   FIRST_ASSUM IMATCH_MP_TAC ;
29838   TYPE_THEN `x` EXISTS_TAC;
29839   ASM_REWRITE_TAC[];
29840   DISCH_THEN_REWRITE;
29841   DISCH_TAC;
29842   UND 26;
29843   REWRITE_TAC[];
29844   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
29845   REP_BASIC_TAC;
29846   TSPEC `e` 26;
29847   REWR 26;
29848   ASM_REWRITE_TAC[INTER];
29849   DISCH_TAC;
29850   (* D start on graph and goal *)
29851   TYPE_THEN `r /(&2)` EXISTS_TAC;
29852   TYPE_THEN `graph_edge_mod G f` EXISTS_TAC;
29853   REWRITE_TAC[good_plane_graph];
29854   ASM_REWRITE_TAC[REAL_LT_HALF1];
29855   CONJ_TAC;
29856   IMATCH_MP_TAC  graph_edge_iso;
29857   ASM_REWRITE_TAC[];
29858   REWRITE_TAC[TAUT `(A /\ B) /\ C <=> (A /\ (B /\ C))`];
29859   (* - *)
29860   CONJ_TAC;
29861   IMATCH_MP_TAC  plane_graph_mod;
29862   USE 16 GSYM;
29863   ASM_REWRITE_TAC[];
29864   REP_BASIC_TAC;
29865   IMATCH_MP_TAC  simple_arc_end_simple;
29866   TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
29867   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);  (* --x-- *)
29868   ASM_REWRITE_TAC[];
29869   REP_BASIC_TAC;
29870   TYPE_THEN `v` EXISTS_TAC;
29871   TYPE_THEN `v'` EXISTS_TAC;
29872   FIRST_ASSUM IMATCH_MP_TAC ;
29873   ASM_REWRITE_TAC[];
29874   (* - *)
29875   CONJ_TAC;
29876   REP_BASIC_TAC;
29877   RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i]);
29878   REP_BASIC_TAC;
29879   USE 29 GSYM;
29880   UND 29;
29881   DISCH_THEN_FULL_REWRITE;
29882   TYPE_THEN `e'' =e'` SUBGOAL_TAC;
29883   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
29884   REP_BASIC_TAC;
29885   FIRST_ASSUM IMATCH_MP_TAC ;
29886   ASM_REWRITE_TAC[];
29887   DISCH_THEN_FULL_REWRITE;
29888   FIRST_ASSUM IMATCH_MP_TAC ;
29889   ASM_REWRITE_TAC[];
29890   (* - *)
29891   TYPE_THEN `!v. closed_ball (euclid 2, d_euclid) v (r/(&2)) SUBSET D v` SUBGOAL_TAC;
29892   GEN_TAC;
29893   EXPAND_TAC "D";
29894   REWRITE_TAC[closed_ball;SUBSET];
29895   TYPE_THEN `r /(&2) < r` SUBGOAL_TAC;
29896   UND 1;
29897   MESON_TAC[  half_pos];
29898   MESON_TAC[REAL_ARITH `x <= u /\ u < v ==> x <= v`];
29899   DISCH_TAC;
29900   (* - *)
29901   CONJ_TAC;
29902   REP_BASIC_TAC;
29903   IMATCH_MP_TAC  SUBSET_ANTISYM;
29904   CONJ_TAC;
29905   IMATCH_MP_TAC  SUBSET_TRANS;
29906   TYPE_THEN `D v INTER D v'` EXISTS_TAC;
29907   CONJ_TAC;
29908   IMATCH_MP_TAC  subset_inter_pair;
29909   ASM_REWRITE_TAC[];
29910   RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v]);
29911   TYPE_THEN `(D v INTER D v' = EMPTY)` SUBGOAL_TAC;
29912   FIRST_ASSUM IMATCH_MP_TAC ;
29913   ASM_REWRITE_TAC[];
29914   DISCH_THEN_REWRITE;
29915   REWRITE_TAC[];
29916   (* E - down to 2 *)
29917   CONJ_TAC;
29918   REP_BASIC_TAC;
29919   RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v;graph_edge_mod_i;graph_edge_mod_e]);
29920   USE 27 (REWRITE_RULE[IMAGE]);
29921   REP_BASIC_TAC;
29922   UND 27;
29923   DISCH_THEN_FULL_REWRITE;
29924   LEFT 25 "e'";
29925   TSPEC `x` 25;
29926   PROOF_BY_CONTR_TAC;
29927   USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER]);
29928   REP_BASIC_TAC;
29929   TYPE_THEN `D v u` SUBGOAL_TAC;
29930   USE 24 (REWRITE_RULE[SUBSET]);
29931   FIRST_ASSUM IMATCH_MP_TAC ;
29932   ASM_REWRITE_TAC[];
29933   DISCH_TAC;
29934   TYPE_THEN `~f x u` SUBGOAL_TAC;
29935   FIRST_ASSUM IMATCH_MP_TAC ;
29936   TYPE_THEN `v` EXISTS_TAC;
29937   ASM_REWRITE_TAC[];
29938   UND 25;
29939   ASM_REWRITE_TAC[];
29940   ASM_REWRITE_TAC[];
29941   (* - final *)
29942   REP_BASIC_TAC;
29943   RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_i;graph_edge_mod_e]);
29944   USE 26 (REWRITE_RULE[IMAGE]);
29945   REP_BASIC_TAC;
29946   UND 28;
29947   DISCH_THEN_FULL_REWRITE;
29948   TYPE_THEN `e' = x` SUBGOAL_TAC;
29949   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
29950   REP_BASIC_TAC;
29951   FIRST_ASSUM IMATCH_MP_TAC ;
29952   ASM_REWRITE_TAC[];
29953   DISCH_THEN_FULL_REWRITE;
29954   (* - *)
29955   TYPE_THEN `f x INTER D v = NC x v INTER D v` SUBGOAL_TAC;
29956   IMATCH_MP_TAC  EQ_EXT;
29957   GEN_TAC;
29958   REWRITE_TAC[INTER];
29959   IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`);
29960   DISCH_TAC;
29961   FIRST_ASSUM IMATCH_MP_TAC ;
29962   ASM_REWRITE_TAC[];
29963   DISCH_TAC;
29964   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;
29965   IMATCH_MP_TAC  EQ_EXT;
29966   GEN_TAC;
29967   REWRITE_TAC[INTER];
29968   USE 28 (REWRITE_RULE[FUN_EQ_THM]);
29969   TSPEC `x'` 28;
29970   UND 28;
29971   UND 24;
29972   REWRITE_TAC[SUBSET;INTER];
29973   MESON_TAC[];
29974   DISCH_THEN_REWRITE;
29975   TYPEL_THEN[`x`;`v`] (USE 10 o ISPECL);
29976   REWR 10;
29977   REP_BASIC_TAC;
29978   UND 10;
29979   EXPAND_TAC "hyper";
29980   DISCH_THEN_REWRITE;
29981   (* Sat Aug 21 14:12:41 EDT 2004 *)
29982
29983   ]);;
29984
29985   (* }}} *)
29986
29987 let hv_finite = jordan_def `hv_finite C <=>
29988    (?E. C SUBSET UNIONS E /\ FINITE E /\ hv_line E)`;;
29989
29990 let hv_finite_subset = prove_by_refinement(
29991   `!A B. hv_finite B /\ A SUBSET B ==> hv_finite A`,
29992   (* {{{ proof *)
29993   [
29994   REWRITE_TAC[hv_finite];
29995   REP_BASIC_TAC;
29996   TYPE_THEN `E` EXISTS_TAC;
29997   ASM_REWRITE_TAC[];
29998   IMATCH_MP_TAC  SUBSET_TRANS;
29999   TYPE_THEN `B` EXISTS_TAC;
30000   ASM_REWRITE_TAC[];
30001   ]);;
30002   (* }}} *)
30003
30004 let mk_line_hyper2_e1 = prove_by_refinement(
30005   `!z. mk_line (point (z, &0)) (point(z, &1)) = hyperplane 2 e1 z`,
30006   (* {{{ proof *)
30007   [
30008   REWRITE_TAC[GSYM line2D_F;e1;mk_line;];
30009   GEN_TAC;
30010   IMATCH_MP_TAC  EQ_EXT;
30011   REWRITE_TAC[point_scale;point_add];
30012   GEN_TAC;
30013   REDUCE_TAC;
30014   TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC;
30015   GEN_TAC;
30016   real_poly_tac;
30017   DISCH_THEN_REWRITE;
30018   EQ_TAC;
30019   REP_BASIC_TAC;
30020   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
30021   TYPE_THEN `(z, &1 - t)` EXISTS_TAC;
30022   REWRITE_TAC[];
30023   REP_BASIC_TAC;
30024   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
30025   TYPE_THEN `&1 - (SND p)` EXISTS_TAC;
30026   REAL_ARITH_TAC;
30027   ]);;
30028   (* }}} *)
30029
30030 let mk_line_hyper2_e2 = prove_by_refinement(
30031   `!z. mk_line (point (&0, z)) (point(&1, z)) = hyperplane 2 e2 z`,
30032   (* {{{ proof *)
30033   [
30034   REWRITE_TAC[GSYM line2D_S;e2;mk_line;];
30035   GEN_TAC;
30036   IMATCH_MP_TAC  EQ_EXT;
30037   REWRITE_TAC[point_scale;point_add];
30038   GEN_TAC;
30039   REDUCE_TAC;
30040   TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC;
30041   GEN_TAC;
30042   real_poly_tac;
30043   DISCH_THEN_REWRITE;
30044   EQ_TAC;
30045   REP_BASIC_TAC;
30046   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
30047   TYPE_THEN `( &1 - t, z)` EXISTS_TAC;
30048   REWRITE_TAC[];
30049   REP_BASIC_TAC;
30050   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
30051   TYPE_THEN `&1 - (FST  p)` EXISTS_TAC;
30052   REAL_ARITH_TAC;
30053   ]);;
30054   (* }}} *)
30055
30056 let hv_finite_hyper = prove_by_refinement(
30057   `!C.
30058   (?v. C SUBSET (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))) ==>
30059    (hv_finite C)`,
30060   (* {{{ proof *)
30061   [
30062   REP_BASIC_TAC;
30063   REWRITE_TAC[hv_finite];
30064   TYPE_THEN `{(hyperplane 2 e2 (v 1)), (hyperplane 2 e1 (v 0))}` EXISTS_TAC ;
30065   ASM_REWRITE_TAC[UNIONS_2;FINITE_INSERT;FINITE_SING;FINITE_RULES; ];
30066   REWRITE_TAC[hv_line;in_pair;GSYM mk_line_hyper2_e2;GSYM mk_line_hyper2_e1];
30067   GEN_TAC;
30068   REP_CASES_TAC;
30069   ASM_REWRITE_TAC[];
30070   TYPE_THEN `(v 0, &0)` EXISTS_TAC;
30071   TYPE_THEN `(v 0, &1)` EXISTS_TAC;
30072   REWRITE_TAC[];
30073   ASM_REWRITE_TAC[];
30074   TYPE_THEN `(&0, v 1)` EXISTS_TAC;
30075   TYPE_THEN `(&1, v 1)` EXISTS_TAC;
30076   REWRITE_TAC[];
30077   ]);;
30078
30079    (* }}} *)
30080
30081 let graph_hv_finite_radius = jordan_def
30082   `graph_hv_finite_radius G r <=> (good_plane_graph G /\
30083       (&0 < r) /\
30084       (!v v'.
30085          graph_vertex G v /\ graph_vertex G v' /\ ~(v = v')
30086          ==> (closed_ball (euclid 2,d_euclid) v r INTER
30087                 closed_ball (euclid 2,d_euclid) v' r =
30088                 {})) /\
30089       (!e v.
30090          graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v
30091          ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\
30092       (!e v.
30093          graph_edge G e /\  graph_inc G e v
30094          ==> (hv_finite (e INTER closed_ball (euclid 2, d_euclid) v r))))
30095     `;;
30096
30097 let p_conn_hv_finite = prove_by_refinement(
30098   `!A x y. ~(x = y) ==>
30099      (p_conn A x y <=> (?C. (hv_finite C) /\ (C SUBSET A) /\
30100     (simple_arc_end C x y)))`,
30101   (* {{{ proof *)
30102
30103   [
30104   REP_BASIC_TAC;
30105   REWRITE_TAC[p_conn;simple_polygonal_arc];
30106   (* - *)
30107   EQ_TAC;
30108   REP_BASIC_TAC;
30109   TH_INTRO_TAC [`C`;`x`;`y`] simple_arc_end_select;
30110   ASM_REWRITE_TAC[top2];
30111   REP_BASIC_TAC;
30112   TYPE_THEN `C'` EXISTS_TAC;
30113   REWRITE_TAC[hv_finite];
30114   CONJ_TAC;
30115   TYPE_THEN `E` EXISTS_TAC;
30116   ASM_REWRITE_TAC[];
30117   IMATCH_MP_TAC  SUBSET_TRANS;
30118   TYPE_THEN `C` EXISTS_TAC;
30119   ASM_REWRITE_TAC[];
30120   CONJ_TAC;
30121   IMATCH_MP_TAC  SUBSET_TRANS;
30122   TYPE_THEN `C` EXISTS_TAC;
30123   ASM_REWRITE_TAC[];
30124   ASM_REWRITE_TAC[];
30125   REP_BASIC_TAC;
30126   RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]);
30127   REP_BASIC_TAC;
30128   TYPE_THEN `C` EXISTS_TAC;
30129   CONJ_TAC;
30130   CONJ_TAC;
30131   REWRITE_TAC[GSYM top2];
30132   IMATCH_MP_TAC  simple_arc_end_simple;
30133   ASM_MESON_TAC[];
30134   ASM_MESON_TAC[];
30135   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
30136   ]);;
30137
30138   (* }}} *)
30139
30140
30141 let graph_iso_around = prove_by_refinement(
30142   `!(G:(A,B)graph_t) (H:(A',B')graph_t) f v. (graph G) /\
30143      graph_iso f G H /\ (graph_vertex G v) ==>
30144         (graph_edge_around H (FST  f v) =
30145             (IMAGE (SND f) (graph_edge_around G v)))`,
30146   (* {{{ proof *)
30147   [
30148   REWRITE_TAC[graph_iso;graph_edge_around];
30149   REP_BASIC_TAC;
30150   IMATCH_MP_TAC  EQ_EXT;
30151   REP_BASIC_TAC;
30152   REWRITE_TAC[];
30153   EQ_TAC ;
30154   REP_BASIC_TAC;
30155   TYPE_THEN `(?y. graph_edge G y /\ (v' y = x))` SUBGOAL_TAC;
30156   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
30157   REP_BASIC_TAC;
30158   FIRST_ASSUM IMATCH_MP_TAC ;
30159   ASM_REWRITE_TAC[];
30160   REP_BASIC_TAC;
30161   USE 8 GSYM;
30162   UND 8;
30163   DISCH_THEN_FULL_REWRITE;
30164   TSPEC `y` 1;
30165   REWR 1;
30166   REWRITE_TAC[IMAGE];
30167   TYPE_THEN `y` EXISTS_TAC;
30168   ASM_REWRITE_TAC[];
30169   REWR 6;
30170   USE 6 (REWRITE_RULE[IMAGE]);
30171   REP_BASIC_TAC;
30172   TYPE_THEN `v = x'` SUBGOAL_TAC;
30173   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
30174   REP_BASIC_TAC;
30175   FIRST_ASSUM IMATCH_MP_TAC ;
30176   ASM_REWRITE_TAC[];
30177   TH_INTRO_TAC [`G`;`y`] graph_inc_subset;
30178   ASM_REWRITE_TAC[];
30179   REWRITE_TAC[SUBSET];
30180   DISCH_THEN IMATCH_MP_TAC  ;
30181   ASM_REWRITE_TAC[];
30182   DISCH_THEN_FULL_REWRITE;
30183   ASM_REWRITE_TAC[];
30184   REWRITE_TAC[IMAGE];
30185   REP_BASIC_TAC;
30186   REWR 6;
30187   UND 6;
30188   DISCH_THEN_FULL_REWRITE;
30189   SUBCONJ_TAC;
30190   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
30191   ASM_MESON_TAC[];
30192   DISCH_TAC;
30193   ASM_SIMP_TAC[];
30194   REWRITE_TAC[IMAGE];
30195   REP_BASIC_TAC;
30196   TYPE_THEN `v` EXISTS_TAC;
30197   ASM_REWRITE_TAC[];
30198   (* Sat Aug 21 16:49:58 EDT 2004 *)
30199
30200   ]);;
30201   (* }}} *)
30202
30203 let graph_radius_exists = prove_by_refinement(
30204   `!G. planar_graph (G:(A,B) graph_t) /\
30205       FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
30206       ~(graph_edge G = EMPTY) /\
30207      (!v. (CARD (graph_edge_around G v) <=| 4)) ==>
30208    (?r H.
30209        (graph_isomorphic G H /\ graph_hv_finite_radius H r))`,
30210   (* {{{ proof *)
30211   [
30212   REP_BASIC_TAC;
30213   RULE_ASSUM_TAC (REWRITE_RULE[planar_graph]);
30214   REP_BASIC_TAC;
30215   TYPE_THEN `FINITE (graph_edge H) /\ FINITE (graph_vertex H) /\ ~(graph_edge H = EMPTY) /\  (!v. (CARD (graph_edge_around H v) <=| 4))` SUBGOAL_TAC;
30216   WITH 4 (REWRITE_RULE[graph_isomorphic]);
30217   REP_BASIC_TAC;
30218   SUBCONJ_TAC;
30219   RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
30220   REP_BASIC_TAC;
30221   TH_INTRO_TAC [`graph_edge H`;`graph_edge G`;`v`] FINITE_BIJ2;
30222   ASM_REWRITE_TAC[];
30223   DISCH_THEN_REWRITE;
30224   DISCH_TAC;
30225   (* -- *)
30226   CONJ_TAC;
30227   RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
30228   REP_BASIC_TAC;
30229   TH_INTRO_TAC [`graph_vertex H`;`graph_vertex G`;`u`] FINITE_BIJ2;
30230   ASM_REWRITE_TAC[];
30231   DISCH_THEN_REWRITE;
30232   CONJ_TAC;
30233   REWRITE_TAC[EMPTY_EXISTS];
30234   RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
30235   REP_BASIC_TAC;
30236    RULE_ASSUM_TAC (REWRITE_RULE[graph_iso;BIJ;SURJ]);
30237   REP_BASIC_TAC;
30238   ASM_MESON_TAC[];
30239   GEN_TAC;
30240   (* -- *)
30241   TYPE_THEN `graph_vertex H v` ASM_CASES_TAC;
30242   TH_INTRO_TAC [`H`;`G`;`f`;`v`] graph_iso_around;
30243   ASM_REWRITE_TAC[];
30244   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
30245   ASM_REWRITE_TAC[];
30246   DISCH_TAC;
30247   RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
30248   REP_BASIC_TAC;
30249   UND 12;
30250   DISCH_THEN_FULL_REWRITE;
30251   TSPEC `u v` 0;
30252   REWR 0;
30253   TH_INTRO_TAC [`v'`;`graph_edge_around H v`] CARD_IMAGE_INJ;
30254   REWRITE_TAC[];
30255   CONJ_TAC;
30256   REP_BASIC_TAC;
30257   RULE_ASSUM_TAC (REWRITE_RULE[INJ;BIJ]);
30258   REP_BASIC_TAC;
30259   FIRST_ASSUM IMATCH_MP_TAC ;
30260   ASM_REWRITE_TAC[];
30261   RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_around]);
30262   ASM_REWRITE_TAC[];
30263   IMATCH_MP_TAC  FINITE_SUBSET;
30264   TYPE_THEN `graph_edge H` EXISTS_TAC ;
30265   ASM_REWRITE_TAC[SUBSET;graph_edge_around];
30266   MESON_TAC[];
30267   DISCH_THEN_FULL_REWRITE;
30268   ASM_REWRITE_TAC[];
30269   TH_INTRO_TAC [`H`;`v`] graph_edge_around_empty;
30270   ASM_REWRITE_TAC[];
30271   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
30272   ASM_REWRITE_TAC[];
30273   DISCH_THEN_REWRITE;
30274   REWRITE_TAC[CARD_CLAUSES];
30275   ARITH_TAC;
30276   REP_BASIC_TAC;
30277   (* - *)
30278   TH_INTRO_TAC [`H`] graph_disk_hv;
30279   REP_BASIC_TAC;
30280   ASM_REWRITE_TAC[];
30281   REP_BASIC_TAC;
30282   TYPE_THEN `r` EXISTS_TAC;
30283   TYPE_THEN `H'` EXISTS_TAC;
30284   REWRITE_TAC[graph_hv_finite_radius];
30285   ASM_REWRITE_TAC[];
30286   CONJ_TAC;
30287   TH_INTRO_TAC [`G`;`H`;`H'`] graph_isomorphic_trans;
30288   ASM_REWRITE_TAC[];
30289   IMATCH_MP_TAC  graph_isomorphic_symm;
30290   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
30291   ASM_REWRITE_TAC[];
30292   DISCH_THEN_REWRITE;
30293   (* - *)
30294   REP_BASIC_TAC;
30295   TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
30296   REWR 10;
30297   IMATCH_MP_TAC  hv_finite_hyper;
30298   TYPE_THEN `v` EXISTS_TAC;
30299   ASM_REWRITE_TAC[];
30300   (* Sat Aug 21 17:28:09 EDT 2004 *)
30301
30302   ]);;
30303   (* }}} *)
30304
30305 let replace = jordan_def `replace (x:A) y =
30306     (\ z. (if (z  = x) then y else z))`;;
30307
30308 let replace_x = prove_by_refinement(
30309   `!(x:A) y. replace x y x = y`,
30310   (* {{{ proof *)
30311   [
30312   REWRITE_TAC[replace];
30313   (* Sun Aug 22 09:01:27 EDT 2004 *)
30314
30315   ]);;
30316   (* }}} *)
30317
30318 let graph_replace = jordan_def
30319    `graph_replace (G:(A,B)graph_t) e e' =
30320      graph_edge_mod G (replace e e')`;;
30321
30322 let replace_inj = prove_by_refinement(
30323   `!(x:A) y Z. ~(Z y) ==> INJ (replace x y) Z UNIV`,
30324   (* {{{ proof *)
30325   [
30326   REWRITE_TAC[INJ;replace];
30327   REP_BASIC_TAC;
30328   MP_TAC (TAUT  `((x' = (x:A)) \/ ~(x' = x)) /\ ((y' = x) \/ ~(y' = x))`);
30329   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
30330   REP_CASES_TAC THEN (REWR 0);
30331   ASM_MESON_TAC[];
30332   ASM_MESON_TAC[];
30333   ]);;
30334   (* }}} *)
30335
30336 let graph_replace_iso = prove_by_refinement(
30337   `!(G:(A,B)graph_t) e e'.
30338       ~(graph_edge G e') ==> graph_isomorphic G (graph_replace G e e')`,
30339   (* {{{ proof *)
30340   [
30341   REWRITE_TAC[graph_replace];
30342   REP_BASIC_TAC;
30343   IMATCH_MP_TAC  graph_edge_iso;
30344   IMATCH_MP_TAC  replace_inj;
30345   ASM_REWRITE_TAC[];
30346   (* Sun Aug 22 09:30:14 EDT 2004 *)
30347
30348   ]);;
30349   (* }}} *)
30350
30351 let graph_replace_plane = prove_by_refinement(
30352   `!G e e'. plane_graph G /\ ~(graph_edge G e') /\
30353       (graph_edge G e) /\
30354       (!e''. graph_edge G e'' /\ ~(e'' = e) ==>
30355            (e' INTER e'' SUBSET  e INTER e'')) /\
30356       (simple_arc top2 e') /\
30357       (e INTER graph_vertex G = e' INTER graph_vertex G) ==>
30358       plane_graph (graph_replace G e e')`,
30359   (* {{{ proof *)
30360   [
30361   REP_BASIC_TAC;
30362   REWRITE_TAC[graph_replace];
30363   IMATCH_MP_TAC  plane_graph_mod;
30364   ASM_REWRITE_TAC[];
30365   (* - *)
30366   CONJ_TAC;
30367   IMATCH_MP_TAC  replace_inj;
30368   ASM_REWRITE_TAC[];
30369   (* - *)
30370   CONJ_TAC;
30371   REP_BASIC_TAC;
30372   REWRITE_TAC[replace];
30373   TYPE_THEN `((e'' = e) \/ ~(e'' = e)) /\ ((e''' = e) \/ ~(e''' = e))` (fun t-> MP_TAC (TAUT t));
30374   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
30375   REP_CASES_TAC THEN (FIRST_ASSUM (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN (ASSUME_TAC t)));
30376   ASM_MESON_TAC[];
30377   FIRST_ASSUM IMATCH_MP_TAC ;
30378   ASM_REWRITE_TAC[];
30379   ONCE_REWRITE_TAC [INTER_COMM];
30380   FIRST_ASSUM IMATCH_MP_TAC ;
30381   ASM_REWRITE_TAC[];
30382   REWRITE_TAC[SUBSET_REFL];
30383   (* - *)
30384   CONJ_TAC;
30385   REP_BASIC_TAC;
30386   REWRITE_TAC[replace];
30387   COND_CASES_TAC;
30388   ASM_REWRITE_TAC[];
30389   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]);
30390   REP_BASIC_TAC;
30391   FIRST_ASSUM IMATCH_MP_TAC ;
30392   ASM_REWRITE_TAC[];
30393   (* - *)
30394   REP_BASIC_TAC;
30395   REWRITE_TAC[replace];
30396   COND_CASES_TAC;
30397   ASM_REWRITE_TAC[];
30398   REWRITE_TAC[];
30399   (* Sun Aug 22 10:28:15 EDT 2004 *)
30400
30401   ]);;
30402   (* }}} *)
30403
30404 let good_replace = prove_by_refinement(
30405   `!G e e'. (good_plane_graph G) /\ plane_graph (graph_replace G e e') /\
30406       ~(graph_edge G e') /\
30407    ( e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\
30408       (!v v'. (graph_vertex G v) /\ (graph_vertex G v') /\
30409             ~(v = v') /\ e' v /\  e' v' ==> simple_arc_end e' v v')
30410     ==> (good_plane_graph (graph_replace G e e'))`,
30411   (* {{{ proof *)
30412   [
30413   REWRITE_TAC[good_plane_graph;graph_replace];
30414   REP_BASIC_TAC;
30415   ASM_REWRITE_TAC[];
30416   REP_BASIC_TAC;
30417   RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i ;IMAGE ]);
30418   REP_BASIC_TAC;
30419   UND 6;
30420   DISCH_THEN_FULL_REWRITE;
30421   TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj;
30422   ASM_REWRITE_TAC[];
30423   DISCH_TAC;
30424   (* - *)
30425   TYPE_THEN `e'''' = x` SUBGOAL_TAC;
30426   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
30427   REP_BASIC_TAC;
30428   FIRST_ASSUM IMATCH_MP_TAC ;
30429   ASM_REWRITE_TAC[];
30430   DISCH_THEN_FULL_REWRITE;
30431   TYPE_THEN `e''' = x` SUBGOAL_TAC;
30432   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
30433   REP_BASIC_TAC;
30434   FIRST_ASSUM IMATCH_MP_TAC ;
30435   ASM_REWRITE_TAC[];
30436   DISCH_THEN_FULL_REWRITE;
30437   (* - *)
30438   REWRITE_TAC[replace];
30439   COND_CASES_TAC;
30440   FIRST_ASSUM IMATCH_MP_TAC ;
30441   ASM_REWRITE_TAC[];
30442   UNDF `x`;
30443   DISCH_THEN_FULL_REWRITE;
30444   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
30445   REP_BASIC_TAC;
30446   TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC;
30447   FIRST_ASSUM IMATCH_MP_TAC ;
30448   ASM_REWRITE_TAC[];
30449   DISCH_THEN_FULL_REWRITE;
30450   UNDF `e INTER u = e' INTER u`;
30451   DISCH_THEN_FULL_REWRITE;
30452   RULE_ASSUM_TAC (REWRITE_RULE[INTER;]);
30453   ASM_REWRITE_TAC[];
30454   (* - *)
30455   KILL 0;
30456   FIRST_ASSUM IMATCH_MP_TAC ;
30457   ASM_REWRITE_TAC[];
30458   (* Sun Aug 22 10:59:34 EDT 2004 *)
30459
30460   ]);;
30461   (* }}} *)
30462
30463 let graph_replace_hv_finite_radius = prove_by_refinement(
30464   `!G r e e'. graph_hv_finite_radius G r /\ ~(graph_edge G e') /\
30465      good_plane_graph (graph_replace G e e') /\
30466     (e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\
30467     (!v. graph_vertex G v /\ ~(e' v) ==>
30468         ((e' INTER closed_ball (euclid 2,d_euclid) v r = {}))) /\
30469     (hv_finite e')
30470     ==> graph_hv_finite_radius (graph_replace G e e') r`,
30471   (* {{{ proof *)
30472   [
30473   REWRITE_TAC[graph_hv_finite_radius];
30474   REP_BASIC_TAC;
30475   ASM_REWRITE_TAC[];
30476   (* - *)
30477   CONJ_TAC;
30478   REP_BASIC_TAC;
30479   UND 7;
30480   DISCH_THEN IMATCH_MP_TAC ;
30481   ASM_REWRITE_TAC[];
30482   RULE_ASSUM_TAC (REWRITE_RULE[graph_replace ;graph_edge_mod_v]);
30483   ASM_REWRITE_TAC[];
30484   (* - *)
30485   CONJ_TAC;
30486   REP_BASIC_TAC;
30487   RULE_ASSUM_TAC (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]);
30488   REP_BASIC_TAC;
30489   UNDF `e''`;
30490   DISCH_THEN_FULL_REWRITE;
30491   REWRITE_TAC[replace];
30492   COND_CASES_TAC;
30493   FIRST_ASSUM IMATCH_MP_TAC ;
30494   ASM_REWRITE_TAC[];
30495   REWR 13;
30496   DISCH_TAC;
30497   LEFT 10 "e'''";
30498   TSPEC `e` 10;
30499   UND 10;
30500   ASM_REWRITE_TAC[];
30501   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
30502   REP_BASIC_TAC;
30503   TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC;
30504   FIRST_ASSUM IMATCH_MP_TAC ;
30505   ASM_REWRITE_TAC[];
30506   DISCH_THEN_FULL_REWRITE;
30507   ASM_REWRITE_TAC[INTER];
30508   KILL 1;
30509   FIRST_ASSUM IMATCH_MP_TAC ;
30510   ASM_REWRITE_TAC[];
30511   LEFT 10 "e'''";
30512   TSPEC `x` 1;
30513   REWR 1;
30514   (* - *)
30515   REP_BASIC_TAC;
30516   RULE_ASSUM_TAC  (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]);
30517   REP_BASIC_TAC;
30518   UNDF `e''`;
30519   DISCH_THEN_FULL_REWRITE;
30520   TYPE_THEN `e''' = x` SUBGOAL_TAC;
30521   TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj;
30522   ASM_REWRITE_TAC[];
30523   REWRITE_TAC[INJ];
30524   REP_BASIC_TAC;
30525   FIRST_ASSUM IMATCH_MP_TAC ;
30526   ASM_REWRITE_TAC[];
30527   DISCH_THEN_FULL_REWRITE;
30528   (* - *)
30529   REWRITE_TAC[replace];
30530   COND_CASES_TAC ;
30531   UNDF `x`;
30532   DISCH_THEN_FULL_REWRITE;
30533   IMATCH_MP_TAC  hv_finite_subset;
30534   TYPE_THEN `e'` EXISTS_TAC;
30535   ASM_REWRITE_TAC[INTER;SUBSET;];
30536   MESON_TAC[];
30537   FIRST_ASSUM IMATCH_MP_TAC ;
30538   ASM_REWRITE_TAC[];
30539   (* Sun Aug 22 12:09:03 EDT 2004 *)
30540
30541   ]);;
30542   (* }}} *)
30543
30544 let card_suc_insert = prove_by_refinement(
30545   `!(x:A) s. FINITE s /\ (~(s x)) ==> (SUC (CARD s) = CARD(x INSERT s))`,
30546   (* {{{ proof *)
30547   [
30548   REP_BASIC_TAC;
30549   ASM_SIMP_TAC [CARD_CLAUSES];
30550   ]);;
30551   (* }}} *)
30552
30553 let graph_replace_card = prove_by_refinement(
30554   `!G e e'.
30555     (FINITE (graph_edge (G:(A,(num->real)->bool)graph_t))) /\
30556       (graph_edge G e) /\ ~(graph_edge G e') /\
30557      ~(hv_finite e) /\ (hv_finite e') ==>
30558    (CARD {x | graph_edge (graph_replace G e e') x /\ ~(hv_finite x)} <
30559       CARD{ x | graph_edge G x /\ ~hv_finite x})
30560                                                 `,
30561   (* {{{ proof *)
30562   [
30563   REP_BASIC_TAC;
30564   IMATCH_MP_TAC  (ARITH_RULE `(SUC x = y) ==> (x <| y)`);
30565   (* - *)
30566   TYPE_THEN `FINITE (graph_edge (graph_replace G e e'))` SUBGOAL_TAC;
30567   REWRITE_TAC[graph_edge_mod_e;graph_replace];
30568   IMATCH_MP_TAC  FINITE_IMAGE;
30569   ASM_REWRITE_TAC[];
30570   DISCH_TAC;
30571   (* - *)
30572   TYPE_THEN `A = {x | graph_edge (graph_replace G e e') x /\ ~hv_finite x}` ABBREV_TAC ;
30573   TYPE_THEN `FINITE A` SUBGOAL_TAC;
30574   EXPAND_TAC "A";
30575   IMATCH_MP_TAC  FINITE_SUBSET;
30576   TYPE_THEN `graph_edge (graph_replace G e e')` EXISTS_TAC;
30577   ASM_REWRITE_TAC[];
30578   EXPAND_TAC "A";
30579   REWRITE_TAC[SUBSET];
30580   MESON_TAC[];
30581   DISCH_TAC;
30582   (* - *)
30583   TYPE_THEN `~A e` SUBGOAL_TAC;
30584   EXPAND_TAC"A";
30585   REWRITE_TAC[];
30586   ASM_REWRITE_TAC[graph_replace;graph_edge_mod_e;IMAGE];
30587   DISCH_TAC;
30588   REP_BASIC_TAC;
30589   RULE_ASSUM_TAC (REWRITE_RULE[replace]);
30590   UND 8;
30591   COND_CASES_TAC;
30592   ASM_MESON_TAC[];
30593   UND 8;
30594   REWRITE_TAC[];
30595   MESON_TAC[];
30596   DISCH_TAC;
30597   (* - *)
30598   TYPE_THEN `SUC (CARD A) = CARD(e INSERT A)` SUBGOAL_TAC;
30599   IMATCH_MP_TAC  card_suc_insert;
30600   ASM_REWRITE_TAC[];
30601   DISCH_THEN_REWRITE;
30602   (* - *)
30603   AP_TERM_TAC;
30604   EXPAND_TAC "A";
30605   IMATCH_MP_TAC  EQ_EXT;
30606   GEN_TAC;
30607   REWRITE_TAC[INSERT;graph_replace;graph_edge_mod_e;IMAGE;replace; ];
30608   EQ_TAC;
30609   REP_BASIC_TAC;
30610   FIRST_ASSUM DISJ_CASES_TAC;
30611   REP_BASIC_TAC;
30612   UNDF `x = u`;
30613   DISCH_THEN_FULL_REWRITE;
30614   COND_CASES_TAC;
30615   UNDF `x' = e`;
30616   DISCH_THEN_FULL_REWRITE;
30617   ASM_MESON_TAC[];
30618   REWR 10;
30619   UNDF `x = e`;
30620   DISCH_THEN_FULL_REWRITE;
30621   ASM_REWRITE_TAC[];
30622   (* - *)
30623   REP_BASIC_TAC;
30624   TYPE_THEN `x = e` ASM_CASES_TAC;
30625   ASM_REWRITE_TAC[];
30626   ASM_REWRITE_TAC[];
30627   TYPE_THEN `x` EXISTS_TAC;
30628   ASM_REWRITE_TAC[];
30629   ]);;
30630   (* }}} *)
30631
30632 let graph_edge_end_select_other = prove_by_refinement(
30633   `!(G:(A,B)graph_t) e v. (graph G /\ graph_edge G e /\
30634          (graph_inc G e v) ==>
30635     (?v'. (graph_inc G e v' /\ ~(v = v'))))`,
30636   (* {{{ proof *)
30637   [
30638   REP_BASIC_TAC;
30639   TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
30640   REP_BASIC_TAC;
30641   ASM_REWRITE_TAC[];
30642   REP_BASIC_TAC;
30643   TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
30644   IMATCH_MP_TAC  graph_edge2;
30645   ASM_REWRITE_TAC[];
30646   REWRITE_TAC[has_size2];
30647   REP_BASIC_TAC;
30648   UND 7;
30649   DISCH_THEN_FULL_REWRITE;
30650   RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
30651   REWRITE_TAC[in_pair];
30652   TYPE_THEN `(v'' = b)` ASM_CASES_TAC;
30653   UNDF `v''`;
30654   DISCH_THEN_FULL_REWRITE;
30655   REWR 5;
30656   UNDF`v'`;
30657   DISCH_THEN_FULL_REWRITE;
30658   ASM_MESON_TAC[];
30659   REWR 4;
30660   UNDF`v''`;
30661   DISCH_THEN_FULL_REWRITE;
30662   REWR 5;
30663   ASM_MESON_TAC[];
30664   ]);;
30665   (* }}} *)
30666
30667 let graph_rad_pt_select = prove_by_refinement(
30668   `!G r e v. graph_hv_finite_radius G r /\ graph_inc G e v  /\
30669      graph_edge G e ==>
30670      (?C u. (hv_finite C) /\ (simple_arc_end C v u) /\ (euclid 2 u) /\
30671         (d_euclid v u = r) /\ (C SUBSET e) /\ (C SUBSET (closed_ball(euclid 2,d_euclid) v r)))   `,
30672   (* {{{ proof *)
30673   [
30674   REWRITE_TAC[graph_hv_finite_radius];
30675   REP_BASIC_TAC;
30676   (* - *)
30677   TH_INTRO_TAC [`e`;`{v}`;`(euclid 2 DIFF (open_ball(euclid 2,d_euclid) v r))`] simple_arc_end_restriction;
30678   (* -- *)
30679     CONJ_TAC;
30680   RULE_ASSUM_TAC (REWRITE_RULE [good_plane_graph;plane_graph;SUBSET ]);
30681   REP_BASIC_TAC;
30682   FIRST_ASSUM IMATCH_MP_TAC ;
30683   ASM_REWRITE_TAC[];
30684   (* -- *)
30685   TH_INTRO_TAC[`G`;`e`;`v`] graph_edge_end_select_other;
30686   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
30687   ASM_REWRITE_TAC[];
30688   REP_BASIC_TAC;
30689   (* -- *)
30690   CONJ_TAC;
30691   RULE_ASSUM_TAC  (REWRITE_RULE[good_plane_graph;plane_graph]);
30692   REP_BASIC_TAC;
30693   IMATCH_MP_TAC simple_arc_end_end_closed;
30694   TYPE_THEN `e` EXISTS_TAC;
30695   TYPE_THEN `v'` EXISTS_TAC;
30696   FIRST_ASSUM IMATCH_MP_TAC ;
30697   ASM_REWRITE_TAC[];
30698   (* -- *)
30699   CONJ_TAC;
30700   TH_INTRO_TAC [`top2`;`open_ball(euclid 2,d_euclid) v r`] open_closed;
30701   REWRITE_TAC[top2_top];
30702   ASM_SIMP_TAC [top2;open_ball_open;metric_euclid;open_DEF ];
30703   REWRITE_TAC[top2_unions];
30704   (* -- *)
30705   CONJ_TAC;
30706   REWRITE_TAC[INTER;DIFF;EQ_EMPTY;open_ball;INR IN_SING ];
30707   REP_BASIC_TAC;
30708   UNDF  `x = v`;
30709   DISCH_THEN_FULL_REWRITE;
30710   UNDF `x < r`;
30711   ASM_REWRITE_TAC[];
30712   TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
30713   IMATCH_MP_TAC  metric_space_zero;
30714   TYPE_THEN `euclid 2` EXISTS_TAC;
30715   ASM_REWRITE_TAC[metric_euclid];
30716   DISCH_THEN_REWRITE;
30717   ASM_REWRITE_TAC[];
30718   (* -- *)
30719   CONJ_TAC;
30720   REWRITE_TAC[EMPTY_EXISTS];
30721   TYPE_THEN `v` EXISTS_TAC;
30722   REWRITE_TAC[INTER;INR IN_SING];
30723   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
30724   REP_BASIC_TAC;
30725   UNDF `graph_inc G e = y`;
30726   DISCH_THEN (TH_INTRO_TAC [`e`]);
30727   ASM_REWRITE_TAC[];
30728   DISCH_THEN_FULL_REWRITE;
30729   RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
30730   ASM_REWRITE_TAC[];
30731   (* -- *)
30732   REWRITE_TAC[EMPTY_EXISTS];
30733   TYPE_THEN `v'` EXISTS_TAC;
30734   REWRITE_TAC[INTER];
30735   CONJ_TAC;
30736   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
30737   REP_BASIC_TAC;
30738   UNDF `graph_inc G e = y`;
30739   DISCH_THEN (TH_INTRO_TAC [`e`]);
30740   ASM_REWRITE_TAC[];
30741   DISCH_THEN_FULL_REWRITE;
30742   RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
30743   ASM_REWRITE_TAC[];
30744   (* -- *)
30745   REWRITE_TAC[DIFF];
30746   CONJ_TAC;
30747   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
30748   REP_BASIC_TAC;
30749   FIRST_ASSUM IMATCH_MP_TAC ;
30750   TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
30751   ASM_REWRITE_TAC[];
30752   REWRITE_TAC[SUBSET];
30753   DISCH_THEN IMATCH_MP_TAC ;
30754   ASM_REWRITE_TAC[];
30755   REWRITE_TAC[open_ball;DE_MORGAN_THM ];
30756   DISJ2_TAC;
30757   DISJ2_TAC;
30758   DISCH_TAC;
30759   (* -- *)
30760   TYPE_THEN `!v. graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC;
30761   TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
30762   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
30763   ASM_REWRITE_TAC[];
30764   REWRITE_TAC[SUBSET];
30765   DISCH_TAC;
30766   (* -- *)
30767   TYPE_THEN `!v. graph_inc G e v ==> euclid 2 v` SUBGOAL_TAC;
30768   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
30769   REP_BASIC_TAC;
30770   FIRST_ASSUM IMATCH_MP_TAC ;
30771   FIRST_ASSUM IMATCH_MP_TAC ;
30772   ASM_REWRITE_TAC[];
30773   DISCH_TAC;
30774   (* -- *)
30775   UND 4;
30776   DISCH_THEN (  TH_INTRO_TAC [`v`;`v'`] );
30777   ASM_MESON_TAC [];
30778   REWRITE_TAC[INTER;EMPTY_EXISTS];
30779   TYPE_THEN `v` EXISTS_TAC;
30780   REWRITE_TAC[closed_ball];
30781   TYPE_THEN `euclid 2 v` SUBGOAL_TAC;
30782   ASM_MESON_TAC[];
30783   DISCH_THEN_REWRITE;
30784   TYPE_THEN `euclid 2 v'` SUBGOAL_TAC;
30785   ASM_MESON_TAC[];
30786   DISCH_THEN_REWRITE;
30787   TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
30788   IMATCH_MP_TAC  metric_space_zero;
30789   TYPE_THEN `euclid 2` EXISTS_TAC;
30790   ASM_MESON_TAC[metric_euclid];
30791   DISCH_THEN_REWRITE;
30792   UND 5;
30793   UND 9;
30794   TYPE_THEN `d_euclid v v' = d_euclid v' v` SUBGOAL_TAC;
30795   IMATCH_MP_TAC  metric_space_symm;
30796   TYPE_THEN `euclid 2` EXISTS_TAC;
30797   ASM_MESON_TAC[metric_euclid];
30798   DISCH_THEN_REWRITE;
30799   REAL_ARITH_TAC;
30800   (* A- *)
30801   REP_BASIC_TAC;
30802   TYPE_THEN `C'` EXISTS_TAC;
30803   TYPE_THEN `v''` EXISTS_TAC;
30804   ASM_REWRITE_TAC[];
30805   TYPE_THEN `v' = v` SUBGOAL_TAC;
30806   UND 8;
30807   REWRITE_TAC[INTER;eq_sing;INR IN_SING ];
30808   MESON_TAC[];
30809   DISCH_THEN_FULL_REWRITE;
30810   ASM_REWRITE_TAC[];
30811   (* - *)
30812   TYPE_THEN `euclid 2 v''` SUBGOAL_TAC;
30813   FIRST_ASSUM MP_TAC;
30814   REWRITE_TAC[INTER;DIFF;eq_sing;];
30815   DISCH_THEN_REWRITE;
30816   DISCH_TAC;
30817   ASM_REWRITE_TAC[];
30818   (* - *)
30819   TYPE_THEN `d_euclid v v'' = r` SUBGOAL_TAC;
30820   IMATCH_MP_TAC  disk_endpoint_outer;
30821   TYPE_THEN `C'` EXISTS_TAC;
30822   TYPE_THEN `v` EXISTS_TAC;
30823   ASM_REWRITE_TAC[];
30824   CONJ_TAC;
30825   IMATCH_MP_TAC  simple_arc_end_symm;
30826   ASM_REWRITE_TAC[];
30827   TH_INTRO_TAC [`C'`] simple_arc_euclid;
30828   IMATCH_MP_TAC  simple_arc_end_simple;
30829   ASM_MESON_TAC[];
30830   REWRITE_TAC[SUBSET];
30831   DISCH_THEN IMATCH_MP_TAC ;
30832   UND 9;
30833   MESON_TAC[simple_arc_end_end];
30834   DISCH_TAC;
30835   ASM_REWRITE_TAC[];
30836   (* B- *)
30837   TYPE_THEN `C' SUBSET closed_ball(euclid 2,d_euclid) v r` SUBGOAL_TAC;
30838   UND 7;
30839   REWRITE_TAC[SUBSET;closed_ball;INTER;open_ball;DIFF;eq_sing;INR IN_SING];
30840   REP_BASIC_TAC;
30841   TYPE_THEN `!x. C' x ==> euclid 2 x` SUBGOAL_TAC;
30842   REP_BASIC_TAC;
30843   TH_INTRO_TAC[`C'`] simple_arc_euclid;
30844   IMATCH_MP_TAC  simple_arc_end_simple;
30845   ASM_MESON_TAC[];
30846   REWRITE_TAC[SUBSET];
30847   DISCH_THEN IMATCH_MP_TAC ;
30848   ASM_REWRITE_TAC[];
30849   DISCH_TAC;
30850   TYPE_THEN `C' v` SUBGOAL_TAC;
30851   UND 8;
30852   REWRITE_TAC[INTER;INR IN_SING;eq_sing;];
30853   DISCH_THEN_REWRITE;
30854   DISCH_TAC;
30855   CONJ_TAC;
30856   FIRST_ASSUM IMATCH_MP_TAC ;
30857   ASM_REWRITE_TAC[];
30858   CONJ_TAC;
30859   FIRST_ASSUM IMATCH_MP_TAC ;
30860   ASM_REWRITE_TAC[];
30861   TYPE_THEN `x = v''` ASM_CASES_TAC;
30862   UNDF `x = v''`;
30863   DISCH_THEN_FULL_REWRITE;
30864   UND 12;
30865   REAL_ARITH_TAC;
30866   TSPEC `x` 13;
30867   PROOF_BY_CONTR_TAC;
30868   UND 19;
30869   REWRITE_TAC[];
30870   FIRST_ASSUM IMATCH_MP_TAC ;
30871   ASM_REWRITE_TAC[];
30872   SUBCONJ_TAC;
30873   FIRST_ASSUM IMATCH_MP_TAC ;
30874   ASM_REWRITE_TAC[];
30875   DISCH_THEN_REWRITE;
30876   REWRITE_TAC[DE_MORGAN_THM];
30877   DISJ2_TAC;
30878   UND 20;
30879   REAL_ARITH_TAC;
30880   DISCH_TAC;
30881   ASM_REWRITE_TAC[];
30882   IMATCH_MP_TAC  hv_finite_subset;
30883   TYPE_THEN `e INTER (closed_ball(euclid 2,d_euclid) v r)` EXISTS_TAC;
30884   CONJ_TAC;
30885   FIRST_ASSUM IMATCH_MP_TAC ;
30886   ASM_REWRITE_TAC[];
30887   REWRITE_TAC[SUBSET_INTER];
30888   ASM_REWRITE_TAC[];
30889   (* Sun Aug 22 15:50:58 EDT 2004 *)
30890
30891   ]);;
30892
30893   (* }}} *)
30894
30895 (* not needed here *)
30896 let top_union = prove_by_refinement(
30897   `!A B U. topology_ U /\ U A /\ U (B:A->bool) ==> U(A UNION B)`,
30898   (* {{{ proof *)
30899   [
30900   REP_BASIC_TAC;
30901   REWRITE_TAC[GSYM UNIONS_2];
30902   IMATCH_MP_TAC  top_unions;
30903   ASM_REWRITE_TAC[in_pair; SUBSET;];
30904   ASM_MESON_TAC[];
30905   ]);;
30906   (* }}} *)
30907
30908 let top_closed_unions = prove_by_refinement(
30909   `!(B:(A->bool)->bool) U.
30910      topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==>
30911             closed_ U(UNIONS B)`,
30912   (* {{{ proof *)
30913   [
30914   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;
30915   INDUCT_TAC;
30916   REP_BASIC_TAC;
30917   TYPE_THEN `B HAS_SIZE 0` SUBGOAL_TAC;
30918   ASM_REWRITE_TAC[HAS_SIZE];
30919   REWRITE_TAC[HAS_SIZE_0];
30920   DISCH_THEN_REWRITE;
30921   IMATCH_MP_TAC  empty_closed;
30922   ASM_REWRITE_TAC[];
30923   REP_BASIC_TAC;
30924   (* -- *)
30925   TYPE_THEN `~(B = EMPTY)` SUBGOAL_TAC;
30926   DISCH_TAC;
30927   UNDF `EMPTY`;
30928   DISCH_THEN_FULL_REWRITE;
30929   UNDF `SUC`;
30930   REWRITE_TAC[CARD_CLAUSES];
30931   ARITH_TAC;
30932   DISCH_TAC;
30933   (* -- *)
30934   TH_INTRO_TAC [`B`] CARD_DELETE_CHOICE;
30935   ASM_REWRITE_TAC[];
30936   DISCH_TAC;
30937   USEF `SUC` SYM;
30938   REWR 4;
30939   RULE_ASSUM_TAC (REWRITE_RULE[SUC_INJ]);
30940   TYPEL_THEN [`(B DELETE CHOICE B)`;`U`] (USE 0 o ISPECL);
30941   UNDF `n`;
30942   DISCH_THEN (TH_INTRO_TAC []);
30943   ASM_REWRITE_TAC[FINITE_DELETE];
30944   UNDF `(SUBSET)`;
30945   REWRITE_TAC[SUBSET;DELETE];
30946   MESON_TAC[];
30947   (* -- *)
30948   DISCH_TAC;
30949   TYPE_THEN `closed_ U( UNIONS (B DELETE CHOICE B) UNION (CHOICE B))` SUBGOAL_TAC;
30950   IMATCH_MP_TAC  closed_union;
30951   ASM_REWRITE_TAC[];
30952   UND 1;
30953   REWRITE_TAC[SUBSET];
30954   USEF `(~)` (MATCH_MP CHOICE_DEF);
30955   UNDF  `(IN)`;
30956   REWRITE_TAC[];
30957   MESON_TAC[];
30958   ASM_MESON_TAC[unions_delete_choice];
30959   ASM_MESON_TAC[];
30960   ]);;
30961   (* }}} *)
30962
30963 let euclid2_d0 = prove_by_refinement(
30964   `!x. (euclid 2 x) ==> (d_euclid x x = &0)`,
30965   (* {{{ proof *)
30966   [
30967   REP_BASIC_TAC;
30968   IMATCH_MP_TAC  metric_space_zero;
30969   TYPE_THEN `euclid 2` EXISTS_TAC;
30970   ASM_REWRITE_TAC[metric_euclid];
30971   ]);;
30972   (* }}} *)
30973
30974 let union_imp_subset = prove_by_refinement(
30975   `!(Z1:A->bool) Z2 A. (Z1 UNION Z2 = A) ==>
30976          (Z1 SUBSET A /\ Z2 SUBSET A)`,
30977   (* {{{ proof *)
30978   [
30979   SET_TAC[UNION;SUBSET];
30980   ]);;
30981   (* }}} *)
30982
30983 let loc_path_conn_top2 = prove_by_refinement(
30984   `loc_path_conn top2`,
30985   (* {{{ proof *)
30986   [
30987   REWRITE_TAC[top2];
30988   IMATCH_MP_TAC  loc_path_conn_euclid;
30989   TYPE_THEN `2` EXISTS_TAC;
30990   MESON_TAC[metric_euclid;top_of_metric_top;top_of_metric_unions;top_univ];
30991   ]);;
30992   (* }}} *)
30993
30994 let connected_empty = prove_by_refinement(
30995   `!U. connected (U:(A->bool)->bool) EMPTY `,
30996   (* {{{ proof *)
30997   [
30998   REWRITE_TAC[connected];
30999   ]);;
31000   (* }}} *)
31001
31002 let component_imp_connected = prove_by_refinement(
31003   `!U (x:A). (topology_ U) ==> (connected U (component U x))`,
31004   (* {{{ proof *)
31005   [
31006   REP_BASIC_TAC;
31007   TYPE_THEN `~(UNIONS U x)` ASM_CASES_TAC;
31008   UND 1;
31009   ASM_SIMP_TAC[GSYM component_empty];
31010   REWRITE_TAC[connected_empty];
31011   REWR 1;
31012   (* - *)
31013   REWRITE_TAC[connected];
31014   CONJ_TAC;
31015   REWRITE_TAC[SUBSET;connected;component];
31016   REP_BASIC_TAC;
31017   ASM_MESON_TAC[];
31018   REP_BASIC_TAC;
31019   TYPE_THEN `component U x x` SUBGOAL_TAC;
31020   ASM_MESON_TAC[component_refl];
31021   DISCH_TAC;
31022   (* - *)
31023   TYPE_THEN `A x \/ B x` SUBGOAL_TAC;
31024   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET;UNION]);
31025   FIRST_ASSUM IMATCH_MP_TAC ;
31026   ASM_REWRITE_TAC[];
31027   (* - *)
31028   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;
31029   REP_BASIC_TAC;
31030   REWRITE_TAC[SUBSET];
31031   REP_BASIC_TAC;
31032   PROOF_BY_CONTR_TAC;
31033   TYPE_THEN `B' x'` SUBGOAL_TAC;
31034   USE 11 (REWRITE_RULE[SUBSET;UNION]);
31035   TSPEC `x'` 11;
31036   ASM_MESON_TAC[];
31037   DISCH_TAC;
31038   USE 12 (REWRITE_RULE[component]);
31039   REP_BASIC_TAC;
31040   TYPE_THEN `Z SUBSET (component U x)` SUBGOAL_TAC;
31041   IMATCH_MP_TAC  connected_component;
31042   ASM_REWRITE_TAC[];
31043   DISCH_TAC;
31044   USE 16 (REWRITE_RULE[connected]);
31045   REP_BASIC_TAC;
31046   TYPEL_THEN[`A'`;`B'`] (USE 16 o ISPECL);
31047   UND 16;
31048   ASM_REWRITE_TAC[];
31049   TYPE_THEN `Z SUBSET A' UNION B'` SUBGOAL_TAC;
31050   IMATCH_MP_TAC  SUBSET_TRANS;
31051   TYPE_THEN `component U x` EXISTS_TAC ;
31052   ASM_REWRITE_TAC[];
31053   DISCH_THEN_REWRITE;
31054   REWRITE_TAC[DE_MORGAN_THM];
31055   REWRITE_TAC[SUBSET];
31056   REP_BASIC_TAC;
31057   CONJ_TAC;
31058   ASM_MESON_TAC[];
31059   USE 10 (REWRITE_RULE[INTER;EQ_EMPTY]);
31060   ASM_MESON_TAC[];
31061   DISCH_TAC;
31062   (* - *)
31063   DISCH_THEN DISJ_CASES_TAC;
31064   TYPEL_THEN[`A`;`B`] (USE 7 o ISPECL);
31065   ASM_MESON_TAC[];
31066   TYPEL_THEN [`B`;`A`] (USE 7 o ISPECL);
31067   REWR 7;
31068   DISJ2_TAC;
31069   FIRST_ASSUM IMATCH_MP_TAC ;
31070   ONCE_REWRITE_TAC[INTER_COMM];
31071   ASM_REWRITE_TAC[];
31072   ONCE_REWRITE_TAC[UNION_COMM];
31073   ASM_REWRITE_TAC[];
31074   ]);;
31075   (* }}} *)
31076
31077 let open_induced = prove_by_refinement(
31078   `!U (A:A->bool). (topology_ U) /\ U A ==>
31079           (induced_top U A = { B | U B /\ B SUBSET A })`,
31080   (* {{{ proof *)
31081   [
31082   REP_BASIC_TAC;
31083   REWRITE_TAC[induced_top;IMAGE;];
31084   IMATCH_MP_TAC  EQ_EXT;
31085   REWRITE_TAC[];
31086   GEN_TAC;
31087   EQ_TAC;
31088   REP_BASIC_TAC;
31089   FIRST_ASSUM MP_TAC ;
31090   DISCH_THEN_FULL_REWRITE;
31091   CONJ_TAC;
31092   IMATCH_MP_TAC  top_inter;
31093   ASM_REWRITE_TAC[];
31094   REWRITE_TAC[INTER;SUBSET];
31095   MESON_TAC[];
31096   REP_BASIC_TAC;
31097   TYPE_THEN `x` EXISTS_TAC;
31098   ASM_REWRITE_TAC[];
31099   UND 2;
31100   SET_TAC [INTER;SUBSET];
31101   ]);;
31102   (* }}} *)
31103
31104 let connected_induced = prove_by_refinement(
31105   `!U (C:A->bool) . (topology_ U /\ U C ) ==>
31106            (connected U C = connected (induced_top U C) C)`,
31107   (* {{{ proof *)
31108   [
31109   REP_BASIC_TAC;
31110   REWRITE_TAC[connected];
31111   ASM_SIMP_TAC[open_induced];
31112   EQ_TAC;
31113   REP_BASIC_TAC;
31114   CONJ_TAC;
31115   IMATCH_MP_TAC  sub_union;
31116   ASM_REWRITE_TAC[SUBSET_REFL ];
31117   REP_BASIC_TAC;
31118   TYPEL_THEN [`A`;`B`] (USE 2 o ISPECL);
31119   FIRST_ASSUM IMATCH_MP_TAC ;
31120   ASM_REWRITE_TAC[];
31121   (* - *)
31122   REP_BASIC_TAC;
31123   CONJ_TAC;
31124   IMATCH_MP_TAC  SUBSET_TRANS;
31125   TYPE_THEN `UNIONS {B | U B /\ B SUBSET C}` EXISTS_TAC;
31126   ASM_REWRITE_TAC[];
31127   IMATCH_MP_TAC  UNIONS_UNIONS;
31128   ONCE_REWRITE_TAC[SUBSET];
31129   REWRITE_TAC[];
31130   MESON_TAC[];
31131   (* - *)
31132   REP_BASIC_TAC;
31133   TYPEL_THEN[`A INTER C`;`B INTER C`] (USE 2 o ISPECL);
31134   REWR 2;
31135   UND 2;
31136   DISCH_THEN  (TH_INTRO_TAC []);
31137   TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC;
31138   REP_BASIC_TAC;
31139   IMATCH_MP_TAC top_inter;
31140   ASM_REWRITE_TAC[];
31141   DISCH_TAC;
31142   REWRITE_TAC[GSYM CONJ_ASSOC];
31143   CONJ_TAC;
31144   ASM_MESON_TAC[];
31145   REWRITE_TAC[INTER_SUBSET];
31146   CONJ_TAC;
31147   ASM_MESON_TAC[];
31148   CONJ_TAC;
31149   UND 5;
31150   SET_TAC[INTER];
31151   UND 4;
31152   SET_TAC[SUBSET;UNION;INTER];
31153   SET_TAC[INTER;SUBSET];
31154   ]);;
31155   (* }}} *)
31156
31157 let connected_induced2 = prove_by_refinement(
31158   `!U (C:A->bool) Z. (topology_ U /\ U C /\ Z SUBSET (UNIONS U))  ==>
31159         (connected (induced_top U C) Z <=> (Z SUBSET C) /\ (connected U Z))`,
31160   (* {{{ proof *)
31161   [
31162   REP_BASIC_TAC;
31163   REWRITE_TAC[connected];
31164   ASM_SIMP_TAC[open_induced];
31165   EQ_TAC;
31166   REP_BASIC_TAC;
31167   SUBCONJ_TAC;
31168   REWRITE_TAC[SUBSET];
31169   REP_BASIC_TAC;
31170   USE 4(REWRITE_RULE[SUBSET;UNIONS]);
31171   TSPEC `x` 4;
31172   REWR 4;
31173   REP_BASIC_TAC;
31174   FIRST_ASSUM IMATCH_MP_TAC ;
31175   ASM_REWRITE_TAC[];
31176   DISCH_TAC;
31177   REP_BASIC_TAC;
31178   TYPEL_THEN [`A INTER C`;`B INTER C`] (USE 3 o ISPECL);
31179   REWR 3;
31180   UND 3;
31181   DISCH_THEN  (TH_INTRO_TAC []);
31182   TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC;
31183   REP_BASIC_TAC;
31184   IMATCH_MP_TAC top_inter;
31185   ASM_REWRITE_TAC[];
31186   DISCH_TAC;
31187   REWRITE_TAC[GSYM CONJ_ASSOC];
31188   CONJ_TAC;
31189   ASM_MESON_TAC[];
31190   REWRITE_TAC[INTER_SUBSET];
31191   CONJ_TAC;
31192   ASM_MESON_TAC[];
31193   CONJ_TAC;
31194   UND 7;
31195   SET_TAC[INTER];
31196   UND 6;
31197   UND 5;
31198   SET_TAC[INTER;SUBSET;UNION];
31199   UND 5;
31200   SET_TAC[INTER;SUBSET;UNION];
31201   REP_BASIC_TAC;
31202   (* - *)
31203   CONJ_TAC;
31204   UND 0;
31205   REWRITE_TAC[SUBSET;UNIONS];
31206   REP_BASIC_TAC;
31207   TSPEC `x` 5;
31208   REWR 5;
31209   REP_BASIC_TAC;
31210   TYPE_THEN `u INTER C` EXISTS_TAC;
31211   REWRITE_TAC[GSYM CONJ_ASSOC];
31212   CONJ_TAC;
31213   IMATCH_MP_TAC  top_inter;
31214   ASM_REWRITE_TAC[];
31215   REWRITE_TAC[INTER];
31216   ASM_MESON_TAC[ISUBSET ];
31217   (* - *)
31218   REP_BASIC_TAC;
31219   FIRST_ASSUM IMATCH_MP_TAC ;
31220   ASM_REWRITE_TAC[];
31221   ]);;
31222   (* }}} *)
31223
31224 let connected_metric = prove_by_refinement(
31225   `!X d (C:A->bool). metric_space (X,d) /\ C SUBSET X /\
31226     (top_of_metric(X,d)C) ==>
31227      (connected(top_of_metric(X,d))C <=> connected(top_of_metric(C,d))C)`,
31228   (* {{{ proof *)
31229   [
31230   REP_BASIC_TAC;
31231   TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d))C` SUBGOAL_TAC;
31232   ASM_MESON_TAC[top_of_metric_induced];
31233   DISCH_THEN_REWRITE;
31234   IMATCH_MP_TAC  connected_induced;
31235   ASM_MESON_TAC[top_of_metric_top];
31236   ]);;
31237   (* }}} *)
31238
31239 let connected_metric_pair = prove_by_refinement(
31240   `!(X:A->bool) Y Z d. metric_space (X,d) /\
31241      top_of_metric(X,d) Y /\ top_of_metric(X,d) Z /\
31242        Z SUBSET Y  ==>
31243    (connected (top_of_metric(X,d)) Z = connected (top_of_metric(Y,d)) Z)`,
31244   (* {{{ proof *)
31245   [
31246   REP_BASIC_TAC;
31247   (* - *)
31248   TYPE_THEN `Y SUBSET X` SUBGOAL_TAC;
31249   USE 2(MATCH_MP sub_union);
31250   UND 2;
31251   ASM_SIMP_TAC[GSYM top_of_metric_unions];
31252   DISCH_TAC;
31253   (* - *)
31254   TYPE_THEN `Z SUBSET X` SUBGOAL_TAC ;
31255   ASM_MESON_TAC[SUBSET_TRANS];
31256   DISCH_TAC;
31257   ASM_SIMP_TAC[connected_metric];
31258   (* - *)
31259   TYPE_THEN `metric_space (Y,d)` SUBGOAL_TAC;
31260   ASM_MESON_TAC[metric_subspace];
31261   DISCH_TAC;
31262   (* - *)
31263   TYPE_THEN `top_of_metric(Y,d)  = induced_top(top_of_metric(X,d)) Y` SUBGOAL_TAC;
31264   ASM_MESON_TAC[top_of_metric_induced];
31265   DISCH_TAC;
31266   TYPE_THEN `top_of_metric(Y,d) Z` SUBGOAL_TAC;
31267   ASM_REWRITE_TAC[];
31268   ASM_SIMP_TAC[open_induced;top_of_metric_top];
31269   DISCH_TAC;
31270   ASM_SIMP_TAC[connected_metric];
31271   ]);;
31272   (* }}} *)
31273
31274 let construct_hv_finite = prove_by_refinement(
31275   `!A C v v'. (top2 A) /\ (C SUBSET A) /\ (simple_arc_end C v v') ==>
31276     (?C'. C' SUBSET A /\ simple_arc_end C' v v' /\ hv_finite C')`,
31277   (* {{{ proof *)
31278   [
31279   REP_BASIC_TAC;
31280   TYPE_THEN `A' = path_component(top_of_metric(A,d_euclid)) v` ABBREV_TAC ;
31281   TYPE_THEN `A' = component (top_of_metric(A,d_euclid)) v` SUBGOAL_TAC;
31282   EXPAND_TAC "A'";
31283   AP_THM_TAC;
31284   IMATCH_MP_TAC  loc_path_euclid_cor ;
31285   TYPE_THEN `2` EXISTS_TAC;
31286   ASM_REWRITE_TAC[GSYM top2];
31287   DISCH_TAC;
31288   (* - *)
31289   TYPE_THEN `A SUBSET (euclid 2)` SUBGOAL_TAC;
31290   USEF `top2`  (MATCH_MP sub_union );
31291   RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
31292   ASM_REWRITE_TAC[];
31293   DISCH_TAC;
31294   (* - *)
31295   TYPE_THEN`UNIONS (top_of_metric(A,d_euclid)) = A` SUBGOAL_TAC;
31296   ASM_MESON_TAC [GSYM top_of_metric_unions;metric_euclid;metric_subspace];
31297   DISCH_TAC;
31298   (* - *)
31299   TYPE_THEN `A' SUBSET (UNIONS (top_of_metric(A,d_euclid)))` SUBGOAL_TAC;
31300   ASM_MESON_TAC[component_unions];
31301   ASM_REWRITE_TAC[];
31302   DISCH_TAC;
31303   (* - *)
31304   TYPE_THEN `A' SUBSET (euclid 2)`  SUBGOAL_TAC;
31305   IMATCH_MP_TAC  SUBSET_TRANS;
31306   TYPE_THEN `A` EXISTS_TAC;
31307   ASM_REWRITE_TAC[];
31308   DISCH_TAC;
31309   (* - *)
31310   ASSUME_TAC  loc_path_conn_top2 ;
31311   (* - *)
31312   TYPE_THEN `A v` SUBGOAL_TAC;
31313   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
31314   UND 1;
31315   DISCH_THEN IMATCH_MP_TAC ;
31316   UND 0;
31317   MESON_TAC[simple_arc_end_end];
31318   DISCH_TAC;
31319   (* - *)
31320   TYPE_THEN `top_of_metric(A,d_euclid) = induced_top top2 A` SUBGOAL_TAC;
31321   REWRITE_TAC[top2];
31322   UND 5;
31323   SIMP_TAC [metric_euclid;top_of_metric_induced ];
31324   DISCH_TAC;
31325   (* - *)
31326   TYPE_THEN `top2 A'` SUBGOAL_TAC;
31327   EXPAND_TAC "A'";
31328   UND 11;
31329   DISCH_THEN_REWRITE;
31330   USE 9 (REWRITE_RULE[ loc_path_conn]);
31331   FIRST_ASSUM IMATCH_MP_TAC ;
31332   ASM_REWRITE_TAC[];
31333   DISCH_TAC;
31334   (* - *)
31335   TYPE_THEN `~(v  = v')` SUBGOAL_TAC;
31336   UND 0;
31337   ASM_MESON_TAC[simple_arc_end_distinct];
31338   DISCH_TAC;
31339   (* A' - *)
31340   TYPE_THEN `connected (top_of_metric(A,d_euclid)) A'` SUBGOAL_TAC;
31341   ASM_REWRITE_TAC[];
31342   IMATCH_MP_TAC  component_imp_connected;
31343   ASM_MESON_TAC[top_of_metric_top;metric_subspace;metric_euclid];
31344   DISCH_TAC;
31345   (* - *)
31346   TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) A'` SUBGOAL_TAC;
31347   TH_INTRO_TAC [`euclid 2`;`A`;`A'`;`d_euclid`] connected_metric_pair;
31348   ASM_MESON_TAC [metric_euclid;GSYM top2];
31349   DISCH_THEN_REWRITE;
31350   ASM_MESON_TAC[];
31351   REWRITE_TAC[GSYM top2];
31352   DISCH_TAC;
31353   (* - *)
31354   TYPE_THEN `connected top2 C` SUBGOAL_TAC;
31355   IMATCH_MP_TAC  simple_arc_connected;
31356   IMATCH_MP_TAC  simple_arc_end_simple;
31357   ASM_MESON_TAC[];
31358   DISCH_TAC;
31359   (* - *)
31360   TYPE_THEN `C SUBSET A'` SUBGOAL_TAC;
31361   ASM_REWRITE_TAC[];
31362   IMATCH_MP_TAC  connected_component;
31363   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\a`);
31364   CONJ_TAC;
31365   UND 0;
31366   MESON_TAC[simple_arc_end_end];
31367   TH_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
31368   REWRITE_TAC[top2_top;top2_unions];
31369   ASM_REWRITE_TAC[];
31370   ASM_MESON_TAC[SUBSET_TRANS];
31371   ASM_MESON_TAC[];
31372   DISCH_TAC;
31373   (* - *)
31374   TYPE_THEN `C v /\ C v'` SUBGOAL_TAC;
31375   UND 0;
31376   MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
31377   DISCH_TAC;
31378   TYPE_THEN `A' v /\ A' v'` SUBGOAL_TAC;
31379   ASM_MESON_TAC[ISUBSET];
31380   DISCH_TAC;
31381   (* - *)
31382   TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_conn;
31383   ASM_REWRITE_TAC[];
31384   DISCH_TAC;
31385   TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_hv_finite;
31386   ASM_REWRITE_TAC[];
31387   DISCH_THEN_FULL_REWRITE;
31388   REP_BASIC_TAC;
31389   TYPE_THEN `C'` EXISTS_TAC;
31390   ASM_REWRITE_TAC[];
31391   IMATCH_MP_TAC  SUBSET_TRANS;
31392   TYPE_THEN `A'` EXISTS_TAC;
31393   ASM_MESON_TAC[];
31394   ]);;
31395   (* }}} *)
31396
31397 let graph_rad_pt_center_piece = prove_by_refinement(
31398   `!G r e v v'.
31399      graph_hv_finite_radius G r /\ graph_inc G e v /\
31400      FINITE(graph_edge G) /\ FINITE(graph_vertex G) /\
31401     graph_edge G e /\ graph_inc G e v' /\ ~(v = v') ==>
31402    (? Cv u Cv' u' C''.
31403         (hv_finite Cv /\ hv_finite Cv' /\  (hv_finite C'') /\
31404         ~(graph_vertex G u) /\
31405         ~(graph_vertex G u') /\
31406         simple_arc_end Cv v u /\
31407         simple_arc_end Cv' v' u' /\
31408         simple_arc_end C'' u u' /\
31409          ~C'' v /\ ~C'' v' /\
31410         (euclid 2 u)  /\ (euclid 2 u') /\
31411         (d_euclid v u = r) /\ (d_euclid v' u' = r) /\
31412         (Cv SUBSET e) /\ (Cv' SUBSET e) /\
31413         (Cv SUBSET  (closed_ball(euclid 2,d_euclid) v r)) /\
31414         (Cv' SUBSET (closed_ball(euclid 2,d_euclid) v' r)) /\
31415    (!e'. (graph_edge G e') /\ ~(e = e') ==> (C'' INTER e' = EMPTY)) /\
31416    (!v''. graph_vertex G v'' /\ ~(graph_inc G e v'') ==>
31417         (C'' INTER (closed_ball(euclid 2,d_euclid) v'' r) = EMPTY))
31418      ))`,
31419   (* {{{ proof *)
31420   [
31421   REP_BASIC_TAC;
31422   TH_INTRO_TAC [`G`;`r`;`e`;`v`] graph_rad_pt_select;
31423   ASM_REWRITE_TAC[];
31424   REP_BASIC_TAC;
31425   TYPE_THEN `Cv = C` ABBREV_TAC ;
31426   KILL 13;
31427   TYPE_THEN `Cv` EXISTS_TAC;
31428   TYPE_THEN `u` EXISTS_TAC;
31429   ASM_REWRITE_TAC[];
31430   TH_INTRO_TAC [`G`;`r`;`e`;`v'`] graph_rad_pt_select;
31431   ASM_REWRITE_TAC[];
31432   REP_BASIC_TAC;
31433   TYPE_THEN `Cv' = C'` ABBREV_TAC ;
31434   KILL 19;
31435   TYPE_THEN `Cv'` EXISTS_TAC;
31436   TYPE_THEN `u'` EXISTS_TAC;
31437   ASM_REWRITE_TAC[];
31438   (* A' *)
31439   TYPE_THEN `!v''. graph_vertex G v'' ==> (euclid 2 v'')` SUBGOAL_TAC;
31440   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;SUBSET ]);
31441   REP_BASIC_TAC;
31442   FIRST_ASSUM IMATCH_MP_TAC ;
31443   ASM_REWRITE_TAC[];
31444   DISCH_TAC;
31445   (* - *)
31446   TYPE_THEN `!v''. graph_inc G e v'' ==> graph_vertex G v''`  SUBGOAL_TAC;
31447   REP_BASIC_TAC;
31448   TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
31449   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]);
31450   ASM_REWRITE_TAC[SUBSET ];
31451   FIRST_ASSUM MP_TAC;
31452   MESON_TAC[ISUBSET];
31453   DISCH_TAC;
31454   (* - *)
31455   TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ;
31456   TYPE_THEN `B  = (UNIONS { e' | graph_edge G e' /\ ~(e' = e)})` ABBREV_TAC ;
31457   TYPE_THEN `B' = (UNIONS { DD | ?v''. (graph_vertex G v'' /\ (DD = D v'') /\ ~(graph_inc G e v''))})` ABBREV_TAC ;
31458   TYPE_THEN `B'' = {v, v'}` ABBREV_TAC ;
31459   TYPE_THEN `A = (euclid 2 DIFF (B UNION B' UNION B''))` ABBREV_TAC ;
31460   TYPE_THEN `top2 A` SUBGOAL_TAC;
31461   TH_INTRO_TAC [`top2`;`B UNION B' UNION B''`] closed_open;
31462   IMATCH_MP_TAC  closed_union;
31463   REWRITE_TAC[top2_top];
31464   EXPAND_TAC "B";
31465   EXPAND_TAC "B'";
31466   EXPAND_TAC "B''";
31467   CONJ_TAC;
31468   IMATCH_MP_TAC  top_closed_unions;
31469   REWRITE_TAC[top2_top;SUBSET;];
31470   CONJ_TAC;
31471   IMATCH_MP_TAC  FINITE_SUBSET;
31472   TYPE_THEN `graph_edge G` EXISTS_TAC ;
31473   ASM_REWRITE_TAC[SUBSET];
31474   MESON_TAC[];
31475   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]);
31476   REP_BASIC_TAC;
31477   IMATCH_MP_TAC  simple_arc_end_closed;
31478   TH_INTRO_TAC [`G`;`x`] graph_edge_end_select;
31479   ASM_REWRITE_TAC[];
31480   REP_BASIC_TAC;
31481   ASM_MESON_TAC[];
31482   (* --- *)
31483   IMATCH_MP_TAC  closed_union;
31484   REWRITE_TAC[top2_top];
31485   CONJ_TAC;
31486   IMATCH_MP_TAC  top_closed_unions;
31487   REWRITE_TAC[top2_top];
31488   CONJ_TAC;
31489   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;
31490   REWRITE_TAC[IMAGE];
31491   IMATCH_MP_TAC  EQ_EXT;
31492   GEN_TAC;
31493   REWRITE_TAC[];
31494   MESON_TAC[];
31495   DISCH_THEN_REWRITE;
31496   IMATCH_MP_TAC  FINITE_IMAGE;
31497   IMATCH_MP_TAC  FINITE_SUBSET;
31498   TYPE_THEN `graph_vertex G` EXISTS_TAC;
31499   ASM_REWRITE_TAC[SUBSET ];
31500   MESON_TAC[];
31501   REWRITE_TAC[SUBSET];
31502   REP_BASIC_TAC;
31503   UNDF `x = D v''`;
31504   DISCH_THEN_FULL_REWRITE;
31505   EXPAND_TAC "D";
31506   REWRITE_TAC[top2];
31507   IMATCH_MP_TAC  closed_ball_closed;
31508   REWRITE_TAC[metric_euclid];
31509   (* --- *)
31510   TYPE_THEN `{v,v'} = {v} UNION {v'}` SUBGOAL_TAC;
31511   IMATCH_MP_TAC  EQ_EXT;
31512   REWRITE_TAC[in_pair;UNION;INR IN_SING];
31513   MESON_TAC[];
31514   DISCH_THEN_REWRITE;
31515   IMATCH_MP_TAC  closed_union;
31516   REWRITE_TAC[top2_top];
31517   TYPE_THEN `graph_inc G e v` (FIND_ASSUM MP_TAC);
31518   TYPE_THEN `graph_inc G e v'` (FIND_ASSUM MP_TAC);
31519   ASM_MESON_TAC[closed_point];
31520   REWRITE_TAC[open_DEF;top2_unions];
31521   EXPAND_TAC "A";
31522   DISCH_THEN_REWRITE;
31523   DISCH_TAC;
31524   (* B' *)
31525   TYPE_THEN `!u'' v''. graph_vertex G v'' /\ (d_euclid v'' u'' = r) ==> ~(graph_vertex G u'')` SUBGOAL_TAC;
31526   REP_BASIC_TAC;
31527   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
31528   REP_BASIC_TAC;
31529   TYPEL_THEN [`u''`;`v''`] (USE 31 o ISPECL);
31530   TYPE_THEN `~(u'' = v'')` SUBGOAL_TAC;
31531   DISCH_TAC;
31532   POP_ASSUM MP_TAC;
31533   DISCH_THEN_FULL_REWRITE;
31534   TYPE_THEN `d_euclid v'' v'' = &0` SUBGOAL_TAC;
31535   IMATCH_MP_TAC  metric_space_zero;
31536   TYPE_THEN `euclid 2` EXISTS_TAC;
31537   ASM_REWRITE_TAC[metric_euclid];
31538   FIRST_ASSUM IMATCH_MP_TAC ;
31539   ASM_REWRITE_TAC[];
31540   DISCH_THEN_FULL_REWRITE;
31541   UNDF `&0 = r`;
31542   UNDF   `&0 < r`;
31543   REAL_ARITH_TAC;
31544   DISCH_TAC;
31545   UNDF `(graph_vertex)`;
31546   ASM_REWRITE_TAC[EMPTY_EXISTS ;INTER ;closed_ball ;];
31547   TYPE_THEN `u''` EXISTS_TAC;
31548   ASM_REWRITE_TAC[];
31549   TYPE_THEN `d_euclid u'' u'' = &0` SUBGOAL_TAC;
31550   IMATCH_MP_TAC  metric_space_zero;
31551   TYPE_THEN `euclid 2` EXISTS_TAC;
31552   ASM_REWRITE_TAC[metric_euclid];
31553   FIRST_ASSUM IMATCH_MP_TAC ;
31554   ASM_REWRITE_TAC[];
31555   DISCH_THEN_REWRITE;
31556   TYPE_THEN `euclid 2 u'' ` SUBGOAL_TAC;
31557   FIRST_ASSUM IMATCH_MP_TAC ;
31558   ASM_REWRITE_TAC[];
31559   DISCH_THEN_REWRITE;
31560   TYPE_THEN `euclid 2 v'' ` SUBGOAL_TAC;
31561   FIRST_ASSUM IMATCH_MP_TAC ;
31562   ASM_REWRITE_TAC[];
31563   DISCH_THEN_REWRITE;
31564   UNDF `&0 < r`;
31565   REAL_ARITH_TAC;
31566   DISCH_TAC;
31567   (* B1'- *)
31568   TYPE_THEN `~graph_vertex G u` SUBGOAL_TAC;
31569   FIRST_ASSUM IMATCH_MP_TAC ;
31570   TYPE_THEN `v` EXISTS_TAC;
31571   ASM_REWRITE_TAC[];
31572   FIRST_ASSUM IMATCH_MP_TAC ;
31573   ASM_REWRITE_TAC[];
31574   DISCH_TAC;
31575   ASM_REWRITE_TAC[];
31576   (* - *)
31577   TYPE_THEN `~graph_vertex G u'` SUBGOAL_TAC;
31578   FIRST_ASSUM IMATCH_MP_TAC ;
31579   TYPE_THEN `v'` EXISTS_TAC;
31580   ASM_REWRITE_TAC[];
31581   FIRST_ASSUM IMATCH_MP_TAC ;
31582   ASM_REWRITE_TAC[];
31583   DISCH_TAC;
31584   ASM_REWRITE_TAC[];
31585   (* C' *)
31586   TYPE_THEN `!(X:A->bool) Y Z. (X UNION Y = Z) ==> (X SUBSET Z)` SUBGOAL_TAC;
31587   SET_TAC[UNION;SUBSET];
31588   DISCH_TAC;
31589   (* - *)
31590   TYPE_THEN `simple_arc_end e v v'` SUBGOAL_TAC;
31591   RULE_ASSUM_TAC (REWRITE_RULE [graph_hv_finite_radius;good_plane_graph]);
31592   REP_BASIC_TAC;
31593   FIRST_ASSUM IMATCH_MP_TAC ;
31594   ASM_REWRITE_TAC[];
31595   DISCH_TAC;
31596   (* - *)
31597   TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
31598   FIRST_ASSUM IMATCH_MP_TAC ;
31599   ASM_REWRITE_TAC[];
31600   DISCH_TAC;
31601   TYPE_THEN `graph_vertex G v'` SUBGOAL_TAC;
31602   FIRST_ASSUM IMATCH_MP_TAC ;
31603   ASM_REWRITE_TAC[];
31604   DISCH_TAC;
31605   (* - *)
31606   TYPE_THEN `~D v u'` SUBGOAL_TAC;
31607   EXPAND_TAC "D";
31608   PROOF_BY_CONTR_TAC;
31609   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]);
31610   REP_BASIC_TAC;
31611   GRABF `~(v = v')` (TH_INTRO_TAC [`v`;`v'`]);
31612   ASM_REWRITE_TAC[];
31613   REWRITE_TAC[EMPTY_EXISTS];
31614   TYPE_THEN `u'` EXISTS_TAC;
31615   ASM_REWRITE_TAC[INTER];
31616   ASM_REWRITE_TAC[closed_ball];
31617   CONJ_TAC;
31618   FIRST_ASSUM IMATCH_MP_TAC ;
31619   ASM_REWRITE_TAC[];
31620   REAL_ARITH_TAC;
31621   DISCH_TAC;
31622   (* C1'- *)
31623   TYPE_THEN `~(v = u) /\ ~(v = u')` SUBGOAL_TAC;
31624   CONJ_TAC;
31625   DISCH_TAC;
31626   POP_ASSUM MP_TAC;
31627   DISCH_THEN_FULL_REWRITE;
31628   TH_INTRO_TAC[`u`] euclid2_d0;
31629   ASM_REWRITE_TAC[];
31630   DISCH_THEN_FULL_REWRITE;
31631   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
31632   REP_BASIC_TAC;
31633   UNDF `&0 < r`;
31634   UNDF `&0 = r`;
31635   REAL_ARITH_TAC;
31636   DISCH_TAC;
31637   POP_ASSUM MP_TAC;
31638   DISCH_THEN_FULL_REWRITE;
31639   POP_ASSUM MP_TAC;
31640   EXPAND_TAC "D";
31641   REWRITE_TAC[closed_ball];
31642   ASM_REWRITE_TAC[];
31643   TH_INTRO_TAC [`u'`] euclid2_d0;
31644   ASM_REWRITE_TAC[];
31645   DISCH_THEN_FULL_REWRITE;
31646   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
31647   REP_BASIC_TAC;
31648   UNDF `&0 < r`;
31649   REAL_ARITH_TAC;
31650   DISCH_TAC;
31651   (* - *)
31652   TYPE_THEN `~(v' = u') ` SUBGOAL_TAC;
31653   DISCH_TAC;
31654   POP_ASSUM MP_TAC;
31655   DISCH_THEN_FULL_REWRITE;
31656   TH_INTRO_TAC[`u'`] euclid2_d0;
31657   ASM_REWRITE_TAC[];
31658   DISCH_THEN_FULL_REWRITE;
31659   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
31660   REP_BASIC_TAC;
31661   UNDF `&0 < r`;
31662   UNDF `&0 = r`;
31663   REAL_ARITH_TAC;
31664   DISCH_TAC;
31665   (* - *)
31666   TH_INTRO_TAC [`e`;`v`;`v'`;`u'`] simple_arc_end_cut;
31667   ASM_REWRITE_TAC[];
31668   TYPE_THEN `Cv' u'` SUBGOAL_TAC;
31669   TYPE_THEN `simple_arc_end Cv' v' u'` (FIND_ASSUM  MP_TAC );
31670   MESON_TAC[simple_arc_end_end2];
31671   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
31672   ASM_REWRITE_TAC[];
31673   REP_BASIC_TAC;
31674   TYPE_THEN `Cvu' = C''` ABBREV_TAC ;
31675   POP_ASSUM (fun t-> ALL_TAC);
31676   TYPE_THEN `Cu'v' = C'''` ABBREV_TAC ;
31677   POP_ASSUM (fun t -> ALL_TAC);
31678   TYPE_THEN `Cu'v' v'` SUBGOAL_TAC;
31679   TYPE_THEN `simple_arc_end Cu'v' u' v'` (FIND_ASSUM  MP_TAC );
31680   MESON_TAC[simple_arc_end_end2];
31681   DISCH_TAC;
31682   TYPE_THEN `~Cvu' v'` SUBGOAL_TAC;
31683   DISCH_TAC;
31684   USEF `(INTER)` (REWRITE_RULE[FUN_EQ_THM]);
31685   TSPEC `v'` 37;
31686   RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing ;INR IN_SING]);
31687   UND 37;
31688   ASM_REWRITE_TAC[];
31689   DISCH_TAC;
31690   (* - *)
31691   TYPE_THEN `~D v' u` SUBGOAL_TAC;
31692   EXPAND_TAC "D";
31693   DISCH_TAC;
31694   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]);
31695   REP_BASIC_TAC;
31696   GRABF `~(v' = v)` (TH_INTRO_TAC [`v'`;`v`]);
31697   ASM_REWRITE_TAC[];
31698   REWRITE_TAC[EMPTY_EXISTS];
31699   TYPE_THEN `u` EXISTS_TAC;
31700   ASM_REWRITE_TAC[INTER];
31701   ASM_REWRITE_TAC[closed_ball];
31702   CONJ_TAC;
31703   FIRST_ASSUM IMATCH_MP_TAC ;
31704   ASM_REWRITE_TAC[];
31705   REAL_ARITH_TAC;
31706   DISCH_TAC;
31707   (* D'- *)
31708   TYPE_THEN `Cvu' u \/ Cu'v' u` SUBGOAL_TAC;
31709   USE 35 (REWRITE_RULE[FUN_EQ_THM;]);
31710   TSPEC  `u` 35 ;
31711   USE 35 (REWRITE_RULE[UNION]);
31712   ASM_REWRITE_TAC[];
31713   USE 8(REWRITE_RULE[SUBSET]);
31714   FIRST_ASSUM IMATCH_MP_TAC ;
31715   UND 11;
31716   MESON_TAC[simple_arc_end_end2];
31717   DISCH_TAC;
31718   (* - *)
31719   USE 35 (MATCH_MP   union_imp_subset);
31720   TYPE_THEN `Cu'v' = Cv'` SUBGOAL_TAC;
31721   TH_INTRO_TAC [`Cu'v'`;`Cv'`;`e`;`v'`;`u'`] simple_arc_end_inj;
31722   ASM_REWRITE_TAC[];
31723   CONJ_TAC;
31724   IMATCH_MP_TAC  simple_arc_end_symm;
31725   ASM_REWRITE_TAC[];
31726   IMATCH_MP_TAC  simple_arc_end_simple;
31727   ASM_MESON_TAC[];
31728   DISCH_THEN_REWRITE;
31729   DISCH_THEN_FULL_REWRITE;
31730   (* - *)
31731   TYPE_THEN `~Cv' u` SUBGOAL_TAC;
31732   DISCH_TAC;
31733   UNDF `~D v' u` ;
31734   REWRITE_TAC[];
31735   EXPAND_TAC "D";
31736   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
31737   FIRST_ASSUM IMATCH_MP_TAC ;
31738   ASM_REWRITE_TAC[];
31739   DISCH_TAC;
31740   REWR 45;
31741   (* - *)
31742   TYPE_THEN `~(u = u')` SUBGOAL_TAC;
31743   DISCH_TAC;
31744   UND 47;
31745   DISCH_THEN_FULL_REWRITE;
31746   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
31747   REP_BASIC_TAC;
31748   GRABF `~(v=v')` (TH_INTRO_TAC[`v`;`v'`]);
31749   ASM_REWRITE_TAC[];
31750   REWRITE_TAC[EMPTY_EXISTS];
31751   TYPE_THEN `u'` EXISTS_TAC;
31752   REWRITE_TAC[INTER;closed_ball];
31753   ASM_REWRITE_TAC[];
31754   REWRITE_TAC[REAL_ARITH `r <= r`];
31755   CONJ_TAC;
31756   FIRST_ASSUM IMATCH_MP_TAC ;
31757   ASM_REWRITE_TAC[];
31758   FIRST_ASSUM IMATCH_MP_TAC ;
31759   ASM_REWRITE_TAC[];
31760   DISCH_TAC;
31761   (* - *)
31762   TH_INTRO_TAC[`Cvu'`;`v`;`u'`;`u`] simple_arc_end_cut;
31763   ASM_REWRITE_TAC[];
31764   REP_BASIC_TAC;
31765   TYPE_THEN `CC = C'''''` ABBREV_TAC ;
31766   POP_ASSUM (fun t->ALL_TAC);
31767   (* E' *)
31768   TYPE_THEN `~CC v` SUBGOAL_TAC;
31769   DISCH_TAC;
31770   TYPE_THEN `C'''' v` SUBGOAL_TAC;
31771   UND 50;
31772   MESON_TAC[simple_arc_end_end];
31773   DISCH_TAC;
31774   TYPE_THEN `v = u` SUBGOAL_TAC;
31775   UND 48;
31776    REWRITE_TAC[INTER;eq_sing;INR IN_SING];
31777   REP_BASIC_TAC;
31778   FIRST_ASSUM IMATCH_MP_TAC ;
31779   ASM_REWRITE_TAC[];
31780   DISCH_THEN_FULL_REWRITE;
31781   ASM_REWRITE_TAC[];
31782   DISCH_TAC;
31783   (* - *)
31784   TYPE_THEN `~CC v'` SUBGOAL_TAC;
31785   DISCH_TAC;
31786   USE 35 (MATCH_MP union_imp_subset);
31787   UND 43;
31788   REWRITE_TAC[];
31789   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
31790   REP_BASIC_TAC;
31791   FIRST_ASSUM IMATCH_MP_TAC ;
31792   ASM_REWRITE_TAC[];
31793   DISCH_TAC;
31794   (* - *)
31795   TYPE_THEN `CC SUBSET A` SUBGOAL_TAC;
31796   EXPAND_TAC "A";
31797   REWRITE_TAC[DIFF_SUBSET];
31798   CONJ_TAC;
31799   IMATCH_MP_TAC  simple_arc_euclid;
31800   IMATCH_MP_TAC  simple_arc_end_simple;
31801   UND 49;
31802   MESON_TAC[];
31803   PROOF_BY_CONTR_TAC;
31804   USE 55 (MATCH_MP inter_union);
31805   FIRST_ASSUM MP_TAC;
31806   REWRITE_TAC[];
31807   REWRITE_TAC[DE_MORGAN_THM];
31808   TYPE_THEN `CC SUBSET e` SUBGOAL_TAC;
31809   USE 35 (MATCH_MP union_imp_subset);
31810   IMATCH_MP_TAC  SUBSET_TRANS;
31811   TYPE_THEN `Cvu'` EXISTS_TAC;
31812   ASM_REWRITE_TAC[];
31813   REWRITE_TAC[SUBSET];
31814   DISCH_TAC;
31815   (* -- *)
31816   CONJ_TAC;
31817   EXPAND_TAC"B";
31818   REWRITE_TAC[INTER;UNIONS;EQ_EMPTY ];
31819   REP_BASIC_TAC;
31820   TYPE_THEN `e x` SUBGOAL_TAC;
31821   FIRST_ASSUM IMATCH_MP_TAC ;
31822   ASM_REWRITE_TAC[];
31823   DISCH_TAC;
31824   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
31825   REP_BASIC_TAC  ; (* we are up to 69 in the hypothesis stack *)
31826   TYPEL_THEN  [`e`;`u''`] (USE 66 o ISPECL);
31827   REWR 66;
31828   TYPE_THEN `graph_vertex G x` SUBGOAL_TAC;
31829   USE 66 (REWRITE_RULE[SUBSET]);
31830   FIRST_ASSUM IMATCH_MP_TAC ;
31831   REWRITE_TAC[INTER];
31832   ASM_REWRITE_TAC[];
31833   DISCH_TAC;
31834   (* --- *)
31835   TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
31836   IMATCH_MP_TAC  graph_edge2;
31837   ASM_REWRITE_TAC[];
31838   TYPE_THEN `graph_inc G e x` SUBGOAL_TAC;
31839   ASM_SIMP_TAC[];
31840   ASM_REWRITE_TAC[INTER];
31841   REP_BASIC_TAC;
31842   TH_INTRO_TAC [`graph_inc G e`;`v`;`x`;`v'`] two_exclusion;
31843   ASM_REWRITE_TAC[];
31844    UND 60;
31845   UND 54;
31846   MESON_TAC[];
31847   UND 60;
31848   UND 53;
31849   MESON_TAC[];
31850   (* -- *)
31851   PROOF_BY_CONTR_TAC;
31852   USE 57 (MATCH_MP inter_union);
31853   UND 57;
31854   REWRITE_TAC[DE_MORGAN_THM];
31855   CONJ_TAC;
31856   EXPAND_TAC "B'";
31857   REWRITE_TAC[INTER;UNIONS;];
31858   REWRITE_TAC [EQ_EMPTY];
31859   REP_BASIC_TAC;
31860   UNDF `u''' = D v''` ;
31861   DISCH_THEN_FULL_REWRITE;
31862   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
31863   REP_BASIC_TAC;
31864   TYPEL_THEN [`e`;`v''`] (USE 59 o ISPECL);
31865   REWR 59;
31866   UND 59;
31867   REWRITE_TAC[EMPTY_EXISTS];
31868   TYPE_THEN `x` EXISTS_TAC;
31869   REWRITE_TAC[INTER];
31870   CONJ_TAC;
31871   FIRST_ASSUM IMATCH_MP_TAC ;
31872   ASM_REWRITE_TAC[];
31873   UND 57;
31874   EXPAND_TAC "D";
31875   DISCH_THEN_REWRITE;
31876   (* -- *)
31877   EXPAND_TAC "B''";
31878   REWRITE_TAC[INTER;EQ_EMPTY;in_pair];
31879   ASM_MESON_TAC[];
31880   DISCH_TAC;
31881   (* F' *)
31882   TH_INTRO_TAC[`A`;`CC`;`u`;`u'`] construct_hv_finite;
31883   ASM_REWRITE_TAC[];
31884   REP_BASIC_TAC;
31885   TYPE_THEN `Chv = C''''''` ABBREV_TAC ;
31886   KILL 59;
31887   TYPE_THEN `Chv` EXISTS_TAC;
31888   ASM_REWRITE_TAC[];
31889   (* - *)
31890   TYPE_THEN `~(A v) /\ ~(A v')` SUBGOAL_TAC;
31891   EXPAND_TAC "A";
31892   EXPAND_TAC "B''";
31893   REWRITE_TAC[DIFF;UNION;in_pair];
31894   DISCH_TAC;
31895   TYPE_THEN `~(Chv v) /\ ~(Chv v')` SUBGOAL_TAC;
31896   UND 59;
31897   UND 58;
31898   MESON_TAC[ISUBSET];
31899   DISCH_THEN_REWRITE;
31900   (* - *)
31901   TYPE_THEN `(!e'. ~(e = e') /\ (graph_edge G e') ==> (A INTER e' = {}))` SUBGOAL_TAC;
31902   EXPAND_TAC "A";
31903   EXPAND_TAC "B";
31904   REP_BASIC_TAC;
31905   REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS ];
31906   REP_BASIC_TAC;
31907   LEFT 64 "u";
31908   LEFT 64 "u";
31909   TSPEC `e'` 64;
31910   UND 64;
31911   ASM_REWRITE_TAC[];
31912   DISCH_TAC;
31913   (* - *)
31914   CONJ_TAC;
31915   REP_BASIC_TAC;
31916   TSPEC `e'` 60;
31917   REWR 60;
31918   UND 60;
31919   UND 58;
31920   REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;];
31921   MESON_TAC[];
31922   (* - *)
31923   TYPE_THEN `!v''. graph_vertex G v'' /\ ~graph_inc G e v'' ==> (A INTER closed_ball (euclid 2,d_euclid) v'' r = {})` SUBGOAL_TAC;
31924   REP_BASIC_TAC;
31925   EXPAND_TAC "A";
31926   EXPAND_TAC "B'";
31927   REP_BASIC_TAC;
31928   REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS;];
31929   EXPAND_TAC "D";
31930   REP_BASIC_TAC;
31931   UND 65;
31932   REWRITE_TAC[];
31933   DISJ2_TAC;
31934   DISJ1_TAC;
31935   CONV_TAC (dropq_conv "u");
31936   TYPE_THEN `v''` EXISTS_TAC;
31937   ASM_REWRITE_TAC[];
31938   REP_BASIC_TAC;
31939   TSPEC `v''` 62;
31940   REWR 62;
31941   UND 62;
31942   UND 58;
31943   REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;];
31944   MESON_TAC[];
31945   (* Wed Aug 25 14:58:37 EDT 2004 *)
31946
31947
31948   ]);;
31949   (* }}} *)
31950
31951 let planar_graph_hv = prove_by_refinement(
31952   `!(G:(A,B)graph_t). (planar_graph G) /\
31953          FINITE (graph_edge G) /\
31954          FINITE (graph_vertex G) /\
31955          ~(graph_edge G = {}) /\
31956          (!v. CARD (graph_edge_around G v) <=| 4)
31957          ==> (?H. graph_isomorphic G H /\
31958               good_plane_graph H /\ (!e. graph_edge H e ==>
31959            hv_finite e))`,
31960   (* {{{ proof *)
31961   [
31962   REP_BASIC_TAC;
31963   TH_INTRO_TAC[`G`] graph_radius_exists;
31964   ASM_REWRITE_TAC[];
31965   REP_BASIC_TAC;
31966   (* - *)
31967   TYPE_THEN `X = { K | graph_isomorphic H K /\ graph_hv_finite_radius K r}` ABBREV_TAC  ;
31968   TYPE_THEN `c = (\ (K:(num->real,(num->real)->bool)graph_t). CARD {x | graph_edge K x /\ ~hv_finite x})` ABBREV_TAC ;
31969   TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ;
31970   TH_INTRO_TAC[`X`;`c`] select_image_num_min;
31971   REWRITE_TAC[EMPTY_EXISTS];
31972   TYPE_THEN `H` EXISTS_TAC;
31973   EXPAND_TAC "X";
31974   REWRITE_TAC[];
31975   ASM_REWRITE_TAC[graph_isomorphic_refl];
31976   REP_BASIC_TAC;
31977   TYPE_THEN `K = z` ABBREV_TAC ;
31978   KILL 12;
31979   TYPE_THEN `K` EXISTS_TAC;
31980   CONJ_TAC;
31981   UND 11;
31982   EXPAND_TAC "X";
31983   REWRITE_TAC[];
31984   ASM_MESON_TAC[graph_isomorphic_trans];
31985   (* - *)
31986   TYPE_THEN `graph_hv_finite_radius K r` SUBGOAL_TAC;
31987   UND 11;
31988   EXPAND_TAC "X";
31989   REWRITE_TAC[];
31990   DISCH_THEN_REWRITE;
31991   DISCH_TAC;
31992   (* - *)
31993   CONJ_TAC;
31994   UND 12;
31995   REWRITE_TAC[graph_hv_finite_radius];
31996   DISCH_THEN_REWRITE;
31997   REP_BASIC_TAC;
31998   PROOF_BY_CONTR_TAC;
31999   (* - *)
32000   TH_INTRO_TAC[`K`;`e`] graph_edge_end_select;
32001   ASM_REWRITE_TAC[];
32002   UND 12;
32003   REWRITE_TAC[graph_hv_finite_radius;good_plane_graph;plane_graph];
32004   DISCH_THEN_REWRITE;
32005   REP_BASIC_TAC;
32006   (* A *)
32007   TYPE_THEN `graph_isomorphic G K` SUBGOAL_TAC;
32008   TH_INTRO_TAC[`G`;`H`;`K`] graph_isomorphic_trans;
32009   ASM_REWRITE_TAC[];
32010   UND 11;
32011   EXPAND_TAC "X";
32012   REWRITE_TAC[];
32013   DISCH_THEN_REWRITE;
32014   DISCH_THEN_REWRITE;
32015   DISCH_TAC;
32016   (* - *)
32017   TYPE_THEN `FINITE (graph_edge K)` SUBGOAL_TAC;
32018   USE 18(REWRITE_RULE[graph_isomorphic;graph_iso]);
32019   REP_BASIC_TAC;
32020   UND 19;
32021   UND 3;
32022   MESON_TAC[FINITE_BIJ];
32023   DISCH_TAC;
32024   (* - *)
32025   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;
32026   DISCH_TAC;
32027   REP_BASIC_TAC;
32028   (* -- *)
32029   TH_INTRO_TAC[`K`;`e`;`e'`] graph_replace_card;
32030   ASM_REWRITE_TAC[];
32031   TYPE_THEN `K' = graph_replace K e e'` ABBREV_TAC ;
32032   DISCH_TAC;
32033   TYPE_THEN `graph_isomorphic H K'` SUBGOAL_TAC;
32034   EXPAND_TAC "X";
32035   EXPAND_TAC "K'";
32036   REWRITE_TAC[];
32037   TH_INTRO_TAC[`H`;`K`;`K'`] graph_isomorphic_trans;
32038   ASM_REWRITE_TAC[];
32039   UND 11;
32040   EXPAND_TAC "X";
32041   REWRITE_TAC[];
32042   DISCH_THEN_REWRITE;
32043   EXPAND_TAC "K'";
32044   IMATCH_MP_TAC  graph_replace_iso;
32045   ASM_REWRITE_TAC[];
32046   EXPAND_TAC "K'";
32047   DISCH_THEN_REWRITE;
32048   DISCH_TAC;
32049   (* -- *)
32050   TYPE_THEN `plane_graph K'` SUBGOAL_TAC;
32051   EXPAND_TAC "K'";
32052   IMATCH_MP_TAC  graph_replace_plane;
32053   ASM_REWRITE_TAC[];
32054   CONJ_TAC;
32055   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]);
32056   ASM_REWRITE_TAC[];
32057   IMATCH_MP_TAC  simple_arc_end_simple;
32058   ASM_MESON_TAC[];
32059   DISCH_TAC;
32060   (* -- *)
32061   TYPE_THEN `good_plane_graph K'` SUBGOAL_TAC;
32062   EXPAND_TAC "K'";
32063   IMATCH_MP_TAC  good_replace;
32064   ASM_REWRITE_TAC[];
32065   CONJ_TAC;
32066   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
32067   ASM_REWRITE_TAC[];
32068   REP_BASIC_TAC;
32069   TYPE_THEN `e v'' /\ e v'''` SUBGOAL_TAC;
32070   USE 22 (REWRITE_RULE[FUN_EQ_THM]);
32071   TYPE_THEN  `v''` (WITH 22 o ISPEC);
32072   TYPE_THEN `v'''` (USE 22 o ISPEC);
32073   RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
32074   UND 22;
32075   UND 35;
32076   UND 33;
32077   UND 34;
32078   DISCH_THEN_REWRITE;
32079   DISCH_THEN_REWRITE;
32080   ASM_REWRITE_TAC[];
32081   MESON_TAC[];
32082   REP_BASIC_TAC;
32083   TYPE_THEN `graph_inc K e = {v,v'}` SUBGOAL_TAC;
32084   IMATCH_MP_TAC  graph_vertex_exhaust;
32085   ASM_REWRITE_TAC[];
32086   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
32087   ASM_REWRITE_TAC[];
32088   DISCH_TAC;
32089   TYPE_THEN `graph_inc K e = {v'',v'''}` SUBGOAL_TAC;
32090   IMATCH_MP_TAC  graph_vertex_exhaust;
32091   USE 37 (SYM);
32092   ASM_REWRITE_TAC[];
32093   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
32094   REP_BASIC_TAC;
32095   ASM_REWRITE_TAC[];
32096   TSPEC `e` 46;
32097   REWR 46;
32098   ASM_REWRITE_TAC[INTER];
32099   DISCH_THEN_FULL_REWRITE;
32100   TYPE_THEN `((v'' = v) /\ (v''' = v')) \/ ((v'' = v') /\ (v''' = v))` SUBGOAL_TAC;
32101   USE 37 (REWRITE_RULE[FUN_EQ_THM]);
32102   TYPE_THEN `v''` (WITH 37 o ISPEC);
32103   TYPE_THEN `v'''` (USE 37 o ISPEC);
32104   UND 37;
32105   UND 38;
32106   REWRITE_TAC[in_pair];
32107   UND 32;
32108   UND 15;
32109   MESON_TAC[];
32110   DISCH_THEN DISJ_CASES_TAC;
32111   REP_BASIC_TAC;
32112   ASM_REWRITE_TAC[];
32113   ASM_REWRITE_TAC[];
32114   IMATCH_MP_TAC  simple_arc_end_symm;
32115   ASM_REWRITE_TAC[];
32116   DISCH_TAC;
32117   (* -- *)
32118   TYPE_THEN `graph_hv_finite_radius K' r` SUBGOAL_TAC;
32119   EXPAND_TAC "K'";
32120   IMATCH_MP_TAC  graph_replace_hv_finite_radius;
32121   ASM_REWRITE_TAC[];
32122   DISCH_TAC;
32123   TYPE_THEN `X K'` SUBGOAL_TAC;
32124   EXPAND_TAC "X";
32125   ASM_REWRITE_TAC[];
32126   DISCH_TAC;
32127   TSPEC `K'` 10;
32128   REWR 10;
32129   UND 10;
32130   EXPAND_TAC "c";
32131   UND 27;
32132 (**** Changed by JRH; the new ARITH_TAC doesn't accept alpha-equivs (maybe)
32133   ARITH_TAC;
32134  ****)
32135   REWRITE_TAC[NOT_IMP; NOT_LE];
32136   REWRITE_TAC[];
32137   (* B *)
32138   TH_INTRO_TAC [`K`;`r`;`e`;`v`;`v'`] graph_rad_pt_center_piece;
32139   ASM_REWRITE_TAC[];
32140   USE 18 (REWRITE_RULE[graph_isomorphic;graph_iso]);
32141   REP_BASIC_TAC;
32142   UND 21;
32143   UND 2;
32144   MESON_TAC[FINITE_BIJ];
32145   REP_BASIC_TAC;
32146   KILL 4;
32147   KILL 3;
32148   KILL 2;
32149   KILL 1;
32150   KILL 0;
32151   KILL 6;
32152   KILL 5;
32153   KILL 7;
32154   KILL 8;
32155   KILL 11;
32156   KILL 10;
32157   KILL 18;
32158   KILL 19;
32159   TYPE_THEN `graph_inc K e  = {v,v'}` SUBGOAL_TAC;
32160   IMATCH_MP_TAC  graph_vertex_exhaust;
32161   ASM_REWRITE_TAC[];
32162   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
32163   ASM_REWRITE_TAC[];
32164   DISCH_TAC;
32165   (* - *)
32166   TYPE_THEN `e INTER graph_vertex K = {v,v'}` SUBGOAL_TAC;
32167   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
32168   REP_BASIC_TAC;
32169   TSPEC `e` 7;
32170   REWR 7;
32171   ASM_REWRITE_TAC[];
32172   DISCH_THEN_REWRITE;
32173   (* C- *)
32174   TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC;
32175   REP_BASIC_TAC;
32176   TH_INTRO_TAC[`K`;`e'`] graph_inc_subset;
32177   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
32178   ASM_REWRITE_TAC[];
32179   REWRITE_TAC[SUBSET];
32180   DISCH_THEN IMATCH_MP_TAC ;
32181   ASM_REWRITE_TAC[];
32182   DISCH_TAC;
32183   (* - *)
32184   TYPE_THEN `p_conn (Cv UNION Cv' UNION C'') v v'` SUBGOAL_TAC;
32185   IMATCH_MP_TAC  pconn_trans;
32186   TYPE_THEN `u` EXISTS_TAC;
32187   CONJ_TAC;
32188   TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`u`] p_conn_hv_finite;
32189   IMATCH_MP_TAC  simple_arc_end_distinct;
32190   ASM_MESON_TAC[];
32191   DISCH_THEN_REWRITE;
32192   TYPE_THEN `Cv` EXISTS_TAC;
32193   ASM_REWRITE_TAC[SUBSET;UNION];
32194   MESON_TAC[];
32195   IMATCH_MP_TAC  pconn_trans;
32196   TYPE_THEN `u'` EXISTS_TAC;
32197   CONJ_TAC;
32198   TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u`;`u'`] p_conn_hv_finite;
32199   IMATCH_MP_TAC  simple_arc_end_distinct;
32200   ASM_MESON_TAC[];
32201   DISCH_THEN_REWRITE;
32202   TYPE_THEN `C''` EXISTS_TAC;
32203   ASM_REWRITE_TAC[SUBSET;UNION];
32204   MESON_TAC[];
32205   TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u'`;`v'`] p_conn_hv_finite;
32206   IMATCH_MP_TAC  simple_arc_end_distinct;
32207   TYPE_THEN `Cv'` EXISTS_TAC;
32208   IMATCH_MP_TAC  simple_arc_end_symm;
32209   ASM_MESON_TAC[];
32210   DISCH_THEN_REWRITE;
32211   TYPE_THEN `Cv'` EXISTS_TAC;
32212   ASM_REWRITE_TAC[SUBSET;UNION];
32213   CONJ_TAC;
32214   MESON_TAC[];
32215   IMATCH_MP_TAC  simple_arc_end_symm;
32216   ASM_REWRITE_TAC[];
32217   DISCH_TAC;
32218   (* - *)
32219   TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`v'`] p_conn_hv_finite;
32220   ASM_REWRITE_TAC[];
32221   ASM_REWRITE_TAC[];
32222   REP_BASIC_TAC;
32223   TYPE_THEN `C` EXISTS_TAC;
32224   ASM_REWRITE_TAC[];
32225   (* D final constraints *)
32226   TYPE_THEN`graph K` SUBGOAL_TAC;
32227   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
32228   ASM_REWRITE_TAC[];
32229   DISCH_TAC;
32230   (* - *)
32231   TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC;
32232   REP_BASIC_TAC;
32233   TH_INTRO_TAC[`K`;`e'`]graph_inc_subset;
32234   ASM_REWRITE_TAC[];
32235   REWRITE_TAC[SUBSET];
32236   DISCH_THEN IMATCH_MP_TAC ;
32237   ASM_REWRITE_TAC[];
32238   DISCH_TAC;
32239   (* - *)
32240   CONJ_TAC;
32241   DISCH_TAC;
32242   TYPE_THEN `C = e` ASM_CASES_TAC;
32243   ASM_MESON_TAC[];
32244   TSPEC `C` 21;
32245   REWR 11;
32246   TYPE_THEN `C SUBSET Cv UNION Cv'` SUBGOAL_TAC;
32247   UND 11;
32248   UND 4;
32249   REWRITE_TAC[SUBSET;UNION;EQ_EMPTY;INTER ];
32250   MESON_TAC[];
32251   DISCH_TAC;
32252   TYPE_THEN `D v INTER D v' = EMPTY ` SUBGOAL_TAC;
32253   EXPAND_TAC "D";
32254   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
32255   REP_BASIC_TAC;
32256   UND 21;
32257   DISCH_THEN IMATCH_MP_TAC ;
32258   ASM_REWRITE_TAC[];
32259   CONJ_TAC;
32260   FIRST_ASSUM IMATCH_MP_TAC ;
32261   ASM_MESON_TAC[];
32262   FIRST_ASSUM IMATCH_MP_TAC ;
32263   ASM_MESON_TAC[];
32264   DISCH_TAC;
32265   (* -- *)
32266   UND 10;
32267   REWRITE_TAC[];
32268   IMATCH_MP_TAC  simple_arc_end_inj;
32269   TYPE_THEN `e` EXISTS_TAC;
32270   TYPE_THEN `v` EXISTS_TAC;
32271   TYPE_THEN `v'` EXISTS_TAC;
32272   ASM_REWRITE_TAC[SUBSET_REFL];
32273   SUBCONJ_TAC;
32274   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]);
32275   REP_BASIC_TAC;
32276   FIRST_ASSUM IMATCH_MP_TAC ;
32277   ASM_REWRITE_TAC[];
32278   DISCH_TAC;
32279   CONJ_TAC;
32280   IMATCH_MP_TAC  simple_arc_end_simple;
32281   ASM_MESON_TAC[];
32282   IMATCH_MP_TAC  SUBSET_TRANS;
32283   TYPE_THEN `Cv UNION Cv'` EXISTS_TAC;
32284   ASM_REWRITE_TAC[union_subset ];
32285   (* E *)
32286   CONJ_TAC;
32287   IMATCH_MP_TAC  EQ_EXT;
32288   REWRITE_TAC[in_pair;INTER ];
32289   GEN_TAC;
32290   EQ_TAC;
32291   DISCH_THEN DISJ_CASES_TAC;
32292   UND 8;
32293   DISCH_THEN_FULL_REWRITE;
32294   CONJ_TAC;
32295   UND 3;
32296   MESON_TAC[simple_arc_end_end2];
32297   FIRST_ASSUM IMATCH_MP_TAC ;
32298   ASM_MESON_TAC[];
32299   UND 8;
32300   DISCH_THEN_FULL_REWRITE;
32301   CONJ_TAC;
32302   UND 3;
32303   MESON_TAC[simple_arc_end_end];
32304   FIRST_ASSUM IMATCH_MP_TAC ;
32305   ASM_MESON_TAC[];
32306   (* -- *)
32307   TYPE_THEN `graph_inc K e x` ASM_CASES_TAC;
32308   REWR 8;
32309   RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
32310   ASM_REWRITE_TAC[];
32311   USE 4 (REWRITE_RULE[SUBSET ]);
32312   REP_BASIC_TAC;
32313   TSPEC `x` 4;
32314   REWR 4;
32315   USE 4(REWRITE_RULE[UNION]);
32316   UND 4;
32317   REP_CASES_TAC;
32318   DISJ2_TAC;
32319   PROOF_BY_CONTR_TAC;
32320   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
32321   REP_BASIC_TAC;
32322   UND 40;
32323   DISCH_THEN (TH_INTRO_TAC[`v`;`x`]);
32324   ASM_REWRITE_TAC[];
32325   FIRST_ASSUM IMATCH_MP_TAC ;
32326   ASM_MESON_TAC[];
32327   REWRITE_TAC[EMPTY_EXISTS];
32328   TYPE_THEN `x` EXISTS_TAC;
32329   REWRITE_TAC[INTER];
32330   CONJ_TAC;
32331   UND 4;
32332   UND 23;
32333   REWRITE_TAC[SUBSET];
32334   MESON_TAC[];
32335   REWRITE_TAC[closed_ball2_center];
32336   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
32337   REP_BASIC_TAC;
32338   CONJ_TAC;
32339   USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
32340   FIRST_ASSUM IMATCH_MP_TAC ;
32341   ASM_REWRITE_TAC[];
32342   UNDF `&0 < r`;
32343   REAL_ARITH_TAC;
32344   (* --- *)
32345   DISJ1_TAC;
32346   PROOF_BY_CONTR_TAC;
32347   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
32348   REP_BASIC_TAC;
32349   UNDF `~(v = v')`;
32350   DISCH_THEN (TH_INTRO_TAC[`v'`;`x`]);
32351   ASM_REWRITE_TAC[];
32352   FIRST_ASSUM IMATCH_MP_TAC ;
32353   ASM_MESON_TAC[];
32354   REWRITE_TAC[EMPTY_EXISTS];
32355   TYPE_THEN `x` EXISTS_TAC;
32356   REWRITE_TAC[INTER];
32357   CONJ_TAC;
32358   UND 4;
32359   UND 22;
32360   REWRITE_TAC[SUBSET];
32361   MESON_TAC[];
32362   REWRITE_TAC[closed_ball2_center];
32363   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
32364   REP_BASIC_TAC;
32365   CONJ_TAC;
32366   USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
32367   FIRST_ASSUM IMATCH_MP_TAC ;
32368   ASM_REWRITE_TAC[];
32369   UNDF `&0 < r`;
32370   REAL_ARITH_TAC;
32371  (* -- *)
32372   TYPE_THEN `graph_inc K e x` ASM_CASES_TAC;
32373   REWR 18;
32374   TSPEC `x` 20;
32375   REWR 19;
32376   PROOF_BY_CONTR_TAC;
32377   UND 19;
32378   REWRITE_TAC[EMPTY_EXISTS];
32379   TYPE_THEN `x` EXISTS_TAC;
32380   ASM_REWRITE_TAC[INTER;closed_ball2_center];
32381   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
32382   REP_BASIC_TAC;
32383   USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
32384   CONJ_TAC;
32385   FIRST_ASSUM IMATCH_MP_TAC ;
32386   ASM_REWRITE_TAC[];
32387   UNDF `&0 < r`;
32388   REAL_ARITH_TAC;
32389   (* F *)
32390   KILL 14;
32391   KILL 39;
32392   KILL 38;
32393   KILL 37;
32394   KILL 36;
32395   KILL 35;
32396   KILL 34;
32397   KILL 33;
32398   KILL 32;
32399   KILL 29;
32400   KILL 28;
32401   KILL 27;
32402   KILL 26;
32403   KILL 5;
32404   KILL 2;
32405   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
32406   CONJ_TAC;
32407   REP_BASIC_TAC;
32408   REWRITE_TAC[SUBSET;INTER];
32409   REP_BASIC_TAC;
32410   USEF `(SUBSET)` (REWRITE_RULE[SUBSET]);
32411   TSPEC `x` 4;
32412   REWR 4;
32413   UND 4;
32414   REWRITE_TAC[UNION];
32415   REP_CASES_TAC;
32416   ASM_MESON_TAC[ISUBSET];
32417   ASM_MESON_TAC[ISUBSET];
32418   PROOF_BY_CONTR_TAC;
32419   UND 21;
32420   DISCH_THEN (TH_INTRO_TAC[`e''`]);
32421   ASM_REWRITE_TAC[];
32422   REWRITE_TAC[EMPTY_EXISTS];
32423   TYPE_THEN `x` EXISTS_TAC;
32424   ASM_REWRITE_TAC[INTER];
32425   (* G *)
32426   REP_BASIC_TAC;
32427   TYPE_THEN `graph_inc K e v''` ASM_CASES_TAC;
32428   REWR 8;
32429   UND 8;
32430   REWRITE_TAC[in_pair];
32431   REP_CASES_TAC;
32432   UND 8;
32433   DISCH_THEN_FULL_REWRITE;
32434   PROOF_BY_CONTR_TAC;
32435   UND 2;
32436   UND 3;
32437   MESON_TAC[simple_arc_end_end2];
32438   UND 8;
32439   DISCH_THEN_FULL_REWRITE;
32440   PROOF_BY_CONTR_TAC;
32441   UND 2;
32442   UND 3;
32443   MESON_TAC[simple_arc_end_end];
32444   (* - *)
32445   TYPE_THEN `C SUBSET D v UNION D v' UNION C''` SUBGOAL_TAC;
32446   EXPAND_TAC "D";
32447   UND 4;
32448   UND 22;
32449   UND 23;
32450   REWRITE_TAC[SUBSET;UNION];
32451   MESON_TAC[];
32452   REWRITE_TAC[SUBSET];
32453   DISCH_TAC;
32454   PROOF_BY_CONTR_TAC;
32455   USE 11 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
32456   REP_BASIC_TAC;
32457   TSPEC `u` 10;
32458   REWR 10;
32459   USE 10 (REWRITE_RULE[UNION]);
32460   UND 10;
32461   REP_CASES_TAC ;
32462   (* -- *)
32463   UND 8;
32464   ASM_REWRITE_TAC[in_pair];
32465   PROOF_BY_CONTR_TAC;
32466   USE 8 (REWRITE_RULE[DE_MORGAN_THM]);
32467   REP_BASIC_TAC;
32468   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
32469   REP_BASIC_TAC;
32470   UND 26;
32471   DISCH_THEN (TH_INTRO_TAC[`v`;`v''`]);
32472   ASM_REWRITE_TAC[];
32473   FIRST_ASSUM IMATCH_MP_TAC ;
32474   ASM_MESON_TAC[];
32475   REWRITE_TAC[INTER;EMPTY_EXISTS];
32476   TYPE_THEN `u` EXISTS_TAC;
32477   UND 10;
32478   EXPAND_TAC "D";
32479   DISCH_THEN_REWRITE;
32480   ASM_REWRITE_TAC[];
32481   (* -- *)
32482   UND 8;
32483   ASM_REWRITE_TAC[in_pair];
32484   PROOF_BY_CONTR_TAC;
32485   USE 8 (REWRITE_RULE[DE_MORGAN_THM]);
32486   REP_BASIC_TAC;
32487   RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
32488   REP_BASIC_TAC;
32489   UND 26;
32490   DISCH_THEN (TH_INTRO_TAC[`v'`;`v''`]);
32491   ASM_REWRITE_TAC[];
32492   FIRST_ASSUM IMATCH_MP_TAC ;
32493   ASM_MESON_TAC[];
32494   REWRITE_TAC[INTER;EMPTY_EXISTS];
32495   TYPE_THEN `u` EXISTS_TAC;
32496   UND 10;
32497   EXPAND_TAC "D";
32498   DISCH_THEN_REWRITE;
32499   ASM_REWRITE_TAC[];
32500   (* - *)
32501   UND 20;
32502   DISCH_THEN (TH_INTRO_TAC[`v''`]);
32503   ASM_REWRITE_TAC[];
32504   REWRITE_TAC[EMPTY_EXISTS;INTER];
32505   ASM_MESON_TAC[];
32506   (* Thu Aug 26 08:46:13 EDT 2004 *)
32507
32508   ]);;
32509   (* }}} *)
32510
32511 (* ------------------------------------------------------------------ *)
32512 (* SECTION P *)
32513 (* ------------------------------------------------------------------ *)
32514
32515
32516 let (UNDISCHQ_TAC:(term->bool) -> tactic) =
32517   fun cond (asl,w) ->
32518   let cond' x = try (cond x) with failure -> false in
32519   let asl' = (fst(partition cond' (map (concl o snd) asl))) in
32520   EVERY (map (TRY o UNDISCH_TAC ) asl') (asl,w);;
32521
32522 let UNABBREV_TAC tm  =
32523   FIRST[ UNDISCHQ_TAC ( ((=) tm o rhs))
32524       THEN (DISCH_THEN (MP_TAC o SYM))  ;
32525       UNDISCHQ_TAC ( ((=) tm o lhs)) ]
32526   THEN DISCH_THEN_FULL_REWRITE;;
32527
32528 let set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net =
32529   let rewrites = ref (basic_rewrites())
32530   and conv_net = ref (basic_net()) in
32531   let set_simp_rewrites thl =
32532     let canon_thl = itlist (mk_rewrites false) thl ([]:thm list) in
32533     (rewrites := canon_thl;
32534      conv_net := itlist (net_of_thm true) canon_thl empty_net) in
32535   let extend_simp_rewrites thl =
32536     (* is false in simp.ml .  Important change.  *)
32537     let canon_thl = itlist (mk_rewrites true) thl ([]:thm list) in
32538      (rewrites := canon_thl @ !rewrites;
32539       conv_net := itlist (net_of_thm true) canon_thl (!conv_net)) in
32540   let simp_rewrites() = !rewrites in
32541   let simp_net() = !conv_net in
32542   set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net;;
32543
32544 let simp_ss =
32545   let rewmaker = mk_rewrites true in
32546   fun thl ->
32547     let cthms = itlist rewmaker thl ([]:thm list) in
32548     let net' = itlist (net_of_thm true) cthms (simp_net()) in
32549     let net'' = itlist net_of_cong (basic_congs()) net' in
32550   Simpset(net'',basic_prover,([]:prover list),rewmaker);;
32551
32552 let RSIMP_CONV thl = ONCE_SIMPLIFY_CONV (simp_ss ([]:thm list)) thl;;
32553
32554 let (RSIMP_TAC:thm list -> tactic) = fun (thl:thm list) -> CONV_TAC(RSIMP_CONV thl);;
32555
32556 let ASM_RSIMP_TAC = ASM RSIMP_TAC;;
32557
32558 EVERY_STEP_TAC :=
32559      (RSIMP_TAC[]) THEN
32560      REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN
32561      (ASM_RSIMP_TAC[]) THEN
32562      (REWRITE_TAC[]) ;;
32563
32564 let SUBAGOAL_TAC t = SUBGOAL_THEN t ASSUME_TAC;;
32565
32566 (* EVERY_STEP_TAC := ALL_TAC *)
32567
32568 let subset_imp = prove_by_refinement(
32569   `!A B (x:A). A x /\ A SUBSET B ==> B x`,
32570   (* {{{ proof *)
32571   [
32572   ASM_MESON_TAC[ISUBSET];
32573   ]);;
32574   (* }}} *)
32575
32576 (*
32577 extend_simp_rewrites[subset_imp]
32578 *)
32579
32580 (* ------------------------------------------------------------------ *)
32581 (* ------------------------------------------------------------------ *)
32582
32583
32584 let plane_graph_image = jordan_def
32585   `plane_graph_image (f:(num->real)->(num->real)) G =
32586      mk_graph_t
32587        (IMAGE f (graph_vertex G),
32588         IMAGE2 f (graph_edge G),
32589         ( \ e v. (?e' v'. (graph_edge G e') /\
32590              (IMAGE f e' = e) /\ (f v' = v) /\
32591             (graph_inc G e' v'))))`;;
32592
32593 let plane_graph_image_e = prove_by_refinement(
32594   `!f G. (graph_edge (plane_graph_image f G)) =
32595          IMAGE2 f (graph_edge G)`,
32596   (* {{{ proof *)
32597   [
32598   REWRITE_TAC[plane_graph_image;graph_edge;part1;drop0;dest_graph_t];
32599   (* Thu Aug 26 10:16:26 EDT 2004 *)
32600
32601   ]);;
32602   (* }}} *)
32603
32604 let plane_graph_image_v = prove_by_refinement(
32605   `!f G. (graph_vertex (plane_graph_image f G)) =
32606           IMAGE f (graph_vertex G)`,
32607   (* {{{ proof *)
32608   [
32609   REWRITE_TAC[plane_graph_image;dest_graph_t;graph_vertex;];
32610   (*     Thu Aug 26 10:17:56 EDT 2004 *)
32611
32612   ]);;
32613   (* }}} *)
32614
32615 let plane_graph_image_i = prove_by_refinement(
32616   `!f G. (graph_inc (plane_graph_image f G)) =
32617      ( \ e v. (?e' v'. (graph_edge G e') /\
32618              (IMAGE f e' = e) /\ (f v' = v) /\
32619             (graph_inc G e' v')))`,
32620   (* {{{ proof *)
32621   [
32622   REWRITE_TAC[plane_graph_image ;graph_inc;dest_graph_t;drop1];
32623   (* Thu Aug 26 10:20:07 EDT 2004 *)
32624
32625   ]);;
32626   (* }}} *)
32627
32628 let plane_graph_image_bij = prove_by_refinement(
32629   `!f G. homeomorphism f top2 top2 /\ plane_graph G ==>
32630    BIJ f (graph_vertex G) (IMAGE f (graph_vertex G)) /\
32631    BIJ (IMAGE f) (graph_edge G) (IMAGE2 f (graph_edge G))`,
32632   (* {{{ proof *)
32633   [
32634   ALL_TAC ;
32635   (* - *)
32636   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]);
32637   TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
32638   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32639   ASM_REWRITE_TAC[];
32640   (* - *)
32641   TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
32642   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32643   IMATCH_MP_TAC  simple_arc_euclid;
32644   IMATCH_MP_TAC  subset_imp;
32645   UNIFY_EXISTS_TAC;
32646   (* - *)
32647   CONJ_TAC;
32648   IMATCH_MP_TAC  inj_bij;
32649   REWRITE_TAC[INJ];
32650   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
32651   FIRST_ASSUM IMATCH_MP_TAC ;
32652   ASM_MESON_TAC[subset_imp];
32653   (* - *)
32654   USE 3 (MATCH_MP image_powerset);
32655   REWRITE_TAC[IMAGE2];
32656   IMATCH_MP_TAC  inj_bij;
32657   REWRITE_TAC[INJ];
32658   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
32659   FIRST_ASSUM IMATCH_MP_TAC ;
32660   (* ASM_MESON_TAC[ISUBSET]; *)
32661   ]);;
32662   (* }}} *)
32663
32664 let plane_graph_image_iso = prove_by_refinement(
32665   `!f G. (homeomorphism f top2 top2 /\ plane_graph G ==>
32666       graph_isomorphic G (plane_graph_image f G))`,
32667   (* {{{ proof *)
32668   [
32669   ALL_TAC;
32670   REWRITE_TAC[graph_isomorphic;graph_iso;];
32671   LEFT_TAC "u";
32672   TYPE_THEN `f` EXISTS_TAC;
32673   LEFT_TAC "v";
32674   TYPE_THEN `IMAGE f` EXISTS_TAC;
32675   TYPE_THEN `f,IMAGE f` EXISTS_TAC;
32676   REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
32677   (* - *)
32678   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]);
32679   TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
32680   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32681   (* - *)
32682   TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
32683   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32684   IMATCH_MP_TAC  simple_arc_euclid;
32685   IMATCH_MP_TAC  subset_imp;
32686   UNIFY_EXISTS_TAC;
32687   (* - *)
32688   CONJ_TAC;
32689   IMATCH_MP_TAC  inj_bij;
32690   REWRITE_TAC[INJ];
32691   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
32692   FIRST_ASSUM IMATCH_MP_TAC ;
32693   ASM_MESON_TAC[ISUBSET];
32694   (* - *)
32695   SUBCONJ_TAC;
32696   USE 3 (MATCH_MP image_powerset);
32697   REWRITE_TAC[IMAGE2];
32698   IMATCH_MP_TAC  inj_bij;
32699   REWRITE_TAC[INJ];
32700   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
32701   FIRST_ASSUM IMATCH_MP_TAC ;
32702   (* A- *)
32703   REP_BASIC_TAC;
32704   IMATCH_MP_TAC  EQ_EXT;
32705   EQ_TAC;
32706   TYPE_THEN `x` UNABBREV_TAC;
32707   TYPE_THEN `e' = e` SUBGOAL_TAC;
32708   RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2;BIJ;INJ]);
32709   FIRST_ASSUM IMATCH_MP_TAC ;
32710   ASM_REWRITE_TAC[];
32711   (* ---- *)
32712   TYPE_THEN `e'`  UNABBREV_TAC ;
32713   REWRITE_TAC[IMAGE];
32714   USE 5 GSYM;
32715   UNIFY_EXISTS_TAC;
32716   ASM_REWRITE_TAC[];
32717   (* - *)
32718   USE 8(REWRITE_RULE[IMAGE]);
32719   UNIFY_EXISTS_TAC;
32720   ASM_REWRITE_TAC[];
32721   (* Thu Aug 26 10:49:22 EDT 2004 *)
32722   ]);;
32723   (* }}} *)
32724
32725 extend_simp_rewrites [(REAL_ARITH `&0 < &1`)];;
32726
32727 extend_simp_rewrites [prove_by_refinement(
32728   `metric_space(euclid 2,d_euclid)`,
32729   (* {{{ proof *)
32730   [
32731   ASM_MESON_TAC[metric_euclid];
32732   ])];;
32733   (* }}} *)
32734
32735 extend_simp_rewrites [prove_by_refinement(
32736   `!G. plane_graph G ==> graph_vertex G SUBSET (euclid 2)`,
32737   (* {{{ proof *)
32738   [
32739   REWRITE_TAC[plane_graph];
32740   ])];;
32741   (* }}} *)
32742
32743 let simple_arc_end_cont = prove_by_refinement(
32744   `!C v v'. simple_arc_end C v v' <=>
32745        (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
32746         continuous f
32747            (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) top2 /\
32748               INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
32749               (f (&0) = v) /\
32750               (f (&1) = v'))`,
32751   (* {{{ proof *)
32752   [
32753   REWRITE_TAC[simple_arc_end];
32754   ONCE_REWRITE_TAC [EQ_SYM_EQ];
32755   EQ_TAC;
32756   TH_INTRO_TAC [`&0`;`&1`;`f`;`euclid 2`;`d_euclid`] cont_extend_real_lemma;
32757   CONJ_TAC;
32758   ASM_REWRITE_TAC[GSYM top2];
32759   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
32760   REWRITE_TAC[IMAGE;SUBSET];
32761   FIRST_ASSUM IMATCH_MP_TAC ;
32762   TYPE_THEN `g` EXISTS_TAC;
32763   CONJ_TAC;
32764   ASM_REWRITE_TAC[];
32765   REWRITE_TAC[IMAGE];
32766   IMATCH_MP_TAC  EQ_EXT;
32767   EQ_TAC;
32768   UNIFY_EXISTS_TAC;
32769   FIRST_ASSUM IMATCH_MP_TAC ;
32770   UNIFY_EXISTS_TAC;
32771   ASM_MESON_TAC[];
32772   (* -- *)
32773   ASM_REWRITE_TAC[top2];
32774   CONJ_TAC;
32775   REWRITE_TAC[INJ];
32776   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
32777   ASM_MESON_TAC[];
32778   ASM_MESON_TAC[REAL_ARITH `x <=. x `;REAL_ARITH `&0 <=. &1`];
32779   (* - *)
32780   UNIFY_EXISTS_TAC;
32781   ASM_REWRITE_TAC[];
32782   IMATCH_MP_TAC  continuous_interval;
32783   (* Thu Aug 26 12:57:09 EDT 2004 *)
32784   ]);;
32785   (* }}} *)
32786
32787 let graph_edge_euclid =  prove_by_refinement(
32788   `!G e. (plane_graph G /\ graph_edge G e) ==> (e SUBSET (euclid 2))`,
32789   (* {{{ proof *)
32790   [
32791   ALL_TAC;
32792   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32793   IMATCH_MP_TAC  simple_arc_euclid;
32794   IMATCH_MP_TAC  subset_imp;
32795   UNIFY_EXISTS_TAC;
32796   ]);;
32797   (* }}} *)
32798
32799 let plane_graph_image_plane = prove_by_refinement(
32800   `!f G. (homeomorphism f top2 top2 /\ good_plane_graph G ==>
32801      good_plane_graph(plane_graph_image f G))`,
32802   (* {{{ proof *)
32803   [
32804   REWRITE_TAC[good_plane_graph];
32805   TH_INTRO_TAC[`G`;`plane_graph_image f G`] graph_isomorphic_graph;
32806   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32807   ASM_REWRITE_TAC[];
32808   IMATCH_MP_TAC  plane_graph_image_iso;
32809   ASM_REWRITE_TAC[plane_graph];
32810   (* - *)
32811   TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
32812   (* - *)
32813   TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
32814   IMATCH_MP_TAC  graph_edge_euclid;
32815   UNIFY_EXISTS_TAC;
32816   (* - *)
32817   TH_INTRO_TAC[`f`;`G`] plane_graph_image_bij;
32818   (* A- *)
32819   ASM_REWRITE_TAC[plane_graph;GSYM CONJ_ASSOC;];
32820   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;
32821   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]);
32822   TYPE_THEN `v` UNABBREV_TAC;
32823   TYPE_THEN `v'` UNABBREV_TAC;
32824   TYPE_THEN `e` UNABBREV_TAC;
32825   TYPE_THEN `e' = e''` SUBGOAL_TAC ;
32826   USE 6 (REWRITE_RULE[BIJ;INJ;IMAGE2]);
32827   FIRST_ASSUM IMATCH_MP_TAC ;
32828   TYPE_THEN `e''` UNABBREV_TAC;
32829   UND 0 THEN (DISCH_THEN (TH_INTRO_TAC [`e'`;`v'''`;`v''`]));
32830   DISCH_TAC;
32831   TYPE_THEN `v'''` UNABBREV_TAC;
32832   USE 0 (REWRITE_RULE[simple_arc_end_cont]);
32833   REWRITE_TAC[simple_arc_end_cont];
32834   TYPE_THEN `f o f'` EXISTS_TAC;
32835   REWRITE_TAC[IMAGE_o];
32836   (* -- *)
32837   CONJ_TAC;
32838   IMATCH_MP_TAC  continuous_comp;
32839   TYPE_THEN `top2` EXISTS_TAC;
32840   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
32841   ASM_REWRITE_TAC[top2_unions];
32842   TYPE_THEN `UNIONS (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
32843   TH_INTRO_TAC[`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_unions;
32844   TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV ` SUBAGOAL_TAC;
32845   alpha_tac;
32846   IMATCH_MP_TAC  metric_subspace;
32847   UNIFY_EXISTS_TAC;
32848   REWRITE_TAC [metric_real;];
32849   UND 21 THEN   DISCH_THEN (fun t->ONCE_REWRITE_TAC[GSYM t]);
32850   REWRITE_TAC[];
32851   USE 15 (REWRITE_RULE[INJ]);
32852   REWRITE_TAC[IMAGE;SUBSET];
32853   FIRST_ASSUM IMATCH_MP_TAC ;
32854   (* -- *)
32855   CONJ_TAC;
32856   REWRITE_TAC[comp_comp];
32857   IMATCH_MP_TAC  COMP_INJ;
32858   UNIFY_EXISTS_TAC;
32859   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]);
32860   REWRITE_TAC[o_DEF];
32861   (* B- *)
32862   ASM_REWRITE_TAC[];
32863   TYPE_THEN `graph_edge (plane_graph_image f G) SUBSET simple_arc top2` SUBGOAL_TAC;
32864   REWRITE_TAC[SUBSET];
32865   TH_INTRO_TAC[`plane_graph_image f G`;`x`] graph_edge_end_select;
32866   UND 8 THEN DISCH_THEN (TH_INTRO_TAC[`x`;`v`;`v'`]);
32867   IMATCH_MP_TAC  simple_arc_end_simple;
32868   UNIFY_EXISTS_TAC;
32869   KILL 8;
32870   (* - *)
32871   CONJ_TAC;
32872   MP_TAC plane_graph_image_v THEN DISCH_THEN_FULL_REWRITE;
32873   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;INJ;]);
32874   USE 16 (REWRITE_RULE[top2_unions]);
32875   REWRITE_TAC[IMAGE;SUBSET];
32876   FIRST_ASSUM IMATCH_MP_TAC ;
32877   IMATCH_MP_TAC  subset_imp;
32878   UNIFY_EXISTS_TAC;
32879   (* - *)
32880   CONJ_TAC;
32881   (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t ))  [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
32882   IMATCH_MP_TAC  EQ_EXT;
32883   EQ_TAC;
32884   TYPE_THEN `x`  UNABBREV_TAC ;
32885   TYPE_THEN `e` UNABBREV_TAC;
32886   REWRITE_TAC[INTER];
32887   CONJ_TAC;
32888   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32889   TSPEC `e'` 11;
32890   REWR 10;
32891   USE 10 (REWRITE_RULE[INTER]);
32892   REWRITE_TAC[IMAGE];
32893   UNIFY_EXISTS_TAC;
32894   ASM_REWRITE_TAC[];
32895   REWRITE_TAC[IMAGE];
32896   TYPE_THEN `v'` EXISTS_TAC;
32897   TH_INTRO_TAC [`G`;`e'`] graph_inc_subset;
32898   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32899   IMATCH_MP_TAC  subset_imp;
32900   UNIFY_EXISTS_TAC;
32901   USE 8 (REWRITE_RULE[IMAGE2]);
32902   TYPE_THEN `FF = IMAGE f` ABBREV_TAC ;
32903   USE 8 (REWRITE_RULE[IMAGE]);
32904   TYPE_THEN `x'` EXISTS_TAC;
32905   USE 10 (REWRITE_RULE[INTER]);
32906   TYPE_THEN `FF`  UNABBREV_TAC;
32907   USE 10 (REWRITE_RULE[IMAGE]);
32908   TYPE_THEN `x` UNABBREV_TAC;
32909   TYPE_THEN `x''` EXISTS_TAC;
32910   TYPE_THEN `e` UNABBREV_TAC;
32911   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32912   REWRITE_TAC[INTER];
32913   USE 13 (REWRITE_RULE[IMAGE]);
32914   TYPE_THEN `x''  =x` SUBAGOAL_TAC;
32915   USE 2(REWRITE_RULE[homeomorphism;BIJ;INJ;top2_unions]);
32916   FIRST_ASSUM IMATCH_MP_TAC ;
32917   CONJ_TAC;
32918   IMATCH_MP_TAC  subset_imp;
32919   UNIFY_EXISTS_TAC;
32920   TSPEC `x'` 5;
32921   IMATCH_MP_TAC  subset_imp;
32922   TYPE_THEN `x'` EXISTS_TAC;
32923   ASM_REWRITE_TAC[];
32924   (* C- *)
32925   (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t ))  [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
32926   USE 10 (REWRITE_RULE[IMAGE2]);
32927   USE 11 (REWRITE_RULE[IMAGE2]);
32928   TYPE_THEN `FF = IMAGE f` ABBREV_TAC ;
32929   USE 10 (REWRITE_RULE[IMAGE]);
32930   USE 11 (REWRITE_RULE[IMAGE]);
32931   TYPE_THEN `e` UNABBREV_TAC;
32932   TYPE_THEN `e'` UNABBREV_TAC;
32933   TH_INTRO_TAC [`f`;`euclid 2`;`euclid 2`;`x'`;`x`] (GSYM inj_inter);
32934   RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]);
32935   TYPE_THEN `FF` UNABBREV_TAC;
32936   IMATCH_MP_TAC  IMAGE_SUBSET;
32937   RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
32938   TYPEL_THEN [`x'`;`x`] (fun t-> UND 1 THEN DISCH_THEN (TH_INTRO_TAC t));
32939   DISCH_TAC;
32940   TYPE_THEN `x'` UNABBREV_TAC;
32941   ]);;
32942   (* }}} *)
32943
32944 (* state MP *)
32945
32946 let h_compat = jordan_def `h_compat f <=> !x y. (SND x = SND y) ==>
32947    (IMAGE f (mk_line (point x) (point y)) =
32948           mk_line (f (point x)) (f (point y)))`;;
32949
32950 let v_compat = jordan_def `v_compat f <=> !x y. (FST x = FST y) ==>
32951    (IMAGE f (mk_line (point x) (point y)) =
32952           mk_line (f (point x)) (f (point y)))`;;
32953
32954 let h_translate = jordan_def `h_translate r p = p + r *# e1`;;
32955
32956 let v_translate = jordan_def `v_translate r p = p + r *# e2`;;
32957
32958 let r_scale = jordan_def `r_scale r p =
32959         if ( &.0 < p 0) then (point (r * p 0, p 1)) else p`;;
32960
32961 let u_scale = jordan_def `u_scale r p =
32962         if ( &.0 < p 1) then (point ( p 0, r * p 1)) else p`;;
32963
32964 let cont_domain = prove_by_refinement(
32965   `!(f:A->B) g U V. (continuous f U V) /\ (!x. UNIONS U x ==> (f x = g x))
32966     ==> (continuous g U V)`,
32967   (* {{{ proof *)
32968   [
32969   REWRITE_TAC[preimage;continuous;];
32970   TYPE_THEN `{x | UNIONS U x /\ v (g x)} = {x | UNIONS U x /\ v (f x)}` SUBAGOAL_TAC;
32971   IMATCH_MP_TAC  EQ_EXT;
32972   IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`);
32973   FIRST_ASSUM IMATCH_MP_TAC ;
32974   ]);;
32975   (* }}} *)
32976
32977 let h_translate_bij = prove_by_refinement(
32978   `!r. BIJ (h_translate r) (euclid 2) (euclid 2)`,
32979   (* {{{ proof *)
32980
32981   [
32982   REWRITE_TAC[BIJ;INJ;h_translate];
32983   SUBCONJ_TAC;
32984   CONJ_TAC;
32985   ASM_SIMP_TAC[euclid_add_closure;e1;point_scale;euclid_point];
32986   RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e1]);
32987   IMATCH_MP_TAC  EQ_EXT;
32988   USE 0 (REWRITE_RULE[FUN_EQ_THM]);
32989   TSPEC `x'` 0;
32990   UND 0 THEN REAL_ARITH_TAC;
32991   REWRITE_TAC[SURJ;h_translate];
32992   REP_BASIC_TAC;
32993   TYPE_THEN `x - (r *# e1)` EXISTS_TAC;
32994   CONJ_TAC;
32995   REWRITE_TAC[point_scale;e1];
32996   ASM_SIMP_TAC[euclid_sub_closure;euclid_point];
32997   REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale];
32998   IMATCH_MP_TAC  EQ_EXT;
32999   REAL_ARITH_TAC;
33000   (* Tue Sep  7 10:15:46 EDT 2004 *)
33001
33002   ]);;
33003
33004   (* }}} *)
33005
33006 let v_translate_bij = prove_by_refinement(
33007   `!r. BIJ (v_translate r) (euclid 2) (euclid 2)`,
33008   (* {{{ proof *)
33009
33010   [
33011   REWRITE_TAC[BIJ;INJ;v_translate];
33012   SUBCONJ_TAC;
33013   CONJ_TAC;
33014   ASM_SIMP_TAC[euclid_add_closure;e2;point_scale;euclid_point];
33015   RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e2]);
33016   IMATCH_MP_TAC  EQ_EXT;
33017   USE 0 (REWRITE_RULE[FUN_EQ_THM]);
33018   TSPEC `x'` 0;
33019   UND 0 THEN REAL_ARITH_TAC;
33020   REWRITE_TAC[SURJ;v_translate];
33021   REP_BASIC_TAC;
33022   TYPE_THEN `x - (r *# e2)` EXISTS_TAC;
33023   CONJ_TAC;
33024   REWRITE_TAC[point_scale;e2];
33025   ASM_SIMP_TAC[euclid_sub_closure;euclid_point];
33026   REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale];
33027   IMATCH_MP_TAC  EQ_EXT;
33028   REAL_ARITH_TAC;
33029   (* Tue Sep  7 10:16:38 EDT 2004 *)
33030
33031   ]);;
33032
33033   (* }}} *)
33034
33035 extend_simp_rewrites [euclid_point];;
33036 extend_simp_rewrites [coord01];;
33037
33038 let r_scale_bij = prove_by_refinement(
33039   `!r. (&0 < r) ==> BIJ (r_scale r) (euclid 2) (euclid 2)`,
33040   (* {{{ proof *)
33041   [
33042   REP_BASIC_TAC;
33043   REWRITE_TAC[BIJ;INJ;r_scale;];
33044   SUBCONJ_TAC;
33045   CONJ_TAC;
33046   COND_CASES_TAC;
33047   REWRITE_TAC[euclid_point];
33048   USE 2 (MATCH_MP   point_onto);
33049   USE 3 (MATCH_MP   point_onto);
33050   REWRITE_TAC[point_inj];
33051   TYPE_THEN `x` UNABBREV_TAC;
33052   TYPE_THEN `y` UNABBREV_TAC;
33053   REWRITE_TAC[PAIR_SPLIT];
33054   RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
33055   UND 1 THEN COND_CASES_TAC;
33056   UND 1 THEN COND_CASES_TAC;
33057   RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
33058   RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]);
33059   UND 4 THEN UND 0 THEN REAL_ARITH_TAC ;
33060   RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
33061   TYPE_THEN `FST p` UNABBREV_TAC;
33062   PROOF_BY_CONTR_TAC;
33063   UND 3 THEN REWRITE_TAC[];
33064   REWRITE_TAC[real_gt];
33065   IMATCH_MP_TAC  REAL_LT_MUL;
33066   UND 1 THEN COND_CASES_TAC;
33067   RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]);
33068   TYPE_THEN `FST p'` UNABBREV_TAC;
33069   PROOF_BY_CONTR_TAC;
33070   UND 2 THEN REWRITE_TAC[];
33071   IMATCH_MP_TAC  REAL_LT_MUL;
33072   RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
33073   KILL 1;
33074   REWRITE_TAC[SURJ;r_scale];
33075   KILL 2;
33076   USE 1 (MATCH_MP point_onto);
33077   TYPE_THEN `x` UNABBREV_TAC;
33078   TYPE_THEN `&0 < FST p` ASM_CASES_TAC;
33079   TYPE_THEN `point ((&1/r)* FST p, SND p)` EXISTS_TAC;
33080   TYPE_THEN `&0 < &1/ r  * FST p` SUBAGOAL_TAC;
33081   IMATCH_MP_TAC  REAL_LT_MUL;
33082   IMATCH_MP_TAC  REAL_LT_DIV;
33083   ASM_REWRITE_TAC[];
33084   AP_TERM_TAC;
33085   REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC];
33086   TYPE_THEN `(r * &1/r) * FST p = &1 * FST p` SUBAGOAL_TAC;
33087   AP_THM_TAC;
33088   AP_TERM_TAC;
33089   IMATCH_MP_TAC  REAL_DIV_LMUL;
33090   UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
33091   REDUCE_TAC;
33092   TYPE_THEN `point p` EXISTS_TAC;
33093   ASM_REWRITE_TAC[];
33094   (* Tue Sep  7 10:55:54 EDT 2004 *)
33095
33096   ]);;
33097   (* }}} *)
33098
33099 let u_scale_bij = prove_by_refinement(
33100   `!r. (&0 < r) ==> BIJ (u_scale r) (euclid 2) (euclid 2)`,
33101   (* {{{ proof *)
33102   [
33103   REP_BASIC_TAC;
33104   REWRITE_TAC[BIJ;INJ;u_scale;];
33105   SUBCONJ_TAC;
33106   CONJ_TAC;
33107   COND_CASES_TAC;
33108   USE 2 (MATCH_MP   point_onto);
33109   USE 3 (MATCH_MP   point_onto);
33110   REWRITE_TAC[point_inj];
33111   TYPE_THEN `x` UNABBREV_TAC;
33112   TYPE_THEN `y` UNABBREV_TAC;
33113   REWRITE_TAC[PAIR_SPLIT];
33114   RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
33115   UND 1 THEN COND_CASES_TAC;
33116   UND 1 THEN COND_CASES_TAC;
33117   RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
33118   RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]);
33119   UND 1 THEN UND 0 THEN REAL_ARITH_TAC ;
33120   RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
33121   TYPE_THEN `SND p` UNABBREV_TAC;
33122   PROOF_BY_CONTR_TAC;
33123   UND 3 THEN REWRITE_TAC[];
33124   IMATCH_MP_TAC  REAL_LT_MUL;
33125   UND 1 THEN COND_CASES_TAC;
33126   RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]);
33127   TYPE_THEN `SND p'` UNABBREV_TAC;
33128   PROOF_BY_CONTR_TAC;
33129   UND 2 THEN REWRITE_TAC[];
33130   IMATCH_MP_TAC  REAL_LT_MUL;
33131   RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
33132   KILL 1;
33133   REWRITE_TAC[SURJ;u_scale];
33134   KILL 2;
33135   USE 1 (MATCH_MP point_onto);
33136   TYPE_THEN `x` UNABBREV_TAC;
33137   TYPE_THEN `&0 < SND  p` ASM_CASES_TAC;
33138   TYPE_THEN `point (FST p, (&1/r)* SND  p)` EXISTS_TAC;
33139   TYPE_THEN `&0 < &1/ r  * SND  p` SUBAGOAL_TAC;
33140   IMATCH_MP_TAC  REAL_LT_MUL;
33141   IMATCH_MP_TAC  REAL_LT_DIV;
33142   ASM_REWRITE_TAC[];
33143   AP_TERM_TAC;
33144   REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC];
33145   TYPE_THEN `(r * &1/r) * SND  p = &1 * SND  p` SUBAGOAL_TAC;
33146   AP_THM_TAC;
33147   AP_TERM_TAC;
33148   IMATCH_MP_TAC  REAL_DIV_LMUL;
33149   UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
33150   REDUCE_TAC;
33151   TYPE_THEN `point p` EXISTS_TAC;
33152   ASM_REWRITE_TAC[];
33153   (* Tue Sep  7 11:01:53 EDT 2004 *)
33154
33155   ]);;
33156   (* }}} *)
33157
33158 let h_translate_inv = prove_by_refinement(
33159   `!r x. (euclid 2 x) ==>
33160    (h_translate (--. r) x = INV (h_translate r) (euclid 2) (euclid 2) x)`,
33161   (* {{{ proof *)
33162   [
33163   REP_BASIC_TAC;
33164   IMATCH_MP_TAC  EQ_SYM;
33165   TH_INTRO_TAC[`h_translate r`;`euclid 2`;`euclid 2`;`h_translate (--. r) x`;`x`] INVERSE_XY;
33166   ASM_REWRITE_TAC[h_translate_bij;h_translate;e1;point_scale];
33167   ASM_SIMP_TAC[euclid_add_closure;euclid_point];
33168   REWRITE_TAC[h_translate;euclid_plus;e1;euclid_scale];
33169   IMATCH_MP_TAC  EQ_EXT;
33170   REAL_ARITH_TAC;
33171   (* Tue Sep  7 11:11:17 EDT 2004 *)
33172   ]);;
33173   (* }}} *)
33174
33175 let v_translate_inv = prove_by_refinement(
33176   `!r x. (euclid 2 x) ==>
33177    (v_translate (--. r) x = INV (v_translate r) (euclid 2) (euclid 2) x)`,
33178   (* {{{ proof *)
33179   [
33180   REP_BASIC_TAC;
33181   IMATCH_MP_TAC  EQ_SYM;
33182   TH_INTRO_TAC[`v_translate r`;`euclid 2`;`euclid 2`;`v_translate (--. r) x`;`x`] INVERSE_XY;
33183   ASM_REWRITE_TAC[v_translate_bij;v_translate;e2;point_scale];
33184   ASM_SIMP_TAC[euclid_add_closure;euclid_point];
33185   REWRITE_TAC[v_translate;euclid_plus;e2;euclid_scale];
33186   IMATCH_MP_TAC  EQ_EXT;
33187   REAL_ARITH_TAC;
33188   (* Tue Sep  7 11:12:42 EDT 2004 *)
33189   ]);;
33190   (* }}} *)
33191
33192 extend_simp_rewrites[prove_by_refinement(
33193   `!x r. (&0 < r) ==> (r * (&1/r) * x = x)`,
33194   (* {{{ proof *)
33195   [
33196   REWRITE_TAC [REAL_MUL_ASSOC];
33197   TYPE_THEN `(r * &1/r) * x = &1 * x` SUBAGOAL_TAC;
33198   AP_THM_TAC;
33199   AP_TERM_TAC;
33200   IMATCH_MP_TAC  REAL_DIV_LMUL;
33201   UND 1 THEN UND 0 THEN REAL_ARITH_TAC;
33202   REDUCE_TAC;
33203   ])];;
33204   (* }}} *)
33205
33206 extend_simp_rewrites[ prove_by_refinement(
33207   `!r. (&0 < r) ==> (&0 < &1 / r)`,
33208   (* {{{ proof *)
33209   [
33210   REP_BASIC_TAC;
33211   IMATCH_MP_TAC  REAL_LT_DIV;
33212   ])];;
33213   (* }}} *)
33214
33215 extend_simp_rewrites[ REAL_LE_POW_2];;
33216
33217 extend_simp_rewrites[ prove_by_refinement(
33218   `!x y. &0 <= x pow 2 + y pow 2`,
33219   (* {{{ proof *)
33220   [
33221   ALL_TAC;
33222   IMATCH_MP_TAC  REAL_LE_ADD;
33223   ])];;
33224   (* }}} *)
33225
33226 let r_scale_inv = prove_by_refinement(
33227   `!r x. (&0 < r) /\ (euclid 2 x) ==>
33228    (r_scale (&1/r) x = INV (r_scale r) (euclid 2) (euclid 2) x)`,
33229   (* {{{ proof *)
33230   [
33231   REP_BASIC_TAC;
33232   IMATCH_MP_TAC  EQ_SYM;
33233   TH_INTRO_TAC[`r_scale r`;`euclid 2`;`euclid 2`;`r_scale (&1/r) x`;`x`] INVERSE_XY;
33234   ASM_SIMP_TAC [r_scale_bij];
33235   TH_INTRO_TAC[`&1/r`] r_scale_bij;
33236   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
33237   REWRITE_TAC[r_scale];
33238   USE 0 (MATCH_MP point_onto);
33239   TYPE_THEN `x` UNABBREV_TAC;
33240   TYPE_THEN `&0 < FST p` ASM_CASES_TAC;
33241   REWRITE_TAC[coord01];
33242   TYPE_THEN `&0 < (&1 / r) * FST p` SUBAGOAL_TAC;
33243   IMATCH_MP_TAC  REAL_LT_MUL;
33244   ASM_REWRITE_TAC[];
33245   ASM_REWRITE_TAC[];
33246   (* Tue Sep  7 11:40:41 EDT 2004 *)
33247
33248   ]);;
33249   (* }}} *)
33250
33251 let u_scale_inv = prove_by_refinement(
33252   `!r x. (&0 < r) /\ (euclid 2 x) ==>
33253    (u_scale (&1/r) x = INV (u_scale r) (euclid 2) (euclid 2) x)`,
33254   (* {{{ proof *)
33255   [
33256   REP_BASIC_TAC;
33257   IMATCH_MP_TAC  EQ_SYM;
33258   TH_INTRO_TAC[`u_scale r`;`euclid 2`;`euclid 2`;`u_scale (&1/r) x`;`x`] INVERSE_XY;
33259   ASM_SIMP_TAC [u_scale_bij];
33260   TH_INTRO_TAC[`&1/r`] u_scale_bij;
33261   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
33262   REWRITE_TAC[u_scale];
33263   USE 0 (MATCH_MP point_onto);
33264   TYPE_THEN `x` UNABBREV_TAC;
33265   TYPE_THEN `&0 < SND p` ASM_CASES_TAC;
33266   REWRITE_TAC[coord01];
33267   TYPE_THEN `&0 < (&1 / r) * SND  p` SUBAGOAL_TAC;
33268   IMATCH_MP_TAC  REAL_LT_MUL;
33269   ASM_REWRITE_TAC[];
33270   ASM_REWRITE_TAC[];
33271   (* Tue Sep  7 11:56:05 EDT 2004 *)
33272
33273
33274   ]);;
33275   (* }}} *)
33276
33277 let metric_continuous_continuous_top2 = prove_by_refinement(
33278   `!f. (IMAGE f (euclid 2) SUBSET (euclid 2) ==>
33279      (continuous f top2 top2 =
33280          metric_continuous f (euclid 2,d_euclid) (euclid 2,d_euclid)))`,
33281   (* {{{ proof *)
33282   [
33283   REWRITE_TAC[top2];
33284   IMATCH_MP_TAC  metric_continuous_continuous;
33285   ]);;
33286   (* }}} *)
33287
33288 let h_translate_cont = prove_by_refinement(
33289   `!r. continuous (h_translate r) (top2) (top2)`,
33290   (* {{{ proof *)
33291   [
33292   ALL_TAC;
33293   TH_INTRO_TAC [`h_translate r`] metric_continuous_continuous_top2;
33294   ASSUME_TAC h_translate_bij;
33295   TSPEC `r` 0;
33296   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
33297   REWRITE_TAC[IMAGE;SUBSET];
33298   FIRST_ASSUM IMATCH_MP_TAC ;
33299   (* - *)
33300   REWRITE_TAC[metric_continuous;metric_continuous_pt];
33301   TYPE_THEN `epsilon` EXISTS_TAC;
33302   REP_BASIC_TAC;
33303   REWRITE_TAC[h_translate];
33304   TH_INTRO_TAC[`2`;`x`;`y`;`r *# e1`] metric_translate;
33305   REWRITE_TAC[e1;point_scale];
33306   (* Tue Sep  7 12:09:30 EDT 2004 *)
33307
33308   ]);;
33309   (* }}} *)
33310
33311 let v_translate_cont = prove_by_refinement(
33312   `!r. continuous (v_translate r) (top2) (top2)`,
33313   (* {{{ proof *)
33314   [
33315   ALL_TAC;
33316   TH_INTRO_TAC [`v_translate r`] metric_continuous_continuous_top2;
33317   ASSUME_TAC v_translate_bij;
33318   TSPEC `r` 0;
33319   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
33320   REWRITE_TAC[IMAGE;SUBSET];
33321   FIRST_ASSUM IMATCH_MP_TAC ;
33322   (* - *)
33323   REWRITE_TAC[metric_continuous;metric_continuous_pt];
33324   TYPE_THEN `epsilon` EXISTS_TAC;
33325   REP_BASIC_TAC;
33326   REWRITE_TAC[v_translate];
33327   TH_INTRO_TAC[`2`;`x`;`y`;`r *# e2`] metric_translate;
33328   REWRITE_TAC[e2;point_scale];
33329   (* Tue Sep  7 12:10:54 EDT 2004 *)
33330   ]);;
33331   (* }}} *)
33332
33333 let r_scale_cont = prove_by_refinement(
33334   `!r. (&0 < r) ==> (continuous (r_scale r) top2 top2)`,
33335   (* {{{ proof *)
33336   [
33337   ALL_TAC;
33338   TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC;
33339   UND 0 THEN REAL_ARITH_TAC;
33340   TH_INTRO_TAC[`r_scale r`] metric_continuous_continuous_top2;
33341   ASSUME_TAC r_scale_bij;
33342   TSPEC `r` 2;
33343   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
33344   REWRITE_TAC[IMAGE;SUBSET];
33345   FIRST_ASSUM IMATCH_MP_TAC ;
33346   REWRITE_TAC[metric_continuous;metric_continuous_pt];
33347   TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC;
33348   TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ;
33349   TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC;
33350   TYPE_THEN `epsilon'` UNABBREV_TAC;
33351   TYPE_THEN `epsilon` UNABBREV_TAC;
33352   KILL 4;
33353   SUBCONJ_TAC;
33354   ASM_MESON_TAC[REAL_PROP_POS_LMUL];
33355   USE 5(MATCH_MP point_onto);
33356   TYPE_THEN `y` UNABBREV_TAC;
33357   USE 6(MATCH_MP point_onto);
33358   TYPE_THEN `x` UNABBREV_TAC;
33359   (* - *)
33360   TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
33361   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ];
33362   IMATCH_MP_TAC  REAL_LE_RMUL;
33363   REWRITE_TAC[REAL_POW_2];
33364   IMATCH_MP_TAC  ABS_SQUARE_LE;
33365   UND 0 THEN REAL_ARITH_TAC;
33366   REWRITE_TAC[GSYM REAL_POW_MUL];
33367   (* - *)
33368   TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
33369   IMATCH_MP_TAC  REAL_LE_RMUL;
33370   REWRITE_TAC[REAL_POW_2];
33371   IMATCH_MP_TAC  ABS_SQUARE_LE;
33372   UND 0 THEN  REAL_ARITH_TAC;
33373   UND 6 THEN REDUCE_TAC;
33374   (* - *)
33375   TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC;
33376   REWRITE_TAC[GSYM REAL_POW_MUL];
33377   REWRITE_TAC[REAL_POW_2];
33378   IMATCH_MP_TAC  ABS_SQUARE_LE;
33379   TYPE_THEN `abs  (r*x' + y') = r*x' + y'` SUBAGOAL_TAC;
33380   REWRITE_TAC[ABS_REFL];
33381   IMATCH_MP_TAC  REAL_LE_ADD;
33382   ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`];
33383   ineq_le_tac `(r*x' + y') + x' + r*y'  = (&1 + r)*(x' + y')` ;
33384   (* A - *)
33385   TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC;
33386   TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC;
33387   IMATCH_MP_TAC  POW_2_SQRT;
33388   IMATCH_MP_TAC  REAL_LE_MUL;
33389   UND 7 THEN UND 1 THEN REAL_ARITH_TAC;
33390   UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]);
33391   IMATCH_MP_TAC SQRT_MONO_LT;
33392   REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ];
33393   REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ];
33394   IMATCH_MP_TAC  REAL_LT_LMUL;
33395   CONJ_TAC;
33396   IMATCH_MP_TAC  REAL_PROP_POS_POW;
33397   TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT);
33398   TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC;
33399   IMATCH_MP_TAC  POW_2_SQRT;
33400   UND 7 THEN REAL_ARITH_TAC;
33401   RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]);
33402   (* - *)
33403   IMATCH_MP_TAC  REAL_LET_TRANS;
33404   TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC;
33405   (* B- *)
33406   REWRITE_TAC[r_scale];
33407   COND_CASES_TAC THEN COND_CASES_TAC;
33408   UND 4 THEN  REWRITE_TAC[d_euclid_point];
33409   IMATCH_MP_TAC  SQRT_MONO_LE;
33410   (*  IMATCH_MP_TAC  REAL_LET_TRANS; *)
33411   REWRITE_TAC[REAL_LDISTRIB];
33412   IMATCH_MP_TAC  REAL_LE_ADD2;
33413   (* 3 LEFT *)
33414   UND 4 THEN (REWRITE_TAC [d_euclid_point]);
33415   TYPE_THEN `u = --. (FST p)` ABBREV_TAC ;
33416   TYPE_THEN `FST p = -- u` SUBAGOAL_TAC;
33417   UND 12 THEN REAL_ARITH_TAC;
33418   REWRITE_TAC[REAL_ARITH `x - --. y = x + y`];
33419   IMATCH_MP_TAC  SQRT_MONO_LE;
33420   REWRITE_TAC[REAL_LDISTRIB];
33421   IMATCH_MP_TAC  REAL_LE_ADD2;
33422   FIRST_ASSUM IMATCH_MP_TAC ;
33423   UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
33424   (* 2 LEFT *)
33425   UND 4 THEN (REWRITE_TAC [d_euclid_point]);
33426   TYPE_THEN `u = --. (FST p')` ABBREV_TAC ;
33427   TYPE_THEN `FST p' = -- u` SUBAGOAL_TAC;
33428   UND 12 THEN REAL_ARITH_TAC;
33429   REWRITE_TAC[REAL_ARITH `-- x -  v = -- (v + x)`;REAL_POW_NEG;EVEN2 ];
33430   IMATCH_MP_TAC  SQRT_MONO_LE;
33431   REWRITE_TAC[REAL_LDISTRIB];
33432   IMATCH_MP_TAC  REAL_LE_ADD2;
33433   FIRST_ASSUM IMATCH_MP_TAC ;
33434   UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
33435   (* 1 LEFT *)
33436   UND 4 THEN (REWRITE_TAC [d_euclid_point]);
33437   IMATCH_MP_TAC  SQRT_MONO_LE;
33438   REWRITE_TAC[REAL_LDISTRIB];
33439   IMATCH_MP_TAC  REAL_LE_ADD2;
33440   (* Tue Sep  7 15:33:59 EDT 2004 *)
33441
33442   ]);;
33443   (* }}} *)
33444
33445 let u_scale_cont = prove_by_refinement(
33446   `!r. (&0 < r) ==> (continuous (u_scale r) top2 top2)`,
33447   (* {{{ proof *)
33448   [
33449   ALL_TAC;
33450   TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC;
33451   UND 0 THEN REAL_ARITH_TAC;
33452   TH_INTRO_TAC[`u_scale r`] metric_continuous_continuous_top2;
33453   ASSUME_TAC u_scale_bij;
33454   TSPEC `r` 2;
33455   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
33456   REWRITE_TAC[IMAGE;SUBSET];
33457   FIRST_ASSUM IMATCH_MP_TAC ;
33458   REWRITE_TAC[metric_continuous;metric_continuous_pt];
33459   TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC;
33460   TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ;
33461   TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC;
33462   TYPE_THEN `epsilon'` UNABBREV_TAC;
33463   TYPE_THEN `epsilon` UNABBREV_TAC;
33464   KILL 4;
33465   SUBCONJ_TAC;
33466   ASM_MESON_TAC[REAL_PROP_POS_LMUL];
33467   USE 5(MATCH_MP point_onto);
33468   TYPE_THEN `y` UNABBREV_TAC;
33469   USE 6(MATCH_MP point_onto);
33470   TYPE_THEN `x` UNABBREV_TAC;
33471   (* - *)
33472   TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
33473   REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ];
33474   IMATCH_MP_TAC  REAL_LE_RMUL;
33475   REWRITE_TAC[REAL_POW_2];
33476   IMATCH_MP_TAC  ABS_SQUARE_LE;
33477   UND 0 THEN REAL_ARITH_TAC;
33478   REWRITE_TAC[GSYM REAL_POW_MUL];
33479   (* - *)
33480   TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
33481   IMATCH_MP_TAC  REAL_LE_RMUL;
33482   REWRITE_TAC[REAL_POW_2];
33483   IMATCH_MP_TAC  ABS_SQUARE_LE;
33484   UND 0 THEN  REAL_ARITH_TAC;
33485   UND 6 THEN REDUCE_TAC;
33486   (* - *)
33487   TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC;
33488   REWRITE_TAC[GSYM REAL_POW_MUL];
33489   REWRITE_TAC[REAL_POW_2];
33490   IMATCH_MP_TAC  ABS_SQUARE_LE;
33491   TYPE_THEN `abs  (r*x' + y') = r*x' + y'` SUBAGOAL_TAC;
33492   REWRITE_TAC[ABS_REFL];
33493   IMATCH_MP_TAC  REAL_LE_ADD;
33494   ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`];
33495   ineq_le_tac `(r*x' + y') + x' + r*y'  = (&1 + r)*(x' + y')` ;
33496   (* A - *)
33497   TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC;
33498   TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC;
33499   IMATCH_MP_TAC  POW_2_SQRT;
33500   IMATCH_MP_TAC  REAL_LE_MUL;
33501   UND 7 THEN UND 1 THEN REAL_ARITH_TAC;
33502   UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]);
33503   IMATCH_MP_TAC SQRT_MONO_LT;
33504   REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ];
33505   REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ];
33506   IMATCH_MP_TAC  REAL_LT_LMUL;
33507   CONJ_TAC;
33508   IMATCH_MP_TAC  REAL_PROP_POS_POW;
33509   TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT);
33510   TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC;
33511   IMATCH_MP_TAC  POW_2_SQRT;
33512   UND 7 THEN REAL_ARITH_TAC;
33513   RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]);
33514   (* - *)
33515   IMATCH_MP_TAC  REAL_LET_TRANS;
33516   TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC;
33517   (* B- *)
33518   REWRITE_TAC[u_scale];
33519   COND_CASES_TAC THEN COND_CASES_TAC;
33520   UND 4 THEN  REWRITE_TAC[d_euclid_point];
33521   IMATCH_MP_TAC  SQRT_MONO_LE;
33522   (*  IMATCH_MP_TAC  REAL_LET_TRANS; *)
33523   REWRITE_TAC[REAL_LDISTRIB];
33524   IMATCH_MP_TAC  REAL_LE_ADD2;
33525   (* 3 LEFT *)
33526   UND 4 THEN (REWRITE_TAC [d_euclid_point]);
33527   TYPE_THEN `u = --. (SND p)` ABBREV_TAC ;
33528   TYPE_THEN `SND p = -- u` SUBAGOAL_TAC;
33529   UND 12 THEN REAL_ARITH_TAC;
33530   REWRITE_TAC[REAL_ARITH `x - --. y = x + y`];
33531   IMATCH_MP_TAC  SQRT_MONO_LE;
33532   REWRITE_TAC[REAL_LDISTRIB];
33533   IMATCH_MP_TAC  REAL_LE_ADD2;
33534   FIRST_ASSUM IMATCH_MP_TAC ;
33535   UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
33536   (* 2 LEFT *)
33537   UND 4 THEN (REWRITE_TAC [d_euclid_point]);
33538   TYPE_THEN `u = --. (SND p')` ABBREV_TAC ;
33539   TYPE_THEN `SND p' = -- u` SUBAGOAL_TAC;
33540   UND 12 THEN REAL_ARITH_TAC;
33541   REWRITE_TAC[REAL_ARITH `-- x -  v = -- (v + x)`;REAL_POW_NEG;EVEN2 ];
33542   IMATCH_MP_TAC  SQRT_MONO_LE;
33543   REWRITE_TAC[REAL_LDISTRIB];
33544   IMATCH_MP_TAC  REAL_LE_ADD2;
33545   FIRST_ASSUM IMATCH_MP_TAC ;
33546   UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
33547   (* 1 LEFT *)
33548   UND 4 THEN (REWRITE_TAC [d_euclid_point]);
33549   IMATCH_MP_TAC  SQRT_MONO_LE;
33550   REWRITE_TAC[REAL_LDISTRIB];
33551   IMATCH_MP_TAC  REAL_LE_ADD2;
33552   (* Tue Sep  7 15:40:34 EDT 2004 *)
33553   ]);;
33554   (* }}} *)
33555
33556 let h_translate_hom = prove_by_refinement(
33557   `!r. (homeomorphism (h_translate r) top2 top2)`,
33558   (* {{{ proof *)
33559   [
33560   REP_BASIC_TAC;
33561   IMATCH_MP_TAC  bicont_homeomorphism;
33562   REWRITE_TAC[top2_unions;h_translate_bij;h_translate_cont];
33563   IMATCH_MP_TAC  cont_domain;
33564   REWRITE_TAC[top2_unions];
33565   TYPE_THEN `h_translate (-- r)` EXISTS_TAC;
33566   REWRITE_TAC[h_translate_inv;h_translate_cont];
33567   (* Tue Sep  7 15:56:20 EDT 2004 *)
33568
33569   ]);;
33570   (* }}} *)
33571
33572 let v_translate_hom = prove_by_refinement(
33573   `!r. (homeomorphism (v_translate r) top2 top2)`,
33574   (* {{{ proof *)
33575   [
33576   REP_BASIC_TAC;
33577   IMATCH_MP_TAC  bicont_homeomorphism;
33578   REWRITE_TAC[top2_unions;v_translate_bij;v_translate_cont];
33579   IMATCH_MP_TAC  cont_domain;
33580   REWRITE_TAC[top2_unions];
33581   TYPE_THEN `v_translate (-- r)` EXISTS_TAC;
33582   REWRITE_TAC[v_translate_inv;v_translate_cont];
33583   (* Tue Sep  7 15:57:06 EDT 2004 *)
33584   ]);;
33585   (* }}} *)
33586
33587 let r_scale_hom = prove_by_refinement(
33588   `!r. (&0 < r) ==> (homeomorphism (r_scale r) top2 top2)`,
33589   (* {{{ proof *)
33590   [
33591   REP_BASIC_TAC;
33592   IMATCH_MP_TAC  bicont_homeomorphism;
33593   ASM_SIMP_TAC [top2_unions;r_scale_bij;r_scale_cont];
33594   IMATCH_MP_TAC  cont_domain;
33595   REWRITE_TAC[top2_unions];
33596   TYPE_THEN `r_scale (&1/r)` EXISTS_TAC;
33597   TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC;
33598   ASM_SIMP_TAC [r_scale_inv;r_scale_cont];
33599   (* Tue Sep  7 16:00:14 EDT 2004 *)
33600
33601   ]);;
33602   (* }}} *)
33603
33604 let u_scale_hom = prove_by_refinement(
33605   `!r. (&0 < r) ==> (homeomorphism (u_scale r) top2 top2)`,
33606   (* {{{ proof *)
33607   [
33608   REP_BASIC_TAC;
33609   IMATCH_MP_TAC  bicont_homeomorphism;
33610   ASM_SIMP_TAC [top2_unions;u_scale_bij;u_scale_cont];
33611   IMATCH_MP_TAC  cont_domain;
33612   REWRITE_TAC[top2_unions];
33613   TYPE_THEN `u_scale (&1/r)` EXISTS_TAC;
33614   TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC;
33615   ASM_SIMP_TAC [u_scale_inv;u_scale_cont];
33616   (* Tue Sep  7 16:01:04 EDT 2004 *)
33617
33618
33619   ]);;
33620   (* }}} *)
33621
33622 let h_translate_h = prove_by_refinement(
33623   `!r. (h_compat (h_translate r))`,
33624   (* {{{ proof *)
33625   [
33626   REWRITE_TAC[h_compat;h_translate;e1;point_scale;mk_line;IMAGE];
33627   IMATCH_MP_TAC  EQ_EXT;
33628   EQ_TAC;
33629   TYPE_THEN `x'` UNABBREV_TAC;
33630   TYPE_THEN `x''` UNABBREV_TAC;
33631   REDUCE_TAC;
33632   TYPE_THEN `t` EXISTS_TAC;
33633   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33634   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33635   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33636   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33637   REAL_ARITH_TAC;
33638   TYPE_THEN `x'` UNABBREV_TAC;
33639   CONV_TAC (dropq_conv "x");
33640   CONV_TAC (dropq_conv "x''");
33641   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33642   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33643   TYPE_THEN `t` EXISTS_TAC;
33644   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33645   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33646   REAL_ARITH_TAC;
33647   (* Tue Sep  7 16:13:50 EDT 2004 *)
33648
33649   ]);;
33650   (* }}} *)
33651
33652 let v_translate_v = prove_by_refinement(
33653   `!r. (v_compat (v_translate r))`,
33654   (* {{{ proof *)
33655   [
33656   REWRITE_TAC[v_compat;v_translate;e2;point_scale;mk_line;IMAGE];
33657   IMATCH_MP_TAC  EQ_EXT;
33658   EQ_TAC;
33659   TYPE_THEN `x'` UNABBREV_TAC;
33660   TYPE_THEN `x''` UNABBREV_TAC;
33661   REDUCE_TAC;
33662   TYPE_THEN `t` EXISTS_TAC;
33663   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33664   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33665   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33666   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33667   REAL_ARITH_TAC;
33668   TYPE_THEN `x'` UNABBREV_TAC;
33669   CONV_TAC (dropq_conv "x");
33670   CONV_TAC (dropq_conv "x''");
33671   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33672   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33673   TYPE_THEN `t` EXISTS_TAC;
33674   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33675   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33676   REAL_ARITH_TAC;
33677   (* Tue Sep  7 16:15:33 EDT 2004 *)
33678
33679
33680   ]);;
33681   (* }}} *)
33682
33683 let h_translate_v = prove_by_refinement(
33684   `!r. (v_compat (h_translate r))`,
33685   (* {{{ proof *)
33686   [
33687   REWRITE_TAC[v_compat;h_translate;e1;point_scale;mk_line;IMAGE];
33688   IMATCH_MP_TAC  EQ_EXT;
33689   EQ_TAC;
33690   TYPE_THEN `x'` UNABBREV_TAC;
33691   TYPE_THEN `x''` UNABBREV_TAC;
33692   REDUCE_TAC;
33693   TYPE_THEN `t` EXISTS_TAC;
33694   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33695   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33696   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33697   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33698   REAL_ARITH_TAC;
33699   TYPE_THEN `x'` UNABBREV_TAC;
33700   CONV_TAC (dropq_conv "x");
33701   CONV_TAC (dropq_conv "x''");
33702   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33703   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33704   TYPE_THEN `t` EXISTS_TAC;
33705   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33706   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33707   REAL_ARITH_TAC;
33708   (* Tue Sep  7 16:17:13 EDT 2004 *)
33709   ]);;
33710   (* }}} *)
33711
33712 let v_translate_h = prove_by_refinement(
33713   `!r. (h_compat (v_translate r))`,
33714   (* {{{ proof *)
33715   [
33716   REWRITE_TAC[h_compat;v_translate;e2;point_scale;mk_line;IMAGE];
33717   IMATCH_MP_TAC  EQ_EXT;
33718   EQ_TAC;
33719   TYPE_THEN `x'` UNABBREV_TAC;
33720   TYPE_THEN `x''` UNABBREV_TAC;
33721   REDUCE_TAC;
33722   TYPE_THEN `t` EXISTS_TAC;
33723   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33724   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33725   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33726   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33727   REAL_ARITH_TAC;
33728   TYPE_THEN `x'` UNABBREV_TAC;
33729   CONV_TAC (dropq_conv "x");
33730   CONV_TAC (dropq_conv "x''");
33731   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33732   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33733   TYPE_THEN `t` EXISTS_TAC;
33734   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33735   REWRITE_TAC[point_inj;PAIR_SPLIT ];
33736   REAL_ARITH_TAC;
33737   (* Tue Sep  7 16:18:12 EDT 2004 *)
33738
33739   ]);;
33740   (* }}} *)
33741
33742 let lin_solve_x = prove_by_refinement(
33743   `!a  c. ~(c = &0) ==> (?t. c*t = a)`,
33744   (* {{{ proof *)
33745   [
33746   REP_BASIC_TAC;
33747   TYPE_THEN `a/c` EXISTS_TAC;
33748   IMATCH_MP_TAC  REAL_DIV_LMUL;
33749   ASM_MESON_TAC[];
33750   ]);;
33751   (* }}} *)
33752
33753 let mk_line_pt = prove_by_refinement(
33754   `!x. mk_line x x = {x}`,
33755   (* {{{ proof *)
33756   [
33757   REWRITE_TAC[mk_line;trivial_lin_combo];
33758   IMATCH_MP_TAC  EQ_EXT;
33759   REWRITE_TAC[INR IN_SING];
33760   ]);;
33761   (* }}} *)
33762
33763 let h_compat_bij = prove_by_refinement(
33764   `!f t. (BIJ f (euclid 2) (euclid 2) /\
33765           (!x. f (point x) 1 = t + SND x) ==>
33766     h_compat f)`,
33767   (* {{{ proof *)
33768   [
33769   REWRITE_TAC[BIJ;h_compat];
33770   TYPE_THEN `x = y` ASM_CASES_TAC;
33771   REWRITE_TAC[mk_line_pt];
33772   IMATCH_MP_TAC  EQ_EXT;
33773   REWRITE_TAC[IMAGE;INR IN_SING];
33774   EQ_TAC;
33775   ASM_REWRITE_TAC[];
33776   TYPE_THEN`point y` EXISTS_TAC;
33777   (* - *)
33778   TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, t + SND x ))` SUBAGOAL_TAC;
33779   TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
33780   RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
33781   USE 5 (MATCH_MP point_onto);
33782   REWRITE_TAC[point_inj ;PAIR_SPLIT;];
33783   TSPEC `x'` 1;
33784   REWR 1;
33785   UND 1 THEN REWRITE_TAC[coord01];
33786   (* A- *)
33787   UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
33788   IMATCH_MP_TAC  SUBSET_ANTISYM;
33789   CONJ_TAC;
33790   REWRITE_TAC[IMAGE;SUBSET;];
33791   TYPE_THEN `x'` UNABBREV_TAC;
33792   UND 7 THEN REWRITE_TAC[mk_line];
33793   TYPE_THEN `x''` UNABBREV_TAC;
33794   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33795   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33796   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33797   TYPE_THEN `x' = (t' * FST x + (&1 - t') * FST y,t' * SND y + (&1 - t') * SND y)` ABBREV_TAC ;
33798   TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC;
33799   TYPE_THEN `x'` UNABBREV_TAC;
33800   REAL_ARITH_TAC;
33801   KILL 8;
33802   COPY 5;
33803   TSPEC `x'` 5;
33804   UND 5 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
33805   REWRITE_TAC[point_inj ;PAIR_SPLIT;];
33806   TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x;
33807   TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
33808   UND 8 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
33809   REWRITE_TAC[point_inj ;PAIR_SPLIT ];
33810   UND 5 THEN REAL_ARITH_TAC;
33811   UND 4 THEN REWRITE_TAC[];
33812   ONCE_REWRITE_TAC[GSYM point_inj];
33813   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
33814   FIRST_ASSUM IMATCH_MP_TAC ;
33815   TYPE_THEN `t'` EXISTS_TAC;
33816   CONJ_TAC;
33817   UND 5 THEN REAL_ARITH_TAC;
33818   REAL_ARITH_TAC;
33819   (* - *)
33820   REWRITE_TAC[mk_line;SUBSET;IMAGE];
33821   CONV_TAC (dropq_conv "x''");
33822   TYPE_THEN `x'` UNABBREV_TAC;
33823   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;
33824   REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
33825   CONV_TAC (dropq_conv "u");
33826   REAL_ARITH_TAC;
33827   KILL 6;
33828   (* - *)
33829   TYPE_THEN `?x'. point(u, t + SND y) = f (point x')` SUBAGOAL_TAC;
33830   RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
33831   TSPEC `point (u,t + SND y)` 2;
33832   RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
33833   USE 7 (MATCH_MP point_onto);
33834   TYPE_THEN `y'` UNABBREV_TAC;
33835   TYPE_THEN `p` EXISTS_TAC;
33836   (* - *)
33837   TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x;
33838   UND 4 THEN REWRITE_TAC[PAIR_SPLIT ];
33839   UND 7 THEN REAL_ARITH_TAC;
33840   TYPE_THEN `t'` EXISTS_TAC;
33841   AP_TERM_TAC;
33842   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33843   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33844   TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
33845   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
33846   CONJ_TAC;
33847   UND 7 THEN REAL_ARITH_TAC;
33848   (* - *)
33849   TSPEC `x'` 5;
33850   TYPE_THEN `f (point x')` UNABBREV_TAC;
33851   USE 5 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
33852   UND 5 THEN REAL_ARITH_TAC;
33853   (* Tue Sep  7 22:08:48 EDT 2004 *)
33854
33855   ]);;
33856   (* }}} *)
33857
33858 let r_scale_h = prove_by_refinement(
33859   `!r. (&0 < r) ==> (h_compat (r_scale r))`,
33860   (* {{{ proof *)
33861   [
33862   REP_BASIC_TAC;
33863   IMATCH_MP_TAC  h_compat_bij;
33864   TYPE_THEN `&0` EXISTS_TAC;
33865   REDUCE_TAC;
33866   ASM_SIMP_TAC [r_scale_bij];
33867   REWRITE_TAC[r_scale];
33868   COND_CASES_TAC;
33869   (* Tue Sep  7 22:11:42 EDT 2004 *)
33870
33871   ]);;
33872   (* }}} *)
33873
33874 let h_compat_bij2 = prove_by_refinement(
33875   `!f s. (BIJ f (euclid 2) (euclid 2) /\
33876           (!x. f (point x) 1 = s(SND x)) /\ (INJ s UNIV UNIV) ==>
33877     h_compat f)`,
33878   (* {{{ proof *)
33879   [
33880   REWRITE_TAC[BIJ;h_compat];
33881   TYPE_THEN `x = y` ASM_CASES_TAC;
33882   REWRITE_TAC[mk_line_pt];
33883   IMATCH_MP_TAC  EQ_EXT;
33884   REWRITE_TAC[IMAGE;INR IN_SING];
33885   EQ_TAC;
33886   ASM_REWRITE_TAC[];
33887   TYPE_THEN`point y` EXISTS_TAC;
33888   (* - *)
33889   TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, s(SND x) ))` SUBAGOAL_TAC;
33890   TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
33891   RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
33892   USE 6 (MATCH_MP point_onto);
33893   REWRITE_TAC[point_inj ;PAIR_SPLIT;];
33894   TSPEC `x'` 2;
33895   REWR 2;
33896   UND 2 THEN REWRITE_TAC[coord01];
33897   (* A- *)
33898   UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
33899   IMATCH_MP_TAC  SUBSET_ANTISYM;
33900   CONJ_TAC;
33901   REWRITE_TAC[IMAGE;SUBSET;];
33902   TYPE_THEN `x'` UNABBREV_TAC;
33903   UND 8 THEN REWRITE_TAC[mk_line];
33904   TYPE_THEN `x''` UNABBREV_TAC;
33905   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33906   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33907   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
33908   TYPE_THEN `x' = (t * FST x + (&1 - t) * FST y,t * SND y + (&1 - t) * SND y)` ABBREV_TAC ;
33909   TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC;
33910   TYPE_THEN `x'` UNABBREV_TAC;
33911   REAL_ARITH_TAC;
33912   KILL 9;
33913   COPY 6;
33914   TSPEC `x'` 6;
33915   UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
33916   REWRITE_TAC[point_inj ;PAIR_SPLIT;];
33917   TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x;
33918   TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
33919   UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
33920   REWRITE_TAC[point_inj ;PAIR_SPLIT ];
33921   UND 6 THEN REAL_ARITH_TAC;
33922   UND 5 THEN REWRITE_TAC[];
33923   ONCE_REWRITE_TAC[GSYM point_inj];
33924   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
33925   FIRST_ASSUM IMATCH_MP_TAC ;
33926   TYPE_THEN `t` EXISTS_TAC;
33927   CONJ_TAC;
33928   UND 6 THEN REAL_ARITH_TAC;
33929   REAL_ARITH_TAC;
33930   (* - *)
33931   REWRITE_TAC[mk_line;SUBSET;IMAGE];
33932   CONV_TAC (dropq_conv "x''");
33933   TYPE_THEN `x'` UNABBREV_TAC;
33934   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;
33935   REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
33936   CONV_TAC (dropq_conv "u");
33937   REAL_ARITH_TAC;
33938   ONCE_ASM_REWRITE_TAC [];
33939   UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
33940   (* - *)
33941   TYPE_THEN `?x'. point(u, s(SND y)) = f (point x')` SUBAGOAL_TAC;
33942   RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
33943   TSPEC `point (u,s(SND y))` 3;
33944   RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
33945   USE 8 (MATCH_MP point_onto);
33946   TYPE_THEN `y'` UNABBREV_TAC;
33947   TYPE_THEN `p` EXISTS_TAC;
33948   (* B- *)
33949   TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x;
33950   UND 5 THEN REWRITE_TAC[PAIR_SPLIT ];
33951   UND 8 THEN REAL_ARITH_TAC;
33952
33953   TYPE_THEN `t` EXISTS_TAC;
33954   AP_TERM_TAC;
33955   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
33956   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
33957   TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
33958   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
33959   CONJ_TAC;
33960   UND 8 THEN REAL_ARITH_TAC;
33961   (* - *)
33962   TSPEC `x'` 6;
33963   TYPE_THEN `f (point x')` UNABBREV_TAC;
33964   USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
33965   TYPE_THEN `SND y = SND x'` SUBAGOAL_TAC;
33966   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
33967   FIRST_ASSUM IMATCH_MP_TAC ;
33968   UND 12 THEN REAL_ARITH_TAC;
33969   (* Wed Sep  8 20:04:34 EDT 2004 *)
33970
33971   ]);;
33972   (* }}} *)
33973
33974 let u_scale_h = prove_by_refinement(
33975   `!r. (&0 < r) ==> (h_compat (u_scale r))`,
33976   (* {{{ proof *)
33977   [
33978   REP_BASIC_TAC;
33979   IMATCH_MP_TAC  h_compat_bij2;
33980   TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC;
33981   ASM_SIMP_TAC[u_scale_bij];
33982   CONJ_TAC;
33983   REWRITE_TAC[u_scale];
33984   TYPE_THEN `&0 < SND x` ASM_CASES_TAC;
33985   REWRITE_TAC[coord01];
33986   TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC;
33987   REWRITE_TAC[INJ];
33988   UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC;
33989   IMATCH_MP_TAC  REAL_EQ_LMUL_IMP;
33990   UNIFY_EXISTS_TAC;
33991   UND 0 THEN REAL_ARITH_TAC;
33992   TYPE_THEN `y` UNABBREV_TAC;
33993   PROOF_BY_CONTR_TAC;
33994   UND 2 THEN REWRITE_TAC[];
33995   IMATCH_MP_TAC REAL_PROP_POS_MUL2;
33996   TYPE_THEN `x` UNABBREV_TAC;
33997   PROOF_BY_CONTR_TAC;
33998   UND 3 THEN REWRITE_TAC[];
33999   IMATCH_MP_TAC REAL_PROP_POS_MUL2;
34000   ]);;
34001   (* }}} *)
34002
34003 let v_compat_bij2 = prove_by_refinement(
34004   `!f s. (BIJ f (euclid 2) (euclid 2) /\
34005           (!x. f (point x) 0 = s(FST  x)) /\ (INJ s UNIV UNIV) ==>
34006     v_compat f)`,
34007   (* {{{ proof *)
34008   [
34009   REWRITE_TAC[BIJ;v_compat];
34010   TYPE_THEN `x = y` ASM_CASES_TAC;
34011   REWRITE_TAC[mk_line_pt];
34012   IMATCH_MP_TAC  EQ_EXT;
34013   REWRITE_TAC[IMAGE;INR IN_SING];
34014   EQ_TAC;
34015   ASM_REWRITE_TAC[];
34016   TYPE_THEN`point y` EXISTS_TAC;
34017   (* - *)
34018   TYPE_THEN `!x. f (point x) = point(s(FST x),  (f (point x)) 1 )` SUBAGOAL_TAC;
34019   TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
34020   RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
34021   USE 6 (MATCH_MP point_onto);
34022   REWRITE_TAC[point_inj ;PAIR_SPLIT;];
34023   TSPEC `x'` 2;
34024   REWR 2;
34025   UND 2 THEN REWRITE_TAC[coord01];
34026   (* A- *)
34027   UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
34028   IMATCH_MP_TAC  SUBSET_ANTISYM;
34029   CONJ_TAC;
34030   REWRITE_TAC[IMAGE;SUBSET;];
34031   TYPE_THEN `x'` UNABBREV_TAC;
34032   UND 8 THEN REWRITE_TAC[mk_line];
34033   TYPE_THEN `x''` UNABBREV_TAC;
34034   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
34035   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
34036   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
34037   TYPE_THEN `x' = (t * FST y + (&1 - t) * FST y,t * SND x + (&1 - t) * SND y)` ABBREV_TAC ;
34038   TYPE_THEN `FST  x' = FST  y` SUBAGOAL_TAC;
34039   TYPE_THEN `x'` UNABBREV_TAC;
34040   REAL_ARITH_TAC;
34041   KILL 9;
34042   COPY 6;
34043   TSPEC `x'` 6;
34044   UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
34045   REWRITE_TAC[point_inj ;PAIR_SPLIT;];
34046   TH_INTRO_TAC[`f (point x') 1 - f(point y) 1`;`f (point x) 1 - f (point y) 1`] lin_solve_x;
34047   TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
34048   UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
34049   REWRITE_TAC[point_inj ;PAIR_SPLIT ];
34050   UND 6 THEN REAL_ARITH_TAC;
34051   UND 5 THEN REWRITE_TAC[];
34052   ONCE_REWRITE_TAC[GSYM point_inj];
34053   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
34054   FIRST_ASSUM IMATCH_MP_TAC ;
34055   TYPE_THEN `t` EXISTS_TAC;
34056   CONJ_TAC;
34057   UND 6 THEN REAL_ARITH_TAC;
34058   UND 6 THEN REAL_ARITH_TAC;
34059   (* - *)
34060   REWRITE_TAC[mk_line;SUBSET;IMAGE];
34061   CONV_TAC (dropq_conv "x''");
34062   TYPE_THEN `x'` UNABBREV_TAC;
34063   TYPE_THEN `?u. (euclid_plus (t *# (f (point x)))  ((&1 - t) *# (f (point y)))) = point ( s(FST  y), u)` SUBAGOAL_TAC;
34064   ONCE_ASM_REWRITE_TAC[];
34065   REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
34066   CONV_TAC (dropq_conv "u");
34067     REAL_ARITH_TAC;
34068   (* - *)
34069   TYPE_THEN `?x'. point( s(FST  y),u) = f (point x')` SUBAGOAL_TAC;
34070   RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
34071   TSPEC `point (s(FST  y),u)` 3;
34072   RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
34073   USE 9 (MATCH_MP point_onto);
34074   TYPE_THEN `y'` UNABBREV_TAC;
34075   TYPE_THEN `p` EXISTS_TAC;
34076   (* B- *)
34077   TH_INTRO_TAC[`SND  x' - SND  y`;`SND  x - SND  y`] lin_solve_x;
34078   UND 5 THEN REWRITE_TAC[PAIR_SPLIT ];
34079   UND 9 THEN REAL_ARITH_TAC;
34080   TYPE_THEN `t'` EXISTS_TAC;
34081   AP_TERM_TAC;
34082   TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
34083   TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
34084   TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
34085   PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
34086   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
34087   CONJ_TAC;
34088   UND 9 THEN REAL_ARITH_TAC;
34089   (* - *)
34090   TSPEC `x'` 6;
34091   TYPE_THEN `f (point x')` UNABBREV_TAC;
34092   USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
34093   TYPE_THEN `FST  y = FST  x'` SUBAGOAL_TAC;
34094   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
34095   FIRST_ASSUM IMATCH_MP_TAC ;
34096   UND 13 THEN REAL_ARITH_TAC;
34097   (* Wed Sep  8 21:10:34 EDT 2004 *)
34098
34099
34100   ]);;
34101   (* }}} *)
34102
34103 let r_scale_v = prove_by_refinement(
34104   `!r. (&0 < r) ==> (v_compat (r_scale r))`,
34105   (* {{{ proof *)
34106   [
34107   REP_BASIC_TAC;
34108   IMATCH_MP_TAC  v_compat_bij2;
34109   TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC;
34110   ASM_SIMP_TAC[r_scale_bij];
34111   CONJ_TAC;
34112   REWRITE_TAC[r_scale];
34113   TYPE_THEN `&0 < FST  x` ASM_CASES_TAC;
34114   REWRITE_TAC[coord01];
34115   TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC;
34116   REWRITE_TAC[INJ];
34117   UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC;
34118   IMATCH_MP_TAC  REAL_EQ_LMUL_IMP;
34119   UNIFY_EXISTS_TAC;
34120   UND 0 THEN REAL_ARITH_TAC;
34121   TYPE_THEN `y` UNABBREV_TAC;
34122   PROOF_BY_CONTR_TAC;
34123   UND 2 THEN REWRITE_TAC[];
34124   IMATCH_MP_TAC REAL_PROP_POS_MUL2;
34125   TYPE_THEN `x` UNABBREV_TAC;
34126   PROOF_BY_CONTR_TAC;
34127   UND 3 THEN REWRITE_TAC[];
34128   IMATCH_MP_TAC REAL_PROP_POS_MUL2;
34129   ]);;
34130   (* }}} *)
34131
34132 let u_scale_v = prove_by_refinement(
34133   `!r. (&0 < r) ==> (v_compat (u_scale r))`,
34134   (* {{{ proof *)
34135   [
34136   REP_BASIC_TAC;
34137   IMATCH_MP_TAC  v_compat_bij2;
34138   TYPE_THEN `(\ z.  &0 + z)` EXISTS_TAC;
34139   ASM_SIMP_TAC[u_scale_bij];
34140   REDUCE_TAC;
34141   CONJ_TAC;
34142   REWRITE_TAC[u_scale];
34143   COND_CASES_TAC;
34144   REWRITE_TAC[INJ];
34145   ]);;
34146   (* }}} *)
34147
34148
34149 (* ------------------------------------------------------------------ *)
34150 (* SECTION Q *)
34151 (* ------------------------------------------------------------------ *)
34152
34153 let mk_line_hyper2_fst = prove_by_refinement(
34154   `!x y. (FST x = FST y) ==> (mk_line (point x) (point y) SUBSET
34155     hyperplane 2 e1 (FST x))`,
34156   (* {{{ proof *)
34157   [
34158   REWRITE_TAC[];
34159   TYPE_THEN `x = y` ASM_CASES_TAC;
34160   REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ];
34161   REWRITE_TAC[e1;GSYM line2D_F;SUBSET;mk_line;];
34162   TYPE_THEN `y` EXISTS_TAC;
34163   (* - *)
34164   IMATCH_MP_TAC  (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]]));
34165   REWRITE_TAC[GSYM mk_line_hyper2_e1];
34166   ONCE_REWRITE_TAC [EQ_SYM_EQ];
34167   IMATCH_MP_TAC  mk_line_2;
34168   REWRITE_TAC[mk_line_hyper2_e1;];
34169   REWRITE_TAC[e1;GSYM line2D_F;point_inj;PAIR_SPLIT];
34170   CONJ_TAC;
34171   TYPE_THEN `x` EXISTS_TAC;
34172   ASM_REWRITE_TAC[];
34173   CONJ_TAC;
34174   TYPE_THEN `y` EXISTS_TAC;
34175   UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT];
34176   (* Thu Sep  9 10:13:23 EDT 2004 *)
34177
34178   ]);;
34179   (* }}} *)
34180
34181 let mk_line_hyper2_snd = prove_by_refinement(
34182   `!x y. (SND x = SND y) ==> (mk_line (point x) (point y) SUBSET
34183     hyperplane 2 e2 (SND x))`,
34184   (* {{{ proof *)
34185   [
34186   REWRITE_TAC[];
34187   TYPE_THEN `x = y` ASM_CASES_TAC;
34188   REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ];
34189   REWRITE_TAC[e2;GSYM line2D_S;SUBSET;mk_line;];
34190   TYPE_THEN `y` EXISTS_TAC;
34191   (* - *)
34192   IMATCH_MP_TAC  (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]]));
34193   REWRITE_TAC[GSYM mk_line_hyper2_e2];
34194   ONCE_REWRITE_TAC [EQ_SYM_EQ];
34195   IMATCH_MP_TAC  mk_line_2;
34196   REWRITE_TAC[mk_line_hyper2_e2;];
34197   REWRITE_TAC[e2;GSYM line2D_S;point_inj;PAIR_SPLIT];
34198   CONJ_TAC;
34199   TYPE_THEN `x` EXISTS_TAC;
34200   ASM_REWRITE_TAC[];
34201   CONJ_TAC;
34202   TYPE_THEN `y` EXISTS_TAC;
34203   UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT];
34204   (* Thu Sep  9 10:16:19 EDT 2004 *)
34205   ]);;
34206   (* }}} *)
34207
34208 let hv_line_hyper = prove_by_refinement(
34209   `!E e. hv_line E /\ E e ==> (?z.
34210      (e SUBSET hyperplane 2 e1 z) \/ (e SUBSET  hyperplane 2 e2 z))`,
34211   (* {{{ proof *)
34212   [
34213   REWRITE_TAC[hv_line];
34214   TSPEC `e` 1;
34215   REP_BASIC_TAC;
34216   FIRST_ASSUM DISJ_CASES_TAC;
34217   TYPE_THEN `FST y` EXISTS_TAC;
34218   DISJ1_TAC;
34219   USE 3 SYM;
34220   IMATCH_MP_TAC  mk_line_hyper2_fst;
34221   TYPE_THEN `SND x` EXISTS_TAC;
34222   USE 3 SYM;
34223   DISJ2_TAC;
34224   IMATCH_MP_TAC  mk_line_hyper2_snd;
34225   (* Thu Sep  9 10:20:05 EDT 2004 *)
34226
34227   ]);;
34228   (* }}} *)
34229
34230 let hv_line_hyper2 = prove_by_refinement(
34231   `!E. hv_line E /\ FINITE E ==> (?E'.
34232    (UNIONS E SUBSET UNIONS E') /\ (FINITE E') /\
34233    (!e. E' e ==>
34234      (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))`,
34235   (* {{{ proof *)
34236   [
34237   REP_BASIC_TAC;
34238   TYPE_THEN `!e. ?h. (E e ==> (e SUBSET h /\ (?z. (h = hyperplane 2 e1 z) \/ (h =  hyperplane 2 e2 z))))` SUBAGOAL_TAC;
34239   RIGHT_TAC "h";
34240   TH_INTRO_TAC[`E`;`e`] hv_line_hyper;
34241   FIRST_ASSUM DISJ_CASES_TAC;
34242   UNIFY_EXISTS_TAC;
34243   TYPE_THEN `z` EXISTS_TAC;
34244   UNIFY_EXISTS_TAC;
34245   TYPE_THEN `z` EXISTS_TAC;
34246   LEFT 2 "h";
34247   TYPE_THEN `IMAGE h E` EXISTS_TAC;
34248   CONJ_TAC;
34249   REWRITE_TAC[UNIONS;SUBSET;IMAGE];
34250   CONV_TAC (dropq_conv "u");
34251   NAME_CONFLICT_TAC;
34252   TYPE_THEN `u` EXISTS_TAC;
34253   ASM_MESON_TAC[ISUBSET];
34254   (* - *)
34255   CONJ_TAC;
34256   IMATCH_MP_TAC  FINITE_IMAGE;
34257   RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
34258   ASM_MESON_TAC[];
34259   (* Thu Sep  9 10:32:28 EDT 2004 *)
34260
34261   ]);;
34262   (* }}} *)
34263
34264 let finite_graph_edge = prove_by_refinement(
34265   `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_edge G) /\
34266     graph_isomorphic G H ==> FINITE (graph_edge H)`,
34267   (* {{{ proof *)
34268   [
34269   REWRITE_TAC[graph_isomorphic;graph_iso];
34270   ASM_MESON_TAC[FINITE_BIJ];
34271   ]);;
34272   (* }}} *)
34273
34274 let finite_graph_vertex = prove_by_refinement(
34275   `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_vertex G) /\
34276     graph_isomorphic G H ==> FINITE (graph_vertex H)`,
34277   (* {{{ proof *)
34278   [
34279   REWRITE_TAC[graph_isomorphic;graph_iso];
34280   ASM_MESON_TAC[FINITE_BIJ];
34281   ]);;
34282   (* }}} *)
34283
34284 let graph_edge_nonempty = prove_by_refinement(
34285   `!(G:(A,B)graph_t) (H:(A',B')graph_t). ~(graph_edge G = EMPTY ) /\
34286     graph_isomorphic G H ==> ~(graph_edge H  = EMPTY )`,
34287   (* {{{ proof *)
34288   [
34289   REWRITE_TAC[graph_isomorphic;graph_iso];
34290   USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
34291   UND 0 THEN (REWRITE_TAC [EMPTY_EXISTS]);
34292   TYPE_THEN `v u'` EXISTS_TAC ;
34293   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
34294   ]);;
34295   (* }}} *)
34296
34297 let graph_edge_around_finite = prove_by_refinement(
34298   `!(G:(A,B)graph_t) v.
34299         (FINITE (graph_edge G)) ==> (FINITE (graph_edge_around G v))`,
34300   (* {{{ proof *)
34301   [
34302   REWRITE_TAC[graph_edge_around];
34303   IMATCH_MP_TAC  FINITE_SUBSET;
34304   UNIFY_EXISTS_TAC;
34305   REWRITE_TAC[SUBSET];
34306   ]);;
34307   (* }}} *)
34308
34309 let graph_edge_around4 = prove_by_refinement(
34310   `!(G:(A,B)graph_t) (H:(A',B')graph_t). (graph G) /\
34311         (FINITE (graph_edge G)) /\
34312         (!v. CARD (graph_edge_around G v) <=| 4)  /\
34313     graph_isomorphic G H ==> (!v. CARD (graph_edge_around H v) <=| 4)`,
34314   (* {{{ proof *)
34315
34316   [
34317   REP_BASIC_TAC;
34318   TYPE_THEN `graph_vertex H v` ASM_CASES_TAC;
34319   RULE_ASSUM_TAC (REWRITE_RULE [graph_isomorphic]);
34320   TYPE_THEN `?v'. (graph_vertex G v' /\ ((FST f) v' = v))` SUBAGOAL_TAC;
34321   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT ;graph_iso]);
34322   USE 6 (REWRITE_RULE[BIJ;SURJ]);
34323   TYPE_THEN `v` UNABBREV_TAC;
34324   TH_INTRO_TAC[`G`;`H`;`f`;`v'`] graph_iso_around;
34325   TH_INTRO_TAC[`SND f`; `(graph_edge_around G v')`] CARD_IMAGE_LE;
34326   IMATCH_MP_TAC  graph_edge_around_finite;
34327   IMATCH_MP_TAC  LE_TRANS;
34328   UNIFY_EXISTS_TAC;
34329   ASM_MESON_TAC [ARITH_RULE `0 <=| 4`; CARD_CLAUSES;graph_isomorphic_graph;graph_edge_around_empty];
34330   (* Thu Sep  9 11:49:01 EDT 2004 *)
34331
34332   ]);;
34333
34334   (* }}} *)
34335
34336 let graph_near_support = prove_by_refinement(
34337   `!(G:(A,B)graph_t). (planar_graph G) /\
34338          FINITE (graph_edge G) /\
34339          FINITE (graph_vertex G) /\
34340          ~(graph_edge G = {}) /\
34341          (!v. CARD (graph_edge_around G v) <=| 4)
34342          ==> (?H E. graph_isomorphic G H /\
34343            (FINITE E) /\ (good_plane_graph H) /\
34344         (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
34345         (!v. (graph_vertex H v ==>
34346          E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\
34347          (!e. (E e ==>
34348             (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z)))))`,
34349   (* {{{ proof *)
34350   [
34351   REP_BASIC_TAC;
34352   TH_INTRO_TAC[`G`] planar_graph_hv;
34353   TYPE_THEN `H` EXISTS_TAC;
34354   TYPE_THEN `A = IMAGE (\ v. hyperplane 2 e1 (v 0)) (graph_vertex H)` ABBREV_TAC ;
34355   TYPE_THEN `B = IMAGE (\ v. hyperplane 2 e2 (v 1)) (graph_vertex H)` ABBREV_TAC ;
34356   RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]);
34357   LEFT 5 "E";
34358   LEFT 5 "E";
34359   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;
34360   LEFT_TAC "e";
34361   RIGHT_TAC "E'";
34362   TSPEC `e` 5;
34363   TH_INTRO_TAC[`E e`] hv_line_hyper2;
34364   TYPE_THEN `E'` EXISTS_TAC;
34365   IMATCH_MP_TAC  SUBSET_TRANS;
34366   UNIFY_EXISTS_TAC;
34367   (* - *)
34368   TYPE_THEN `C = UNIONS (IMAGE E' (graph_edge H))` ABBREV_TAC ;
34369   TYPE_THEN `A UNION B UNION C` EXISTS_TAC;
34370   CONJ_TAC;
34371   REWRITE_TAC[FINITE_UNION];
34372   CONJ_TAC;
34373   TYPE_THEN `A` UNABBREV_TAC;
34374   IMATCH_MP_TAC  FINITE_IMAGE;
34375   IMATCH_MP_TAC  finite_graph_vertex;
34376   UNIFY_EXISTS_TAC;
34377   CONJ_TAC;
34378   TYPE_THEN `B` UNABBREV_TAC;
34379   IMATCH_MP_TAC  FINITE_IMAGE;
34380   IMATCH_MP_TAC  finite_graph_vertex;
34381   UNIFY_EXISTS_TAC;
34382   TYPE_THEN `C` UNABBREV_TAC;
34383   TH_INTRO_TAC[`IMAGE E' (graph_edge H)`] FINITE_FINITE_UNIONS;
34384   IMATCH_MP_TAC  FINITE_IMAGE;
34385   IMATCH_MP_TAC  finite_graph_edge;
34386   UNIFY_EXISTS_TAC;
34387   USE 11 (REWRITE_RULE[IMAGE]);
34388   ASM_MESON_TAC[];
34389   (* - *)
34390   CONJ_TAC;
34391   REWRITE_TAC[UNIONS_UNION];
34392   IMATCH_MP_TAC  in_union;
34393   DISJ2_TAC;
34394   IMATCH_MP_TAC  in_union;
34395   DISJ2_TAC;
34396   TYPE_THEN `C` UNABBREV_TAC;
34397   TSPEC `e` 10;
34398   REP_BASIC_TAC;
34399   IMATCH_MP_TAC  SUBSET_TRANS;
34400   UNIFY_EXISTS_TAC;
34401   IMATCH_MP_TAC  UNIONS_UNIONS;
34402   REWRITE_TAC[SUBSET;UNIONS;IMAGE;];
34403   CONV_TAC (dropq_conv "u");
34404   UNIFY_EXISTS_TAC;
34405   (* - *)
34406   CONJ_TAC;
34407   REWRITE_TAC[UNION];
34408   TYPE_THEN  `A` UNABBREV_TAC;
34409   TYPE_THEN `B` UNABBREV_TAC;
34410   REWRITE_TAC[IMAGE];
34411   CONJ_TAC;
34412   DISJ1_TAC;
34413   UNIFY_EXISTS_TAC;
34414   ASM_REWRITE_TAC[];
34415   DISJ2_TAC;
34416   DISJ1_TAC;
34417   UNIFY_EXISTS_TAC;
34418   ASM_REWRITE_TAC[];
34419   (* - *)
34420   USE 12 (REWRITE_RULE[UNION]);
34421   UND 12 THEN REP_CASES_TAC;
34422   TYPE_THEN `A` UNABBREV_TAC;
34423   USE 12 (REWRITE_RULE[IMAGE]);
34424   MESON_TAC[];
34425   TYPE_THEN `B` UNABBREV_TAC;
34426   USE 12 (REWRITE_RULE[IMAGE]);
34427   MESON_TAC[];
34428   TYPE_THEN `C` UNABBREV_TAC;
34429   USE 12 (REWRITE_RULE[IMAGE;UNIONS]);
34430   TYPE_THEN `u` UNABBREV_TAC;
34431   TSPEC `x` 10;
34432   (* Thu Sep  9 12:12:51 EDT 2004 *)
34433
34434   ]);;
34435   (* }}} *)
34436
34437 let h_translate_point = prove_by_refinement(
34438   `!u v r. (h_translate r (point (u,v)) = point (u+r,v))`,
34439   (* {{{ proof *)
34440   [
34441   REWRITE_TAC[h_translate;e1;point_scale;point_add];
34442   REDUCE_TAC;
34443   ]);;
34444   (* }}} *)
34445
34446 let v_translate_point = prove_by_refinement(
34447   `!u v r. (v_translate r (point (u,v)) = point (u,v + r))`,
34448   (* {{{ proof *)
34449   [
34450   REWRITE_TAC[v_translate;e2;point_scale;point_add];
34451   REDUCE_TAC;
34452   ]);;
34453   (* }}} *)
34454
34455 let hyperplane1_h_translate = prove_by_refinement(
34456   `!z r. (IMAGE (h_translate r) (hyperplane 2 e1 z) =
34457             (hyperplane 2 e1 (z + r)))`,
34458   (* {{{ proof *)
34459   [
34460   REWRITE_TAC[GSYM mk_line_hyper2_e1];
34461   ASSUME_TAC v_compat;
34462   TSPEC `(h_translate r)` 0;
34463   RULE_ASSUM_TAC (REWRITE_RULE[h_translate_v]);
34464   UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`z, &0`;`z, &1`]));
34465   REWRITE_TAC[h_translate_point];
34466   ]);;
34467   (* }}} *)
34468
34469 let hyperplane2_h_translate = prove_by_refinement(
34470   `!z r. (IMAGE (h_translate r) (hyperplane 2 e2 z) =
34471             (hyperplane 2 e2 z))`,
34472   (* {{{ proof *)
34473   [
34474   REWRITE_TAC[GSYM mk_line_hyper2_e2];
34475   ASSUME_TAC h_compat;
34476   TSPEC `(h_translate r)` 0;
34477   RULE_ASSUM_TAC (REWRITE_RULE[h_translate_h]);
34478   UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;` &1,z`]));
34479   REWRITE_TAC[h_translate_point];
34480   ONCE_REWRITE_TAC[EQ_SYM_EQ];
34481   IMATCH_MP_TAC  mk_line_2;
34482   REWRITE_TAC[mk_line_hyper2_e2;];
34483   REWRITE_TAC[GSYM line2D_S;e2;point_inj ];
34484   CONJ_TAC;
34485   CONV_TAC (dropq_conv "p");
34486   CONJ_TAC;
34487   CONV_TAC (dropq_conv "p");
34488    RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]);
34489   UND 1 THEN REAL_ARITH_TAC;
34490   ]);;
34491   (* }}} *)
34492
34493 let hyperplane2_v_translate = prove_by_refinement(
34494   `!z r. (IMAGE (v_translate r) (hyperplane 2 e2 z) =
34495             (hyperplane 2 e2 (z + r)))`,
34496   (* {{{ proof *)
34497   [
34498   REWRITE_TAC[GSYM mk_line_hyper2_e2];
34499   ASSUME_TAC h_compat;
34500   TSPEC `(v_translate r)` 0;
34501   RULE_ASSUM_TAC (REWRITE_RULE[v_translate_h]);
34502   UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`]));
34503   REWRITE_TAC[v_translate_point];
34504   ]);;
34505   (* }}} *)
34506
34507 let hyperplane1_v_translate = prove_by_refinement(
34508   `!z r. (IMAGE (v_translate r) (hyperplane 2 e1 z) =
34509             (hyperplane 2 e1 z))`,
34510   (* {{{ proof *)
34511   [
34512   REWRITE_TAC[GSYM mk_line_hyper2_e1];
34513   ASSUME_TAC v_compat;
34514   TSPEC `(v_translate r)` 0;
34515   RULE_ASSUM_TAC (REWRITE_RULE[v_translate_v]);
34516   UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`]));
34517   REWRITE_TAC[v_translate_point];
34518   ONCE_REWRITE_TAC[EQ_SYM_EQ];
34519   IMATCH_MP_TAC  mk_line_2;
34520   REWRITE_TAC[mk_line_hyper2_e1;];
34521   REWRITE_TAC[GSYM line2D_F;e1;point_inj ];
34522   CONJ_TAC;
34523   CONV_TAC (dropq_conv "p");
34524   CONJ_TAC;
34525   CONV_TAC (dropq_conv "p");
34526    RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]);
34527   UND 1 THEN REAL_ARITH_TAC;
34528   (* Thu Sep  9 13:43:45 EDT 2004 *)
34529
34530   ]);;
34531   (* }}} *)
34532
34533 let r_scale_point = prove_by_refinement(
34534   `!r u v. (r_scale r (point (u,v))) =
34535   point ((if (&0 < u) then r*u else u),v)`,
34536   (* {{{ proof *)
34537   [
34538   REWRITE_TAC[r_scale];
34539   TYPE_THEN `&0  < u` ASM_CASES_TAC;
34540   ]);;
34541   (* }}} *)
34542
34543 let u_scale_point = prove_by_refinement(
34544   `!r u v. (u_scale r (point (u,v))) =
34545   point (u,(if (&0 < v) then r*v else v))`,
34546   (* {{{ proof *)
34547   [
34548   REWRITE_TAC[u_scale];
34549   TYPE_THEN `&0  < v` ASM_CASES_TAC;
34550   ]);;
34551   (* }}} *)
34552
34553 let hyperplane2_r_scale = prove_by_refinement(
34554   `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e2 z) =
34555              (hyperplane 2 e2 z))`,
34556   (* {{{ proof *)
34557   [
34558   REWRITE_TAC[GSYM mk_line_hyper2_e2];
34559   ASSUME_TAC h_compat;
34560   TSPEC `(r_scale r)` 1;
34561   TYPE_THEN `h_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_h];ALL_TAC];
34562   REWR 1;
34563   UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;`&1,z`]));
34564   REWRITE_TAC[r_scale_point];
34565   ONCE_REWRITE_TAC[EQ_SYM_EQ];
34566   IMATCH_MP_TAC  mk_line_2;
34567   REWRITE_TAC[REAL_ARITH `~(&0 < &0)`];
34568   REWRITE_TAC[mk_line_hyper2_e2;];
34569   REWRITE_TAC[GSYM line2D_S;e2;point_inj ];
34570   CONJ_TAC;
34571   CONV_TAC (dropq_conv "p");
34572   CONJ_TAC;
34573   CONV_TAC (dropq_conv "p");
34574   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]);
34575   UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
34576   ]);;
34577   (* }}} *)
34578
34579 let hyperplane1_r_scale = prove_by_refinement(
34580   `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e1 z) =
34581              (hyperplane 2 e1 (if &0 < z then r*z else z)))`,
34582   (* {{{ proof *)
34583   [
34584   REWRITE_TAC[GSYM mk_line_hyper2_e1];
34585   ASSUME_TAC v_compat;
34586   TSPEC `(r_scale r)` 1;
34587   TYPE_THEN `v_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_v];ALL_TAC];
34588   REWR 1;
34589   UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`z,&0`;`z,&1`]));
34590   REWRITE_TAC[r_scale_point];
34591   ]);;
34592   (* }}} *)
34593
34594 let hyperplane1_u_scale = prove_by_refinement(
34595   `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e1 z) =
34596              (hyperplane 2 e1 z))`,
34597   (* {{{ proof *)
34598   [
34599   REWRITE_TAC[GSYM mk_line_hyper2_e1];
34600   ASSUME_TAC v_compat;
34601   TSPEC `(u_scale r)` 1;
34602   TYPE_THEN `v_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_v];ALL_TAC];
34603   REWR 1;
34604   UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`]));
34605   REWRITE_TAC[u_scale_point];
34606   ONCE_REWRITE_TAC[EQ_SYM_EQ];
34607   IMATCH_MP_TAC  mk_line_2;
34608   REWRITE_TAC[REAL_ARITH `~(&0 < &0)`];
34609   REWRITE_TAC[mk_line_hyper2_e1;];
34610   REWRITE_TAC[GSYM line2D_F;e1;point_inj ];
34611   CONJ_TAC;
34612   CONV_TAC (dropq_conv "p");
34613   CONJ_TAC;
34614   CONV_TAC (dropq_conv "p");
34615   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]);
34616   UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
34617   ]);;
34618   (* }}} *)
34619
34620 let hyperplane2_u_scale = prove_by_refinement(
34621   `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e2 z) =
34622              (hyperplane 2 e2 (if &0 < z then r*z else z)))`,
34623   (* {{{ proof *)
34624   [
34625   REWRITE_TAC[GSYM mk_line_hyper2_e2];
34626   ASSUME_TAC h_compat;
34627   TSPEC `(u_scale r)` 1;
34628   TYPE_THEN `h_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_h];ALL_TAC];
34629   REWR 1;
34630   UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`]));
34631   REWRITE_TAC[u_scale_point];
34632   (* Thu Sep  9 14:04:58 EDT 2004 *)
34633
34634   ]);;
34635   (* }}} *)
34636
34637 let homeomorphism_compose = prove_by_refinement(
34638   `!U V W (f:A->B) (g:B->C). homeomorphism f U V /\ homeomorphism g V W
34639    ==>
34640    homeomorphism (g o f) U W`,
34641   (* {{{ proof *)
34642   [
34643   REWRITE_TAC[homeomorphism];
34644   SUBCONJ_TAC;
34645   REWRITE_TAC[comp_comp];
34646   IMATCH_MP_TAC  COMP_BIJ;
34647   UNIFY_EXISTS_TAC;
34648   (* - *)
34649   CONJ_TAC;
34650   IMATCH_MP_TAC  continuous_comp;
34651   UNIFY_EXISTS_TAC;
34652   RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
34653   REWRITE_TAC[IMAGE;SUBSET];
34654   FIRST_ASSUM IMATCH_MP_TAC ;
34655   (* - *)
34656   REWRITE_TAC[IMAGE_o];
34657   FIRST_ASSUM IMATCH_MP_TAC ;
34658   ]);;
34659   (* }}} *)
34660
34661 let hyperplane1_inj = prove_by_refinement(
34662   `!z w. (hyperplane 2 e1 z = hyperplane 2 e1 w) ==> (z = w)`,
34663   (* {{{ proof *)
34664   [
34665   REWRITE_TAC[e1; GSYM line2D_F];
34666   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
34667   USE 0 (REWRITE_RULE[]);
34668   TSPEC `point(z,&0)` 0;
34669   RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
34670   USE 0 SYM;
34671   TYPE_THEN `(?p. (z,&0 = p) /\ (FST p = z))` SUBAGOAL_TAC;
34672   CONV_TAC (dropq_conv "p");
34673   ASM_MESON_TAC[];
34674   ]);;
34675   (* }}} *)
34676
34677 let hyperplane2_inj = prove_by_refinement(
34678   `!z w. (hyperplane 2 e2 z = hyperplane 2 e2 w) ==> (z = w)`,
34679   (* {{{ proof *)
34680   [
34681   REWRITE_TAC[e2; GSYM line2D_S];
34682   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
34683   USE 0 (REWRITE_RULE[]);
34684   TSPEC `point(z,z)` 0;
34685   RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
34686   USE 0 SYM;
34687   TYPE_THEN `(?p. (z,z = p) /\ (SND p = z))` SUBAGOAL_TAC;
34688   CONV_TAC (dropq_conv "p");
34689   ASM_MESON_TAC[];
34690   ]);;
34691   (* }}} *)
34692
34693 let graph_support_init = prove_by_refinement(
34694   `!(G:(A,B)graph_t). (planar_graph G) /\
34695          FINITE (graph_edge G) /\
34696          FINITE (graph_vertex G) /\
34697          ~(graph_edge G = {}) /\
34698          (!v. CARD (graph_edge_around G v) <=| 4)
34699          ==> (?H E. graph_isomorphic G H /\
34700            (FINITE E) /\ (good_plane_graph H) /\
34701         (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
34702         (!v. (graph_vertex H v ==>
34703          E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\
34704          (!e. (E e ==>
34705             (?z. (&0 < z) /\
34706                ((e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))))`,
34707   (* {{{ proof *)
34708   [
34709   REP_BASIC_TAC;
34710   TH_INTRO_TAC[`G`] graph_near_support;
34711   TYPE_THEN `EH = E INTER { h | ?z. (h = hyperplane 2 e1 z) }` ABBREV_TAC ;
34712   TYPE_THEN `EV = E INTER {h | ?z. (h = hyperplane 2 e2 z) }` ABBREV_TAC ;
34713   TYPE_THEN `E = EH UNION EV` SUBAGOAL_TAC;
34714   IMATCH_MP_TAC  SUBSET_ANTISYM;
34715   CONJ_TAC;
34716   TYPE_THEN `EH` UNABBREV_TAC;
34717   TYPE_THEN `EV` UNABBREV_TAC;
34718   REWRITE_TAC[SUBSET;INTER;UNION];
34719   ASM_MESON_TAC[];
34720   REWRITE_TAC[UNION;SUBSET];
34721   TYPE_THEN `EH` UNABBREV_TAC;
34722   TYPE_THEN `EV` UNABBREV_TAC;
34723   RULE_ASSUM_TAC (REWRITE_RULE[INTER;GSYM LEFT_AND_OVER_OR]);
34724   (* - *)
34725   TYPE_THEN `FINITE EH /\ FINITE EV` SUBAGOAL_TAC;
34726   USE 13 SYM;
34727   USE 13 (MATCH_MP union_imp_subset);
34728   ASM_MESON_TAC[FINITE_SUBSET];
34729 (*** Modified by JRH for new theorem name
34730   TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE;
34731  ***)
34732   TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE_IMP;
34733   TYPE_THEN `EH` UNABBREV_TAC;
34734   REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV];
34735 (*** Modified by JRH for new theorem name
34736   TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE;
34737  ***)
34738   TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE_IMP;
34739   TYPE_THEN `EV` UNABBREV_TAC;
34740   REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV];
34741   (* - *)
34742   WITH 21 (MATCH_MP finite_LB);
34743   WITH 18 (MATCH_MP finite_LB);
34744   TYPE_THEN `f = (h_translate (&1 - t')) o (v_translate (&1 - t))` ABBREV_TAC ;
34745   TYPE_THEN `plane_graph_image f H` EXISTS_TAC;
34746   TYPE_THEN `IMAGE2 f E` EXISTS_TAC;
34747   (* A- *)
34748   TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC;
34749   TYPE_THEN `f` UNABBREV_TAC;
34750   IMATCH_MP_TAC  homeomorphism_compose;
34751   TYPE_THEN `top2` EXISTS_TAC;
34752   REWRITE_TAC[v_translate_hom;h_translate_hom];
34753   (* - *)
34754   TYPE_THEN `graph_isomorphic H (plane_graph_image f H)` SUBAGOAL_TAC;
34755   IMATCH_MP_TAC  plane_graph_image_iso;
34756   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph]);
34757   (* - *)
34758   CONJ_TAC;
34759   TH_INTRO_TAC[`G`;`H`;`plane_graph_image f H`] graph_isomorphic_trans;
34760   (* - *)
34761   CONJ_TAC;
34762   REWRITE_TAC[IMAGE2];
34763   IMATCH_MP_TAC  FINITE_IMAGE;
34764   ASM_REWRITE_TAC[FINITE_UNION];
34765   (* - *)
34766   CONJ_TAC;
34767   IMATCH_MP_TAC  plane_graph_image_plane;
34768   (* B- *)
34769   TYPE_THEN `!z. IMAGE  f (hyperplane 2 e1 z) = hyperplane 2 e1 (z - t' + &1)` SUBAGOAL_TAC;
34770   TYPE_THEN `f` UNABBREV_TAC;
34771   REWRITE_TAC[IMAGE_o;hyperplane1_v_translate;hyperplane1_h_translate];
34772   AP_TERM_TAC;
34773   REAL_ARITH_TAC;
34774   TYPE_THEN `!z. IMAGE f (hyperplane 2 e2 z) = hyperplane 2 e2 (z - t + &1)` SUBAGOAL_TAC;
34775   TYPE_THEN `f` UNABBREV_TAC;
34776   REWRITE_TAC[IMAGE_o;hyperplane2_v_translate;hyperplane2_h_translate];
34777   AP_TERM_TAC;
34778   REAL_ARITH_TAC;
34779   REWRITE_TAC[IMAGE2;GSYM image_unions;];
34780   REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;IMAGE2];
34781   (* - *)
34782   CONJ_TAC;
34783   TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
34784   USE 29 (REWRITE_RULE[IMAGE]);
34785   TYPE_THEN `g` UNABBREV_TAC;
34786   IMATCH_MP_TAC  IMAGE_SUBSET;
34787   USE 13 GSYM;
34788   FIRST_ASSUM IMATCH_MP_TAC ;
34789   (* C- *)
34790   USE 13 GSYM;
34791   CONJ_TAC;
34792   USE 29 (REWRITE_RULE[IMAGE]);
34793   TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
34794   RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
34795   USE 31 (MATCH_MP point_onto);
34796   TYPE_THEN `x` UNABBREV_TAC;
34797   TYPE_THEN `v` UNABBREV_TAC;
34798   TYPE_THEN `f (point p) = point(FST p - t' + &1 , SND p  - t + &1)` SUBAGOAL_TAC;
34799   TYPE_THEN `f` UNABBREV_TAC;
34800   TYPE_THEN `p = FST p,SND p` SUBAGOAL_TAC;
34801   PURE_ONCE_ASM_REWRITE_TAC[] THEN  PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;];
34802   PURE_ONCE_ASM_REWRITE_TAC[] THEN  PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;];
34803   REWRITE_TAC[point_inj ;PAIR_SPLIT];
34804   REAL_ARITH_TAC;
34805   USE 28 GSYM ;
34806   USE 27 GSYM;
34807   TSPEC `point p` 6;
34808   CONJ_TAC;
34809   IMATCH_MP_TAC  image_imp;
34810   RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
34811   IMATCH_MP_TAC  image_imp;
34812   RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
34813   (* D- *)
34814   TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
34815   USE 29 (REWRITE_RULE[IMAGE]);
34816   TYPE_THEN `EH x \/ EV x` SUBAGOAL_TAC;
34817   TYPE_THEN `E` UNABBREV_TAC;
34818   RULE_ASSUM_TAC (REWRITE_RULE[UNION]);
34819   FIRST_ASSUM DISJ_CASES_TAC;
34820   TYPE_THEN `EH` UNABBREV_TAC;
34821   RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
34822   ASM_REWRITE_TAC[];
34823   TYPE_THEN `z - t' + &1` EXISTS_TAC;
34824   TYPE_THEN `s' z` SUBAGOAL_TAC;
34825   USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
34826   TSPEC `x` 16;
34827   REWR 16;
34828   LEFT 16 "z'";
34829   TSPEC `z` 16;
34830   REWR 16;
34831   TYPE_THEN `z = x'` SUBAGOAL_TAC;
34832   IMATCH_MP_TAC  hyperplane1_inj;
34833   ASM_REWRITE_TAC[];
34834   TSPEC `z` 23;
34835   UND 23 THEN REAL_ARITH_TAC;
34836   TYPE_THEN `EV` UNABBREV_TAC;
34837   RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
34838   ASM_REWRITE_TAC[];
34839   TYPE_THEN `z - t + &1` EXISTS_TAC;
34840   TYPE_THEN `s'' z` SUBAGOAL_TAC;
34841   USE 19 (REWRITE_RULE[SUBSET;IMAGE]);
34842   TSPEC `x` 19;
34843   REWR 19;
34844   LEFT 19 "z'";
34845   TSPEC `z` 19;
34846   REWR 19;
34847   TYPE_THEN `z = x'` SUBAGOAL_TAC;
34848   IMATCH_MP_TAC  hyperplane2_inj;
34849   ASM_REWRITE_TAC[];
34850   TSPEC `z` 22;
34851   UND 22 THEN REAL_ARITH_TAC;
34852   (* Thu Sep  9 17:00:37 EDT 2004 *)
34853
34854   ]);;
34855   (* }}} *)
34856
34857 let hyperplane_ne = prove_by_refinement(
34858   `!z z'. ~(hyperplane 2 e1 z = hyperplane 2 e2 z')`,
34859   (* {{{ proof *)
34860   [
34861   REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM line2D_F];
34862   RULE_ASSUM_TAC (ONCE_REWRITE_RULE[FUN_EQ_THM]);
34863   TSPEC `point(z, z'+ &1)` 0;
34864   REWR 0;
34865   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;point_inj]);
34866   USE 0 SYM;
34867   TYPE_THEN `(?p. ((z = FST p) /\ (z' + &1 = SND p)) /\ (FST p = z))` SUBAGOAL_TAC;
34868   TYPE_THEN `(z,z' + &1)` EXISTS_TAC;
34869   ASSUME_TAC (REAL_ARITH `~(z' + &1 = z')`);
34870   ASM_MESON_TAC[];
34871   ]);;
34872   (* }}} *)
34873
34874
34875 (* ------------------------------------------------------------------ *)
34876 (* SECTION R *)
34877 (* ------------------------------------------------------------------ *)
34878
34879
34880 extend_simp_rewrites[UNION_EMPTY ];;
34881
34882 let inductive_set_restrict = prove_by_refinement(
34883   `!G A S. inductive_set G S /\
34884      ~(S INTER A = EMPTY) /\
34885      segment A /\ A SUBSET G ==> inductive_set A (S INTER A)`,
34886   (* {{{ proof *)
34887   [
34888   REWRITE_TAC[inductive_set];
34889   CONJ_TAC;
34890   REWRITE_TAC[INTER;SUBSET];
34891   REWRITE_TAC[INTER];
34892   FIRST_ASSUM IMATCH_MP_TAC ;
34893   RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
34894   UNIFY_EXISTS_TAC;
34895   ASM_MESON_TAC[ISUBSET];
34896   ]);;
34897   (* }}} *)
34898
34899 let inductive_set_adj = prove_by_refinement(
34900   `!A B S m. inductive_set (A UNION B) S /\ (endpoint B m) /\
34901    (FINITE A) /\ (FINITE B) /\
34902    (endpoint A m) /\ (A SUBSET S) ==> (~(S INTER B = EMPTY)) `,
34903   (* {{{ proof *)
34904   [
34905   REP_BASIC_TAC;
34906   TYPE_THEN `?e. A e /\ closure top2 e (pointI m)` SUBAGOAL_TAC;
34907   TYPE_THEN `terminal_edge A m` EXISTS_TAC;
34908   IMATCH_MP_TAC  terminal_endpoint;
34909   TYPE_THEN `?e'. B e' /\ closure top2 e' (pointI m)` SUBAGOAL_TAC;
34910   TYPE_THEN `terminal_edge B m` EXISTS_TAC;
34911   IMATCH_MP_TAC  terminal_endpoint;
34912   RULE_ASSUM_TAC (REWRITE_RULE[inductive_set]);
34913   TSPEC `e` 6;
34914   TSPEC `e'` 6;
34915   (* - *)
34916   TYPE_THEN `e = e'` ASM_CASES_TAC;
34917   TYPE_THEN `e'` UNABBREV_TAC;
34918   RULE_ASSUM_TAC (REWRITE_RULE[SUBSET ;EQ_EMPTY;INTER; ]);
34919   ASM_MESON_TAC[];
34920   (* - *)
34921   TYPE_THEN `S e /\ (A UNION B) e' /\ adj e e'` SUBAGOAL_TAC;
34922   CONJ_TAC;
34923   ASM_MESON_TAC[ISUBSET];
34924   CONJ_TAC;
34925   REWRITE_TAC[UNION];
34926   REWRITE_TAC[adj];
34927   REWRITE_TAC[EMPTY_EXISTS;INTER;];
34928   UNIFY_EXISTS_TAC;
34929   REWR 6;
34930   RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY ;INTER]);
34931   ASM_MESON_TAC[];
34932   ]);;
34933   (* }}} *)
34934
34935 let inductive_set_join = prove_by_refinement(
34936   `!A B S . ~(S INTER A = EMPTY) /\ (segment B) /\ (segment A) /\
34937       (?m. endpoint A m /\ endpoint B m) /\
34938       (inductive_set (A UNION B) S)  ==>
34939     (S = (A UNION B))`,
34940   (* {{{ proof *)
34941   [
34942   REP_BASIC_TAC;
34943   TH_INTRO_TAC[`A UNION B`;`A`;`S`] inductive_set_restrict;
34944   REWRITE_TAC[SUBSET;UNION];
34945   (* - *)
34946   TYPE_THEN `(S INTER A) = A` SUBAGOAL_TAC;
34947   USE 6 (REWRITE_RULE[inductive_set]);
34948   USE 3 (REWRITE_RULE[segment]);
34949   FIRST_ASSUM IMATCH_MP_TAC ;
34950   ASM_REWRITE_TAC[];
34951   TYPE_THEN `A SUBSET S` SUBAGOAL_TAC;
34952   UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
34953   REWRITE_TAC[INTER;SUBSET];
34954   (* - *)
34955   TH_INTRO_TAC [`A`;`B`;`S`;`m`] inductive_set_adj;
34956   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
34957   (* - *)
34958   TH_INTRO_TAC[`A UNION B`;`B`;`S`] inductive_set_restrict;
34959   REWRITE_TAC[SUBSET;UNION];
34960   TYPE_THEN `(S INTER B) = B` SUBAGOAL_TAC;
34961   USE 10 (REWRITE_RULE[inductive_set]);
34962   USE 4 (REWRITE_RULE[segment]);
34963   FIRST_ASSUM IMATCH_MP_TAC ;
34964   ASM_REWRITE_TAC[];
34965   TYPE_THEN `B SUBSET S` SUBAGOAL_TAC;
34966   UND 11 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
34967   REWRITE_TAC[INTER;SUBSET];
34968   IMATCH_MP_TAC  SUBSET_ANTISYM;
34969   USE 0 (REWRITE_RULE[inductive_set]);
34970   REWRITE_TAC[union_subset];
34971   ]);;
34972   (* }}} *)
34973
34974 let segment_union = prove_by_refinement(
34975   `!A B m. segment A /\ segment B /\
34976      endpoint A m /\ endpoint B m /\
34977      (A INTER B = EMPTY) /\
34978   (!n. (0 < num_closure A (pointI n)) /\
34979           (0 < num_closure B (pointI n)) ==> (n = m) )
34980     ==>
34981     segment (A UNION B)` ,
34982   (* {{{ proof *)
34983   [
34984   REP_BASIC_TAC;
34985   (* - *)
34986   TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
34987   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
34988   (* - *)
34989   REWRITE_TAC[segment];
34990   ASM_REWRITE_TAC[FINITE_UNION];
34991   (* - *)
34992   CONJ_TAC;
34993   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
34994   RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
34995   UND 8 THEN REWRITE_TAC[EMPTY_EXISTS;UNION];
34996   TYPE_THEN `u` EXISTS_TAC;
34997   (* - *)
34998   CONJ_TAC;
34999   REWRITE_TAC[union_subset];
35000   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35001   (* - *)
35002   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;
35003   IMATCH_MP_TAC  EQ_EXT;
35004   REWRITE_TAC[UNION];
35005   TYPE_THEN `A x` ASM_CASES_TAC;
35006   RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]);
35007   TSPEC `x` 1;
35008   REWR 1;
35009   TYPE_THEN `!m. num_closure(A UNION B) (pointI m) =  num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC;
35010   REWRITE_TAC[num_closure];
35011   IMATCH_MP_TAC  (CARD_UNION);
35012   CONJ_TAC;
35013   IMATCH_MP_TAC  FINITE_SUBSET;
35014   TYPE_THEN `A` EXISTS_TAC;
35015   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35016   REWRITE_TAC[SUBSET];
35017   CONJ_TAC;
35018   IMATCH_MP_TAC  FINITE_SUBSET;
35019   TYPE_THEN `B` EXISTS_TAC;
35020   REWRITE_TAC[SUBSET];
35021   REWRITE_TAC[EQ_EMPTY ];
35022   RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]);
35023   ASM_MESON_TAC[];
35024   (* - *)
35025   CONJ_TAC;
35026   TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC;
35027   REDUCE_TAC;
35028   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35029   TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC;
35030   REDUCE_TAC;
35031   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35032   UND 10 THEN UND 11 THEN REWRITE_TAC [ARITH_RULE  `~(x = 0) <=> (0 < x)`];
35033   TYPE_THEN `m' = m` SUBAGOAL_TAC;
35034   FIRST_ASSUM IMATCH_MP_TAC ;
35035   RULE_ASSUM_TAC (REWRITE_RULE[endpoint]);
35036   REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT];
35037   (* -A *)
35038   TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC;
35039   REWRITE_TAC[inductive_set];
35040   ASM_REWRITE_TAC[];
35041   (* - *)
35042   TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC;
35043   (* -- cut here *)
35044   IMATCH_MP_TAC  inductive_set_join;
35045   UNIFY_EXISTS_TAC;
35046   REWR 14;
35047   TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC;
35048   UND 15 THEN UND 14 THEN UND 11 THEN UND 12 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[];
35049   (* - *)
35050   ONCE_REWRITE_TAC [UNION_COMM];
35051   IMATCH_MP_TAC  inductive_set_join;
35052   ONCE_REWRITE_TAC [UNION_COMM];
35053   UNIFY_EXISTS_TAC;
35054   ]);;
35055   (* }}} *)
35056
35057 let two_endpoint_segment = prove_by_refinement(
35058   `!C p q m. segment C /\ endpoint C q /\ endpoint C p /\ endpoint C m /\
35059      ~(m = p) ==>
35060       (q = m) \/ (q = p)`,
35061   (* {{{ proof *)
35062   [
35063   REP_BASIC_TAC;
35064   TYPE_THEN `psegment C` SUBAGOAL_TAC;
35065   IMATCH_MP_TAC  endpoint_psegment;
35066   UNIFY_EXISTS_TAC;
35067   (* - *)
35068   TH_INTRO_TAC[`C`] endpoint_size2;
35069   IMATCH_MP_TAC  (TAUT `(~A ==> B) ==> (A \/ B)`);
35070   IMATCH_MP_TAC  two_exclusion;
35071   UNIFY_EXISTS_TAC;
35072   ]);;
35073   (* }}} *)
35074
35075 let EQ_ANTISYM = prove_by_refinement(
35076   `!A B. (A ==>B) /\ (B ==> A) ==> (A = B)`,
35077   (* {{{ proof *)
35078   [
35079   MESON_TAC[];
35080   ]);;
35081   (* }}} *)
35082
35083 let segment_union2 = prove_by_refinement(
35084   `!A B m p. segment A /\ segment B /\ ~(m = p) /\
35085      endpoint A m /\ endpoint B m /\
35086      endpoint A p /\ endpoint B p /\
35087      (A INTER B = EMPTY) /\
35088   (!n. (0 < num_closure A (pointI n)) /\ (0 < num_closure B (pointI n)) <=>
35089           (((n = m ) \/ (n = p) )))
35090     ==>
35091     rectagon (A UNION B)`,
35092   (* {{{ proof *)
35093   [
35094   REP_BASIC_TAC;
35095   TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
35096   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35097   (* - *)
35098   REWRITE_TAC[rectagon];
35099   ASM_REWRITE_TAC[FINITE_UNION];
35100   (* - *)
35101   CONJ_TAC;
35102   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35103   RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
35104   UND 11 THEN REWRITE_TAC[EMPTY_EXISTS;UNION];
35105   TYPE_THEN `u` EXISTS_TAC;
35106   (* - *)
35107   CONJ_TAC;
35108   REWRITE_TAC[union_subset];
35109   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35110   (* - *)
35111   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;
35112   IMATCH_MP_TAC  EQ_EXT;
35113   REWRITE_TAC[UNION];
35114   TYPE_THEN `A x` ASM_CASES_TAC;
35115   RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]);
35116   TSPEC `x` 1;
35117   REWR 1;
35118   (* - *)
35119   TYPE_THEN `!m. num_closure(A UNION B) (pointI m) =  num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC;
35120   REWRITE_TAC[num_closure];
35121   IMATCH_MP_TAC  (CARD_UNION);
35122   CONJ_TAC;
35123   IMATCH_MP_TAC  FINITE_SUBSET;
35124   TYPE_THEN `A` EXISTS_TAC;
35125   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35126   REWRITE_TAC[SUBSET];
35127   CONJ_TAC;
35128   IMATCH_MP_TAC  FINITE_SUBSET;
35129   TYPE_THEN `B` EXISTS_TAC;
35130   REWRITE_TAC[SUBSET];
35131   REWRITE_TAC[EQ_EMPTY ];
35132   RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]);
35133   ASM_MESON_TAC[];
35134   (* - *)
35135   TYPE_THEN `!q. endpoint A q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC;
35136   IMATCH_MP_TAC two_endpoint_segment;
35137   UNIFY_EXISTS_TAC;
35138   TYPE_THEN `!q. endpoint B q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC;
35139   IMATCH_MP_TAC two_endpoint_segment;
35140   TYPE_THEN  `B` EXISTS_TAC;
35141   UNIFY_EXISTS_TAC;
35142   (* -A *)
35143   TYPE_THEN `!m. (num_closure A (pointI m) = 1) <=> (num_closure B (pointI m) = 1)` SUBAGOAL_TAC;
35144   IMATCH_MP_TAC  EQ_ANTISYM;
35145   RULE_ASSUM_TAC (REWRITE_RULE[endpoint]);
35146   CONJ_TAC;
35147   TSPEC `m'` 13;
35148   FIRST_ASSUM DISJ_CASES_TAC;
35149   ASM_REWRITE_TAC[];
35150   ASM_REWRITE_TAC[];
35151   TSPEC `m'` 14;
35152   FIRST_ASSUM DISJ_CASES_TAC;
35153   ASM_REWRITE_TAC[];
35154   ASM_REWRITE_TAC[];
35155   (* - *)
35156   CONJ_TAC;
35157   FULL_REWRITE_TAC[endpoint];
35158   TYPE_THEN `!x. {0, 2} x <=> {0, 1, 2} x /\ ~(x = 1)` SUBAGOAL_TAC;
35159   REWRITE_TAC[INSERT];
35160   ARITH_TAC;
35161   KILL 16;
35162   TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC;
35163   REDUCE_TAC;
35164   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35165   TSPEC `m'` 15;
35166   REWR 25;
35167   UND 25 THEN ARITH_TAC;
35168   (* -- *)
35169   TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC;
35170   REDUCE_TAC;
35171   RULE_ASSUM_TAC (REWRITE_RULE[segment]);
35172   ARITH_TAC;
35173   FULL_REWRITE_TAC [ARITH_RULE  `~(x = 0) <=> (0 < x)`];
35174   TYPE_THEN `(m' = m) \/ (m' = p)` SUBAGOAL_TAC;
35175   TSPEC `m'` 0;
35176   REWR 0;
35177   TYPE_THEN `num_closure A (pointI m') = 1` SUBAGOAL_TAC;
35178   FIRST_ASSUM DISJ_CASES_TAC;
35179   ASM_REWRITE_TAC[];
35180   ASM_REWRITE_TAC[];
35181   TYPE_THEN `num_closure B (pointI m') = 1` SUBAGOAL_TAC;
35182   FIRST_ASSUM DISJ_CASES_TAC;
35183   ASM_REWRITE_TAC[];
35184   ASM_REWRITE_TAC[];
35185   REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT;ARITH_RULE `~(2 = 1)`];
35186   (* - *)
35187   TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC;
35188   REWRITE_TAC[inductive_set];
35189   ASM_REWRITE_TAC[];
35190   (* - *)
35191   TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC;
35192   (* -- *)
35193   IMATCH_MP_TAC  inductive_set_join;
35194   UNIFY_EXISTS_TAC;
35195   REWR 20;
35196   TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC;
35197   UND 20 THEN UND 21 THEN UND 17 THEN UND 18 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[];
35198   (* - *)
35199   ONCE_REWRITE_TAC [UNION_COMM];
35200   IMATCH_MP_TAC  inductive_set_join;
35201   ONCE_REWRITE_TAC [UNION_COMM];
35202   UNIFY_EXISTS_TAC;
35203   ]);;
35204   (* }}} *)
35205
35206 let card_inj = prove_by_refinement(
35207   `!(f:A->B) A B. INJ f A B /\ FINITE B ==> (CARD A <= CARD B)`,
35208   (* {{{ proof *)
35209   [
35210   REP_BASIC_TAC;
35211   TYPE_THEN `CARD (IMAGE f A) = CARD A` SUBAGOAL_TAC;
35212   IMATCH_MP_TAC  CARD_IMAGE_INJ;
35213   CONJ_TAC;
35214   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
35215   FIRST_ASSUM IMATCH_MP_TAC ;
35216   IMATCH_MP_TAC  FINITE_INJ;
35217   ASM_MESON_TAC[];
35218   USE 2 GSYM;
35219   IMATCH_MP_TAC  CARD_SUBSET;
35220   RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
35221   REWRITE_TAC[IMAGE;SUBSET];
35222   FIRST_ASSUM IMATCH_MP_TAC ;
35223   ]);;
35224   (* }}} *)
35225
35226 let inj_bij_size = prove_by_refinement(
35227   `!A B (f:A->B). INJ f A B /\ B HAS_SIZE (CARD A) ==> BIJ f A B`,
35228   (* {{{ proof *)
35229   [
35230   REWRITE_TAC[HAS_SIZE];
35231   TH_INTRO_TAC [`f`;`A`] inj_bij;
35232   FULL_REWRITE_TAC[INJ];
35233   ASM_MESON_TAC[];
35234   TYPE_THEN `IMAGE f A = B` SUBAGOAL_TAC;
35235   IMATCH_MP_TAC  CARD_SUBSET_EQ;
35236   CONJ_TAC;
35237   FULL_REWRITE_TAC[INJ];
35238   REWRITE_TAC[IMAGE;SUBSET];
35239   ASM_MESON_TAC[];
35240   IMATCH_MP_TAC  EQ_SYM;
35241   IMATCH_MP_TAC  BIJ_CARD;
35242   UNIFY_EXISTS_TAC;
35243   ASM_MESON_TAC[FINITE_INJ];
35244   ASM_MESON_TAC[];
35245   ]);;
35246   (* }}} *)
35247
35248 let bij_empty = prove_by_refinement(
35249   `!(f:A->B). BIJ f EMPTY EMPTY `,
35250   (* {{{ proof *)
35251   [
35252   REWRITE_TAC[BIJ;INJ;SURJ];
35253   ]);;
35254   (* }}} *)
35255
35256 let bij_sing = prove_by_refinement(
35257   `!(f:A->B) a b. BIJ f {a} {b} <=> (f a = b)`,
35258   (* {{{ proof *)
35259   [
35260   REWRITE_TAC[BIJ;INJ;SURJ;INR IN_SING ];
35261   MESON_TAC[];
35262   ]);;
35263   (* }}} *)
35264
35265 let card_sing = prove_by_refinement(
35266   `!(a:A). (CARD {a} = 1)`,
35267   (* {{{ proof *)
35268   [
35269   REP_BASIC_TAC;
35270   THM_INTRO_TAC[`a`;`EMPTY:A->bool`] card_suc_insert;
35271   REWRITE_TAC[FINITE_RULES];
35272   FULL_REWRITE_TAC[CARD_CLAUSES];
35273   TYPE_THEN `CARD {a}` UNABBREV_TAC;
35274   ARITH_TAC;
35275   ]);;
35276   (* }}} *)
35277
35278 let pair_indistinct = prove_by_refinement(
35279   `!(a:A). {a,a} = {a}`,
35280   (* {{{ proof *)
35281   [
35282   MESON_TAC[INR ABSORPTION;INR COMPONENT];
35283   ]);;
35284   (* }}} *)
35285
35286 let has_size2_distinct = prove_by_refinement(
35287   `!(a:A) b. {a,b} HAS_SIZE 2 ==> ~(a = b)`,
35288   (* {{{ proof *)
35289   [
35290   REP_BASIC_TAC;
35291   TYPE_THEN `b` UNABBREV_TAC;
35292   FULL_REWRITE_TAC [pair_indistinct];
35293   THM_INTRO_TAC[`a`] sing_has_size1;
35294   FULL_REWRITE_TAC[HAS_SIZE];
35295   UND 0 THEN UND 2 THEN ARITH_TAC;
35296   ]);;
35297   (* }}} *)
35298
35299 let has_size2_subset = prove_by_refinement(
35300   `!X (a:A) b. X HAS_SIZE 2 /\ X SUBSET {a,b} ==> (X = {a,b})`,
35301   (* {{{ proof *)
35302   [
35303   REP_BASIC_TAC;
35304   FULL_REWRITE_TAC [has_size2];
35305   TYPE_THEN `X` UNABBREV_TAC;
35306   IMATCH_MP_TAC  SUBSET_ANTISYM;
35307   FULL_REWRITE_TAC[SUBSET;in_pair];
35308   FIRST_ASSUM DISJ_CASES_TAC;
35309   TYPE_THEN `x` UNABBREV_TAC;
35310   COPY 0;
35311   TSPEC `b'` 0;
35312   TSPEC `a'` 3;
35313   ASM_MESON_TAC[];
35314   ASM_MESON_TAC[];
35315   ]);;
35316   (* }}} *)
35317
35318 let inj_subset2 = prove_by_refinement(
35319   `!t t' s (f:A->B). INJ f s t /\ t SUBSET t' ==> INJ f s t'`,
35320   (* {{{ proof *)
35321   [
35322   REWRITE_TAC[INJ;SUBSET;];
35323   CONJ_TAC;
35324   FIRST_ASSUM IMATCH_MP_TAC;
35325   FIRST_ASSUM IMATCH_MP_TAC ;
35326   ]);;
35327   (* }}} *)
35328
35329 let terminal_adj = prove_by_refinement(
35330   `!E b. segment E /\ endpoint E b /\ ~(SING E) ==>
35331     (?!e.  E e /\ adj (terminal_edge E b) e )`,
35332   (* {{{ proof *)
35333   [
35334   REP_BASIC_TAC;
35335   REWRITE_TAC[EXISTS_UNIQUE_ALT];
35336   THM_INTRO_TAC[`E`;`b`] terminal_endpoint;
35337   FULL_REWRITE_TAC[segment];
35338   (* - *)
35339   THM_INTRO_TAC[`terminal_edge E b`] two_endpoint;
35340   FULL_REWRITE_TAC[segment;ISUBSET];
35341   (* - *)
35342   FULL_REWRITE_TAC[has_size2];
35343   USE 6 (REWRITE_RULE[FUN_EQ_THM]);
35344   TYPE_THEN `?x. !y. (closure top2 (terminal_edge E b) (pointI y) <=> ((y = x) \/ (y = b)))` SUBAGOAL_TAC;
35345   USE 6 (REWRITE_RULE[in_pair]);
35346   REWRITE_TAC[in_pair];
35347   TYPE_THEN `(b = b') \/ (b = a)` SUBAGOAL_TAC;
35348   ASM_MESON_TAC[];
35349   FIRST_ASSUM DISJ_CASES_TAC  ;
35350   TYPE_THEN  `a` EXISTS_TAC;
35351   ASM_MESON_TAC[];
35352   TYPE_THEN `b'` EXISTS_TAC;
35353   (* - *)
35354   TYPE_THEN `!e. (adj (terminal_edge E b) e /\ (E e) ==> (closure top2 e (pointI x)))` SUBAGOAL_TAC;
35355   THM_INTRO_TAC[`terminal_edge E b`;`e`] edge_inter;
35356   ASM_MESON_TAC[segment;ISUBSET];
35357   FULL_REWRITE_TAC[INTER;eq_sing];
35358   TSPEC `m` 7;
35359   REWR 7;
35360   FIRST_ASSUM DISJ_CASES_TAC;
35361   ASM_MESON_TAC[];
35362   FULL_REWRITE_TAC[endpoint];
35363   THM_INTRO_TAC[`E`;`(pointI b)`] num_closure1;
35364   FULL_REWRITE_TAC[segment];
35365   REWR 14;
35366   COPY 14;
35367   TSPEC `terminal_edge E b` 15;
35368   TSPEC `e` 14;
35369   TYPE_THEN `e' = terminal_edge E b` SUBAGOAL_TAC;
35370   ASM_MESON_TAC[];
35371   TYPE_THEN `e' = e` SUBAGOAL_TAC;
35372   ASM_MESON_TAC[];
35373   FULL_REWRITE_TAC[adj];
35374   UND 18 THEN UND 17 THEN UND 16 THEN MESON_TAC[];
35375   (* - *)
35376   THM_INTRO_TAC[`E`;`terminal_edge E b`] midpoint_exists;
35377   FULL_REWRITE_TAC[SING];
35378   LEFT 0 "x" ;
35379   TSPEC `terminal_edge E b` 0;
35380   ASM_MESON_TAC[];
35381   (* - *)
35382   FULL_REWRITE_TAC[midpoint];
35383   THM_INTRO_TAC[`E`;`(pointI m)`] num_closure2;
35384   FULL_REWRITE_TAC[segment];
35385   REWR 11;
35386   (* -DD *)
35387   TYPE_THEN `?c. ~(terminal_edge E b = c) /\ (E c) /\ (closure top2 c (pointI m))` SUBAGOAL_TAC;
35388   COPY 12;
35389   TSPEC `terminal_edge E b` 11;
35390   REWR 11;
35391   FIRST_ASSUM DISJ_CASES_TAC;
35392   TYPE_THEN `b''` EXISTS_TAC;
35393   TYPE_THEN `a'` EXISTS_TAC;
35394   (* - *)
35395   TYPE_THEN `c` EXISTS_TAC;
35396   COPY 7;
35397   TSPEC `m` 16;
35398   REWR 16;
35399   TYPE_THEN `adj (terminal_edge E b) c` SUBAGOAL_TAC;
35400   REWRITE_TAC[adj];
35401   REWRITE_TAC[EMPTY_EXISTS;INTER;];
35402   TYPE_THEN `pointI m` EXISTS_TAC;
35403   (* - *)
35404   IMATCH_MP_TAC  EQ_ANTISYM ;
35405   CONJ_TAC;
35406   TYPE_THEN `closure top2 y (pointI x)` SUBAGOAL_TAC;
35407   FIRST_ASSUM IMATCH_MP_TAC ;
35408   TYPE_THEN `closure top2 c (pointI x)` SUBAGOAL_TAC;
35409   FIRST_ASSUM IMATCH_MP_TAC ;
35410   KILL 6;
35411   TYPE_THEN `closure top2 (terminal_edge E b) (pointI x)` SUBAGOAL_TAC;
35412   TYPE_THEN `({0,1,2} (num_closure E (pointI x)))` SUBAGOAL_TAC;
35413   UND 2 THEN MESON_TAC[segment];
35414   FULL_REWRITE_TAC[INSERT;];
35415   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
35416   FULL_REWRITE_TAC[segment];
35417   THM_INTRO_TAC[`E`;`(pointI x)`] num_closure0;
35418   REWR 22;
35419   THM_INTRO_TAC[`E`;`(pointI x)`] num_closure1;
35420   THM_INTRO_TAC[`E`;`(pointI x)`] num_closure2;
35421   REWR 22;
35422   UND 22 THEN REP_CASES_TAC ;
35423   TYPE_THEN `(terminal_edge E b = a'') \/ (terminal_edge E b = b''')` SUBAGOAL_TAC;
35424   TSPEC `terminal_edge E b` 22;
35425   REWR 22;
35426   TYPE_THEN `(c = a'') \/ (c = b''')` SUBAGOAL_TAC;
35427   TSPEC `c` 22;
35428   REWR 22;
35429   TYPE_THEN `(y = a'') \/ (y = b''')` SUBAGOAL_TAC;
35430   TSPEC `y` 22;
35431   REWR 22;
35432   FIRST_ASSUM DISJ_CASES_TAC;
35433   TYPE_THEN `a''` UNABBREV_TAC;
35434   PROOF_BY_CONTR_TAC;
35435   REWR 29;
35436   TYPE_THEN `b'''` UNABBREV_TAC;
35437   USE 18(REWRITE_RULE[adj]);
35438   UND 29 THEN UND 15 THEN UND 28 THEN MESON_TAC[];
35439   TYPE_THEN `b'''` UNABBREV_TAC;
35440   USE 18 (REWRITE_RULE[adj]);
35441   UND 31 THEN UND 15 THEN UND 29 THEN UND 28 THEN MESON_TAC[];
35442   (* --- *)
35443   UND 20 THEN UND 21 THEN UND 14 THEN UND 19 THEN UND 22 THEN MESON_TAC[];
35444   UND 22 THEN UND 19 THEN UND 20 THEN MESON_TAC[];
35445   (* - *)
35446   TYPE_THEN `y` UNABBREV_TAC;
35447   ]);;
35448   (* }}} *)
35449
35450 let psegment_order_induct_lemma = prove_by_refinement(
35451   `!n. !E a b. psegment E /\ (CARD E = n) /\ (endpoint E a) /\
35452     (endpoint E b) /\ ~(a = b) ==>
35453     (?f. (BIJ f { p | p < n} E) /\ (f 0 = terminal_edge E a) /\
35454       ((0 < n) ==> (f (n - 1) = terminal_edge E b)) /\
35455       (!i j. (i < CARD E /\ j < CARD E) ==>
35456              (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,
35457   (* {{{ proof *)
35458   [
35459   INDUCT_TAC;
35460   (* -- 0 case *)
35461   TYPE_THEN `f = (\ (x:num). terminal_edge E a)` ABBREV_TAC ;
35462   TYPE_THEN `f` EXISTS_TAC;
35463   TYPE_THEN `{ p | p < 0} = EMPTY` SUBAGOAL_TAC;
35464   REWRITE_TAC[EQ_EMPTY];
35465   UND 6 THEN ARITH_TAC;
35466   TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC;
35467   REWRITE_TAC[HAS_SIZE];
35468   FULL_REWRITE_TAC[psegment;segment];
35469   FULL_REWRITE_TAC[HAS_SIZE_0];
35470   REWRITE_TAC[ARITH_RULE `~(k <| 0)`;bij_empty];
35471   EXPAND_TAC "f";
35472   (* - 1 case *)
35473   REWRITE_TAC[ARITH_RULE `0 <| SUC n /\ (SUC n - 1 = n)`];
35474   TYPE_THEN `n = 0` ASM_CASES_TAC;
35475   KILL 5;
35476   REWRITE_TAC[ARITH_RULE `i <| SUC 0 <=> (i = 0)`;];
35477   REWRITE_TAC[ARITH_RULE `~(SUC 0 = 0)`;adj];
35478   TYPE_THEN `n` UNABBREV_TAC;
35479   FULL_REWRITE_TAC[ARITH_RULE `SUC 0 = 1`];
35480   TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC;
35481   FULL_REWRITE_TAC[HAS_SIZE;psegment;segment];
35482   USE 5(MATCH_MP   CARD_SING_CONV);
35483   FULL_REWRITE_TAC[SING];
35484   TYPE_THEN `E` UNABBREV_TAC;
35485   TYPE_THEN `f = (\ (y:num). x )` ABBREV_TAC ;
35486   TYPE_THEN `f` EXISTS_TAC;
35487   TYPE_THEN `FINITE {x}` SUBAGOAL_TAC;
35488   FULL_REWRITE_TAC[psegment;segment];
35489   TYPE_THEN `{p | p = 0} = {0}` SUBAGOAL_TAC;
35490   IMATCH_MP_TAC  EQ_EXT;
35491   REWRITE_TAC[INR IN_SING];
35492   KILL 7;
35493   TYPE_THEN `f 0 = x` SUBAGOAL_TAC;
35494   EXPAND_TAC "f";
35495   REWRITE_TAC[bij_sing];
35496   TH_INTRO_TAC[`{x}`;`a`] terminal_endpoint;
35497   TH_INTRO_TAC[`{x}`;`b`] terminal_endpoint;
35498   FULL_REWRITE_TAC[INR IN_SING];
35499   (* - A2 and above *)
35500   TYPE_THEN `e = terminal_edge E b` ABBREV_TAC ;
35501   TYPE_THEN `b' = other_end e b` ABBREV_TAC ;
35502   TYPE_THEN `E' = E DELETE e` ABBREV_TAC ;
35503   (* - *)
35504   TYPE_THEN `E e /\ closure top2 e (pointI b)` SUBAGOAL_TAC;
35505   TYPE_THEN `e` UNABBREV_TAC;
35506   IMATCH_MP_TAC  terminal_endpoint;
35507   RULE_ASSUM_TAC (REWRITE_RULE[psegment;segment]);
35508   (* - *)
35509   TYPE_THEN `psegment E'` SUBAGOAL_TAC;
35510   REWRITE_TAC[psegment];
35511   CONJ_TAC;
35512   TYPE_THEN `E'` UNABBREV_TAC;
35513   IMATCH_MP_TAC  segment_delete;
35514   TYPE_THEN `b` EXISTS_TAC;
35515   RULE_ASSUM_TAC (REWRITE_RULE[psegment]);
35516   REWRITE_TAC[];
35517   TYPE_THEN `E` UNABBREV_TAC;
35518   THM_INTRO_TAC [`e`] sing_has_size1;
35519   RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
35520   UND 12 THEN UND 3 THEN UND 6 THEN ARITH_TAC;
35521   THM_INTRO_TAC [`E'`;`E`] rectagon_subset;
35522   RULE_ASSUM_TAC (REWRITE_RULE[psegment]);
35523   TYPE_THEN `E'` UNABBREV_TAC;
35524   REWRITE_TAC[DELETE;SUBSET];
35525   TYPE_THEN `E'` UNABBREV_TAC;
35526   UND 13 THEN UND 11 THEN MESON_TAC[INR DELETE_NON_ELEMENT];
35527   (* - *)
35528   TYPE_THEN `SUC (CARD E') = SUC n` SUBAGOAL_TAC;
35529   TYPE_THEN `E'` UNABBREV_TAC;
35530   TYPE_THEN `SUC n` UNABBREV_TAC;
35531   IMATCH_MP_TAC  CARD_SUC_DELETE;
35532   FULL_REWRITE_TAC[psegment;segment];
35533   FULL_REWRITE_TAC[SUC_INJ];
35534   (* -B *)
35535   THM_INTRO_TAC [`E`;`b`;`e`] psegment_delete_end;
35536   REWRITE_TAC[];
35537   TYPE_THEN `E` UNABBREV_TAC;
35538   FULL_REWRITE_TAC[card_sing];
35539   UND 3 THEN UND 6 THEN ARITH_TAC;
35540   (* - *)
35541   TYPE_THEN `endpoint E' = {a,b'}` SUBAGOAL_TAC;
35542   IMATCH_MP_TAC  has_size2_subset;
35543   CONJ_TAC;
35544   IMATCH_MP_TAC  endpoint_size2;
35545   TYPE_THEN `E'` UNABBREV_TAC;
35546   REWRITE_TAC[SUBSET;INSERT;DELETE];
35547   FIRST_ASSUM DISJ_CASES_TAC;
35548   THM_INTRO_TAC [`E`;`x`;`a`;`b`] two_endpoint_segment;
35549   FULL_REWRITE_TAC[psegment];
35550   ASM_MESON_TAC[];
35551   THM_INTRO_TAC[`e`;`b`] other_end_prop;
35552   UND 4 THEN REWRITE_TAC[psegment;segment;SUBSET;];
35553   (* - *)
35554   TYPE_THEN `{a,b'} HAS_SIZE 2` SUBAGOAL_TAC;
35555   TYPE_THEN `{a,b'}` UNABBREV_TAC;
35556   IMATCH_MP_TAC  endpoint_size2;
35557   USE 16 (MATCH_MP has_size2_distinct);
35558   UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`a`;`b'`]);
35559   REWRITE_TAC[in_pair];
35560   (* - *)
35561   TYPE_THEN `g = (\ i.  if (i <| n) then f i else e)` ABBREV_TAC ;
35562   TYPE_THEN `!i. (i <| n) ==> (g i = f i)` SUBAGOAL_TAC;
35563   TYPE_THEN `g` UNABBREV_TAC;
35564   TYPE_THEN `g n = e` SUBAGOAL_TAC;
35565   TYPE_THEN `g` UNABBREV_TAC;
35566   REWRITE_TAC[ARITH_RULE `~(n <| n)`];
35567   TYPE_THEN `g` EXISTS_TAC;
35568   (* - FINAL PUSH *)
35569   SUBCONJ_TAC;
35570   IMATCH_MP_TAC  inj_bij_size;
35571   REWRITE_TAC[CARD_NUMSEG_LT];
35572   CONJ_TAC;
35573   TYPE_THEN `{p | p <| SUC n} = {p | p <| n} UNION {n}` SUBAGOAL_TAC;
35574   IMATCH_MP_TAC  EQ_EXT;
35575   REWRITE_TAC[UNION;INR IN_SING];
35576   ARITH_TAC;
35577   IMATCH_MP_TAC  inj_split;
35578   CONJ_TAC;
35579   TYPE_THEN `INJ g {p | p <| n} E = INJ f {p | p <| n} E` SUBAGOAL_TAC;
35580   IMATCH_MP_TAC  inj_domain_sub;
35581   USE 24 (REWRITE_RULE[]);
35582   RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
35583   (* --- temp *)
35584   IMATCH_MP_TAC  inj_subset2;
35585   UNIFY_EXISTS_TAC;
35586   UND 9 THEN REWRITE_TAC[SUBSET;DELETE];
35587   TYPE_THEN `E'` UNABBREV_TAC;
35588   CONJ_TAC;
35589   REWRITE_TAC[INJ;INR IN_SING;];
35590   REP_BASIC_TAC;
35591   REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING ];
35592   TYPE_THEN `x''` UNABBREV_TAC;
35593   TYPE_THEN `x` UNABBREV_TAC;
35594   TYPE_THEN `g n` UNABBREV_TAC;
35595   TSPEC `x'` 21;
35596   TYPE_THEN `g x'` UNABBREV_TAC;
35597   FULL_REWRITE_TAC[BIJ;SURJ];
35598   TSPEC `x'` 22;
35599   TYPE_THEN `E'` UNABBREV_TAC;
35600   FULL_REWRITE_TAC[DELETE];
35601   ASM_MESON_TAC[];
35602   UND 4 THEN ASM_REWRITE_TAC[HAS_SIZE;psegment;segment;rectagon];
35603   (* - C*)
35604   TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
35605   TYPE_THEN `E'` UNABBREV_TAC;
35606   REWRITE_TAC[DELETE;SUBSET];
35607   (* - *)
35608   TSPEC `0` 21;
35609   TYPE_THEN `0 <| n` SUBAGOAL_TAC;
35610   UND 6 THEN ARITH_TAC;
35611   TYPE_THEN `f 0` UNABBREV_TAC;
35612   CONJ_TAC;
35613   TYPE_THEN `e' = terminal_edge E' a` ABBREV_TAC ;
35614   THM_INTRO_TAC[`E'`;`a`;`e'`] terminal_unique;
35615   REWRITE_TAC[INR in_pair];
35616   UND 12 THEN REWRITE_TAC[psegment;segment];
35617   TYPE_THEN `e'` UNABBREV_TAC;
35618   TYPE_THEN `g 0 ` UNABBREV_TAC;
35619   THM_INTRO_TAC[`E`;`a`;`terminal_edge E' a`] terminal_unique;
35620   UND 4 THEN (REWRITE_TAC[psegment;segment]);
35621   REWR 26;
35622   ASM_MESON_TAC[ISUBSET];
35623   (* -D *)
35624   TYPE_THEN `E' (terminal_edge E' b')` SUBAGOAL_TAC;
35625   THM_INTRO_TAC[`E'`;`b'`] terminal_endpoint;
35626   FULL_REWRITE_TAC[psegment;segment;INR in_pair ];
35627   (* - *)
35628   TYPE_THEN `~(E' (terminal_edge E b))` SUBAGOAL_TAC;
35629   TYPE_THEN `E'` UNABBREV_TAC;
35630   FULL_REWRITE_TAC[DELETE];
35631   TYPE_THEN `terminal_edge E b` UNABBREV_TAC;
35632   (* - *)
35633   TYPE_THEN `adj e (g (n - 1))` SUBAGOAL_TAC;
35634   TYPE_THEN `g (n - 1) = f (n-1 )` SUBAGOAL_TAC;
35635   TYPE_THEN `g` UNABBREV_TAC;
35636   TYPE_THEN `n - 1 < n` SUBAGOAL_TAC;
35637   UND 21 THEN ARITH_TAC;
35638   TYPE_THEN `f (n - 1)` UNABBREV_TAC;
35639   TYPE_THEN `e` UNABBREV_TAC;
35640   REWRITE_TAC[adj];
35641   REWRITE_TAC[INTER;EMPTY_EXISTS];
35642   CONJ_TAC;
35643    TYPE_THEN `g n` UNABBREV_TAC;
35644   ASM_MESON_TAC[];
35645   TYPE_THEN `pointI b'` EXISTS_TAC;
35646   CONJ_TAC;
35647   TYPE_THEN `b'` UNABBREV_TAC;
35648   THM_INTRO_TAC[`terminal_edge E b`;`b`]other_end_prop;
35649   FULL_REWRITE_TAC[psegment;segment;ISUBSET];
35650   THM_INTRO_TAC  [`E'`;`b'`] terminal_endpoint;
35651   FULL_REWRITE_TAC[psegment;segment;in_pair];
35652   (* - *)
35653   TYPE_THEN `!i. (i <| SUC n) ==> (adj (g n) (g i) = (SUC i = n))` SUBAGOAL_TAC;
35654   TYPE_THEN `( i' = n) \/ (i' <| n)` SUBAGOAL_TAC;
35655   UND 30 THEN ARITH_TAC;
35656   FIRST_ASSUM DISJ_CASES_TAC;
35657   REWRITE_TAC[adj];
35658   ARITH_TAC;
35659   (* -- *)
35660   THM_INTRO_TAC[`E`;`b`] terminal_adj;
35661   FULL_REWRITE_TAC[psegment];
35662   REWRITE_TAC[];
35663   USE 35 (MATCH_MP CARD_SING);
35664   TYPE_THEN `CARD E` UNABBREV_TAC;
35665   UND 3 THEN UND 21 THEN ARITH_TAC;
35666   FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT];
35667   TYPE_THEN `!i'. (i' <| n) ==> (adj e (g i') = (e' = (g i')))` SUBAGOAL_TAC;
35668   TSPEC  `g (i'')`33;
35669   TYPE_THEN `E (g i'')` SUBAGOAL_TAC;
35670   FULL_REWRITE_TAC[BIJ;SURJ];
35671   FIRST_ASSUM IMATCH_MP_TAC ;
35672   UND 34 THEN ARITH_TAC;
35673   REWR 33;
35674   IMATCH_MP_TAC  EQ_ANTISYM;
35675   CONJ_TAC;
35676   TYPE_THEN `e'` UNABBREV_TAC;
35677   TSPEC `n - 1` 34;
35678   TYPE_THEN `n - 1 < n` SUBAGOAL_TAC;
35679   UND 21 THEN ARITH_TAC;
35680   TYPE_THEN `(g i' = g (n - 1)) ==> (SUC i' = n)` SUBAGOAL_TAC;
35681   FULL_REWRITE_TAC [BIJ;INJ];
35682   IMATCH_MP_TAC  (ARITH_RULE  `((i' = n - 1) /\ (0 < n)) ==> (SUC i' = n)` );
35683   FIRST_ASSUM IMATCH_MP_TAC ;
35684   ARITH_TAC;
35685   FIRST_ASSUM IMATCH_MP_TAC ;
35686   REWR 34;
35687   (* -- *)
35688   TYPE_THEN `i' = n - 1` SUBAGOAL_TAC;
35689   UND 35 THEN UND 21 THEN ARITH_TAC;
35690   TSPEC `i'` 34;
35691   TYPE_THEN `i'` UNABBREV_TAC;
35692   REWR 32;
35693   (* -E *)
35694   TYPE_THEN `(i = n) \/ (i <| n)` SUBAGOAL_TAC;
35695   UND 26 THEN ARITH_TAC;
35696   FIRST_ASSUM DISJ_CASES_TAC;
35697   TSPEC `j` 30;
35698   UND 30 THEN ARITH_TAC;
35699   (* - *)
35700   TYPE_THEN `(j = n) \/ (j <| n)` SUBAGOAL_TAC;
35701   UND 25 THEN ARITH_TAC;
35702   FIRST_ASSUM DISJ_CASES_TAC;
35703   ONCE_REWRITE_TAC [adj_symm];
35704   UND 26 THEN ARITH_TAC;
35705   (* - *)
35706   TYPE_THEN `g` UNABBREV_TAC;
35707   FIRST_ASSUM IMATCH_MP_TAC ;
35708   ASM_REWRITE_TAC[];
35709
35710   ]);;
35711   (* }}} *)
35712
35713 (* a couple of variants *)
35714 let psegment_order = prove_by_refinement(
35715   `!E a b. psegment E /\ (endpoint E a) /\
35716     (endpoint E b) /\ ~(a = b) ==>
35717     (?f. (BIJ f { p | p < CARD E} E) /\ (f 0 = terminal_edge E a) /\
35718       ((0 < CARD E) ==> (f (CARD E - 1) = terminal_edge E b)) /\
35719       (!i j. (i < CARD E /\ j < CARD E) ==>
35720              (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,
35721   (* {{{ proof *)
35722   [
35723   REP_BASIC_TAC;
35724   THM_INTRO_TAC[`CARD E`;`E`;`a`;`b`] psegment_order_induct_lemma;
35725   REWRITE_TAC[];
35726   ]);;
35727   (* }}} *)
35728
35729 let psegment_order' = prove_by_refinement(
35730   `!A m. psegment A /\ endpoint A m  ==>
35731     (?f. BIJ f {p | p < CARD A} A /\
35732         (f 0 = terminal_edge A m) /\
35733         (!i j. (i < CARD A /\ j < CARD A) ==>
35734              (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,
35735   (* {{{ proof *)
35736   [
35737   REP_BASIC_TAC;
35738   THM_INTRO_TAC[`A`] endpoint_size2;
35739   FULL_REWRITE_TAC[has_size2];
35740   TYPE_THEN `?n. (endpoint A n) /\ ~(m = n)` SUBAGOAL_TAC;
35741   REWR 0;
35742   FULL_REWRITE_TAC[in_pair];
35743   FIRST_ASSUM DISJ_CASES_TAC;
35744   TYPE_THEN `a` EXISTS_TAC;
35745   TYPE_THEN `b` EXISTS_TAC;
35746   THM_INTRO_TAC[`A`;`m`;`n`] psegment_order;
35747   TYPE_THEN `f` EXISTS_TAC;
35748   ASM_REWRITE_TAC[];
35749     ]);;
35750   (* }}} *)
35751
35752 let order_imp_psegment = prove_by_refinement(
35753   `!f n. (INJ f { p | p < n} (edge)) /\ (0 < n) /\
35754      (!i j. (i < n /\ j < n) ==>
35755              (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))) ==>
35756     (psegment (IMAGE f { p | p < n}))`,
35757   (* {{{ proof *)
35758   [
35759   REP_BASIC_TAC;
35760   TYPE_THEN `E = IMAGE f {p | p <| n}` ABBREV_TAC ;
35761   IMATCH_MP_TAC  endpoint_psegment;
35762   REWRITE_TAC[segment;];
35763   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
35764   TYPE_THEN `E` UNABBREV_TAC;
35765   IMATCH_MP_TAC  FINITE_IMAGE;
35766   REWRITE_TAC[FINITE_NUMSEG_LT];
35767   (* - *)
35768   TYPE_THEN `~(E = {})` SUBAGOAL_TAC;
35769   TYPE_THEN `E` UNABBREV_TAC;
35770   FULL_REWRITE_TAC[image_empty];
35771   FULL_REWRITE_TAC[EQ_EMPTY];
35772   ASM_MESON_TAC[];
35773   (* - *)
35774   TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
35775   TYPE_THEN `E` UNABBREV_TAC;
35776   FULL_REWRITE_TAC[IMAGE;INJ;SUBSET];
35777   FIRST_ASSUM IMATCH_MP_TAC ;
35778   (* - *)
35779   TYPE_THEN `E (f 0)` SUBAGOAL_TAC;
35780   TYPE_THEN `E` UNABBREV_TAC ;
35781   REWRITE_TAC[IMAGE];
35782   TYPE_THEN `0` EXISTS_TAC;
35783   ASM_REWRITE_TAC[];
35784   (* - *)
35785   TYPE_THEN `edge (f 0)` SUBAGOAL_TAC;
35786   FULL_REWRITE_TAC[SUBSET];
35787   (* -A *)
35788   TYPE_THEN `?m. endpoint E m` SUBAGOAL_TAC;
35789   REWRITE_TAC[endpoint];
35790   ASM_SIMP_TAC[num_closure1];
35791   LEFT_TAC "e";
35792   TYPE_THEN `f 0 ` EXISTS_TAC;
35793   THM_INTRO_TAC[`f 0`] two_endpoint;
35794   FULL_REWRITE_TAC[has_size2];
35795   ASM_CASES_TAC `n =1`;
35796   TYPE_THEN `a` EXISTS_TAC;
35797   IMATCH_MP_TAC  EQ_ANTISYM;
35798   CONJ_TAC;
35799   TYPE_THEN `E` UNABBREV_TAC;
35800   TYPE_THEN `n` UNABBREV_TAC;
35801   FULL_REWRITE_TAC[IMAGE];
35802   TYPE_THEN `(x' = 0) /\ (x = 0)` SUBAGOAL_TAC;
35803   UND 7 THEN UND 13 THEN ARITH_TAC;
35804   TYPE_THEN `e'` UNABBREV_TAC;
35805   USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
35806   TSPEC `a` 10;
35807   FULL_REWRITE_TAC[in_pair];
35808   (* -- *)
35809   TYPE_THEN `E (f 1)` SUBAGOAL_TAC;
35810   TYPE_THEN `E` UNABBREV_TAC;
35811   REWRITE_TAC[IMAGE];
35812   TYPE_THEN `1` EXISTS_TAC;
35813   UND 11 THEN UND 1 THEN ARITH_TAC;
35814   (* -- *)
35815   TYPE_THEN `edge (f 1)` SUBAGOAL_TAC;
35816   FULL_REWRITE_TAC[SUBSET];
35817   (* -- *)
35818   TYPE_THEN `adj (f 0 ) (f 1)` SUBAGOAL_TAC;
35819   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`;`1`]);
35820   UND 11 THEN UND 1 THEN ARITH_TAC;
35821   ARITH_TAC;
35822   THM_INTRO_TAC[`f 0`;`f 1`] edge_inter;
35823   FULL_REWRITE_TAC[INTER;INR eq_sing  ];
35824   (* -- *)
35825   TYPE_THEN `?r. closure top2 (f 0) (pointI r) /\ ~(r = m)` SUBAGOAL_TAC;
35826   USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
35827   FULL_REWRITE_TAC[in_pair];
35828   TYPE_THEN `m = a` ASM_CASES_TAC;
35829   TYPE_THEN `m` UNABBREV_TAC;
35830   TYPE_THEN `b` EXISTS_TAC;
35831   TYPE_THEN `a` EXISTS_TAC;
35832   TYPE_THEN `r` EXISTS_TAC;
35833   IMATCH_MP_TAC  EQ_ANTISYM;
35834   CONJ_TAC;
35835   TYPE_THEN`?j. (j <| n) /\ (e' = f j)` SUBAGOAL_TAC;
35836   TYPE_THEN`E` UNABBREV_TAC;
35837   FULL_REWRITE_TAC[IMAGE];
35838   TYPE_THEN`x` EXISTS_TAC;
35839   ASM_REWRITE_TAC[];
35840   TYPE_THEN `e'` UNABBREV_TAC;
35841   PROOF_BY_CONTR_TAC;
35842   TYPE_THEN `adj (f 0) (f j)` SUBAGOAL_TAC;
35843   REWRITE_TAC[adj;EMPTY_EXISTS;INTER ];
35844   TYPE_THEN`pointI r` EXISTS_TAC;
35845   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[` 0`;` j`] );
35846   REWR 0;
35847   TYPE_THEN `j = 1` SUBAGOAL_TAC;
35848   UND 0 THEN ARITH_TAC;
35849   TYPE_THEN `j` UNABBREV_TAC;
35850   TSPEC `pointI r` 15;
35851   REWR 15;
35852   FULL_REWRITE_TAC[pointI_inj];
35853   ASM_MESON_TAC[];
35854   TYPE_THEN `e'` UNABBREV_TAC;
35855   CONJ_TAC;
35856   UNIFY_EXISTS_TAC;
35857   (* -B *)
35858   TYPE_THEN `!e. (E e ==> ?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC;
35859   TYPE_THEN `E` UNABBREV_TAC;
35860   FULL_REWRITE_TAC[IMAGE];
35861   ASM_MESON_TAC[];
35862   (* - *)
35863   CONJ_TAC;
35864   REWRITE_TAC[INSERT];
35865   ASM_SIMP_TAC [num_closure0;num_closure1;num_closure2];
35866   PROOF_BY_CONTR_TAC;
35867   FULL_REWRITE_TAC[DE_MORGAN_THM];
35868   LEFT 11 "e";
35869   LEFT 12 "e";
35870   TSPEC `e` 12;
35871   LEFT 12 "e'";
35872   FULL_REWRITE_TAC[NOT_IMP];
35873   TYPE_THEN `E e' /\ closure top2 e' (pointI m') /\ ~(e = e')` SUBAGOAL_TAC;
35874   ASM_MESON_TAC[];
35875   TYPE_THEN `adj e e'` SUBAGOAL_TAC;
35876   REWRITE_TAC[adj;EMPTY_EXISTS;INTER;];
35877   UNIFY_EXISTS_TAC;
35878   TYPE_THEN `(?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC;
35879   TYPE_THEN `(?j. (j <| n) /\ (e' = f j))` SUBAGOAL_TAC;
35880   TYPE_THEN `e` UNABBREV_TAC;
35881   TYPE_THEN `e'` UNABBREV_TAC;
35882   TYPE_THEN `(SUC i = j) \/ (SUC j = i)` SUBAGOAL_TAC;
35883   ASM_MESON_TAC[];
35884   LEFT 13 "a";
35885   TSPEC `f i` 13;
35886   LEFT 13 "b";
35887   TSPEC `f j` 13;
35888   UND 13 THEN REWRITE_TAC[];
35889   REWRITE_TAC[];
35890   IMATCH_MP_TAC  EQ_ANTISYM;
35891   CONJ_TAC;
35892   TYPE_THEN `?k. (k <| n) /\ (e'' = f k)` SUBAGOAL_TAC;
35893   TYPE_THEN `e''` UNABBREV_TAC;
35894   PROOF_BY_CONTR_TAC;
35895   FULL_REWRITE_TAC[DE_MORGAN_THM];
35896   TYPE_THEN `adj (f i) (f k) /\ adj (f j) (f k)` SUBAGOAL_TAC;
35897   REWRITE_TAC[adj];
35898   REWRITE_TAC[INTER;EMPTY_EXISTS];
35899   LEFT_TAC "u";
35900   UNIFY_EXISTS_TAC;
35901   TYPE_THEN `(SUC j = k) \/ (SUC k = j)` SUBAGOAL_TAC;
35902   ASM_MESON_TAC[];
35903   TYPE_THEN `(SUC i = k) \/ (SUC k = i)` SUBAGOAL_TAC;
35904   ASM_MESON_TAC[];
35905    UND 29 THEN UND 28 THEN UND 19 THEN ARITH_TAC;
35906   FIRST_ASSUM DISJ_CASES_TAC;
35907   ASM_REWRITE_TAC[];
35908   ASM_REWRITE_TAC[];
35909   (* -C *)
35910   TYPE_THEN `X = {p | p <| n /\ S (f p)}` ABBREV_TAC ;
35911   TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
35912   FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET];
35913   TYPE_THEN `E u` SUBAGOAL_TAC;
35914   TYPE_THEN `(?i. (i <| n) /\ (u = f i))` SUBAGOAL_TAC;
35915   TYPE_THEN `u` UNABBREV_TAC;
35916   UNDF `EMPTY` THEN REWRITE_TAC[EMPTY_EXISTS];
35917   TYPE_THEN `i` EXISTS_TAC;
35918   TYPE_THEN `X` UNABBREV_TAC;
35919   (* - *)
35920   TYPE_THEN `!j k. X j /\ (k <| n) /\ ((SUC j = k) \/ (SUC k = j)) ==> (X k)` SUBAGOAL_TAC;
35921   TYPE_THEN `j = k` ASM_CASES_TAC;
35922   ASM_MESON_TAC[];
35923   TYPE_THEN `S (f j)` SUBAGOAL_TAC;
35924   TYPE_THEN `X` UNABBREV_TAC;
35925   TYPE_THEN `E (f k)` SUBAGOAL_TAC;
35926   TYPE_THEN `E` UNABBREV_TAC;
35927   REWRITE_TAC[IMAGE];
35928   TYPE_THEN `k` EXISTS_TAC;
35929   ASM_REWRITE_TAC[];
35930   TYPE_THEN `adj (f j) (f k)` SUBAGOAL_TAC;
35931   TYPE_THEN `X` UNABBREV_TAC;
35932   ASM_MESON_TAC[];
35933   TYPE_THEN `S (f k)` SUBAGOAL_TAC;
35934   ASM_MESON_TAC[];
35935   TYPE_THEN `X` UNABBREV_TAC;
35936   (* - *)
35937   TYPE_THEN `(?i. X i /\ (!m. m <| i ==> ~X m))` SUBAGOAL_TAC;
35938   FULL_REWRITE_TAC[EMPTY_EXISTS];
35939   ASM_MESON_TAC[num_WOP];
35940   TYPE_THEN `i = 0` SUBAGOAL_TAC;
35941   PROOF_BY_CONTR_TAC;
35942   TYPE_THEN `?j. SUC j = i` SUBAGOAL_TAC;
35943   TYPE_THEN `i - 1` EXISTS_TAC;
35944   UND 19 THEN ARITH_TAC;
35945   TSPEC `j` 17;
35946   UND 17 THEN DISCH_THEN (THM_INTRO_TAC[]);
35947   UND 20 THEN ARITH_TAC;
35948   UND 17 THEN REWRITE_TAC[];
35949   FIRST_ASSUM IMATCH_MP_TAC ;
35950   TYPE_THEN `i` EXISTS_TAC;
35951   TYPE_THEN `X` UNABBREV_TAC;
35952   UND 17 THEN UND 20 THEN ARITH_TAC;
35953   TYPE_THEN `i` UNABBREV_TAC;
35954   (* -D *)
35955   TYPE_THEN `X = { p | p <| n }` SUBAGOAL_TAC;
35956   IMATCH_MP_TAC  subset_imp_eq;
35957   CONJ_TAC;
35958   TYPE_THEN `X` UNABBREV_TAC;
35959   REWRITE_TAC[SUBSET];
35960   PROOF_BY_CONTR_TAC;
35961   FULL_REWRITE_TAC[EMPTY_EXISTS];
35962   TYPE_THEN `Z = ({p | p <| n} DIFF X)` ABBREV_TAC ;
35963   TYPE_THEN `?n. Z n /\ (!m. m <| n ==> ~Z m)` SUBAGOAL_TAC;
35964   UND 19 THEN MESON_TAC[num_WOP];
35965   TYPE_THEN `Z` UNABBREV_TAC;
35966   FULL_REWRITE_TAC[DIFF];
35967   TSPEC `n' - 1` 21;
35968   TYPE_THEN `~(n' = 0)` SUBAGOAL_TAC;
35969   ASM_MESON_TAC[];
35970   TYPE_THEN `n' - 1 <| n'` SUBAGOAL_TAC;
35971   UND 24 THEN ARITH_TAC;
35972   TYPE_THEN `n' - 1 <| n` SUBAGOAL_TAC;
35973   UND 20 THEN ARITH_TAC;
35974   REWR 21;
35975   UND 19 THEN REWRITE_TAC[];
35976   FIRST_ASSUM IMATCH_MP_TAC ;
35977   TYPE_THEN `n' - 1` EXISTS_TAC;
35978   UND 24 THEN ARITH_TAC;
35979   IMATCH_MP_TAC  SUBSET_ANTISYM;
35980   REWRITE_TAC[SUBSET];
35981   TYPE_THEN `E` UNABBREV_TAC;
35982   TYPE_THEN `X` UNABBREV_TAC;
35983   USE 20 (REWRITE_RULE[IMAGE]);
35984   USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
35985   TSPEC `x'` 19;
35986   FULL_REWRITE_TAC[];
35987   REWR 19;
35988   ]);;
35989   (* }}} *)
35990
35991 let rectagon_nonsing = prove_by_refinement(
35992   `!G. rectagon G ==> ~SING G`,
35993   (* {{{ proof *)
35994   [
35995   REWRITE_TAC[rectagon;SING];
35996   TYPE_THEN `G` UNABBREV_TAC;
35997   THM_INTRO_TAC [`x`] two_endpoint;
35998   FULL_REWRITE_TAC[SUBSET;INR IN_SING;];
35999   FULL_REWRITE_TAC[has_size2];
36000   USE 6 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
36001   FULL_REWRITE_TAC[in_pair];
36002   TSPEC `b` 6;
36003   REWR 6;
36004   TSPEC `b` 2;
36005   THM_INTRO_TAC[`{x}`;`pointI b`] num_closure0;
36006   FULL_REWRITE_TAC[INR IN_SING];
36007   REWR 2;
36008   LEFT 2 "e" ;
36009   TSPEC  `x` 2;
36010   REWR 2;
36011   THM_INTRO_TAC[`{x}`;`pointI b`] num_closure2;
36012   REWR 8;
36013   FULL_REWRITE_TAC[INR IN_SING];
36014   ASM_MESON_TAC[];
36015   ]);;
36016   (* }}} *)
36017
36018 let rectagon_2 = prove_by_refinement(
36019   `!G S. rectagon G /\ S SUBSET G /\ ~(S = EMPTY) /\
36020     (!m. {0,2} (num_closure S (pointI m))) ==> (S = G)`,
36021   (* {{{ proof *)
36022
36023   [
36024   REP_BASIC_TAC;
36025   TYPE_THEN `Tx = { A | ~(A = EMPTY) /\ A SUBSET S /\ (!m. {0,2} (num_closure A (pointI m))) }` ABBREV_TAC ;
36026   TYPE_THEN `~(Tx = EMPTY)` SUBAGOAL_TAC;
36027   UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
36028   TYPE_THEN `S` EXISTS_TAC;
36029   TYPE_THEN `Tx` UNABBREV_TAC;
36030   REWRITE_TAC[SUBSET];
36031   USE 5 (MATCH_MP select_card_min);
36032   (* - *)
36033   TYPE_THEN `z SUBSET G` SUBAGOAL_TAC;
36034   TYPE_THEN `Tx` UNABBREV_TAC;
36035   IMATCH_MP_TAC  SUBSET_TRANS;
36036   UNIFY_EXISTS_TAC;
36037   (* - *)
36038   TYPE_THEN `(z = G) ==> (S = G)` SUBAGOAL_TAC;
36039   TYPE_THEN `Tx` UNABBREV_TAC;
36040   IMATCH_MP_TAC  EQ_EXT;
36041   FULL_REWRITE_TAC [ISUBSET];
36042   ASM_MESON_TAC[];
36043   FIRST_ASSUM IMATCH_MP_TAC ;
36044   KILL 8;
36045   (* - *)
36046   IMATCH_MP_TAC  rectagon_subset;
36047   TYPE_THEN `segment G` SUBAGOAL_TAC;
36048   IMATCH_MP_TAC  rectagon_segment;
36049   (* - *)
36050   REWRITE_TAC[rectagon];
36051   TYPE_THEN `Tx` UNABBREV_TAC;
36052   SUBCONJ_TAC;
36053   IMATCH_MP_TAC  FINITE_SUBSET;
36054   TYPE_THEN `G` EXISTS_TAC;
36055   FULL_REWRITE_TAC[rectagon];
36056   CONJ_TAC;
36057   FULL_REWRITE_TAC[rectagon];
36058   IMATCH_MP_TAC  SUBSET_TRANS;
36059   TYPE_THEN `G` EXISTS_TAC;
36060   (* -A1 *)
36061   IMATCH_MP_TAC  CARD_SUBSET_LE;
36062   FIRST_ASSUM IMATCH_MP_TAC ;
36063   CONJ_TAC;
36064   IMATCH_MP_TAC  SUBSET_TRANS;
36065   UNIFY_EXISTS_TAC;
36066   KILL 5;
36067   KILL 0;
36068   TSPEC `m` 4;
36069   FULL_REWRITE_TAC[INSERT];
36070   USE 0 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
36071   FIRST_ASSUM DISJ_CASES_TAC;
36072   THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono;
36073   UND 4 THEN UND 5 THEN ARITH_TAC;
36074   KILL 0;
36075   (* - *)
36076   TYPE_THEN `~(num_closure S' (pointI m) = 1)` ASM_CASES_TAC;
36077   THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono;
36078   UND 5 THEN UND 0 THEN UND 4 THEN ARITH_TAC;
36079   REWR 0;
36080   (* - *)
36081   THM_INTRO_TAC[`S'`;`(pointI m)`] num_closure1;
36082   IMATCH_MP_TAC  FINITE_SUBSET;
36083   UNIFY_EXISTS_TAC;
36084   REWR 5;
36085   (* - *)
36086   THM_INTRO_TAC[`z`;`pointI m`] num_closure2;
36087   REWR 14;
36088   COPY 14;
36089   TSPEC `e` 16;
36090   COPY 5;
36091   TSPEC `e` 5;
36092   USE 5 (REWRITE_RULE[]);
36093   TYPE_THEN `z e` SUBAGOAL_TAC;
36094   FULL_REWRITE_TAC[ISUBSET];
36095   TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
36096   ASM_MESON_TAC[];
36097   KILL 16;
36098   (* -B1 *)
36099   TYPE_THEN `?e'. (closure top2 e' (pointI m)) /\ z e' /\ ~(e = e')` SUBAGOAL_TAC;
36100   FIRST_ASSUM DISJ_CASES_TAC;
36101   TYPE_THEN `b` EXISTS_TAC;
36102   ASM_MESON_TAC[];
36103   TYPE_THEN `a` EXISTS_TAC;
36104   ASM_MESON_TAC[];
36105   (* - *)
36106   UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`e`;`e'`]);
36107   REWRITE_TAC[adj;INTER;EMPTY_EXISTS;];
36108   TYPE_THEN `pointI m` EXISTS_TAC;
36109   TSPEC  `e'` 17 ;
36110   ASM_MESON_TAC[];
36111   ]);;
36112
36113   (* }}} *)
36114
36115 let closure_imp_adj = prove_by_refinement(
36116   `!X Y m. (closure top2 X (pointI m) /\ closure top2 Y (pointI m) /\
36117       ~(X = Y) ==> adj X Y)`,
36118   (* {{{ proof *)
36119   [
36120   REWRITE_TAC[adj];
36121   REWRITE_TAC[INTER;EMPTY_EXISTS];
36122   UNIFY_EXISTS_TAC;
36123   ]);;
36124   (* }}} *)
36125
36126 let inductive_set_endpoint = prove_by_refinement(
36127   `!G S. FINITE G /\ inductive_set G S ==>
36128      (endpoint S SUBSET endpoint G)`,
36129   (* {{{ proof *)
36130   [
36131   REWRITE_TAC[inductive_set];
36132   REWRITE_TAC[SUBSET;endpoint];
36133   TYPE_THEN `FINITE S` SUBAGOAL_TAC;
36134   IMATCH_MP_TAC  FINITE_SUBSET;
36135   UNIFY_EXISTS_TAC;
36136   THM_INTRO_TAC[`S`;`pointI x`] num_closure1;
36137   REWR 6;
36138   ASM_SIMP_TAC[num_closure1];
36139   TYPE_THEN `e` EXISTS_TAC;
36140   IMATCH_MP_TAC  EQ_ANTISYM;
36141   CONJ_TAC;
36142   COPY 6;
36143   TSPEC `e'` 6;
36144   TSPEC `e` 9;
36145   REWR 6;
36146   REWR 9;
36147   PROOF_BY_CONTR_TAC;
36148   UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`e`;`e'`]);
36149   IMATCH_MP_TAC  closure_imp_adj;
36150   TYPE_THEN `x` EXISTS_TAC;
36151   ASM_MESON_TAC[];
36152   (* - *)
36153   TYPE_THEN `e'` UNABBREV_TAC;
36154   TSPEC `e` 6;
36155   ASM_MESON_TAC[ISUBSET];
36156   ]);;
36157   (* }}} *)
36158
36159 let endpoint_closure = prove_by_refinement(
36160   `!e. (edge e) ==> (endpoint {e} = {m | closure top2 e (pointI m)})`,
36161   (* {{{ proof *)
36162   [
36163   REP_BASIC_TAC;
36164   IMATCH_MP_TAC  EQ_EXT;
36165   REWRITE_TAC[endpoint];
36166   THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
36167   REWRITE_TAC[FINITE_SING];
36168   REWRITE_TAC[INR IN_SING];
36169   IMATCH_MP_TAC  EQ_ANTISYM;
36170   CONJ_TAC;
36171   TYPE_THEN `e = e'` SUBAGOAL_TAC;
36172   ASM_MESON_TAC[];
36173   TYPE_THEN `e'` UNABBREV_TAC;
36174   ASM_MESON_TAC[];
36175   TYPE_THEN `e` EXISTS_TAC;
36176   ASM_REWRITE_TAC[];
36177   ASM_MESON_TAC[];
36178   ]);;
36179   (* }}} *)
36180
36181 let rectagon_delete = prove_by_refinement(
36182   `!E e. (rectagon E) /\ (E e) ==> (psegment (E DELETE e))`,
36183   (* {{{ proof *)
36184   [
36185   REWRITE_TAC[psegment];
36186   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
36187   CONJ_TAC;
36188   THM_INTRO_TAC[`E DELETE e`;`E`] rectagon_subset;
36189   CONJ_TAC;
36190   IMATCH_MP_TAC  rectagon_segment;
36191   REWRITE_TAC[DELETE;SUBSET];
36192   ASM_MESON_TAC[INR DELETE_NON_ELEMENT];
36193   (* - *)
36194   REWRITE_TAC[segment];
36195   CONJ_TAC;
36196   FULL_REWRITE_TAC[rectagon];
36197   REWRITE_TAC[FINITE_DELETE];
36198   (* - *)
36199   SUBCONJ_TAC;
36200   FULL_REWRITE_TAC[delete_empty];
36201   FULL_REWRITE_TAC[EMPTY_EXISTS];
36202   USE 1 (MATCH_MP rectagon_nonsing);
36203   FULL_REWRITE_TAC[SING];
36204   ASM_MESON_TAC[];
36205   (* - *)
36206   SUBCONJ_TAC;
36207   IMATCH_MP_TAC  SUBSET_TRANS;
36208   TYPE_THEN `E` EXISTS_TAC;
36209   CONJ_TAC;
36210   REWRITE_TAC[DELETE;SUBSET];
36211   FULL_REWRITE_TAC[rectagon];
36212   (* - *)
36213   SUBCONJ_TAC;
36214   THM_INTRO_TAC[`E DELETE e`;`E`;`pointI m`] num_closure_mono;
36215   FULL_REWRITE_TAC[rectagon;DELETE;SUBSET];
36216   FULL_REWRITE_TAC[rectagon];
36217   UND 5 THEN UND 4 THEN (REWRITE_TAC[INSERT]) ;
36218   TSPEC `m` 4;
36219   UND 4 THEN UND 5 THEN ARITH_TAC;
36220   (* -A *)
36221   TYPE_THEN `~S e` SUBAGOAL_TAC;
36222   FULL_REWRITE_TAC[SUBSET;DELETE];
36223   ASM_MESON_TAC[];
36224   TYPE_THEN `(e INSERT S = E) ==> (S = E DELETE e)` SUBAGOAL_TAC;
36225   TYPE_THEN `E` UNABBREV_TAC;
36226   REWRITE_TAC [DELETE_INSERT];
36227   ASM_MESON_TAC[INR DELETE_NON_ELEMENT];
36228   FIRST_ASSUM IMATCH_MP_TAC ;
36229   (* - *)
36230   TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
36231   IMATCH_MP_TAC  FINITE_SUBSET;
36232   TYPE_THEN `E` EXISTS_TAC;
36233   FULL_REWRITE_TAC[rectagon];
36234   REWRITE_TAC[DELETE;SUBSET];
36235   (* - *)
36236   THM_INTRO_TAC[`E DELETE e`;`S`] inductive_set_endpoint;
36237   REWRITE_TAC[inductive_set];
36238   ASM_REWRITE_TAC[];
36239   IMATCH_MP_TAC  rectagon_2;
36240   CONJ_TAC;
36241   REWRITE_TAC[INSERT_SUBSET];
36242   UND 6 THEN REWRITE_TAC[SUBSET;DELETE];
36243   (* - *)
36244   CONJ_TAC;
36245   FULL_REWRITE_TAC[EQ_EMPTY;INSERT;];
36246   ASM_MESON_TAC[];
36247   (* -B *)
36248   TYPE_THEN `e INSERT S SUBSET E` SUBAGOAL_TAC;
36249   UND 6 THEN REWRITE_TAC[INSERT;DELETE;SUBSET];
36250   ASM_MESON_TAC[];
36251   (* - *)
36252   THM_INTRO_TAC[`e INSERT S`;`E`;`pointI m`] num_closure_mono;
36253   FULL_REWRITE_TAC[rectagon];
36254   TYPE_THEN `~(num_closure (e INSERT S) (pointI m) = 1)` ASM_CASES_TAC;
36255   TYPE_THEN `S' = e INSERT S` ABBREV_TAC ;
36256   KILL 15;
36257   FULL_REWRITE_TAC[INSERT;rectagon];
36258   TSPEC `m` 15;
36259   UND 15 THEN UND 14 THEN UND 13 THEN ARITH_TAC;
36260   REWR 14;
36261   PROOF_BY_CONTR_TAC;
36262   KILL 13;
36263   KILL 15;
36264   KILL 9;
36265   (* - *)
36266   TYPE_THEN `!A x. (A SUBSET E) /\ (num_closure A (pointI x) = 1) ==> (num_closure E (pointI x) = 2)` SUBAGOAL_TAC;
36267   FULL_REWRITE_TAC[rectagon];
36268   TSPEC `x` 15;
36269   USE 15 (REWRITE_RULE[INSERT]);
36270   FIRST_ASSUM DISJ_CASES_TAC;
36271   THM_INTRO_TAC[`A`;`E`;`pointI x`] num_closure_mono;
36272   UND 20 THEN UND 19 THEN UND 9 THEN ARITH_TAC;
36273   (* - *)
36274   TYPE_THEN `endpoint (E DELETE e) SUBSET  endpoint {e}` SUBAGOAL_TAC;
36275   REWRITE_TAC[SUBSET;endpoint];
36276   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`E DELETE e`;`x`]);
36277   REWRITE_TAC[SUBSET;DELETE];
36278   THM_INTRO_TAC[`E`;`pointI x`] num_closure2;
36279   FULL_REWRITE_TAC[rectagon];
36280   REWR 15;
36281   THM_INTRO_TAC[`E DELETE e`;`pointI x`] num_closure1;
36282   REWR 17;
36283   USE 17 (REWRITE_RULE[DELETE]);
36284   THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
36285   REWRITE_TAC[FINITE_SING];
36286   REWRITE_TAC[INR IN_SING];
36287   TYPE_THEN `e` EXISTS_TAC;
36288   IMATCH_MP_TAC  EQ_ANTISYM;
36289   REWRITE_TAC[];
36290   TYPE_THEN `e''` UNABBREV_TAC;
36291   PROOF_BY_CONTR_TAC;
36292   TYPE_THEN `E a /\ closure top2 a (pointI x)` SUBAGOAL_TAC;
36293   TYPE_THEN `E b /\ closure top2 b (pointI x)` SUBAGOAL_TAC;
36294   TSPEC `e` 15;
36295   UND 15 THEN ASM_REWRITE_TAC[];
36296   PROOF_BY_CONTR_TAC ;
36297   USE 15 (REWRITE_RULE[DE_MORGAN_THM]);
36298   COPY 17;
36299   TSPEC `a` 17;
36300   TSPEC `b` 25;
36301   KILL 18;
36302   KILL 4;
36303   KILL 7;
36304   TYPE_THEN `e' = b` SUBAGOAL_TAC;
36305   ASM_MESON_TAC[];
36306   KILL 25;
36307   TYPE_THEN `e' = a` SUBAGOAL_TAC;
36308   ASM_MESON_TAC[];
36309   UND 7 THEN UND 4 THEN UND 16 THEN MESON_TAC[];
36310   (* -C *)
36311   TYPE_THEN `endpoint S SUBSET endpoint {e}` SUBAGOAL_TAC;
36312   IMATCH_MP_TAC  SUBSET_TRANS;
36313   UNIFY_EXISTS_TAC;
36314   KILL 13;
36315   KILL 11;
36316   (* - *)
36317   THM_INTRO_TAC[`S`;`E`] endpoint_even;
36318   SUBCONJ_TAC;
36319   ASM_MESON_TAC[rectagon_segment];
36320   SUBCONJ_TAC;
36321   UND 12 THEN REWRITE_TAC[INSERT;SUBSET] THEN MESON_TAC[];
36322   THM_INTRO_TAC[`S`;`E`] rectagon_subset;
36323   TYPE_THEN `S` UNABBREV_TAC;
36324   UND 8 THEN REWRITE_TAC[];
36325   (* - *)
36326   TYPE_THEN `X = {S' | ?e. S e /\ (S' = segment_of S e)}` ABBREV_TAC ;
36327   TYPE_THEN `FINITE X` SUBAGOAL_TAC;
36328   THM_INTRO_TAC[`segment_of S`;`S`] FINITE_IMAGE;
36329   IMATCH_MP_TAC  FINITE_SUBSET;
36330   TYPE_THEN `E DELETE e` EXISTS_TAC;
36331   TYPE_THEN `X = IMAGE (segment_of S) S` SUBAGOAL_TAC;
36332   IMATCH_MP_TAC  EQ_EXT;
36333   TYPE_THEN `X` UNABBREV_TAC;
36334   REWRITE_TAC[IMAGE];
36335   ASM_REWRITE_TAC[];
36336   TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
36337   USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
36338   UND 17 THEN REWRITE_TAC[EMPTY_EXISTS];
36339   TYPE_THEN `segment_of S u` EXISTS_TAC;
36340   TYPE_THEN `X` UNABBREV_TAC;
36341   UNIFY_EXISTS_TAC;
36342   ASM_REWRITE_TAC[];
36343   FULL_REWRITE_TAC[HAS_SIZE];
36344   (* -D *)
36345   TYPE_THEN `edge e` SUBAGOAL_TAC;
36346   FULL_REWRITE_TAC[rectagon];
36347   FULL_REWRITE_TAC[ISUBSET];
36348   THM_INTRO_TAC[`e`] endpoint_closure;
36349   THM_INTRO_TAC[`e`] two_endpoint;
36350   FULL_REWRITE_TAC[HAS_SIZE];
36351   (* - *)
36352   TYPE_THEN `endpoint S = endpoint {e}` SUBAGOAL_TAC;
36353   IMATCH_MP_TAC  CARD_SUBSET_LE;
36354   CONJ_TAC;
36355   ASM_MESON_TAC[];
36356   IMATCH_MP_TAC  (ARITH_RULE  `~(CARD X = 0) ==> 2 <= 2 * CARD X`);
36357   TYPE_THEN `X HAS_SIZE 0` SUBAGOAL_TAC;
36358   ASM_REWRITE_TAC[HAS_SIZE];
36359   FULL_REWRITE_TAC[HAS_SIZE_0];
36360   ASM_MESON_TAC[];
36361   (* - *)
36362   THM_INTRO_TAC[`e INSERT S`;`pointI m`] num_closure1;
36363   IMATCH_MP_TAC  FINITE_SUBSET;
36364   TYPE_THEN `E` EXISTS_TAC;
36365   FULL_REWRITE_TAC[rectagon];
36366   REWR 24;
36367   USE 24 (REWRITE_RULE[INSERT]);
36368   TYPE_THEN `closure top2 e (pointI m)` ASM_CASES_TAC;
36369   TYPE_THEN `e' = e` SUBAGOAL_TAC;
36370   TSPEC `e` 24;
36371   ASM_MESON_TAC[];
36372   TYPE_THEN `e'` UNABBREV_TAC;
36373   TYPE_THEN `endpoint S m` SUBAGOAL_TAC;
36374   ASM_REWRITE_TAC[];
36375   THM_INTRO_TAC[`S`;`m`]endpoint_edge;
36376   IMATCH_MP_TAC  FINITE_SUBSET;
36377   TYPE_THEN `E DELETE e` EXISTS_TAC ;
36378   FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT];
36379   TSPEC  `e''` 27;
36380   TSPEC  `e''` 24;
36381   TYPE_THEN `e = e''` SUBAGOAL_TAC;
36382   ASM_MESON_TAC[];
36383   TYPE_THEN `e''` UNABBREV_TAC;
36384   KILL 9;
36385   KILL 20;
36386   KILL 7;
36387   ASM_MESON_TAC[];
36388   (* - *)
36389   TYPE_THEN `~endpoint S m` SUBAGOAL_TAC;
36390   UND 26 THEN ASM_REWRITE_TAC[];
36391   (* - *)
36392   USE 26 (REWRITE_RULE[endpoint]);
36393   THM_INTRO_TAC[`S`;`E`;`pointI m`] num_closure_mono;
36394   FULL_REWRITE_TAC[rectagon];
36395   UND 6 THEN REWRITE_TAC[DELETE;SUBSET];
36396   TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC;
36397   FULL_REWRITE_TAC[rectagon];
36398   TYPE_THEN `FINITE S` SUBAGOAL_TAC;
36399   IMATCH_MP_TAC  FINITE_SUBSET ;
36400   TYPE_THEN `E DELETE e` EXISTS_TAC;
36401   TYPE_THEN `~(num_closure S (pointI m) = 0)` SUBAGOAL_TAC;
36402   THM_INTRO_TAC[`S`;`pointI m`] num_closure0;
36403   REWR 30;
36404   TSPEC `e'` 30;
36405   COPY 24;
36406   TSPEC `e` 32;
36407   TSPEC `e'` 24;
36408   REWR 24;
36409   FIRST_ASSUM DISJ_CASES_TAC;
36410   ASM_MESON_TAC[];
36411   TYPE_THEN `e'` UNABBREV_TAC;
36412   KILL 4;
36413   KILL 9;
36414   ASM_MESON_TAC[];
36415   (* - *)
36416   USE 28 (REWRITE_RULE [INSERT]);
36417   USE 28 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
36418   FIRST_ASSUM DISJ_CASES_TAC;
36419   UND 27 THEN UND 31 THEN UND 30 THEN ARITH_TAC;
36420   KILL 28;
36421   TYPE_THEN `num_closure S (pointI m) = 2` SUBAGOAL_TAC;
36422   UND 31 THEN UND 30 THEN UND 26 THEN UND 27 THEN ARITH_TAC;
36423   KILL 31;
36424   KILL 9;
36425   KILL 4;
36426   KILL 7;
36427   KILL 30;
36428   (* -E *)
36429   THM_INTRO_TAC[`S`;`pointI m`] num_closure2;
36430   REWR 4;
36431   TYPE_THEN `S a /\ closure top2 a (pointI m)` SUBAGOAL_TAC;
36432   TYPE_THEN `S b /\ closure top2 b (pointI m)` SUBAGOAL_TAC;
36433   KILL 4;
36434   TYPE_THEN `e' = a` SUBAGOAL_TAC;
36435   ASM_MESON_TAC[];
36436   TYPE_THEN `e' =b` SUBAGOAL_TAC;
36437   ASM_MESON_TAC[];
36438   UND 7 THEN REWRITE_TAC[];
36439   TYPE_THEN `e'` UNABBREV_TAC;
36440   ]);;
36441   (* }}} *)
36442
36443 let rectagon_adj = prove_by_refinement(
36444   `!E e f. (rectagon E) /\ E e /\ E f ==>
36445          (adj e f <=>
36446     (?a. endpoint (E DELETE e) a /\ (f = terminal_edge (E DELETE e) a)))`,
36447   (* {{{ proof *)
36448   [
36449   REP_BASIC_TAC;
36450   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
36451   FULL_REWRITE_TAC[rectagon];
36452   TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
36453   IMATCH_MP_TAC  FINITE_SUBSET;
36454   TYPE_THEN `E` EXISTS_TAC;
36455   REWRITE_TAC[DELETE;SUBSET];
36456   (* - *)
36457   IMATCH_MP_TAC  EQ_ANTISYM;
36458   IMATCH_MP_TAC  (TAUT `A /\ b ==> b /\ A`);
36459   CONJ_TAC;
36460   IMATCH_MP_TAC closure_imp_adj;
36461   TYPE_THEN `a` EXISTS_TAC;
36462   TYPE_THEN `f` UNABBREV_TAC;
36463   FULL_REWRITE_TAC[endpoint];
36464   THM_INTRO_TAC[`E DELETE e`;`pointI a`] num_closure1;
36465   REWR 5;
36466   USE 5 (REWRITE_RULE[DELETE]);
36467   TYPE_THEN `{0,2} (num_closure E (pointI a))` SUBAGOAL_TAC;
36468   FULL_REWRITE_TAC[rectagon];
36469   USE 7 (REWRITE_RULE[INSERT]);
36470   FIRST_ASSUM DISJ_CASES_TAC;
36471   THM_INTRO_TAC[`E`;`pointI a`] num_closure2;
36472   REWR 9;
36473   TYPE_THEN `E a' /\ closure top2 a' (pointI a)` SUBAGOAL_TAC;
36474   TYPE_THEN `E b /\ closure top2 b (pointI a)` SUBAGOAL_TAC;
36475   SUBCONJ_TAC;
36476   PROOF_BY_CONTR_TAC;
36477   TSPEC `e` 9;
36478   UND 9 THEN ASM_REWRITE_TAC[];
36479   PROOF_BY_CONTR_TAC;
36480   USE 9(REWRITE_RULE[DE_MORGAN_THM]);
36481   COPY 5;
36482   TSPEC `a'` 5;
36483   TSPEC `b` 17;
36484   TYPE_THEN `e' = b` SUBAGOAL_TAC;
36485   ASM_MESON_TAC[];
36486   TYPE_THEN `e'` UNABBREV_TAC;
36487   ASM_MESON_TAC[];
36488   THM_INTRO_TAC[`E DELETE e`;`a`]terminal_endpoint;
36489   REWRITE_TAC[endpoint];
36490   UND 17 THEN REWRITE_TAC[DELETE] THEN MESON_TAC[];
36491   (* -- case 0 *)
36492   THM_INTRO_TAC[`E`;`pointI a`] num_closure0;
36493   REWR 9;
36494   ASM_MESON_TAC[];
36495   (* -A *)
36496   THM_INTRO_TAC[`e`;`f`] edge_inter;
36497   FULL_REWRITE_TAC[rectagon;ISUBSET];
36498   FULL_REWRITE_TAC[INTER;INR eq_sing];
36499   TYPE_THEN `m` EXISTS_TAC;
36500   SUBCONJ_TAC;
36501   REWRITE_TAC[endpoint];
36502   THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1;
36503   KILL 9;
36504   TYPE_THEN `f` EXISTS_TAC;
36505   REWRITE_TAC[DELETE];
36506   IMATCH_MP_TAC  EQ_ANTISYM;
36507   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
36508   CONJ_TAC;
36509   TYPE_THEN `e''` UNABBREV_TAC;
36510   FULL_REWRITE_TAC[adj];
36511   ASM_MESON_TAC[];
36512   (* -- *)
36513   TYPE_THEN `{0, 2} (num_closure E (pointI m))` SUBAGOAL_TAC;
36514   FULL_REWRITE_TAC[rectagon];
36515   FULL_REWRITE_TAC[INSERT];
36516   FIRST_ASSUM DISJ_CASES_TAC;
36517   THM_INTRO_TAC[`E`;`pointI m`]num_closure2;
36518   REWR 14;
36519   PROOF_BY_CONTR_TAC;
36520   COPY 14;
36521   COPY 14;
36522   TSPEC `e` 14;
36523   TSPEC `f` 18;
36524   TSPEC `e''` 17;
36525   KILL 13;
36526   KILL 12;
36527   KILL 6;
36528   TYPE_THEN `e'' = a` ASM_CASES_TAC ;
36529   TYPE_THEN `e''` UNABBREV_TAC;
36530   TYPE_THEN `(f = b)` SUBAGOAL_TAC;
36531   ASM_MESON_TAC[];
36532   TYPE_THEN `f` UNABBREV_TAC;
36533   TYPE_THEN `e = b` SUBAGOAL_TAC;
36534   ASM_MESON_TAC[];
36535   TYPE_THEN `e` UNABBREV_TAC;
36536   FULL_REWRITE_TAC[adj];
36537   TYPE_THEN `e'' = b` SUBAGOAL_TAC;
36538   ASM_MESON_TAC[];
36539   TYPE_THEN `e''` UNABBREV_TAC;
36540   TYPE_THEN `f = a` SUBAGOAL_TAC;
36541   KILL 14;
36542   ASM_MESON_TAC[];
36543   TYPE_THEN `f` UNABBREV_TAC ;
36544   FULL_REWRITE_TAC[adj];
36545   ASM_MESON_TAC[];
36546   (* -- 0 case -- *)
36547   THM_INTRO_TAC[`E`;`pointI m`] num_closure0;
36548   REWR 14;
36549   KILL 6;
36550   ASM_MESON_TAC[];
36551   (* -B *)
36552   THM_INTRO_TAC[`E DELETE e`;`m`;`f`] terminal_unique;
36553   USE 10 (ONCE_REWRITE_RULE [EQ_SYM_EQ]);
36554   ASM_REWRITE_TAC[DELETE];
36555   ASM_MESON_TAC[adj];
36556   ]);;
36557   (* }}} *)
36558
36559 let rectagon_delete_end = prove_by_refinement(
36560   `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==>
36561        endpoint (E DELETE e ) m`,
36562   (* {{{ proof *)
36563   [
36564   REP_BASIC_TAC;
36565   REWRITE_TAC[endpoint];
36566   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
36567   FULL_REWRITE_TAC[rectagon];
36568   TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
36569   IMATCH_MP_TAC  FINITE_SUBSET;
36570   UNIFY_EXISTS_TAC;
36571   REWRITE_TAC[DELETE;SUBSET];
36572   THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1;
36573   KILL 5;
36574   REWRITE_TAC[DELETE];
36575   (* - *)
36576   TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC;
36577   FULL_REWRITE_TAC[rectagon];
36578   FULL_REWRITE_TAC[INSERT];
36579   (* - *)
36580   FIRST_ASSUM DISJ_CASES_TAC;
36581   KILL 5;
36582   THM_INTRO_TAC[`E`;`pointI m`] num_closure2;
36583   REWR 5;
36584   TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
36585   ASM_MESON_TAC[];
36586   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;
36587   FIRST_ASSUM DISJ_CASES_TAC;
36588   TYPE_THEN `b` EXISTS_TAC;
36589   ASM_MESON_TAC[];
36590   TYPE_THEN `a` EXISTS_TAC;
36591   ASM_MESON_TAC[];
36592   TYPE_THEN `c` EXISTS_TAC;
36593   TYPE_THEN `c = e''` ASM_CASES_TAC;
36594   TYPE_THEN `e''` UNABBREV_TAC;
36595   PROOF_BY_CONTR_TAC;
36596   REWR 14;
36597   KILL 5;
36598   TSPEC `e''` 9;
36599   ASM_MESON_TAC[];
36600   (* - *)
36601   THM_INTRO_TAC[`E`;`pointI m`] num_closure0;
36602   REWR 7;
36603   ASM_MESON_TAC[];
36604   ]);;
36605   (* }}} *)
36606
36607 let rectagon_order = prove_by_refinement(
36608   `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==>
36609      (?f. BIJ f { p | p < CARD E } E /\
36610          (f (CARD E - 1) = e) /\ (closure top2 (f 0) (pointI m)) /\
36611       (!i j. (i < CARD E /\ j < CARD E) ==>
36612             (adj (f i) (f j) <=> ((SUC i = j) \/ (SUC j = i) \/
36613    ((i = 0) /\ (j = (CARD E -1))) \/ ((i = CARD E -1) /\ (j = 0))))))`,
36614   (* {{{ proof *)
36615   [
36616   REP_BASIC_TAC;
36617   THM_INTRO_TAC[`E`;`e`] rectagon_delete;
36618   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
36619   FULL_REWRITE_TAC[rectagon];
36620   TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
36621   IMATCH_MP_TAC   FINITE_SUBSET;
36622   UNIFY_EXISTS_TAC;
36623   REWRITE_TAC[DELETE;SUBSET];
36624   TYPE_THEN `endpoint (E DELETE e) m` SUBAGOAL_TAC;
36625   IMATCH_MP_TAC  rectagon_delete_end;
36626   (* - *)
36627   TYPE_THEN `?n. (endpoint (E DELETE e) n) /\ ~(n = m)` SUBAGOAL_TAC;
36628   THM_INTRO_TAC[`E DELETE e`] endpoint_size2;
36629   FULL_REWRITE_TAC[has_size2];
36630   TYPE_THEN `m = a` ASM_CASES_TAC ;
36631   TYPE_THEN `b` EXISTS_TAC;
36632   REWRITE_TAC[INR in_pair];
36633   TYPE_THEN `a` EXISTS_TAC;
36634   REWRITE_TAC[INR in_pair];
36635   (* - *)
36636   THM_INTRO_TAC[`E DELETE e`;`m`;`n`] psegment_order;
36637   THM_INTRO_TAC[`e`;`E`;] CARD_SUC_DELETE;
36638   TYPE_THEN `~(CARD E = 0)` SUBAGOAL_TAC;
36639   TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC;
36640   REWRITE_TAC[HAS_SIZE];
36641   FULL_REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY];
36642   ASM_MESON_TAC[];
36643   TYPE_THEN `CARD (E DELETE e) = CARD (E) - 1` SUBAGOAL_TAC;
36644   UND 14 THEN UND 13 THEN ARITH_TAC;
36645   (* - *)
36646   TYPE_THEN `g = \ (i:num). if (i < CARD E - 1) then f i else e` ABBREV_TAC ;
36647   TYPE_THEN `(g (CARD E - 1) = e)` SUBAGOAL_TAC;
36648   TYPE_THEN `g` UNABBREV_TAC;
36649   REWRITE_TAC[ARITH_RULE `~(x <| x)`];
36650   TYPE_THEN `(!i. (i < CARD E -| 1) ==> (g i = f i))` SUBAGOAL_TAC;
36651   TYPE_THEN `g` UNABBREV_TAC;
36652   KILL 16;
36653   TYPE_THEN `g` EXISTS_TAC;
36654   (* -A *)
36655   TYPE_THEN `{p | p < CARD E - 1} UNION {(CARD E - 1)} = {p | p <| CARD E}` SUBAGOAL_TAC;
36656   IMATCH_MP_TAC  EQ_EXT;
36657   REWRITE_TAC[UNION;INR IN_SING ];
36658   UND 14 THEN ARITH_TAC;
36659   (* - *)
36660   SUBCONJ_TAC;
36661   REWRITE_TAC[BIJ];
36662   SUBCONJ_TAC;
36663   USE 16 (SYM);
36664   IMATCH_MP_TAC  inj_split;
36665   CONJ_TAC;
36666   FULL_REWRITE_TAC[BIJ;INJ];
36667   TYPE_THEN `CARD (E DELETE e)` UNABBREV_TAC;
36668   CONJ_TAC;
36669   UND 20 THEN REWRITE_TAC[DELETE] THEN UND 15 THEN MESON_TAC[];
36670   FIRST_ASSUM IMATCH_MP_TAC ;
36671   UND 15 THEN UND 21 THEN UND 22 THEN UND 18 THEN MESON_TAC[];
36672   CONJ_TAC;
36673   REWRITE_TAC[INJ;INR IN_SING ];
36674   ASM_REWRITE_TAC[];
36675   REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING  ];
36676   TYPE_THEN `x` UNABBREV_TAC ;
36677   TYPE_THEN `x''` UNABBREV_TAC;
36678   REWR 19;
36679   TYPE_THEN `g x' = f x'` SUBAGOAL_TAC;
36680   ASM_MESON_TAC[];
36681   TYPE_THEN `g x'` UNABBREV_TAC;
36682   FULL_REWRITE_TAC[BIJ;INJ];
36683   TYPE_THEN `CARD(E DELETE e)` UNABBREV_TAC;
36684   USE 21(REWRITE_RULE[DELETE]);
36685   ASM_MESON_TAC[];
36686   (* -- SURJ -- *)
36687   REWRITE_TAC[SURJ];
36688   USE 19 (REWRITE_RULE[INJ]);
36689   REWRITE_TAC[];
36690   TYPE_THEN `x = e` ASM_CASES_TAC;
36691   TYPE_THEN `CARD E - 1` EXISTS_TAC;
36692   UND 14 THEN ARITH_TAC;
36693   TYPE_THEN `(E DELETE e) x` SUBAGOAL_TAC;
36694   ASM_REWRITE_TAC[DELETE];
36695   FULL_REWRITE_TAC[BIJ;SURJ];
36696   TSPEC `x` 12;
36697   REWR 12;
36698   TYPE_THEN `y` EXISTS_TAC;
36699   CONJ_TAC;
36700   UND 26 THEN ARITH_TAC;
36701   (* -B *)
36702   TYPE_THEN `~(SING E)` SUBAGOAL_TAC;
36703   FULL_REWRITE_TAC[SING];
36704   TYPE_THEN `E` UNABBREV_TAC;
36705   FULL_REWRITE_TAC[INR IN_SING];
36706   TYPE_THEN `x` UNABBREV_TAC;
36707   FULL_REWRITE_TAC[psegment;segment];
36708   FULL_REWRITE_TAC[EMPTY_EXISTS];
36709   UND 22 THEN ASM_REWRITE_TAC[DELETE;INR IN_SING];
36710   ASM_MESON_TAC[];
36711   TYPE_THEN `~(CARD E = 1)` SUBAGOAL_TAC;
36712   TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC;
36713   ASM_REWRITE_TAC[HAS_SIZE];
36714   ASM_MESON_TAC[CARD_SING_CONV];
36715   (* - *)
36716   TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC;
36717   UND 21 THEN UND 14 THEN ARITH_TAC;
36718   COPY 18 ;
36719   TSPEC `0` 23;
36720   (* - *)
36721   SUBCONJ_TAC;
36722   THM_INTRO_TAC[`E DELETE e`;`m`]terminal_endpoint;
36723   (* -C *)
36724   UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
36725   ASM_REWRITE_TAC[];
36726   (* - *)
36727   TYPE_THEN `CARD (E DELETE e) - 1 = CARD E - 2` SUBAGOAL_TAC;
36728   UND 23 THEN ARITH_TAC;
36729   REWR 10;
36730   (* - *)
36731   TYPE_THEN `!k. endpoint (E DELETE e) k  ==> (k = n) \/ (k = m)` SUBAGOAL_TAC;
36732   PROOF_BY_CONTR_TAC;
36733   USE 29 (REWRITE_RULE[DE_MORGAN_THM]);
36734   THM_INTRO_TAC[`E DELETE e`] endpoint_size2;
36735   THM_INTRO_TAC[`endpoint(E DELETE e)`;`n`;`m`;`k`]two_exclusion;
36736   ASM_MESON_TAC[];
36737   (* - *)
36738   TYPE_THEN `!j. (j <| CARD E - 1) ==> (adj e (g j) <=> (j = 0) \/ (j = CARD E - 2))` SUBAGOAL_TAC;
36739   THM_INTRO_TAC[`E`;`e`;`g j'`] rectagon_adj;
36740   TSPEC `j'` 18;
36741   TYPE_THEN `f j'` UNABBREV_TAC;
36742   USE 19 (REWRITE_RULE[BIJ;SURJ]);
36743   FIRST_ASSUM IMATCH_MP_TAC ;
36744   UND 29 THEN ARITH_TAC;
36745   (* -- *)
36746   IMATCH_MP_TAC  EQ_ANTISYM;
36747   CONJ_TAC;
36748   UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`j'`]);
36749   TYPE_THEN `g j'` UNABBREV_TAC;
36750   REWR 30;
36751   TSPEC  `a` 28;
36752   FIRST_ASSUM DISJ_CASES_TAC ;
36753   TYPE_THEN `a` UNABBREV_TAC;
36754   DISJ2_TAC;
36755   TYPE_THEN `f j' = f (CARD E -| 2)` SUBAGOAL_TAC;
36756   USE 12(REWRITE_RULE[BIJ;INJ]);
36757   FIRST_ASSUM IMATCH_MP_TAC ;
36758   UND 29 THEN UND 23 THEN ARITH_TAC;
36759   TYPE_THEN `a` UNABBREV_TAC;
36760   DISJ1_TAC;
36761   TYPE_THEN `f j' = f 0` SUBAGOAL_TAC;
36762   USE 12 (REWRITE_RULE[BIJ;INJ]);
36763   FIRST_ASSUM IMATCH_MP_TAC ;
36764   ASM_REWRITE_TAC[];
36765   (* -- *)
36766   FIRST_ASSUM DISJ_CASES_TAC;
36767   ASM_REWRITE_TAC[];
36768   THM_INTRO_TAC[`E`;`e`;`f 0`] rectagon_adj;
36769   TYPE_THEN `terminal_edge (E DELETE e) m` UNABBREV_TAC;
36770   USE 22 SYM;
36771   USE 19 (REWRITE_RULE[BIJ;SURJ]);
36772   TSPEC `0` 22;
36773   FIRST_ASSUM IMATCH_MP_TAC ;
36774   UND 23 THEN ARITH_TAC;
36775   ASM_MESON_TAC[];
36776   (* -- *)
36777   ASM_REWRITE_TAC[];
36778   THM_INTRO_TAC[`E`;`e`;`f (CARD E - 2)`] rectagon_adj;
36779   TYPE_THEN `terminal_edge (E DELETE e) n` UNABBREV_TAC;
36780   UND 18 THEN DISCH_THEN  (THM_INTRO_TAC[`CARD E -2`]);
36781   UND 23 THEN ARITH_TAC;
36782   USE 10 GSYM;
36783   USE 19 (REWRITE_RULE[BIJ;SURJ]);
36784   FIRST_ASSUM IMATCH_MP_TAC ;
36785   UND 23 THEN ARITH_TAC;
36786   REWR 33;
36787   TYPE_THEN `n` EXISTS_TAC;
36788   ASM_REWRITE_TAC[];
36789   (* - *)
36790   TYPE_THEN `i  = CARD E - 1` ASM_CASES_TAC;
36791   ASM_REWRITE_TAC[];
36792   TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC;
36793   ASM_REWRITE_TAC[];
36794   REWRITE_TAC[adj];
36795   UND 32 THEN UND 23 THEN ARITH_TAC;
36796   UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
36797   UND 31 THEN UND 24 THEN ARITH_TAC;
36798   IMATCH_MP_TAC  EQ_ANTISYM;
36799   CONJ_TAC;
36800   FIRST_ASSUM DISJ_CASES_TAC;
36801   TYPE_THEN `j` UNABBREV_TAC;
36802   DISJ2_TAC;
36803   DISJ1_TAC;
36804   UND 23 THEN ARITH_TAC;
36805   UND 32 THEN REP_CASES_TAC;
36806   TYPE_THEN `j` UNABBREV_TAC;
36807   UND 24 THEN ARITH_TAC;
36808   DISJ2_TAC;
36809   UND 32 THEN UND 23 THEN ARITH_TAC;
36810   (* - *)
36811   TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC;
36812   ASM_REWRITE_TAC[];
36813   ONCE_REWRITE_TAC [adj_symm];
36814   UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
36815   UND 30 THEN UND 25 THEN ARITH_TAC;
36816   IMATCH_MP_TAC  EQ_ANTISYM;
36817   CONJ_TAC;
36818   FIRST_ASSUM DISJ_CASES_TAC ;
36819   UND 23 THEN ARITH_TAC;
36820   UND 32 THEN REP_CASES_TAC;
36821   UND 32 THEN UND 23 THEN ARITH_TAC;
36822   TYPE_THEN `i` UNABBREV_TAC;
36823   PROOF_BY_CONTR_TAC;
36824   UND 25 THEN ARITH_TAC;
36825   (* - *)
36826   TYPE_THEN `i < CARD E - 1 /\ j < CARD E - 1` SUBAGOAL_TAC;
36827   UND 31 THEN UND 30 THEN UND 24 THEN UND 25 THEN ARITH_TAC;
36828   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
36829   ASM_REWRITE_TAC[];
36830   ]);;
36831   (* }}} *)
36832
36833
36834 let order_imp_psegment_shift = prove_by_refinement(
36835   `! f m n.
36836      INJ f { p | m <= p /\ p < n} edge /\
36837        m <| n /\
36838        (! i j. m <= i /\ i < n /\ m <= j /\ j < n ==>
36839          (adj (f i) (f j) <=> (SUC i = j) \/ (SUC j = i))) ==>
36840       psegment (IMAGE f {p | m <= p /\ p < n})`,
36841   (* {{{ proof *)
36842   [
36843   REP_BASIC_TAC;
36844   TYPE_THEN `g = \ (i: num). f (i + m)` ABBREV_TAC ;
36845   TYPE_THEN `IMAGE f {p | m <=| p /\ p < n} = IMAGE g {p | p < n - m}` SUBAGOAL_TAC;
36846   REWRITE_TAC[IMAGE];
36847   IMATCH_MP_TAC  EQ_EXT;
36848   IMATCH_MP_TAC  EQ_ANTISYM;
36849   CONJ_TAC;
36850   TYPE_THEN `x` UNABBREV_TAC;
36851   TYPE_THEN `g` UNABBREV_TAC;
36852   TYPE_THEN `x' -| m` EXISTS_TAC;
36853   CONJ_TAC;
36854   UND 5 THEN UND 6 THEN ARITH_TAC;
36855   AP_TERM_TAC;
36856   UND 6 THEN ARITH_TAC;
36857   TYPE_THEN `x` UNABBREV_TAC;
36858   TYPE_THEN `g` UNABBREV_TAC;
36859   TYPE_THEN `x' +| m` EXISTS_TAC;
36860   UND 5 THEN UND 1 THEN ARITH_TAC;
36861   IMATCH_MP_TAC  order_imp_psegment;
36862   (* - *)
36863   SUBCONJ_TAC;
36864   REWRITE_TAC[INJ];
36865   CONJ_TAC;
36866   TYPE_THEN`g`UNABBREV_TAC;
36867   FULL_REWRITE_TAC[INJ];
36868   FIRST_ASSUM IMATCH_MP_TAC ;
36869   UND 5 THEN UND 1 THEN ARITH_TAC;
36870   TYPE_THEN `g` UNABBREV_TAC;
36871   IMATCH_MP_TAC  (ARITH_RULE `((x +| m) = (y + m)) ==> (x = y)`);
36872   FULL_REWRITE_TAC[INJ];
36873   FIRST_ASSUM IMATCH_MP_TAC ;
36874   UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC;
36875   (* - *)
36876   CONJ_TAC;
36877   UND 1 THEN ARITH_TAC;
36878   TYPE_THEN `g` UNABBREV_TAC;
36879   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i +| m`;`j +| m`]);
36880   UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC;
36881   REWRITE_TAC[ARITH_RULE `(SUC(i + m) = (j +| m)) <=> (SUC i = j)`];
36882   ]);;
36883   (* }}} *)
36884
36885 let cls = jordan_def
36886   `cls E = {m | ?e. E e /\ closure top2 e (pointI m)}`;;
36887
36888 let cls_edge = prove_by_refinement(
36889   `!e. (cls {e} = {m | closure top2 e (pointI m)})`,
36890   (* {{{ proof *)
36891   [
36892   REWRITE_TAC[cls;INR IN_SING ;];
36893   IMATCH_MP_TAC  EQ_EXT;
36894   MESON_TAC[];
36895   ]);;
36896   (* }}} *)
36897
36898 let cls_inj_lemma_v = prove_by_refinement(
36899   `!m n. (cls {(v_edge m)} = cls {(v_edge n)}) ==> (m = n)`,
36900   (* {{{ proof *)
36901   [
36902   REWRITE_TAC[cls_edge;INR IN_SING;];
36903   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
36904   USE 0 (REWRITE_RULE[INR IN_SING]);
36905   FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
36906   SUBCONJ_TAC;
36907   TSPEC `m` 0;
36908   ASM_MESON_TAC[];
36909   TYPE_THEN `FST n` UNABBREV_TAC;
36910   COPY 0;
36911   TSPEC `m` 1;
36912   TSPEC `(FST m, SND n)` 0;
36913   REWR 0;
36914   REWR 1;
36915   UND 0 THEN UND 1 THEN INT_ARITH_TAC;
36916   ]);;
36917   (* }}} *)
36918
36919 let cls_inj_lemma_h = prove_by_refinement(
36920   `!m n. (cls {(h_edge m)} = cls {(h_edge n)}) ==> (m = n)`,
36921   (* {{{ proof *)
36922   [
36923   REWRITE_TAC[cls_edge;INR IN_SING;];
36924   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
36925   USE 0 (REWRITE_RULE[INR IN_SING]);
36926   FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
36927   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
36928   SUBCONJ_TAC;
36929   TSPEC `m` 0;
36930   ASM_MESON_TAC[];
36931   TYPE_THEN `SND  n` UNABBREV_TAC;
36932   COPY 0;
36933   TSPEC `m` 1;
36934   TSPEC `(FST n, SND m)` 0;
36935   REWR 0;
36936   REWR 1;
36937   UND 0 THEN UND 1 THEN INT_ARITH_TAC;
36938   ]);;
36939   (* }}} *)
36940
36941 let cls_inj_lemma_hv = prove_by_refinement(
36942   `!m n. ~(cls {(h_edge m)} = cls {(v_edge n)})` ,
36943   (* {{{ proof *)
36944   [
36945   REWRITE_TAC[cls_edge;];
36946   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
36947   USE 0 (REWRITE_RULE[INR IN_SING]);
36948   FULL_REWRITE_TAC[v_edge_closure;vc_edge;h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
36949   COPY 0;
36950   TSPEC  `n` 0;
36951   TSPEC `(FST n, SND n +: &:1)` 1;
36952   REWR 0;
36953   REWR 1;
36954   TYPE_THEN `SND n = SND m` SUBAGOAL_TAC;
36955   ASM_MESON_TAC[];
36956   TYPE_THEN `SND m` UNABBREV_TAC;
36957   UND 1 THEN INT_ARITH_TAC;
36958   ]);;
36959   (* }}} *)
36960
36961 let cls_inj = prove_by_refinement(
36962   `!e f . (edge e /\ edge f /\ (cls {e} = cls {f}) ==> (e = f))`,
36963   (* {{{ proof *)
36964   [
36965   REWRITE_TAC[edge];
36966   JOIN 1 2 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
36967   UND 1 THEN REP_CASES_TAC THEN REWR 0 THEN REWRITE_TAC[v_edge_inj;h_edge_inj];
36968   IMATCH_MP_TAC cls_inj_lemma_v;
36969   ASM_MESON_TAC[cls_inj_lemma_hv];
36970   ASM_MESON_TAC[cls_inj_lemma_hv];
36971   IMATCH_MP_TAC  cls_inj_lemma_h;
36972   ]);;
36973   (* }}} *)
36974
36975 let adjv = jordan_def
36976   `adjv e f = @m. (closure top2 e (pointI m)) /\
36977                   (closure top2 f (pointI m))` ;;
36978
36979 let adjv_adj = prove_by_refinement(
36980   `!e f. edge e /\ edge f /\ adj e f ==>
36981         closure top2 e (pointI (adjv e f))`,
36982   (* {{{ proof *)
36983   [
36984   REWRITE_TAC[adjv];
36985   SELECT_TAC ;
36986   THM_INTRO_TAC[`e`;`f`] edge_inter;
36987   FULL_REWRITE_TAC [INTER;INR eq_sing;];
36988   ASM_MESON_TAC[];
36989   ]);;
36990   (* }}} *)
36991
36992 let adjv_adj2 = prove_by_refinement(
36993   `!e f. edge e /\ edge f /\ adj e f ==>
36994         closure top2 f (pointI (adjv e f))`,
36995   (* {{{ proof *)
36996   [
36997   REWRITE_TAC[adjv];
36998   SELECT_TAC ;
36999   THM_INTRO_TAC[`e`;`f`] edge_inter;
37000   FULL_REWRITE_TAC [INTER;INR eq_sing;];
37001   ASM_MESON_TAC[];
37002   ]);;
37003   (* }}} *)
37004
37005 let has_size2_pair = prove_by_refinement(
37006   `!(X:A->bool) a b. (X HAS_SIZE 2) /\ X a /\ X b /\ ~(a = b) ==>
37007       (X = {a,b})`,
37008   (* {{{ proof *)
37009   [
37010   REP_BASIC_TAC;
37011   ONCE_REWRITE_TAC[EQ_SYM_EQ];
37012   IMATCH_MP_TAC  CARD_SUBSET_EQ;
37013   FULL_REWRITE_TAC[HAS_SIZE];
37014   REWRITE_TAC[SUBSET;INR in_pair];
37015   ASM_MESON_TAC[pair_size_2;HAS_SIZE];
37016   ]);;
37017   (* }}} *)
37018
37019 let adjv_unique = prove_by_refinement(
37020   `!e f n. edge e /\ edge f /\ adj e f /\ closure top2 e (pointI n) /\
37021       closure top2 f (pointI n) ==> (n = adjv e f)`,
37022   (* {{{ proof *)
37023   [
37024   REWRITE_TAC[adjv];
37025   SELECT_TAC;
37026   PROOF_BY_CONTR_TAC;
37027   THM_INTRO_TAC[`e`] two_endpoint;
37028   THM_INTRO_TAC[`f`] two_endpoint;
37029   THM_INTRO_TAC[ `{m | closure top2 f (pointI m)}`;`n`;`t`] has_size2_pair;
37030   ASM_REWRITE_TAC[];
37031   THM_INTRO_TAC[ `{m | closure top2 e (pointI m)}`;`n`;`t`] has_size2_pair;
37032   ASM_REWRITE_TAC[];
37033   TYPE_THEN `cls {e} = cls {f}` SUBAGOAL_TAC;
37034   REWRITE_TAC[cls_edge;INR IN_SING ];
37035   THM_INTRO_TAC[`e`;`f`] cls_inj;
37036   TYPE_THEN`f` UNABBREV_TAC;
37037   FULL_REWRITE_TAC[adj];
37038   (* - *)
37039   ASM_MESON_TAC[];
37040   ]);;
37041   (* }}} *)
37042
37043 let adjv_symm = prove_by_refinement(
37044   `!e f. edge e /\ edge f /\ adj e f ==>
37045     (adjv f e = adjv e f)`,
37046   (* {{{ proof *)
37047   [
37048   REP_BASIC_TAC;
37049   IMATCH_MP_TAC  adjv_unique;
37050   THM_INTRO_TAC[`f`;`e`] adjv_adj;
37051   ASM_MESON_TAC[adj_symm];
37052   THM_INTRO_TAC[`f`;`e`] adjv_adj2;
37053   ASM_MESON_TAC[adj_symm];
37054   ]);;
37055   (* }}} *)
37056
37057 let adjv_segment  = prove_by_refinement(
37058   `!E e f. segment E /\ E e /\ E f /\ adj e f ==>
37059      ({C| E C /\ closure top2 C (pointI (adjv e f))} = {e,f} ) `,
37060   (* {{{ proof *)
37061   [
37062   REP_BASIC_TAC;
37063   IMATCH_MP_TAC  has_size2_pair;
37064   TYPE_THEN `~(e = f)` SUBAGOAL_TAC;
37065   FULL_REWRITE_TAC[adj];
37066   ASM_MESON_TAC[];
37067   (* - *)
37068   TYPE_THEN `edge e /\ edge f` SUBAGOAL_TAC;
37069   FULL_REWRITE_TAC[segment;ISUBSET];
37070   (* - *)
37071   TYPE_THEN `closure top2 e (pointI (adjv e f))` SUBAGOAL_TAC;
37072   IMATCH_MP_TAC  adjv_adj;
37073   TYPE_THEN `closure top2 f (pointI (adjv e f))` SUBAGOAL_TAC;
37074   IMATCH_MP_TAC  adjv_adj2;
37075   (* - *)
37076   TYPE_THEN `{0,1,2} (num_closure E (pointI (adjv e f)))` SUBAGOAL_TAC;
37077   FULL_REWRITE_TAC[segment];
37078   FULL_REWRITE_TAC[INSERT];
37079   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
37080   FULL_REWRITE_TAC[segment];
37081   UND 9 THEN REP_CASES_TAC;
37082   THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure_size;
37083   REWR 11;
37084   (* -- *)
37085   THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure1;
37086   REWR 11;
37087   COPY 11;
37088   TSPEC `f` 11;
37089   TSPEC `e` 12;
37090   REWR 11;
37091   REWR 12;
37092   (* - *)
37093   THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure0;
37094   REWR 11;
37095   TSPEC  `e` 11;
37096   ASM_MESON_TAC[];
37097   ]);;
37098   (* }}} *)
37099
37100 let num_closure_elt = prove_by_refinement(
37101   `!S m. (0 <| num_closure S m) ==> (?e. S e /\ closure top2 e m)`,
37102   (* {{{ proof *)
37103   [
37104   REWRITE_TAC[num_closure];
37105   TYPE_THEN `~({C | S C /\ closure top2 C m} = EMPTY)` SUBAGOAL_TAC;
37106   REWR 0;
37107   FULL_REWRITE_TAC[CARD_CLAUSES];
37108   UND 0 THEN ARITH_TAC;
37109   FULL_REWRITE_TAC[EMPTY_EXISTS];
37110   UNIFY_EXISTS_TAC;
37111   ]);;
37112   (* }}} *)
37113
37114 (* I shouldn't need three minor variations of the same
37115    thing here, but here they are *)
37116
37117 let rectagon_subset_endpoint = prove_by_refinement(
37118   `!E S k. rectagon E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\
37119    (0 <| num_closure (E DIFF S) (pointI k)) ==>
37120    (endpoint S k)`,
37121   (* {{{ proof *)
37122   [
37123   REP_BASIC_TAC;
37124   REWRITE_TAC[endpoint];
37125   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
37126   FULL_REWRITE_TAC[rectagon];
37127   THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono;
37128   TYPE_THEN `{0,2} (num_closure E (pointI k))` SUBAGOAL_TAC;
37129   FULL_REWRITE_TAC[rectagon];
37130   FULL_REWRITE_TAC[INSERT];
37131   (* - *)
37132   FIRST_ASSUM DISJ_CASES_TAC ;
37133   PROOF_BY_CONTR_TAC;
37134   TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC;
37135   REWR 5;
37136   UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC;
37137   TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC;
37138   IMATCH_MP_TAC  CARD_SUBSET_EQ;
37139   USE 9 (REWRITE_RULE[num_closure]);
37140   USE 7 (REWRITE_RULE[num_closure]);
37141   CONJ_TAC;
37142   IMATCH_MP_TAC  FINITE_SUBSET;
37143   UNIFY_EXISTS_TAC;
37144   REWRITE_TAC[SUBSET;];
37145   REWRITE_TAC[SUBSET;];
37146   FULL_REWRITE_TAC[ISUBSET];
37147   (* -- *)
37148   USE 0 (REWRITE_RULE[num_closure]);
37149   USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`));
37150   TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC;
37151   REWRITE_TAC[EQ_EMPTY ];
37152   USE 12 (REWRITE_RULE[DIFF]);
37153   USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
37154   TSPEC `x` 10;
37155   REWR 10;
37156   UND 0 THEN ASM_REWRITE_TAC[];
37157   REWRITE_TAC[CARD_CLAUSES];
37158   UND 7 THEN UND 5 THEN UND 1 THEN ARITH_TAC;
37159   ]);;
37160   (* }}} *)
37161
37162 let psegment_subset_endpoint = prove_by_refinement(
37163   `!E S k. psegment E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\
37164    (0 <| num_closure (E DIFF S) (pointI k)) ==>
37165    (endpoint S k)`,
37166   (* {{{ proof *)
37167   [
37168   REP_BASIC_TAC;
37169   REWRITE_TAC[endpoint];
37170   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
37171   FULL_REWRITE_TAC[psegment;segment];
37172   THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono;
37173   TYPE_THEN `{0,1,2} (num_closure E (pointI k))` SUBAGOAL_TAC;
37174   FULL_REWRITE_TAC[psegment;segment];
37175   FULL_REWRITE_TAC[INSERT];
37176   (* - *)
37177   FULL_REWRITE_TAC[DISJ_ACI];
37178   FIRST_ASSUM DISJ_CASES_TAC ;
37179   PROOF_BY_CONTR_TAC;
37180   TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC;
37181   REWR 5;
37182   UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC;
37183   TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC;
37184   IMATCH_MP_TAC  CARD_SUBSET_EQ;
37185   USE 9 (REWRITE_RULE[num_closure]);
37186   USE 7 (REWRITE_RULE[num_closure]);
37187   CONJ_TAC;
37188   IMATCH_MP_TAC  FINITE_SUBSET;
37189   UNIFY_EXISTS_TAC;
37190   REWRITE_TAC[SUBSET;];
37191   REWRITE_TAC[SUBSET;];
37192   FULL_REWRITE_TAC[ISUBSET];
37193   (* -- *)
37194   USE 0 (REWRITE_RULE[num_closure]);
37195   USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`));
37196   TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC;
37197   REWRITE_TAC[EQ_EMPTY ];
37198   USE 12 (REWRITE_RULE[DIFF]);
37199   USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
37200   TSPEC `x` 10;
37201   REWR 10;
37202   UND 0 THEN ASM_REWRITE_TAC[];
37203   REWRITE_TAC[CARD_CLAUSES];
37204   (* - *)
37205   KILL 6;
37206   FIRST_ASSUM DISJ_CASES_TAC;
37207   THM_INTRO_TAC[`E`;`pointI k`] num_closure1;
37208   REWR 8;
37209   USE 0 (MATCH_MP num_closure_elt);
37210   FULL_REWRITE_TAC[DIFF];
37211   USE 1 (MATCH_MP num_closure_elt);
37212   COPY 8;
37213   TSPEC `e'` 12;
37214   TSPEC `e''` 8;
37215   FULL_REWRITE_TAC[ISUBSET];
37216   ASM_MESON_TAC[];
37217   (* - *)
37218   UND 6 THEN UND 5 THEN UND 1 THEN ARITH_TAC;
37219   ]);;
37220   (* }}} *)
37221
37222
37223 let num_closure_pos = prove_by_refinement(
37224   `!G m.
37225       FINITE G /\ (?e. G e /\ closure top2 e (pointI m)) ==>
37226          (0 <| (num_closure G (pointI m)))`,
37227   (* {{{ proof *)
37228   [
37229   REP_BASIC_TAC;
37230   PROOF_BY_CONTR_TAC ;
37231   TYPE_THEN `num_closure G (pointI m) = 0` SUBAGOAL_TAC;
37232   UND 3 THEN ARITH_TAC;
37233   THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
37234   REWR 5;
37235   ASM_MESON_TAC[];
37236   ]);;
37237   (* }}} *)
37238
37239 let cut_rectagon = prove_by_refinement(
37240   `!E m n. (rectagon E) /\ (0 < num_closure E (pointI m)) /\
37241      (0 < num_closure E (pointI n)) /\ ~(m = n) ==>
37242     (?A B. psegment A /\ psegment B /\ (E = A UNION B) /\
37243        (A INTER B = EMPTY) /\ (endpoint A = {m,n}) /\
37244        (endpoint B = {m,n}) /\
37245        (!k. (0 < num_closure A (pointI k)) /\
37246           (0 < num_closure B (pointI k)) ==> (k = m) \/ (k = n) ))
37247     `,
37248   (* {{{ proof *)
37249
37250   [
37251   REP_BASIC_TAC;
37252   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
37253   FULL_REWRITE_TAC[rectagon];
37254   THM_INTRO_TAC[`E`;`pointI m`] num_closure_size;
37255   TYPE_THEN `~({C | E C /\ closure top2 C (pointI m)} = EMPTY)` SUBAGOAL_TAC;
37256   USE 6 SYM;
37257   FULL_REWRITE_TAC[HAS_SIZE];
37258   USE 6 (AP_TERM `CARD:(((num->real)->bool)->bool)->num`);
37259   USE 6 (REWRITE_RULE[CARD_CLAUSES]);
37260 (**** Changed by JRH because of new ARITH_RULE's inability to handle alpha equivs
37261   UND 6 THEN UND 5 THEN UND 2 THEN ARITH_TAC;
37262  ****)
37263   UND 6 THEN UND 5 THEN UND 2 THEN REWRITE_TAC[ARITH_RULE `0 < x ==> (y = x) ==> (0 = y) ==> F`];
37264   FULL_REWRITE_TAC[EMPTY_EXISTS];
37265   (* - *)
37266   THM_INTRO_TAC[`E`;`u`;`m`] rectagon_order;
37267   TYPE_THEN `!n. (0 <| num_closure E (pointI n)) ==> (num_closure E (pointI n) = 2)` SUBAGOAL_TAC ;
37268   TYPE_THEN `{0,2} (num_closure E (pointI n'))` SUBAGOAL_TAC;
37269   FULL_REWRITE_TAC[rectagon];
37270   FULL_REWRITE_TAC[INSERT];
37271   FIRST_ASSUM DISJ_CASES_TAC;
37272   UND 14 THEN UND 12 THEN ARITH_TAC;
37273   TYPE_THEN `u` UNABBREV_TAC;
37274   (* -A *)
37275   TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC;
37276   PROOF_BY_CONTR_TAC;
37277   TYPE_THEN `num_closure E (pointI m) = 2` SUBAGOAL_TAC;
37278   THM_INTRO_TAC[`E`;`pointI m`] num_closure;
37279   REWR 14;
37280   THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI m)}`;`E`] CARD_SUBSET;
37281   REWRITE_TAC[SUBSET];
37282   USE 14 SYM ;
37283   REWR 15;
37284   UND 15 THEN UND 10 THEN ARITH_TAC;
37285   (* - *)
37286   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;
37287   IMATCH_MP_TAC  adjv_unique;
37288   FULL_REWRITE_TAC[BIJ;INJ;rectagon;ISUBSET ];
37289   CONJ_TAC;
37290   FIRST_ASSUM IMATCH_MP_TAC  ;
37291   FIRST_ASSUM IMATCH_MP_TAC ;
37292   UND 10 THEN ARITH_TAC;
37293   REWRITE_TAC[adj;EMPTY_EXISTS;INTER;];
37294   CONJ_TAC;
37295   TYPE_THEN `0 = (CARD E -| 1)` SUBAGOAL_TAC;
37296   FIRST_ASSUM IMATCH_MP_TAC ;
37297   UND 10 THEN ARITH_TAC;
37298   UND 22 THEN UND 10 THEN ARITH_TAC;
37299   TYPE_THEN `pointI m'` EXISTS_TAC;
37300   (* -B *)
37301   TYPE_THEN `num_closure E (pointI n) = 2` SUBAGOAL_TAC;
37302   THM_INTRO_TAC[`E`;`pointI n`] num_closure2;
37303   REWR 15;
37304   TYPE_THEN `E a /\ closure top2 a (pointI n)` SUBAGOAL_TAC;
37305   TYPE_THEN `E b /\ closure top2 b (pointI n)` SUBAGOAL_TAC;
37306   TYPE_THEN `?i. (i < CARD E) /\ (f i = a)` SUBAGOAL_TAC;
37307   FULL_REWRITE_TAC[BIJ;SURJ];
37308   TYPE_THEN `a` UNABBREV_TAC;
37309   TYPE_THEN `?j. (j < CARD E) /\ (f j = b)` SUBAGOAL_TAC;
37310   FULL_REWRITE_TAC[BIJ;SURJ];
37311   TYPE_THEN `b` UNABBREV_TAC;
37312   COPY 8;
37313   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
37314   (* - *)
37315   TYPE_THEN `adj (f i) (f j)` SUBAGOAL_TAC THEN REWRITE_TAC[adj];
37316   REWRITE_TAC[INTER;EMPTY_EXISTS ];
37317   UNIFY_EXISTS_TAC;
37318   REWR 8;
37319   (* -C *)
37320   TYPE_THEN `edge (f i)` SUBAGOAL_TAC;
37321   FULL_REWRITE_TAC[rectagon;ISUBSET];
37322   TYPE_THEN `edge (f j)` SUBAGOAL_TAC;
37323   FULL_REWRITE_TAC[rectagon;ISUBSET];
37324   TYPE_THEN `?k. (k < CARD E -| 1) /\ (n = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
37325   FIRST_ASSUM DISJ_CASES_TAC;
37326   TYPE_THEN `i` EXISTS_TAC;
37327   ASM_REWRITE_TAC[];
37328   CONJ_TAC;
37329   UND 27 THEN UND 23 THEN ARITH_TAC;
37330   IMATCH_MP_TAC  adjv_unique;
37331   FIRST_ASSUM DISJ_CASES_TAC;
37332   TYPE_THEN `j` EXISTS_TAC;
37333   ASM_REWRITE_TAC[];
37334   CONJ_TAC;
37335   UND 28 THEN UND 22 THEN ARITH_TAC;
37336   IMATCH_MP_TAC  adjv_unique;
37337   USE 24 (ONCE_REWRITE_RULE[adj_symm]);
37338   (* -- *)
37339   FIRST_ASSUM DISJ_CASES_TAC;
37340   TYPE_THEN `i` UNABBREV_TAC;
37341   TYPE_THEN `j` UNABBREV_TAC;
37342   COPY 13;
37343   UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]);
37344   UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]);
37345   PROOF_BY_CONTR_TAC;
37346   UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[];
37347   TYPE_THEN `i` UNABBREV_TAC;
37348   TYPE_THEN `j` UNABBREV_TAC;
37349   COPY 13;
37350   UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]);
37351   UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]);
37352   PROOF_BY_CONTR_TAC;
37353   UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[];
37354   (* - *)
37355   TYPE_THEN `A = IMAGE f {p | p <| SUC(k)}` ABBREV_TAC ;
37356   TYPE_THEN `B = IMAGE f {p | SUC(k) <=| p /\ p < CARD E}` ABBREV_TAC ;
37357   TYPE_THEN `A` EXISTS_TAC;
37358   TYPE_THEN `B` EXISTS_TAC;
37359   (* -D , now prove properties *)
37360   KILL 26;
37361   KILL 25;
37362   KILL 8;
37363   KILL 24;
37364   KILL 23;
37365   KILL 22;
37366   KILL 19;
37367   KILL 20;
37368   KILL 17;
37369   KILL 18;
37370   KILL 15;
37371   KILL 16;
37372   (* - *)
37373   SUBCONJ_TAC;
37374   TYPE_THEN `A` UNABBREV_TAC;
37375   IMATCH_MP_TAC  order_imp_psegment;
37376   REWRITE_TAC[ARITH_RULE `0 <| SUC k`];
37377   (* -- *)
37378   SUBCONJ_TAC;
37379   FULL_REWRITE_TAC[BIJ;INJ];
37380   TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
37381   FULL_REWRITE_TAC[rectagon;ISUBSET];
37382   CONJ_TAC;
37383   FIRST_ASSUM IMATCH_MP_TAC ;
37384   FIRST_ASSUM IMATCH_MP_TAC ;
37385   UND 17 THEN UND 28 THEN ARITH_TAC;
37386   FIRST_ASSUM IMATCH_MP_TAC ;
37387   UND 18 THEN UND 19 THEN UND 28 THEN ARITH_TAC;
37388   (* -- *)
37389   UND 21 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`j`]);
37390   UND 8 THEN UND 15 THEN UND 28 THEN ARITH_TAC;
37391   TYPE_THEN `~(j = CARD E -| 1)` SUBAGOAL_TAC;
37392   UND 18 THEN UND 8 THEN UND 28 THEN ARITH_TAC;
37393   TYPE_THEN `~(i = CARD E -| 1)` SUBAGOAL_TAC;
37394   UND 19 THEN UND 15 THEN UND 28 THEN ARITH_TAC;
37395   (* - *)
37396   SUBCONJ_TAC;
37397   TYPE_THEN `B` UNABBREV_TAC;
37398   IMATCH_MP_TAC  order_imp_psegment_shift;
37399   SUBCONJ_TAC;
37400   FULL_REWRITE_TAC[BIJ;INJ];
37401   TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
37402   FULL_REWRITE_TAC[rectagon;ISUBSET];
37403   CONJ_TAC;
37404   FIRST_ASSUM IMATCH_MP_TAC ;
37405   FIRST_ASSUM IMATCH_MP_TAC ;
37406   CONJ_TAC;
37407   UND 28 THEN ARITH_TAC;
37408   (* -- *)
37409   UND 21 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`j`]);
37410   TYPE_THEN `~(j = 0)` SUBAGOAL_TAC;
37411   UND 21 THEN UND 17 THEN ARITH_TAC;
37412   TYPE_THEN `~(i = 0)` SUBAGOAL_TAC;
37413   UND 22 THEN UND 19 THEN ARITH_TAC;
37414   (* -E *)
37415   SUBCONJ_TAC;
37416   TYPE_THEN `(IMAGE f {p | p <| CARD E} = E)` SUBAGOAL_TAC;
37417   IMATCH_MP_TAC  bij_imp_image;
37418   TYPE_THEN `A` UNABBREV_TAC;
37419   TYPE_THEN `B` UNABBREV_TAC;
37420   REWRITE_TAC[GSYM IMAGE_UNION];
37421   TYPE_THEN `cE = CARD E` ABBREV_TAC ;
37422   UND 16 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
37423   AP_TERM_TAC;
37424   IMATCH_MP_TAC  EQ_EXT;
37425   REWRITE_TAC[UNION];
37426   UND 28 THEN ARITH_TAC;
37427   (* - *)
37428   SUBCONJ_TAC;
37429   TYPE_THEN `A` UNABBREV_TAC;
37430   TYPE_THEN `B` UNABBREV_TAC ;
37431   REWRITE_TAC[IMAGE];
37432   PROOF_BY_CONTR_TAC ;
37433   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
37434   TYPE_THEN `u'` UNABBREV_TAC;
37435   TYPE_THEN `x = x'` SUBAGOAL_TAC;
37436   FULL_REWRITE_TAC[BIJ;INJ];
37437   FIRST_ASSUM IMATCH_MP_TAC ;
37438   UND 22 THEN UND 28 THEN ARITH_TAC;
37439   UND 20 THEN UND 19 THEN UND 22 THEN ARITH_TAC;
37440   (* - *)
37441   TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC;
37442   UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
37443   TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC;
37444   UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
37445   (* - finite A ,B *)
37446   TYPE_THEN `FINITE A` SUBAGOAL_TAC;
37447   IMATCH_MP_TAC  FINITE_SUBSET;
37448   TYPE_THEN `E` EXISTS_TAC;
37449   REWRITE_TAC[SUBSET;UNION];
37450   TYPE_THEN `FINITE B` SUBAGOAL_TAC;
37451   IMATCH_MP_TAC  FINITE_SUBSET;
37452   TYPE_THEN `E` EXISTS_TAC;
37453   REWRITE_TAC[SUBSET;UNION];
37454   (* -F *)
37455   TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC;
37456   FULL_REWRITE_TAC[rectagon;ISUBSET];
37457   KILL 16;
37458   CONJ_TAC;
37459   FIRST_ASSUM IMATCH_MP_TAC ;
37460   USE 11 (REWRITE_RULE[BIJ;SURJ]);
37461   FIRST_ASSUM IMATCH_MP_TAC ;
37462   UND 28 THEN ARITH_TAC;
37463   CONJ_TAC;
37464   FIRST_ASSUM IMATCH_MP_TAC ;
37465   USE 11 (REWRITE_RULE[BIJ;SURJ]);
37466   FIRST_ASSUM IMATCH_MP_TAC ;
37467   UND 28 THEN ARITH_TAC;
37468   UND 21 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]);
37469   UND 28 THEN ARITH_TAC;
37470   (* - *)
37471   TYPE_THEN `0 <| num_closure A (pointI n)` SUBAGOAL_TAC;
37472   IMATCH_MP_TAC  num_closure_pos;
37473   TYPE_THEN `f k` EXISTS_TAC;
37474   TYPE_THEN `A` UNABBREV_TAC;
37475   CONJ_TAC;
37476   REWRITE_TAC[IMAGE];
37477   TYPE_THEN `k` EXISTS_TAC;
37478   ARITH_TAC;
37479   IMATCH_MP_TAC  adjv_adj;
37480   (* - *)
37481   TYPE_THEN `0 <| num_closure B (pointI n)` SUBAGOAL_TAC;
37482   IMATCH_MP_TAC  num_closure_pos;
37483   TYPE_THEN `f (SUC k)` EXISTS_TAC;
37484   TYPE_THEN `B` UNABBREV_TAC;
37485   CONJ_TAC;
37486   REWRITE_TAC[IMAGE];
37487   TYPE_THEN `SUC k` EXISTS_TAC;
37488   UND 28 THEN ARITH_TAC;
37489   IMATCH_MP_TAC  adjv_adj2;
37490   (* - *)
37491   TYPE_THEN `0 <| num_closure A (pointI m)` SUBAGOAL_TAC;
37492   IMATCH_MP_TAC  num_closure_pos;
37493   TYPE_THEN `f 0` EXISTS_TAC;
37494   TYPE_THEN `A` UNABBREV_TAC;
37495   REWRITE_TAC[IMAGE];
37496   TYPE_THEN `0` EXISTS_TAC;
37497   ARITH_TAC;
37498   (* - *)
37499   TYPE_THEN `0 <| num_closure B (pointI m)` SUBAGOAL_TAC;
37500   IMATCH_MP_TAC  num_closure_pos;
37501   KILL 16;
37502   TYPE_THEN `f (CARD E -| 1)` EXISTS_TAC;
37503   TYPE_THEN `B` UNABBREV_TAC;
37504   REWRITE_TAC[IMAGE];
37505   TYPE_THEN `CARD E -| 1` EXISTS_TAC;
37506   UND 28 THEN ARITH_TAC;
37507   (* -G *)
37508   SUBCONJ_TAC;
37509   IMATCH_MP_TAC  has_size2_pair;
37510   ASM_REWRITE_TAC[];
37511   CONJ_TAC;
37512   IMATCH_MP_TAC  endpoint_size2;
37513   CONJ_TAC;
37514   IMATCH_MP_TAC  rectagon_subset_endpoint;
37515   UNIFY_EXISTS_TAC ;
37516   ASM_REWRITE_TAC[SUBSET;UNION];
37517   CONJ_TAC;
37518   IMATCH_MP_TAC  rectagon_subset_endpoint;
37519   UNIFY_EXISTS_TAC;
37520   ASM_REWRITE_TAC[SUBSET;UNION];
37521   TYPE_THEN `n` UNABBREV_TAC;
37522   UND 34 THEN UND 27 THEN UND 0 THEN MESON_TAC[];
37523   (* - *)
37524   SUBCONJ_TAC;
37525   IMATCH_MP_TAC  has_size2_pair;
37526   ASM_REWRITE_TAC[];
37527   CONJ_TAC;
37528   IMATCH_MP_TAC  endpoint_size2;
37529   CONJ_TAC;
37530   IMATCH_MP_TAC  rectagon_subset_endpoint;
37531   UNIFY_EXISTS_TAC ;
37532   ASM_REWRITE_TAC[SUBSET;UNION];
37533   CONJ_TAC;
37534   IMATCH_MP_TAC  rectagon_subset_endpoint;
37535   UNIFY_EXISTS_TAC;
37536   ASM_REWRITE_TAC[SUBSET;UNION];
37537   TYPE_THEN `n` UNABBREV_TAC;
37538   UND 35 THEN UND 27 THEN UND 0 THEN MESON_TAC[];
37539   (* - *)
37540   THM_INTRO_TAC[`E`;`A`;`k'`] rectagon_subset_endpoint;
37541   ASM_REWRITE_TAC[SUBSET;UNION];
37542   REWR 38;
37543   USE 38 (REWRITE_RULE[INR in_pair]);
37544   UND 38 THEN MESON_TAC[];
37545   ]);;
37546
37547   (* }}} *)
37548
37549 (* ------------------------------------------------------------------ *)
37550 (* SECTION S *)
37551 (* ------------------------------------------------------------------ *)
37552
37553 (* 2 - connected *)
37554
37555
37556 (* -------------- MOVE TO TACTICS,  *)
37557 (* proves ineqs of the form a + (&:0)*c <= b.
37558    This handles ineqs such as a <=: a + &:(SUC n) that
37559    INT_ARITH_TAC can't do.  *)
37560
37561 let int_le_mp = prove_by_refinement(
37562   `!a b c. (a +: c = b) /\ (&:0 <=: c) ==> (a + (&:0)*c <=: b)`,
37563   (* {{{ proof *)
37564   [
37565   INT_ARITH_TAC;
37566   ]);;
37567   (* }}} *)
37568
37569 (* rewrites assumptions as 0 <= A, breaks 0 <= A + B into 2,
37570    then breaks 0 <= A*B into 2, and tries rewriting and INT_ARITH_TAC *)
37571
37572 let int_le_tac = RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM INT_SUB_LE]) THEN
37573              IMATCH_MP_TAC  int_le_mp THEN
37574              CONJ_TAC THENL [TRY INT_ARITH_TAC;ALL_TAC] THEN
37575              ASM_REWRITE_TAC[INT_POS] THEN
37576              REPEAT (IMATCH_MP_TAC  INT_LE_ADD THEN CONJ_TAC THEN
37577              ASM_REWRITE_TAC[INT_POS]) THEN
37578              REPEAT (IMATCH_MP_TAC  INT_LE_MUL THEN CONJ_TAC THEN
37579              ASM_REWRITE_TAC[INT_POS]) THEN
37580              ASM_REWRITE_TAC[INT_POS] THEN
37581              TRY INT_ARITH_TAC;;
37582
37583
37584 let clean_int_le_tac = FULL_REWRITE_TAC[INT_MUL_LZERO;INT_ADD_RID];;
37585
37586 let test_case_int_le_tac = prove_by_refinement(
37587   `!a b n. a +: &:(SUC n) <= b ==> a <= b`,
37588   (* {{{ proof *)
37589   [
37590   (* INT_ARITH_TAC fails *)
37591   REP_BASIC_TAC;
37592   TYPE_THEN `a + (&:0)*((b - (a +: &:(SUC n))) + (&:(SUC n))) <=: b` SUBAGOAL_TAC;
37593   int_le_tac;
37594   clean_int_le_tac;
37595   ]);;
37596   (* }}} *)
37597
37598
37599
37600
37601 (* -------------- *)
37602
37603 let segment_end = jordan_def `segment_end S a b <=>
37604    psegment S /\ (endpoint S = {a,b})`;;
37605
37606 let conn = jordan_def `conn E <=> (!a b.
37607    (cls E a /\ cls E b /\ ~(a = b) ==>
37608         (?S. (S SUBSET E /\ segment_end S a b))))`;;
37609
37610 let conn2 = jordan_def `conn2 E <=> (FINITE E) /\
37611    (2 <=| CARD E) /\ (!a b c. cls E a /\ cls E b /\
37612    ~(a = b) /\ ~(b = c) /\ ~(a = c) ==>
37613    (?S. (S SUBSET E /\ segment_end S a b /\ ~(cls S c))))`;;
37614
37615 let segment_end_symm = prove_by_refinement(
37616   `!S a b. (segment_end S a b = segment_end S b a)`,
37617   (* {{{ proof *)
37618   [
37619   REWRITE_TAC[segment_end];
37620   TYPE_THEN `{a,b} = {b,a}` SUBAGOAL_TAC;
37621   IMATCH_MP_TAC  EQ_EXT;
37622   REWRITE_TAC[INR in_pair];
37623   MESON_TAC[];
37624   ]);;
37625   (* }}} *)
37626
37627 let segment_end_disj = prove_by_refinement(
37628   `!S a b. segment_end S a b ==> ~(a = b)`,
37629   (* {{{ proof *)
37630   [
37631   REWRITE_TAC[segment_end];
37632   THM_INTRO_TAC[`S`] endpoint_size2;
37633   USE 3 (REWRITE_RULE[has_size2]);
37634   TYPE_THEN `endpoint S` UNABBREV_TAC;
37635   USE 1 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
37636   FULL_REWRITE_TAC[INR in_pair];
37637   COPY 1;
37638   TSPEC `a'` 4;
37639   TSPEC `b'` 1;
37640   REWR 1;
37641   REWR 4;
37642   ASM_MESON_TAC[];
37643   ]);;
37644   (* }}} *)
37645
37646 let cut_psegment = prove_by_refinement(
37647   `!E a b c. segment_end E a b /\ cls E c /\ ~(c = a) /\ ~(c = b) ==>
37648     (?A B. (E = (A UNION B)) /\ (A INTER B = EMPTY) /\
37649      (cls A INTER cls B = {c}) /\
37650      segment_end A a c /\ segment_end B c b)`,
37651   (* {{{ proof *)
37652   [
37653   REP_BASIC_TAC;
37654   TYPE_THEN `~(a = b)` SUBAGOAL_TAC;
37655   THM_INTRO_TAC[`E`;`a`;`b`] segment_end_disj;
37656   ASM_MESON_TAC[];
37657   (* - *)
37658   FULL_REWRITE_TAC[segment_end];
37659   FULL_REWRITE_TAC[cls];
37660   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
37661   FULL_REWRITE_TAC[psegment;segment];
37662   REWRITE_TAC[INR eq_sing;INTER;EQ_EMPTY  ];
37663   REWRITE_TAC[CONJ_ACI];
37664   (* - *)
37665   THM_INTRO_TAC[`E`;`a`;`b`] psegment_order;
37666   REWRITE_TAC[INR in_pair];
37667   TYPE_THEN `num_closure E (pointI c) = 2` SUBAGOAL_TAC;
37668   TYPE_THEN `{0,1,2} (num_closure E (pointI c))` SUBAGOAL_TAC;
37669   FULL_REWRITE_TAC[psegment;segment];
37670   FULL_REWRITE_TAC[INSERT;DISJ_ACI];
37671   FIRST_ASSUM DISJ_CASES_TAC;
37672   FIRST_ASSUM DISJ_CASES_TAC;
37673   USE 3 SYM;
37674   TYPE_THEN `endpoint E c` SUBAGOAL_TAC;
37675   REWRITE_TAC[endpoint];
37676   TYPE_THEN `endpoint E` UNABBREV_TAC;
37677   ASM_MESON_TAC[];
37678   THM_INTRO_TAC[`E`;`pointI c`] num_closure0;
37679   REWR 15;
37680   TSPEC `e` 15;
37681   ASM_MESON_TAC[];
37682   (* - *)
37683   TYPE_THEN `?k. (k < CARD E -| 1) /\ (c = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
37684   THM_INTRO_TAC[`E`;`pointI c`] num_closure2;
37685   REWR 13;
37686   TYPE_THEN `E a' /\ closure top2 a' (pointI c)` SUBAGOAL_TAC;
37687   TYPE_THEN `?i'.  (i' <| CARD E) /\ ( f i' = a')` SUBAGOAL_TAC;
37688   FULL_REWRITE_TAC[BIJ;SURJ];
37689   TYPE_THEN `a'` UNABBREV_TAC;
37690   TYPE_THEN `E b' /\ closure top2 b' (pointI c)` SUBAGOAL_TAC;
37691   TYPE_THEN `?j'.  (j' <| CARD E) /\ ( f j' = b')` SUBAGOAL_TAC;
37692   FULL_REWRITE_TAC[BIJ;SURJ];
37693   TYPE_THEN `b'` UNABBREV_TAC;
37694   UND 8 THEN DISCH_THEN (  THM_INTRO_TAC[`i'`;`j'`]);
37695   USE 8 SYM;
37696   TYPE_THEN `adj (f i') (f j')` SUBAGOAL_TAC;
37697   IMATCH_MP_TAC  closure_imp_adj;
37698   UNIFY_EXISTS_TAC;
37699   REWR 8;
37700   FIRST_ASSUM DISJ_CASES_TAC;
37701   TYPE_THEN  `i'` EXISTS_TAC;
37702   CONJ_TAC;
37703   UND 22 THEN UND 21 THEN ARITH_TAC;
37704   IMATCH_MP_TAC  adjv_unique;
37705   FULL_REWRITE_TAC[psegment;segment;ISUBSET];
37706   TYPE_THEN `j'` EXISTS_TAC;
37707   CONJ_TAC;
37708   UND 22 THEN UND 18 THEN ARITH_TAC;
37709   IMATCH_MP_TAC  adjv_unique;
37710   USE 20 (ONCE_REWRITE_RULE[adj_symm]);
37711   FULL_REWRITE_TAC[psegment;segment;ISUBSET];
37712   (* -A *)
37713   TYPE_THEN `c` UNABBREV_TAC;
37714   TYPE_THEN `A = IMAGE f { p | p <| SUC k}` ABBREV_TAC ;
37715   TYPE_THEN `B = IMAGE f { p | SUC k <=| p /\ p < CARD E}` ABBREV_TAC ;
37716   TYPE_THEN `A` EXISTS_TAC;
37717   TYPE_THEN `B` EXISTS_TAC;
37718   (* - now prove properties *)
37719   TYPE_THEN `psegment A` SUBAGOAL_TAC;
37720   TYPE_THEN `A` UNABBREV_TAC;
37721   IMATCH_MP_TAC  order_imp_psegment;
37722   CONJ_TAC;
37723   FULL_REWRITE_TAC[BIJ;INJ];
37724   TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
37725   FULL_REWRITE_TAC[psegment;segment;ISUBSET];
37726   CONJ_TAC;
37727   FIRST_ASSUM IMATCH_MP_TAC ;
37728   FIRST_ASSUM IMATCH_MP_TAC ;
37729   UND 18 THEN UND 14 THEN ARITH_TAC;
37730   FIRST_ASSUM IMATCH_MP_TAC ;
37731   UND 19 THEN UND 20 THEN UND 14 THEN ARITH_TAC;
37732   CONJ_TAC;
37733   ARITH_TAC;
37734   FIRST_ASSUM IMATCH_MP_TAC ;
37735   UND 13 THEN UND 16 THEN UND 14 THEN ARITH_TAC;
37736   (* - *)
37737   TYPE_THEN `psegment B` SUBAGOAL_TAC;
37738   TYPE_THEN `B` UNABBREV_TAC;
37739   IMATCH_MP_TAC  order_imp_psegment_shift;
37740   CONJ_TAC;
37741   FULL_REWRITE_TAC[BIJ;INJ];
37742   TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
37743   FULL_REWRITE_TAC[psegment;segment;ISUBSET];
37744   CONJ_TAC;
37745   FIRST_ASSUM IMATCH_MP_TAC ;
37746   FIRST_ASSUM IMATCH_MP_TAC ;
37747   CONJ_TAC;
37748   UND 14 THEN ARITH_TAC;
37749   FIRST_ASSUM IMATCH_MP_TAC ;
37750   (* - *)
37751   SUBCONJ_TAC;
37752   TYPE_THEN `A` UNABBREV_TAC;
37753   TYPE_THEN `B` UNABBREV_TAC;
37754   FULL_REWRITE_TAC[IMAGE];
37755   TYPE_THEN`x` UNABBREV_TAC;
37756   TYPE_THEN `x' = x''` SUBAGOAL_TAC;
37757   FULL_REWRITE_TAC[BIJ;INJ];
37758   FIRST_ASSUM IMATCH_MP_TAC ;
37759   UND 15 THEN UND 14 THEN ARITH_TAC;
37760   TYPE_THEN `x''` UNABBREV_TAC;
37761   UND 15 THEN UND 20 THEN ARITH_TAC;
37762   (* -B *)
37763   TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
37764   FULL_REWRITE_TAC[psegment;segment;ISUBSET];
37765   (* - *)
37766   TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC;
37767   CONJ_TAC;
37768   FIRST_ASSUM IMATCH_MP_TAC ;
37769   FULL_REWRITE_TAC[BIJ;SURJ];
37770   FIRST_ASSUM IMATCH_MP_TAC ;
37771   UND 14 THEN ARITH_TAC;
37772   CONJ_TAC;
37773   FIRST_ASSUM IMATCH_MP_TAC ;
37774   FULL_REWRITE_TAC[BIJ;SURJ];
37775   FIRST_ASSUM IMATCH_MP_TAC ;
37776   UND 14 THEN ARITH_TAC;
37777   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]);
37778   UND 14 THEN ARITH_TAC;
37779   (* - *)
37780   TYPE_THEN `(?e. A e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC;
37781   TYPE_THEN `f k` EXISTS_TAC;
37782   TYPE_THEN `A` UNABBREV_TAC;
37783   CONJ_TAC;
37784   REWRITE_TAC[IMAGE];
37785   TYPE_THEN `k` EXISTS_TAC;
37786   ARITH_TAC;
37787   IMATCH_MP_TAC  adjv_adj;
37788   (* - *)
37789   TYPE_THEN `(?e. B e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC;
37790   TYPE_THEN `f (SUC k)` EXISTS_TAC;
37791   TYPE_THEN `B` UNABBREV_TAC;
37792   CONJ_TAC;
37793   REWRITE_TAC[IMAGE];
37794   TYPE_THEN `SUC k` EXISTS_TAC;
37795   UND 14 THEN ARITH_TAC;
37796   IMATCH_MP_TAC  adjv_adj2;
37797   (* - *)
37798   TYPE_THEN `IMAGE f {p | p <| CARD E} = E` SUBAGOAL_TAC;
37799   IMATCH_MP_TAC bij_imp_image;
37800   (* - *)
37801   TYPE_THEN `A UNION B = E` SUBAGOAL_TAC;
37802   TYPE_THEN `A` UNABBREV_TAC;
37803   TYPE_THEN `B` UNABBREV_TAC;
37804   REWRITE_TAC[GSYM IMAGE_UNION];
37805   TYPE_THEN `cE = CARD E` ABBREV_TAC ;
37806   UND 27 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t])) THEN AP_TERM_TAC;
37807   IMATCH_MP_TAC  EQ_EXT;
37808   REWRITE_TAC[UNION];
37809   UND 14 THEN ARITH_TAC;
37810   (* -C *)
37811   TYPE_THEN `FINITE A` SUBAGOAL_TAC;
37812   IMATCH_MP_TAC  FINITE_SUBSET;
37813   TYPE_THEN `E` EXISTS_TAC;
37814   USE 28 SYM;
37815   REWRITE_TAC[SUBSET;UNION];
37816   TYPE_THEN `FINITE B` SUBAGOAL_TAC;
37817   IMATCH_MP_TAC  FINITE_SUBSET;
37818   TYPE_THEN `E` EXISTS_TAC;
37819   USE 28 SYM;
37820   REWRITE_TAC[SUBSET;UNION];
37821   (* - *)
37822   TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC;
37823   USE 28 SYM;
37824   IMATCH_MP_TAC  EQ_EXT;
37825   REWRITE_TAC[UNION;DIFF];
37826   UND 18 THEN MESON_TAC[];
37827   (* - *)
37828   TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC;
37829   USE 28 SYM;
37830   IMATCH_MP_TAC  EQ_EXT;
37831   REWRITE_TAC[UNION;DIFF];
37832   UND 18 THEN MESON_TAC[];
37833   (* - *)
37834   TYPE_THEN `endpoint A (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
37835   IMATCH_MP_TAC  psegment_subset_endpoint;
37836   UNIFY_EXISTS_TAC;
37837   USE 28 (SYM);
37838   CONJ_TAC;
37839   REWRITE_TAC[SUBSET;UNION];
37840   REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`];
37841   CONJ_TAC;
37842   THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
37843   REWR 34;
37844   ASM_MESON_TAC[];
37845   THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
37846   REWR 34;
37847   ASM_MESON_TAC[];
37848   (* - *)
37849   TYPE_THEN `endpoint B (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
37850   IMATCH_MP_TAC  psegment_subset_endpoint;
37851   UNIFY_EXISTS_TAC;
37852   USE 28 (SYM);
37853   CONJ_TAC;
37854   REWRITE_TAC[SUBSET;UNION];
37855   REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`];
37856   CONJ_TAC;
37857   THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
37858   REWR 35;
37859   ASM_MESON_TAC[];
37860   THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
37861   REWR 35;
37862   ASM_MESON_TAC[];
37863   (* -D *)
37864   TYPE_THEN `endpoint A a` SUBAGOAL_TAC;
37865   REWRITE_TAC[endpoint];
37866   TYPE_THEN `endpoint E a` SUBAGOAL_TAC;
37867   REWRITE_TAC[INR in_pair];
37868   THM_INTRO_TAC[`A`;`E`;`pointI a`] num_closure_mono;
37869   USE 28 SYM;
37870   REWRITE_TAC[SUBSET;UNION];
37871   USE 35 (REWRITE_RULE[endpoint]);
37872   REWR 36;
37873   USE 36 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]);
37874   FIRST_ASSUM DISJ_CASES_TAC;
37875   THM_INTRO_TAC[`A`;`pointI a`] num_closure0;
37876   REWR 38;
37877   TSPEC `f 0` 38 ;
37878   USE 10 SYM;
37879   UND 38 THEN DISCH_THEN (THM_INTRO_TAC[]);
37880   TYPE_THEN`A` UNABBREV_TAC;
37881   REWRITE_TAC[IMAGE];
37882   TYPE_THEN `0` EXISTS_TAC;
37883   ARITH_TAC;
37884   THM_INTRO_TAC[`E`;`a`] terminal_endpoint;
37885   REWRITE_TAC[INR in_pair];
37886   UND 39 THEN ASM_REWRITE_TAC[];
37887   (* -E *)
37888   TYPE_THEN `endpoint B b` SUBAGOAL_TAC;
37889   REWRITE_TAC[endpoint];
37890   TYPE_THEN `endpoint E b` SUBAGOAL_TAC;
37891   REWRITE_TAC[INR in_pair];
37892   THM_INTRO_TAC[`B`;`E`;`pointI b`] num_closure_mono;
37893   USE 28 SYM;
37894   REWRITE_TAC[SUBSET;UNION];
37895   USE 36 (REWRITE_RULE[endpoint]);
37896   REWR 37;
37897   USE 37 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]);
37898   FIRST_ASSUM DISJ_CASES_TAC;
37899   THM_INTRO_TAC[`B`;`pointI b`] num_closure0;
37900   REWR 39;
37901   TSPEC `f (CARD E -| 1)` 39 ;
37902   UND 39 THEN DISCH_THEN (THM_INTRO_TAC[]);
37903   TYPE_THEN`B` UNABBREV_TAC;
37904   REWRITE_TAC[IMAGE];
37905   TYPE_THEN `CARD E -| 1` EXISTS_TAC;
37906   UND 14 THEN ARITH_TAC;
37907   THM_INTRO_TAC[`E`;`b`] terminal_endpoint;
37908   REWRITE_TAC[INR in_pair];
37909   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
37910   UND 14 THEN ARITH_TAC;
37911   UND 39 THEN ASM_REWRITE_TAC[];
37912   (* - *)
37913   TYPE_THEN `endpoint A = {a, (adjv (f k) (f (SUC k)))}` SUBAGOAL_TAC;
37914   IMATCH_MP_TAC  has_size2_pair;
37915   IMATCH_MP_TAC  endpoint_size2;
37916   TYPE_THEN `endpoint B = {(adjv (f k) (f (SUC k))), b}` SUBAGOAL_TAC;
37917   IMATCH_MP_TAC  has_size2_pair;
37918   IMATCH_MP_TAC  endpoint_size2;
37919   (* - *)
37920   CONJ_TAC;
37921   USE 37 SYM;
37922   TYPE_THEN `endpoint A u` SUBAGOAL_TAC;
37923   IMATCH_MP_TAC  psegment_subset_endpoint;
37924   UNIFY_EXISTS_TAC;
37925   CONJ_TAC;
37926   USE 28 SYM;
37927   REWRITE_TAC[SUBSET;UNION];
37928   CONJ_TAC;
37929   IMATCH_MP_TAC  num_closure_pos;
37930   UNIFY_EXISTS_TAC;
37931   IMATCH_MP_TAC  num_closure_pos;
37932   TYPE_THEN `e''''` EXISTS_TAC ;
37933   USE 38 SYM;
37934   TYPE_THEN `endpoint B u` SUBAGOAL_TAC;
37935   IMATCH_MP_TAC  psegment_subset_endpoint;
37936   UNIFY_EXISTS_TAC;
37937   CONJ_TAC;
37938   USE 28 SYM;
37939   REWRITE_TAC[SUBSET;UNION];
37940   CONJ_TAC;
37941   IMATCH_MP_TAC  num_closure_pos;
37942   TYPE_THEN `e''''` EXISTS_TAC ;
37943   IMATCH_MP_TAC  num_closure_pos;
37944   TYPE_THEN `e'''` EXISTS_TAC ;
37945   TYPE_THEN `endpoint A` UNABBREV_TAC;
37946   TYPE_THEN `endpoint B` UNABBREV_TAC;
37947   FULL_REWRITE_TAC[INR in_pair];
37948   FIRST_ASSUM DISJ_CASES_TAC;
37949   TYPE_THEN `u` UNABBREV_TAC;
37950   ASM_MESON_TAC[];
37951   (* - *)
37952   CONJ_TAC;
37953   TYPE_THEN `e'` EXISTS_TAC;
37954   TYPE_THEN `e''` EXISTS_TAC;
37955   ]);;
37956   (* }}} *)
37957
37958 let segment_end_inj = prove_by_refinement(
37959   `!S a b c. (segment_end S a b /\ segment_end S a c) ==> (b = c)`,
37960   (* {{{ proof *)
37961   [
37962   REP_BASIC_TAC;
37963   THM_INTRO_TAC[`S`;`a`;`b`] segment_end_disj;
37964   THM_INTRO_TAC[`S`;`a`;`c`] segment_end_disj;
37965   FULL_REWRITE_TAC[segment_end];
37966   TYPE_THEN `endpoint S` UNABBREV_TAC;
37967   USE 0 (ONCE_REWRITE_RULE  [FUN_EQ_THM]);
37968   TSPEC `b` 0;
37969   FULL_REWRITE_TAC[INR in_pair];
37970   ASM_MESON_TAC[];
37971   ]);;
37972   (* }}} *)
37973
37974 let segment_end_finite = prove_by_refinement(
37975   `!S a b. segment_end S a b ==> FINITE S`,
37976   (* {{{ proof *)
37977   [
37978   REWRITE_TAC[segment_end;psegment;segment];
37979   ]);;
37980   (* }}} *)
37981
37982 let segment_superset_endpoint = prove_by_refinement(
37983   `!E S k. segment E /\ S SUBSET E /\ (endpoint S k) /\
37984      (num_closure (E DIFF S) (pointI k) = 0) ==>
37985      (endpoint E k) `,
37986   (* {{{ proof *)
37987   [
37988   REWRITE_TAC[endpoint];
37989   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
37990   FULL_REWRITE_TAC[segment];
37991   ASM_SIMP_TAC[num_closure1];
37992   TYPE_THEN `FINITE S` SUBAGOAL_TAC;
37993   IMATCH_MP_TAC  FINITE_SUBSET;
37994   UNIFY_EXISTS_TAC;
37995   THM_INTRO_TAC[`S`;`pointI k`] num_closure1;
37996   REWR 6;
37997   TYPE_THEN `e` EXISTS_TAC;
37998   TYPE_THEN `S e /\ closure top2 e (pointI k)` SUBAGOAL_TAC;
37999   TYPE_THEN `S e'` ASM_CASES_TAC;
38000   FULL_REWRITE_TAC[ISUBSET];
38001   ASM_MESON_TAC[];
38002   THM_INTRO_TAC[`S`;`pointI k`] num_closure0;
38003   REWR 10;
38004   FULL_REWRITE_TAC[ARITH_RULE `~(1=0)`];
38005   TYPE_THEN `~(e = e')` SUBAGOAL_TAC;
38006   ASM_MESON_TAC[];
38007   REWRITE_TAC[];
38008   USE 0 (REWRITE_RULE[ARITH_RULE `(x = 0) <=> ~(0 <| x)`]);
38009   UND 0 THEN REWRITE_TAC[];
38010   IMATCH_MP_TAC  num_closure_pos;
38011   CONJ_TAC;
38012   IMATCH_MP_TAC  FINITE_SUBSET;
38013   TYPE_THEN `E` EXISTS_TAC;
38014   REWRITE_TAC[DIFF;SUBSET];
38015   TYPE_THEN `e'` EXISTS_TAC;
38016   REWRITE_TAC[DIFF];
38017   ]);;
38018   (* }}} *)
38019
38020 let segment_end_union_lemma = prove_by_refinement(
38021   `!A B a b c. segment_end A a b /\ segment_end B b c /\
38022      (A INTER B = EMPTY) /\ (cls A INTER cls B = {b}) ==>
38023     segment_end (A UNION B) a c `,
38024   (* {{{ proof *)
38025
38026   [
38027   REP_BASIC_TAC;
38028   THM_INTRO_TAC[`A`;`a`;`b`] segment_end_disj;
38029   THM_INTRO_TAC[`B`;`b`;`c`] segment_end_disj;
38030   FULL_REWRITE_TAC[cls;segment_end];
38031   TYPE_THEN `segment (A UNION B) /\ (endpoint (A UNION B) = {a,c})  ==> psegment (A UNION B) /\ (endpoint (A UNION B) = {a, c})` SUBAGOAL_TAC;
38032   IMATCH_MP_TAC  endpoint_psegment;
38033   TYPE_THEN `a` EXISTS_TAC;
38034   REWRITE_TAC[INR in_pair];
38035   FIRST_ASSUM IMATCH_MP_TAC ;
38036   (* - *)
38037   SUBCONJ_TAC;
38038   IMATCH_MP_TAC  segment_union;
38039   TYPE_THEN `b` EXISTS_TAC;
38040   REWRITE_TAC[INR in_pair];
38041   CONJ_TAC;
38042   FULL_REWRITE_TAC[psegment];
38043   CONJ_TAC;
38044   FULL_REWRITE_TAC[psegment];
38045   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
38046   FULL_REWRITE_TAC[INR IN_SING;INTER;];
38047   TSPEC `n` 0;
38048   ASM_MESON_TAC[num_closure_elt];
38049   (* - *)
38050   TYPE_THEN `FINITE A` SUBAGOAL_TAC;
38051   FULL_REWRITE_TAC[psegment;segment];
38052   TYPE_THEN `FINITE B` SUBAGOAL_TAC;
38053   FULL_REWRITE_TAC[psegment;segment];
38054   TYPE_THEN `FINITE (A UNION B)` SUBAGOAL_TAC;
38055   REWRITE_TAC[FINITE_UNION];
38056   (* -A *)
38057   TYPE_THEN `endpoint (A UNION B) a` SUBAGOAL_TAC;
38058   IMATCH_MP_TAC  segment_superset_endpoint;
38059   TYPE_THEN `A` EXISTS_TAC;
38060   CONJ_TAC;
38061   REWRITE_TAC[SUBSET;UNION ];
38062   REWRITE_TAC[INR in_pair];
38063   TYPE_THEN `(A UNION B) DIFF A = B` SUBAGOAL_TAC;
38064   UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
38065   ASM_SIMP_TAC[num_closure0];
38066   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
38067   USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
38068   TSPEC `a` 0;
38069   TYPE_THEN `(?e. A e /\ closure top2 e (pointI a))` SUBAGOAL_TAC;
38070   TYPE_THEN `terminal_edge A a` EXISTS_TAC;
38071   TYPE_THEN `endpoint A a` SUBAGOAL_TAC;
38072   REWRITE_TAC[INR in_pair];
38073   IMATCH_MP_TAC  terminal_endpoint;
38074   ASM_MESON_TAC[];
38075   TYPE_THEN `psegment (A UNION B)` SUBAGOAL_TAC;
38076   ASM_MESON_TAC[endpoint_psegment];
38077   IMATCH_MP_TAC  has_size2_pair;
38078   (* - *)
38079   TYPE_THEN `endpoint (A UNION B) c` SUBAGOAL_TAC;
38080   IMATCH_MP_TAC  segment_superset_endpoint;
38081   TYPE_THEN `B` EXISTS_TAC;
38082   CONJ_TAC;
38083   REWRITE_TAC[SUBSET;UNION ];
38084   REWRITE_TAC[INR in_pair];
38085   TYPE_THEN `(A UNION B) DIFF B = A` SUBAGOAL_TAC;
38086   UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
38087   ASM_SIMP_TAC[num_closure0];
38088   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
38089   USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
38090   TSPEC `c` 0;
38091   TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
38092   TYPE_THEN `terminal_edge B c` EXISTS_TAC;
38093   TYPE_THEN `endpoint B c` SUBAGOAL_TAC;
38094   REWRITE_TAC[INR in_pair];
38095   IMATCH_MP_TAC  terminal_endpoint;
38096   ASM_MESON_TAC[];
38097   (* - *)
38098   CONJ_TAC;
38099   IMATCH_MP_TAC  endpoint_size2;
38100   (* - *)
38101   TYPE_THEN`a` UNABBREV_TAC;
38102   TYPE_THEN `endpoint B c /\ endpoint A c` SUBAGOAL_TAC;
38103   REWRITE_TAC[INR in_pair];
38104   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
38105   USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
38106   TSPEC `c` 0;
38107   TYPE_THEN `(?e. A e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
38108   TYPE_THEN `terminal_edge A c` EXISTS_TAC;
38109   IMATCH_MP_TAC  terminal_endpoint;
38110   TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
38111   TYPE_THEN `terminal_edge B c` EXISTS_TAC;
38112   IMATCH_MP_TAC  terminal_endpoint;
38113   ASM_MESON_TAC[];
38114   ]);;
38115
38116   (* }}} *)
38117
38118 let cls_subset = prove_by_refinement(
38119   `!A B. A SUBSET B ==> cls A SUBSET cls B`,
38120   (* {{{ proof *)
38121   [
38122   REWRITE_TAC[cls];
38123   REWRITE_TAC[SUBSET];
38124   TYPE_THEN `e` EXISTS_TAC;
38125   ASM_MESON_TAC[ISUBSET];
38126   ]);;
38127   (* }}} *)
38128
38129 let segment_end_union = prove_by_refinement(
38130   `!A B a b c. segment_end A a b /\ segment_end B b c /\
38131      (cls A INTER cls B = {b}) ==>
38132     segment_end (A UNION B) a c`,
38133   (* {{{ proof *)
38134   [
38135   REP_BASIC_TAC;
38136   IMATCH_MP_TAC  segment_end_union_lemma;
38137   TYPE_THEN `b` EXISTS_TAC;
38138   PROOF_BY_CONTR_TAC;
38139   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER ];
38140   TYPE_THEN `edge u` SUBAGOAL_TAC;
38141   FULL_REWRITE_TAC[segment_end;psegment;segment;ISUBSET];
38142   TYPE_THEN `(cls {u} ) HAS_SIZE 2` SUBAGOAL_TAC;
38143   REWRITE_TAC[cls_edge];
38144   IMATCH_MP_TAC  two_endpoint;
38145   FULL_REWRITE_TAC[has_size2];
38146   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
38147   USE 0 (REWRITE_RULE[INR IN_SING ]);
38148   COPY 0;
38149   TSPEC  `a'` 8;
38150   TSPEC `b'` 0;
38151   TYPE_THEN `cls {u} a' /\ cls {u} b'` SUBAGOAL_TAC;
38152   REWRITE_TAC[INR in_pair];
38153   KILL 7;
38154   TYPE_THEN `cls {u} SUBSET cls A` SUBAGOAL_TAC;
38155   IMATCH_MP_TAC  cls_subset;
38156   REWRITE_TAC[SUBSET;INR IN_SING];
38157   TYPE_THEN `cls {u} SUBSET cls B` SUBAGOAL_TAC;
38158   IMATCH_MP_TAC  cls_subset;
38159   REWRITE_TAC[SUBSET;INR IN_SING];
38160   FULL_REWRITE_TAC[ISUBSET];
38161   ASM_MESON_TAC[];
38162   ]);;
38163
38164   (* }}} *)
38165
38166 let segment_end_cls = prove_by_refinement(
38167   `!A a b. segment_end A a b ==> cls A a`,
38168   (* {{{ proof *)
38169   [
38170   REWRITE_TAC[cls;segment_end];
38171   TYPE_THEN `terminal_edge A a` EXISTS_TAC;
38172   IMATCH_MP_TAC  terminal_endpoint;
38173   FULL_REWRITE_TAC[INR in_pair;psegment;segment];
38174   ]);;
38175   (* }}} *)
38176
38177 let segment_end_cls2 = prove_by_refinement(
38178   `!A a b. segment_end A a b ==> cls A b`,
38179   (* {{{ proof *)
38180   [
38181   REWRITE_TAC[cls;segment_end];
38182   TYPE_THEN `terminal_edge A b` EXISTS_TAC;
38183   IMATCH_MP_TAC  terminal_endpoint;
38184   FULL_REWRITE_TAC[INR in_pair;psegment;segment];
38185   ]);;
38186   (* }}} *)
38187
38188 let card_subset_lt = prove_by_refinement(
38189   `!(a:A->bool) b. a SUBSET b /\ ~(a = b) /\ FINITE b ==>
38190           (CARD a < CARD b)`,
38191   (* {{{ proof *)
38192   [
38193   REP_BASIC_TAC;
38194   IMATCH_MP_TAC  (ARITH_RULE (`x <=| y /\ ~( x = y) ==> (x < y)`));
38195   CONJ_TAC;
38196   IMATCH_MP_TAC  CARD_SUBSET;
38197   UND 1 THEN REWRITE_TAC[];
38198   IMATCH_MP_TAC  CARD_SUBSET_EQ;
38199   ]);;
38200   (* }}} *)
38201
38202 let segment_end_trans = prove_by_refinement(
38203   `!R S a b c. segment_end R a b /\ segment_end S b c /\ ~(a = c) ==>
38204      (?U. segment_end U a c /\ (U SUBSET (R UNION S)))`,
38205   (* {{{ proof *)
38206   [
38207   REP_BASIC_TAC;
38208   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 ;
38209   TYPE_THEN `~(SS = EMPTY)` SUBAGOAL_TAC;
38210   UND 4 THEN REWRITE_TAC[EMPTY_EXISTS];
38211   TYPE_THEN `(R,S,b)` EXISTS_TAC;
38212   TYPE_THEN `SS` UNABBREV_TAC;
38213   REWRITE_TAC[PAIR_SPLIT];
38214   CONV_TAC (dropq_conv "U");
38215   CONV_TAC (dropq_conv "V");
38216   TYPE_THEN `b` EXISTS_TAC;
38217   REWRITE_TAC[SUBSET;UNION];
38218   (* - *)
38219   TYPE_THEN `FINITE R` SUBAGOAL_TAC;
38220   IMATCH_MP_TAC  segment_end_finite;
38221   UNIFY_EXISTS_TAC;
38222   TYPE_THEN `FINITE S` SUBAGOAL_TAC;
38223   IMATCH_MP_TAC  segment_end_finite;
38224   UNIFY_EXISTS_TAC;
38225   TYPE_THEN `FINITE (R UNION S)` SUBAGOAL_TAC;
38226   ASM_REWRITE_TAC[FINITE_UNION];
38227   (* - *)
38228   TYPE_THEN `f = (\ ((U,V,b):((((num->real)->bool)->bool)#((((num->real)->bool)->bool)#(int#int))) ). (CARD U) + (CARD V))` ABBREV_TAC ;
38229   THM_INTRO_TAC[`SS`;`f`] select_image_num_min;
38230   ASM_MESON_TAC[];
38231   (* - *)
38232   TYPE_THEN `?Um Vm bm. z = (Um,Vm,bm)` SUBAGOAL_TAC ;
38233   REWRITE_TAC[PAIR_SPLIT];
38234   MESON_TAC[];
38235   TYPE_THEN `z` UNABBREV_TAC;
38236   TYPE_THEN `!U' V' b''. (SS (U',V',b'') ==> f (Um,Vm,bm) <=| f (U',V',b''))` SUBAGOAL_TAC;
38237   KILL 9;
38238   TYPE_THEN `SS` UNABBREV_TAC;
38239   KILL 4;
38240   (* - *)
38241   USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
38242   REWR 4;
38243   TYPE_THEN `U` UNABBREV_TAC;
38244   USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
38245   REWR 4;
38246   TYPE_THEN `V` UNABBREV_TAC;
38247   TYPE_THEN `b'` UNABBREV_TAC;
38248   (* - *)
38249   TYPE_THEN `! U V b'. f (U,V,b') = CARD U +| CARD V` SUBAGOAL_TAC;
38250   USE 8 SYM;
38251   GBETA_TAC;
38252   KILL 8;
38253   REWR 11;
38254   KILL 3;
38255   USE 4 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
38256   REWR 3;
38257   USE 3 (CONV_RULE (dropq_conv "U"));
38258   USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
38259   REWR 3;
38260   USE 3 (CONV_RULE (dropq_conv "V"));
38261   USE 3 (CONV_RULE (dropq_conv "b''"));
38262   (* - *)
38263   TYPE_THEN `FINITE Vm` SUBAGOAL_TAC;
38264   IMATCH_MP_TAC  FINITE_SUBSET;
38265   UNIFY_EXISTS_TAC;
38266   TYPE_THEN `FINITE Um` SUBAGOAL_TAC;
38267   IMATCH_MP_TAC  FINITE_SUBSET;
38268   UNIFY_EXISTS_TAC;
38269   (* -A *)
38270   THM_INTRO_TAC[`S`;`b`;`c`] segment_end_disj;
38271   THM_INTRO_TAC[`R`;`a`;`b`] segment_end_disj;
38272   TYPE_THEN `cls Vm a` ASM_CASES_TAC;
38273   THM_INTRO_TAC[`Vm`;`bm`;`c`;`a`] cut_psegment;
38274   THM_INTRO_TAC[`Um`;`a`;`bm`] segment_end_disj;
38275   TYPE_THEN `B` EXISTS_TAC;
38276   IMATCH_MP_TAC  SUBSET_TRANS;
38277   TYPE_THEN `Vm` EXISTS_TAC;
38278   REWRITE_TAC[SUBSET;UNION];
38279   TYPE_THEN `cls Um c` ASM_CASES_TAC;
38280   THM_INTRO_TAC[`Um`;`a`;`bm`;`c`] cut_psegment;
38281   THM_INTRO_TAC[`Vm`;`bm`;`c`] segment_end_disj;
38282   TYPE_THEN `A` EXISTS_TAC;
38283   IMATCH_MP_TAC  SUBSET_TRANS;
38284   TYPE_THEN `Um` EXISTS_TAC;
38285   REWRITE_TAC[SUBSET;UNION];
38286   (* - *)
38287   TYPE_THEN `Um UNION Vm` EXISTS_TAC;
38288   IMATCH_MP_TAC  (TAUT ` a /\ b ==> b /\ a`);
38289   SUBCONJ_TAC;
38290   REWRITE_TAC[union_subset];
38291   (* - *)
38292   IMATCH_MP_TAC  segment_end_union;
38293   TYPE_THEN `bm` EXISTS_TAC;
38294   REWRITE_TAC[INTER;eq_sing];
38295   TYPE_THEN `cls Um bm /\ cls Vm bm` SUBAGOAL_TAC;
38296   ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
38297   REP_BASIC_TAC;
38298   PROOF_BY_CONTR_TAC;
38299   (* -B *)
38300   TYPE_THEN `~(u = a)` SUBAGOAL_TAC;
38301   ASM_MESON_TAC[];
38302   TYPE_THEN `~(u = c)` SUBAGOAL_TAC;
38303   ASM_MESON_TAC[];
38304   THM_INTRO_TAC[`Vm`;`bm`;`c`;`u`] cut_psegment;
38305   THM_INTRO_TAC[`Um`;`a`;`bm`;`u`] cut_psegment;
38306   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`A'`;`B`;`u`]);
38307   CONJ_TAC;
38308   IMATCH_MP_TAC  SUBSET_TRANS;
38309   TYPE_THEN `Um` EXISTS_TAC;
38310   REWRITE_TAC[SUBSET;UNION];
38311   IMATCH_MP_TAC  SUBSET_TRANS;
38312   TYPE_THEN `Vm` EXISTS_TAC;
38313   REWRITE_TAC[SUBSET;UNION];
38314   (* - *)
38315   TYPE_THEN `FINITE A'` SUBAGOAL_TAC;
38316   IMATCH_MP_TAC  FINITE_SUBSET;
38317   TYPE_THEN `Um` EXISTS_TAC;
38318   REWRITE_TAC[SUBSET;UNION];
38319   TYPE_THEN `FINITE B` SUBAGOAL_TAC;
38320   IMATCH_MP_TAC  FINITE_SUBSET;
38321   TYPE_THEN `Vm` EXISTS_TAC;
38322   REWRITE_TAC[SUBSET;UNION];
38323   (* -C *)
38324   USE 34 SYM;
38325   TYPE_THEN `CARD A' < CARD Um` SUBAGOAL_TAC;
38326   IMATCH_MP_TAC  card_subset_lt;
38327   USE 34 SYM;
38328   CONJ_TAC;
38329   REWRITE_TAC[SUBSET;UNION];
38330   TYPE_THEN `B' = EMPTY` SUBAGOAL_TAC;
38331   FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY];
38332   USE 37(ONCE_REWRITE_RULE[FUN_EQ_THM]);
38333   TSPEC `x` 37;
38334   FULL_REWRITE_TAC[];
38335   ASM_MESON_TAC[];
38336   TYPE_THEN`B'` UNABBREV_TAC;
38337   FULL_REWRITE_TAC[segment_end;segment;psegment];
38338   (* - *)
38339   USE 29 SYM;
38340   TYPE_THEN `CARD B < CARD Vm` SUBAGOAL_TAC;
38341   IMATCH_MP_TAC  card_subset_lt;
38342   USE 29 SYM;
38343   CONJ_TAC;
38344   REWRITE_TAC[SUBSET;UNION];
38345   TYPE_THEN `A = EMPTY` SUBAGOAL_TAC;
38346   FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY];
38347   USE 38(ONCE_REWRITE_RULE[FUN_EQ_THM]);
38348   TSPEC `x` 38;
38349   FULL_REWRITE_TAC[];
38350   ASM_MESON_TAC[];
38351   TYPE_THEN`A` UNABBREV_TAC;
38352   FULL_REWRITE_TAC[segment_end;segment;psegment];
38353   (* - *)
38354   UND 38 THEN UND 37 THEN UND 3 THEN ARITH_TAC;
38355   ]);;
38356   (* }}} *)
38357
38358 let cls_union = prove_by_refinement(
38359   `!A B. cls(A UNION B) = cls A UNION cls B`,
38360   (* {{{ proof *)
38361   [
38362   REWRITE_TAC[cls;UNION ];
38363   IMATCH_MP_TAC  EQ_EXT;
38364   MESON_TAC[];
38365   ]);;
38366   (* }}} *)
38367
38368 let conn_union = prove_by_refinement(
38369   `!E E'. conn E /\ conn E' /\ ~(cls E INTER cls E' = EMPTY) ==>
38370     conn (E UNION E')`,
38371   (* {{{ proof *)
38372   [
38373   REP_BASIC_TAC;
38374   REWRITE_TAC[conn;cls_union];
38375   RULE_ASSUM_TAC (REWRITE_RULE[UNION]);
38376   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
38377   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;
38378   FULL_REWRITE_TAC[conn];
38379   UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`u'`]);
38380   ASM_MESON_TAC [];
38381   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`u'`;`b'`]);
38382   ASM_MESON_TAC[];
38383   THM_INTRO_TAC[`S`;`S'`;`a'`;`u'`;`b'`] segment_end_trans;
38384   TYPE_THEN `U` EXISTS_TAC;
38385   IMATCH_MP_TAC  SUBSET_TRANS;
38386   TYPE_THEN `S UNION S'` EXISTS_TAC;
38387   IMATCH_MP_TAC  subset_union_pair;
38388   (* - *)
38389   TYPE_THEN `cls E a /\ cls E b` ASM_CASES_TAC;
38390   USE 2 (REWRITE_RULE[conn]);
38391   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
38392   TYPE_THEN `S` EXISTS_TAC;
38393   UND 10 THEN REWRITE_TAC[SUBSET;UNION];
38394   (* - *)
38395   TYPE_THEN `cls E' a /\ cls E' b` ASM_CASES_TAC;
38396   USE 1 (REWRITE_RULE[conn]);
38397   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
38398   TYPE_THEN `S` EXISTS_TAC;
38399   UND 11 THEN REWRITE_TAC[SUBSET;UNION];
38400   (* - *)
38401   TYPE_THEN `cls E a /\ cls E' b` ASM_CASES_TAC;
38402   REWR 9;
38403   REWR 8;
38404   UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E`;`E'`;`a`;`b`;`u`]);
38405   (* - *)
38406   TYPE_THEN `cls E' a /\ cls E b` ASM_CASES_TAC;
38407   REWR 9;
38408   REWR 8;
38409   UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`E`;`a`;`b`;`u`]);
38410   TYPE_THEN `S` EXISTS_TAC;
38411   UND 13 THEN REWRITE_TAC[SUBSET;UNION];
38412   ASM_MESON_TAC[];
38413   ASM_MESON_TAC[];
38414   ]);;
38415   (* }}} *)
38416
38417 let cls_empty = prove_by_refinement(
38418   `cls EMPTY  = EMPTY `,
38419   (* {{{ proof *)
38420   [
38421   IMATCH_MP_TAC  EQ_EXT;
38422   REWRITE_TAC[cls];
38423   ]);;
38424   (* }}} *)
38425
38426 let finite_cls = prove_by_refinement(
38427   `!E. FINITE E  ==> (E SUBSET edge ==> FINITE (cls E))`,
38428   (* {{{ proof *)
38429   [
38430   IMATCH_MP_TAC  FINITE_INDUCT_STRONG;
38431   REWRITE_TAC[cls_empty;FINITE_RULES ];
38432   IMATCH_MP_TAC  FINITE_SUBSET;
38433   TYPE_THEN `cls (E UNION {x})` EXISTS_TAC;
38434   CONJ_TAC;
38435   REWRITE_TAC[cls_union;FINITE_UNION;];
38436   (* -- *)
38437   TYPE_THEN `edge x /\ E SUBSET edge` SUBAGOAL_TAC;
38438   FULL_REWRITE_TAC[INSERT;SUBSET];
38439   ASM_MESON_TAC[];
38440   REWRITE_TAC[cls_edge];
38441   USE 5 (MATCH_MP two_endpoint);
38442   FULL_REWRITE_TAC[HAS_SIZE];
38443   (* - *)
38444   IMATCH_MP_TAC  cls_subset;
38445   REWRITE_TAC[INSERT;SUBSET;INR IN_SING;UNION ];
38446   ]);;
38447   (* }}} *)
38448
38449 let infinite_int = prove_by_refinement(
38450   `INFINITE (UNIV:int->bool)`,
38451   (* {{{ proof *)
38452   [
38453   IMATCH_MP_TAC  infinite_subset;
38454   TYPE_THEN `IMAGE (&:) UNIV` EXISTS_TAC;
38455   THM_INTRO_TAC[`(&:)`] INFINITE_IMAGE_INJ;
38456   ASM_MESON_TAC[INT_OF_NUM_EQ];
38457   TSPEC  `UNIV:num->bool` 0;
38458   FIRST_ASSUM IMATCH_MP_TAC ;
38459   REWRITE_TAC[num_INFINITE];
38460   ]);;
38461   (* }}} *)
38462
38463 let infinite_intpair = prove_by_refinement(
38464   `INFINITE (UNIV:int#int->bool)`,
38465   (* {{{ proof *)
38466   [
38467   IMATCH_MP_TAC  infinite_subset;
38468   TYPE_THEN `IMAGE (\ (i:int) . (i,&:0)) UNIV` EXISTS_TAC;
38469   THM_INTRO_TAC[`(\ (i:int) . (i,&:0))`] INFINITE_IMAGE_INJ;
38470   FULL_REWRITE_TAC[PAIR_SPLIT];
38471   FIRST_ASSUM IMATCH_MP_TAC ;
38472   REWRITE_TAC[infinite_int];
38473   ]);;
38474   (* }}} *)
38475
38476 let not_cls_exists = prove_by_refinement(
38477   `!E. ?c. (FINITE E /\ E SUBSET edge) ==>   ~cls E c`,
38478   (* {{{ proof *)
38479   [
38480   REP_BASIC_TAC;
38481   RIGHT_TAC "c";
38482   THM_INTRO_TAC[`E`] finite_cls;
38483   FULL_REWRITE_TAC[cls];
38484   TYPE_THEN `INFINITE (UNIV DIFF {m | ?e. E e /\ closure top2 e (pointI m)})` SUBAGOAL_TAC;
38485   IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
38486   REWRITE_TAC[infinite_intpair];
38487   (* - *)
38488   USE 3 (MATCH_MP INFINITE_NONEMPTY);
38489   USE 3 (REWRITE_RULE[EMPTY_EXISTS;DIFF]);
38490   ASM_MESON_TAC[];
38491   ]);;
38492   (* }}} *)
38493
38494 let conn2_imp_conn = prove_by_refinement(
38495   `!E. (E SUBSET edge ) /\ conn2 E ==> conn E`,
38496   (* {{{ proof *)
38497   [
38498   REWRITE_TAC[conn;conn2];
38499   THM_INTRO_TAC[`E`] finite_cls;
38500   THM_INTRO_TAC[`E`] not_cls_exists;
38501   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
38502   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]);
38503   ASM_MESON_TAC[];
38504   ASM_MESON_TAC[];
38505   ]);;
38506   (* }}} *)
38507
38508 let has_size1 = prove_by_refinement(
38509   `!(X:A -> bool). X HAS_SIZE 1 <=> SING X`,
38510   (* {{{ proof *)
38511   [
38512   REWRITE_TAC[];
38513   IMATCH_MP_TAC  EQ_ANTISYM;
38514   ASM_REWRITE_TAC[CARD_SING_CONV];
38515   FULL_REWRITE_TAC[SING];
38516   REWRITE_TAC[sing_has_size1];
38517   ]);;
38518   (* }}} *)
38519
38520 let card_gt_3 = prove_by_refinement(
38521   `!(X:A->bool). FINITE X ==> ( 3 <= CARD X <=>
38522      (?a b c. X a /\ X b /\ X c /\ ~(a = b) /\ ~(a = c) /\ ~( b = c)))`,
38523   (* {{{ proof *)
38524   [
38525   FULL_REWRITE_TAC[ARITH_RULE `(3 <= x) <=> ~(x = 0) /\ ~(x = 1) /\ ~(x = 2)`];
38526   IMATCH_MP_TAC  EQ_ANTISYM;
38527   CONJ_TAC;
38528   TYPE_THEN `~(X HAS_SIZE 0)` SUBAGOAL_TAC;
38529   ASM_MESON_TAC[HAS_SIZE];
38530   FULL_REWRITE_TAC[HAS_SIZE_0 ;EMPTY_EXISTS ];
38531   TYPE_THEN `~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2)` SUBAGOAL_TAC;
38532   ASM_MESON_TAC[HAS_SIZE];
38533   FULL_REWRITE_TAC[has_size1 ;SING;has_size2;INR eq_sing ];
38534   TYPE_THEN `?v. (X v /\ ~(v = u))` SUBAGOAL_TAC;
38535   ASM_MESON_TAC[];
38536   TYPE_THEN `u` EXISTS_TAC;
38537   TYPE_THEN `v` EXISTS_TAC;
38538   LEFT 5 "a";
38539   TSPEC `u` 5;
38540   LEFT 5 "b";
38541   TSPEC `v` 5;
38542   USE 5 (REWRITE_RULE[DE_MORGAN_THM]);
38543   REWR 5;
38544   USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
38545   LEFT 5 "x";
38546   FULL_REWRITE_TAC[INR in_pair];
38547   TYPE_THEN `x` EXISTS_TAC;
38548   ASM_MESON_TAC[];
38549   (* - *)
38550   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;
38551   FULL_REWRITE_TAC[HAS_SIZE];
38552   ASM_MESON_TAC[];
38553   FIRST_ASSUM IMATCH_MP_TAC ;
38554   KILL 7;
38555   REWRITE_TAC[HAS_SIZE_0;has_size1;SING;EMPTY_EXISTS ];
38556   CONJ_TAC;
38557   TYPE_THEN `a` EXISTS_TAC;
38558   CONJ_TAC;
38559   TYPE_THEN `X` UNABBREV_TAC;
38560   FULL_REWRITE_TAC[INR IN_SING];
38561   ASM_MESON_TAC[];
38562   THM_INTRO_TAC[`X`;`a`;`b`;`c`] two_exclusion;
38563   ASM_MESON_TAC[];
38564   ]);;
38565   (* }}} *)
38566
38567 let card_has_subset = prove_by_refinement(
38568   `!(A:A->bool) n. FINITE A /\ (n <= CARD A) ==>
38569        (?B. B SUBSET A /\ (B HAS_SIZE n))`,
38570   (* {{{ proof *)
38571   [
38572   REP_BASIC_TAC;
38573   TYPE_THEN `A HAS_SIZE CARD A` SUBAGOAL_TAC;
38574   REWRITE_TAC[HAS_SIZE];
38575   FULL_REWRITE_TAC[has_size_bij];
38576   TYPE_THEN `IMAGE f {m | m <| n}` EXISTS_TAC;
38577   CONJ_TAC;
38578   FULL_REWRITE_TAC[IMAGE;SUBSET;BIJ;SURJ];
38579   FIRST_ASSUM IMATCH_MP_TAC ;
38580   UND 3 THEN UND 0 THEN ARITH_TAC;
38581   TYPE_THEN `f` EXISTS_TAC;
38582   IMATCH_MP_TAC  inj_bij;
38583   FULL_REWRITE_TAC[INJ;BIJ;];
38584   FIRST_ASSUM IMATCH_MP_TAC ;
38585   UND 3 THEN UND 4 THEN UND 0 THEN ARITH_TAC;
38586   ]);;
38587   (* }}} *)
38588
38589 let cls_edge_size2 = prove_by_refinement(
38590   `!e. (edge e) ==> (cls {e} HAS_SIZE 2)`,
38591   (* {{{ proof *)
38592   [
38593   REWRITE_TAC[cls_edge];
38594   IMATCH_MP_TAC  two_endpoint;
38595   ]);;
38596   (* }}} *)
38597
38598 let conn2_cls3 = prove_by_refinement(
38599   `!E. (E SUBSET edge) /\ conn2 E ==> (3 <= CARD (cls E))`,
38600   (* {{{ proof *)
38601   [
38602   REP_BASIC_TAC;
38603   THM_INTRO_TAC[`E`] finite_cls;
38604   FULL_REWRITE_TAC[conn2];
38605   ASM_SIMP_TAC[card_gt_3];
38606   FULL_REWRITE_TAC[conn2];
38607   THM_INTRO_TAC[`E`;`2`] card_has_subset;
38608   FULL_REWRITE_TAC[has_size2];
38609   TYPE_THEN `B` UNABBREV_TAC;
38610   USE 6(REWRITE_RULE[SUBSET;INR in_pair]);
38611   TYPE_THEN `E b` SUBAGOAL_TAC ;
38612   FIRST_ASSUM IMATCH_MP_TAC ;
38613   TYPE_THEN `E a` SUBAGOAL_TAC;
38614   FIRST_ASSUM IMATCH_MP_TAC ;
38615   (* - *)
38616   USE 2(REWRITE_RULE[SUBSET]);
38617   TYPE_THEN `edge a /\ edge b` SUBAGOAL_TAC;
38618   (* - *)
38619   TYPE_THEN `cls {a} HAS_SIZE 2 /\ cls {b} HAS_SIZE 2` SUBAGOAL_TAC;
38620   ASM_MESON_TAC[cls_edge_size2];
38621   FULL_REWRITE_TAC[has_size2];
38622   USE 12 SYM;
38623   USE 14 SYM;
38624   TYPE_THEN `cls {a} SUBSET cls E` SUBAGOAL_TAC;
38625   IMATCH_MP_TAC  cls_subset;
38626   REWRITE_TAC[SUBSET;INR IN_SING];
38627   TYPE_THEN `cls {b} SUBSET cls E` SUBAGOAL_TAC;
38628   IMATCH_MP_TAC  cls_subset;
38629   REWRITE_TAC[SUBSET;INR IN_SING];
38630   (* - *)
38631   TYPE_THEN `cls E a' /\ cls E b' /\ cls E a'' /\ cls E b''` SUBAGOAL_TAC;
38632   USE 12 GSYM;
38633   USE 14 SYM;
38634   REWR 15;
38635   REWR 16;
38636   FULL_REWRITE_TAC[SUBSET;INR in_pair];
38637   ASM_MESON_TAC[];
38638   (* -A *)
38639   TYPE_THEN `a'` EXISTS_TAC;
38640   TYPE_THEN `b'` EXISTS_TAC;
38641   (* - *)
38642   TYPE_THEN `~(cls {a} = cls {b})` SUBAGOAL_TAC;
38643   THM_INTRO_TAC[`a`;`b`] cls_inj;
38644   ASM_MESON_TAC[];
38645   USE 14 SYM;
38646   TYPE_THEN `cls {b} a''` ASM_CASES_TAC;
38647   REWR 22;
38648   FULL_REWRITE_TAC[INR in_pair ];
38649   TYPE_THEN `b''` EXISTS_TAC;
38650   CONJ_TAC;
38651   TYPE_THEN `b''` UNABBREV_TAC;
38652   FIRST_ASSUM DISJ_CASES_TAC;
38653   TYPE_THEN `a''` UNABBREV_TAC;
38654   TYPE_THEN `cls {b}` UNABBREV_TAC;
38655   TYPE_THEN `cls {a}` UNABBREV_TAC;
38656   UND 21 THEN REWRITE_TAC[];
38657   IMATCH_MP_TAC  EQ_EXT;
38658   REWRITE_TAC[INSERT];
38659   MESON_TAC[];
38660   TYPE_THEN `a''` UNABBREV_TAC;
38661   (* -- *)
38662   TYPE_THEN `b''` UNABBREV_TAC;
38663   FIRST_ASSUM DISJ_CASES_TAC  ;
38664   TYPE_THEN `a''` UNABBREV_TAC;
38665   TYPE_THEN `a''` UNABBREV_TAC;
38666   TYPE_THEN `cls {b}` UNABBREV_TAC;
38667   TYPE_THEN `cls {a}` UNABBREV_TAC;
38668   (* -B *)
38669   TYPE_THEN `a''` EXISTS_TAC;
38670   REWR 22;
38671   FULL_REWRITE_TAC[INR in_pair];
38672   UND 22 THEN MESON_TAC[];
38673   ]);;
38674   (* }}} *)
38675
38676 let has_size2_subset_ne = prove_by_refinement(
38677   `!X (a:A) b. X HAS_SIZE 2 /\ {a,b} SUBSET X /\ ~(a = b) ==>
38678            (X = {a,b})`,
38679   (* {{{ proof *)
38680   [
38681   REP_BASIC_TAC;
38682   ONCE_REWRITE_TAC [EQ_SYM_EQ];
38683   IMATCH_MP_TAC  CARD_SUBSET_EQ;
38684   THM_INTRO_TAC[`a`;`b`] pair_size_2;
38685   ASM_MESON_TAC[];
38686   FULL_REWRITE_TAC[HAS_SIZE];
38687   ]);;
38688   (* }}} *)
38689
38690 let segment_end_sing = prove_by_refinement(
38691   `!a b e. closure top2 e (pointI a) /\ closure top2 e (pointI b) /\
38692      ~(a = b) /\ (edge e) ==> segment_end {e} a b`,
38693   (* {{{ proof *)
38694   [
38695   REWRITE_TAC[segment_end];
38696   CONJ_TAC ;
38697   IMATCH_MP_TAC  psegment_edge;
38698   (* - *)
38699   IMATCH_MP_TAC has_size2_subset_ne;
38700   CONJ_TAC;
38701   IMATCH_MP_TAC  endpoint_size2;
38702   IMATCH_MP_TAC  psegment_edge;
38703   (* - *)
38704   REWRITE_TAC[endpoint;SUBSET];
38705   FULL_REWRITE_TAC[INR in_pair];
38706   THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
38707   REWRITE_TAC[FINITE_SING];
38708   KILL 5;
38709   TYPE_THEN `e` EXISTS_TAC;
38710   REWRITE_TAC[INR IN_SING];
38711   ASM_MESON_TAC[];
38712   ]);;
38713   (* }}} *)
38714
38715 let conn2_no1 = prove_by_refinement(
38716   `!E. (E SUBSET edge) /\ conn2 E ==>
38717          (!m. ~(num_closure E (pointI m) = 1))`,
38718   (* {{{ proof *)
38719   [
38720   REP_BASIC_TAC;
38721     TYPE_THEN `FINITE E` SUBAGOAL_TAC ;
38722   FULL_REWRITE_TAC[conn2];
38723   TYPE_THEN `?e. E e /\ closure top2 e (pointI m)` SUBAGOAL_TAC;
38724   THM_INTRO_TAC[`E`;`pointI m`] num_closure1;
38725   REWR 4;
38726   MESON_TAC[];
38727   THM_INTRO_TAC[`e`] cls_edge_size2;
38728   ASM_MESON_TAC[ISUBSET];
38729   TYPE_THEN `?n. closure top2 e (pointI n) /\ ~(n = m)` SUBAGOAL_TAC;
38730   FULL_REWRITE_TAC[has_size2];
38731   USE 7 SYM;
38732   TYPE_THEN `cls {e} m` SUBAGOAL_TAC;
38733   REWRITE_TAC[cls;INR IN_SING ];
38734   ASM_MESON_TAC[];
38735   USE 7 SYM;
38736   REWR 8;
38737   FULL_REWRITE_TAC[INR in_pair];
38738   FIRST_ASSUM DISJ_CASES_TAC ;
38739   TYPE_THEN `a` EXISTS_TAC;
38740   TYPE_THEN `cls{e} a` SUBAGOAL_TAC;
38741   REWRITE_TAC[INSERT];
38742   FULL_REWRITE_TAC[cls;INR IN_SING ];
38743   ASM_MESON_TAC[];
38744   TYPE_THEN `b` EXISTS_TAC;
38745   TYPE_THEN `cls{e} b` SUBAGOAL_TAC;
38746   FULL_REWRITE_TAC[INR in_pair;cls; INR IN_SING];
38747   FULL_REWRITE_TAC[cls;INR IN_SING];
38748   ASM_MESON_TAC[];
38749   TYPE_THEN `edge e` SUBAGOAL_TAC;
38750   FULL_REWRITE_TAC[SUBSET];
38751   (* -A *)
38752   TYPE_THEN`?c. cls E c /\ ~(c = m) /\ ~(c = n)` SUBAGOAL_TAC;
38753   THM_INTRO_TAC[`E`] conn2_cls3;
38754   THM_INTRO_TAC[`E`] finite_cls;
38755   THM_INTRO_TAC[`cls E`] card_gt_3;
38756   REWR 12;
38757   TYPE_THEN `~(a = m) /\ ~(a = n)` ASM_CASES_TAC;
38758   TYPE_THEN `a` EXISTS_TAC;
38759   TYPE_THEN `~(b = m) /\ ~(b = n)` ASM_CASES_TAC;
38760   TYPE_THEN `b` EXISTS_TAC;
38761   TYPE_THEN `~(c = m) /\ ~(c = n)` ASM_CASES_TAC;
38762   TYPE_THEN `c` EXISTS_TAC;
38763   FULL_REWRITE_TAC[DE_MORGAN_THM];
38764   ASM_MESON_TAC[];
38765   (* - *)
38766   FULL_REWRITE_TAC[conn2];
38767   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`c`;`n`]);
38768   REWRITE_TAC[cls];
38769   ASM_MESON_TAC[];
38770   (* - *)
38771   TYPE_THEN `cls {e} n` SUBAGOAL_TAC;
38772   REWRITE_TAC[cls;INR IN_SING ];
38773   ASM_MESON_TAC[];
38774   (* - *)
38775   TYPE_THEN `~S e` SUBAGOAL_TAC;
38776   TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC;
38777   IMATCH_MP_TAC  cls_subset;
38778   REWRITE_TAC[SUBSET;INR IN_SING];
38779   FULL_REWRITE_TAC[SUBSET];
38780   ASM_MESON_TAC[];
38781   (* - *)
38782   THM_INTRO_TAC[`S`;`m`] terminal_endpoint;
38783   FULL_REWRITE_TAC[segment_end];
38784   FULL_REWRITE_TAC[psegment;segment;INR in_pair];
38785   THM_INTRO_TAC[`E`;`pointI m`] num_closure1;
38786   REWR 21;
38787   COPY 21;
38788   TSPEC  `e` 21;
38789   TYPE_THEN `e = e'` SUBAGOAL_TAC;
38790   ASM_MESON_TAC[];
38791   TYPE_THEN `e'` UNABBREV_TAC;
38792   TSPEC  `(terminal_edge S m)` 22;
38793   REWR 22;
38794   USE 22 SYM;
38795   TYPE_THEN `E (terminal_edge S m)` SUBAGOAL_TAC;
38796   FULL_REWRITE_TAC[ISUBSET];
38797   REWR 22;
38798   TYPE_THEN `e` UNABBREV_TAC;
38799   ASM_MESON_TAC[];
38800   ]);;
38801   (* }}} *)
38802
38803 let conn2_union = prove_by_refinement(
38804   `!A B. (A SUBSET edge) /\ (B SUBSET edge) /\ (conn2 A) /\ (conn2 B) /\
38805     (?a b. ~(a = b) /\ ({a,b} SUBSET (cls A INTER cls B))) ==>
38806     (conn2 (A UNION B))`,
38807   (* {{{ proof *)
38808   [
38809   REP_BASIC_TAC;
38810   REWRITE_TAC[conn2];
38811   TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
38812   FULL_REWRITE_TAC[conn2];
38813   SUBCONJ_TAC;
38814   REWRITE_TAC[FINITE_UNION];
38815   (* - *)
38816   SUBCONJ_TAC;
38817   IMATCH_MP_TAC  LE_TRANS;
38818   TYPE_THEN `CARD A` EXISTS_TAC;
38819   FULL_REWRITE_TAC[conn2];
38820   IMATCH_MP_TAC  CARD_SUBSET;
38821   REWRITE_TAC[SUBSET;UNION];
38822   (* - *)
38823   TYPE_THEN `cls A a' /\ cls A b'` ASM_CASES_TAC;
38824   FULL_REWRITE_TAC[conn2];
38825   UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]);
38826   TYPE_THEN`S` EXISTS_TAC;
38827   UND 22 THEN REWRITE_TAC[SUBSET;UNION];
38828   (* - *)
38829   TYPE_THEN `cls B a' /\ cls B b'` ASM_CASES_TAC;
38830   FULL_REWRITE_TAC[conn2];
38831   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]);
38832   TYPE_THEN`S` EXISTS_TAC;
38833   UND 23 THEN REWRITE_TAC[SUBSET;UNION];
38834   (* - *)
38835   TYPE_THEN `?d. cls A d /\ cls B d /\ ~(c = d)` SUBAGOAL_TAC;
38836   TYPE_THEN `c = a` ASM_CASES_TAC;
38837   TYPE_THEN `c` UNABBREV_TAC;
38838   TYPE_THEN `b` EXISTS_TAC;
38839   FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair];
38840   ASM_MESON_TAC[];
38841   TYPE_THEN `a` EXISTS_TAC;
38842   FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair];
38843   ASM_MESON_TAC[];
38844   (* -A *)
38845   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;
38846   FULL_REWRITE_TAC[conn2];
38847   UND 28 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`d`;`c`]);
38848   REWRITE_TAC[];
38849   TYPE_THEN `m` UNABBREV_TAC;
38850   ASM_MESON_TAC[];
38851   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`d`;`n`;`c`]);
38852   ASM_MESON_TAC[];
38853   THM_INTRO_TAC[`S`;`S'`;`m`;`d`;`n`] segment_end_trans;
38854   TYPE_THEN `U` EXISTS_TAC;
38855   CONJ_TAC;
38856   IMATCH_MP_TAC  SUBSET_TRANS;
38857   TYPE_THEN `S UNION S'` EXISTS_TAC ;
38858   IMATCH_MP_TAC  subset_union_pair;
38859   TYPE_THEN `cls U SUBSET cls (S UNION S')` SUBAGOAL_TAC;
38860   IMATCH_MP_TAC  cls_subset;
38861   FULL_REWRITE_TAC[cls_union ];
38862   FULL_REWRITE_TAC[ISUBSET];
38863   TSPEC `c` 38;
38864   USE 37 (REWRITE_RULE[UNION]);
38865   ASM_MESON_TAC[];
38866   (* -B *)
38867   FULL_REWRITE_TAC[DE_MORGAN_THM];
38868   FULL_REWRITE_TAC[cls_union ];
38869   USE 12(REWRITE_RULE[UNION]);
38870   USE 13 (REWRITE_RULE[UNION]);
38871   FIRST_ASSUM DISJ_CASES_TAC;
38872   REWR 15;
38873   REWR 12;
38874   REWR 16;
38875   UND 20 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`]);
38876   (* - *)
38877   REWR 16;
38878   REWR 12;
38879   REWR 15;
38880   UND 20 THEN DISCH_THEN  (THM_INTRO_TAC[`b'`;`a'`]);
38881   TYPE_THEN `S` EXISTS_TAC;
38882   ONCE_REWRITE_TAC[segment_end_symm];
38883   ]);;
38884   (* }}} *)
38885
38886 let cut_rectagon_cls = prove_by_refinement(
38887   `!E m n. rectagon E /\ ~(m = n) /\ cls E m /\ cls E n ==>
38888     (?A B. segment_end A m n /\ segment_end B m n /\
38889         (E = A UNION B) /\ (A INTER B = EMPTY) /\
38890          (cls A INTER cls B = {m,n}))`,
38891   (* {{{ proof *)
38892   [
38893   REWRITE_TAC[segment_end;cls;];
38894   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
38895   FULL_REWRITE_TAC[rectagon;segment;psegment];
38896   THM_INTRO_TAC[`E`;`m`;`n`] cut_rectagon;
38897   CONJ_TAC;
38898   IMATCH_MP_TAC  num_closure_pos;
38899   ASM_MESON_TAC[];
38900   IMATCH_MP_TAC  num_closure_pos;
38901   ASM_MESON_TAC[];
38902   TYPE_THEN `A` EXISTS_TAC;
38903   TYPE_THEN `B` EXISTS_TAC;
38904   ASM_REWRITE_TAC[];
38905   IMATCH_MP_TAC  EQ_EXT;
38906   REWRITE_TAC[INTER;INR in_pair];
38907   IMATCH_MP_TAC  EQ_ANTISYM;
38908   CONJ_TAC;
38909   IMATCH_MP_TAC  (TAUT `a \/ b ==> b \/ a`);
38910   FIRST_ASSUM IMATCH_MP_TAC ;
38911   CONJ_TAC;
38912   IMATCH_MP_TAC  num_closure_pos;
38913   ASM_MESON_TAC[psegment;segment];
38914   IMATCH_MP_TAC  num_closure_pos;
38915   ASM_MESON_TAC[psegment;segment];
38916   (* - *)
38917   TYPE_THEN `FINITE A` SUBAGOAL_TAC;
38918   IMATCH_MP_TAC  FINITE_SUBSET;
38919   TYPE_THEN `E` EXISTS_TAC;
38920   REWRITE_TAC[SUBSET;UNION];
38921   TYPE_THEN `FINITE B` SUBAGOAL_TAC;
38922   IMATCH_MP_TAC  FINITE_SUBSET;
38923   TYPE_THEN `E` EXISTS_TAC;
38924   REWRITE_TAC[SUBSET;UNION];
38925   (* - *)
38926   TYPE_THEN `endpoint A m /\ endpoint A n /\ endpoint B m /\ endpoint B n` SUBAGOAL_TAC;
38927   REWRITE_TAC[INR in_pair];
38928   (* - *)
38929   FIRST_ASSUM DISJ_CASES_TAC;
38930   CONJ_TAC;
38931   TYPE_THEN  `terminal_edge A n` EXISTS_TAC;
38932   IMATCH_MP_TAC  terminal_endpoint;
38933   TYPE_THEN  `terminal_edge B n` EXISTS_TAC;
38934   IMATCH_MP_TAC  terminal_endpoint;
38935   CONJ_TAC;
38936   TYPE_THEN  `terminal_edge A m` EXISTS_TAC;
38937   IMATCH_MP_TAC  terminal_endpoint;
38938   TYPE_THEN  `terminal_edge B m` EXISTS_TAC;
38939   IMATCH_MP_TAC  terminal_endpoint;
38940   ]);;
38941   (* }}} *)
38942
38943 let conn2_rectagon = prove_by_refinement(
38944   `!E. rectagon E ==> conn2 E`,
38945   (* {{{ proof *)
38946   [
38947   FULL_REWRITE_TAC[conn2];
38948   SUBCONJ_TAC;
38949   FULL_REWRITE_TAC[rectagon];
38950   SUBCONJ_TAC;
38951   THM_INTRO_TAC[`E`] rectagon_h_edge;
38952   THM_INTRO_TAC[`E`] rectagon_v_edge;
38953   TYPE_THEN `~(h_edge m = v_edge m')` SUBAGOAL_TAC;
38954   ASM_MESON_TAC[hv_edgeV2];
38955   TYPE_THEN `CARD {(h_edge m),(v_edge m')} <= CARD E` SUBAGOAL_TAC;
38956   IMATCH_MP_TAC  CARD_SUBSET;
38957   REWRITE_TAC[SUBSET;INR in_pair];
38958   ASM_MESON_TAC[];
38959   TYPE_THEN `{(h_edge m),(v_edge m')} HAS_SIZE 2` SUBAGOAL_TAC;
38960   IMATCH_MP_TAC  pair_size_2;
38961   ASM_MESON_TAC[];
38962   FULL_REWRITE_TAC[HAS_SIZE];
38963   REWR 5;
38964   (* - *)
38965   THM_INTRO_TAC[`E`;`a`;`b`] cut_rectagon_cls;
38966   TYPE_THEN `~cls A c` ASM_CASES_TAC;
38967   TYPE_THEN `A` EXISTS_TAC;
38968   REWRITE_TAC[SUBSET;UNION];
38969   REWR 13;
38970   (* - *)
38971   TYPE_THEN `~cls B c ` SUBAGOAL_TAC;
38972   USE 8 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
38973   TSPEC `c` 8;
38974   FULL_REWRITE_TAC[INTER;INR in_pair];
38975   ASM_MESON_TAC[];
38976   (* - *)
38977   TYPE_THEN `B` EXISTS_TAC;
38978   REWRITE_TAC[SUBSET;UNION];
38979   ]);;
38980   (* }}} *)
38981
38982 let rectangle_grid = jordan_def
38983   `rectangle_grid p q = { e |
38984      (?m. (e = h_edge m) /\ FST p <= FST m /\ (FST m +: &:1 <=: FST q) /\
38985                           SND p <= SND m /\ SND m <=: SND q) \/
38986      (?m. (e = v_edge m) /\ FST p <= FST m /\ FST m <= FST q /\
38987                           SND p <= SND m /\ SND m +: &:1 <=: SND q) }`;;
38988
38989 let rectangle_grid_h = prove_by_refinement(
38990   `!p q m. rectangle_grid p q (h_edge m) <=>
38991         (FST p <=: FST m) /\ (FST m +: &:1 <=: FST q) /\
38992         (SND p <=: SND m) /\ (SND m <=: SND q)`,
38993   (* {{{ proof *)
38994   [
38995   REWRITE_TAC[rectangle_grid];
38996   REWRITE_TAC[cell_clauses;];
38997   MESON_TAC[];
38998   ]);;
38999   (* }}} *)
39000
39001 let rectangle_grid_v = prove_by_refinement(
39002   `!p q m. rectangle_grid p q (v_edge m) <=>
39003         (FST p <= FST m /\ FST m <= FST q /\
39004                  SND p <= SND m /\ SND m +: &:1 <=: SND q)`,
39005   (* {{{ proof *)
39006   [
39007   REWRITE_TAC[rectangle_grid];
39008   REWRITE_TAC[cell_clauses;];
39009   MESON_TAC[];
39010   ]);;
39011   (* }}} *)
39012
39013 let rectangle_grid_edge = prove_by_refinement(
39014   `!p q. rectangle_grid p q SUBSET edge`,
39015   (* {{{ proof *)
39016   [
39017   REWRITE_TAC[SUBSET;rectangle_grid;edge];
39018   ASM_MESON_TAC[];
39019   ]);;
39020   (* }}} *)
39021
39022 let rectangle_grid_sq = prove_by_refinement(
39023   `!p.  (rectangle_grid p (FST p +: &:1, SND p +: &:1)) =
39024          {(h_edge p), (h_edge (up p)), (v_edge p), (v_edge (right  p))}`,
39025   (* {{{ proof *)
39026   [
39027   REP_BASIC_TAC;
39028   TYPE_THEN `E = rectangle_grid p (FST p +: &:1, SND p +: &:1)` ABBREV_TAC ;
39029   IMATCH_MP_TAC  EQ_EXT;
39030   REWRITE_TAC[INSERT];
39031   IMATCH_MP_TAC  EQ_ANTISYM;
39032   CONJ_TAC;
39033   TYPE_THEN `edge x` SUBAGOAL_TAC;
39034   TYPE_THEN `E` UNABBREV_TAC;
39035   ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
39036   (* - *)
39037   FULL_REWRITE_TAC[edge];
39038   FIRST_ASSUM DISJ_CASES_TAC ;
39039   TYPE_THEN `x` UNABBREV_TAC;
39040   TYPE_THEN `E` UNABBREV_TAC;
39041   FULL_REWRITE_TAC[rectangle_grid_v;PAIR_SPLIT];
39042   REWRITE_TAC[cell_clauses];
39043   REWRITE_TAC[PAIR_SPLIT;right ];
39044   UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
39045   TYPE_THEN `x` UNABBREV_TAC;
39046   TYPE_THEN `E` UNABBREV_TAC;
39047   FULL_REWRITE_TAC[rectangle_grid_h;PAIR_SPLIT];
39048   REWRITE_TAC[cell_clauses];
39049   REWRITE_TAC[PAIR_SPLIT;up ];
39050   UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
39051   (* - *)
39052   TYPE_THEN `E` UNABBREV_TAC;
39053   UND 1 THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[rectangle_grid_v;rectangle_grid_h;up;right ;] THEN INT_ARITH_TAC;
39054   ]);;
39055   (* }}} *)
39056
39057 let rectangle_grid_sq_cls = prove_by_refinement(
39058   `!p. cls (rectangle_grid p (FST p +: &:1, SND p +: &:1)) =
39059      {(p),(right  p),(up p),  (up (right  p))}`,
39060   (* {{{ proof *)
39061
39062   [
39063   REWRITE_TAC[cls];
39064   IMATCH_MP_TAC  EQ_EXT;
39065   REWRITE_TAC[rectangle_grid_sq];
39066   REWRITE_TAC[INSERT];
39067   IMATCH_MP_TAC  EQ_ANTISYM;
39068   (* - *)
39069   CONJ_TAC;
39070   FULL_REWRITE_TAC[right ;up;];
39071   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[];
39072   (* - *)
39073   FULL_REWRITE_TAC[right ;up;];
39074   TYPE_THEN `closure top2 (h_edge p) (pointI x) \/ closure top2 (h_edge (FST p,SND p +: &:1)) (pointI x)` SUBAGOAL_TAC;
39075   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;];
39076   FIRST_ASSUM DISJ_CASES_TAC;
39077   ASM_MESON_TAC[];
39078   ASM_MESON_TAC[];
39079   ]);;
39080
39081   (* }}} *)
39082
39083 let segment_end_union_rectagon = prove_by_refinement(
39084   `!A B m p. segment_end A m p /\ segment_end B m p /\
39085        (A INTER B = EMPTY) /\ (cls A INTER cls B = {m,p}) ==>
39086        (rectagon (A UNION B))`,
39087   (* {{{ proof *)
39088   [
39089   REP_BASIC_TAC;
39090   THM_INTRO_TAC[`A`;`m`;`p`] segment_end_disj;
39091   IMATCH_MP_TAC  segment_union2;
39092   TYPE_THEN `m` EXISTS_TAC;
39093   TYPE_THEN `p` EXISTS_TAC;
39094   FULL_REWRITE_TAC[segment_end;INR in_pair];
39095   REWRITE_TAC[INR in_pair];
39096   FULL_REWRITE_TAC[psegment];
39097   REP_BASIC_TAC;
39098   (* - *)
39099   IMATCH_MP_TAC  EQ_ANTISYM;
39100   CONJ_TAC;
39101   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
39102   TSPEC `n` 0;
39103   USE 0 (REWRITE_RULE[INR in_pair;INTER;cls]);
39104   IMATCH_MP_TAC  (TAUT `a \/ b ==> b \/ a`);
39105   USE 0 SYM;
39106   CONJ_TAC;
39107   USE 10 (MATCH_MP num_closure_elt);
39108   ASM_MESON_TAC[];
39109   USE 9 (MATCH_MP num_closure_elt);
39110   ASM_MESON_TAC[];
39111   (* -A *)
39112   TYPE_THEN `FINITE A` SUBAGOAL_TAC;
39113   FULL_REWRITE_TAC[segment];
39114   TYPE_THEN `FINITE B` SUBAGOAL_TAC;
39115   FULL_REWRITE_TAC[segment];
39116   TYPE_THEN `endpoint B m /\ endpoint B p /\ endpoint A m /\ endpoint A p` SUBAGOAL_TAC;
39117   REWRITE_TAC[INR in_pair];
39118   CONJ_TAC;
39119   IMATCH_MP_TAC  num_closure_pos;
39120   FIRST_ASSUM DISJ_CASES_TAC;
39121   THM_INTRO_TAC[`A`;`m`] terminal_endpoint;
39122   ASM_MESON_TAC[];
39123   THM_INTRO_TAC[`A`;`p`] terminal_endpoint;
39124   ASM_MESON_TAC[];
39125     IMATCH_MP_TAC  num_closure_pos;
39126   FIRST_ASSUM DISJ_CASES_TAC;
39127   THM_INTRO_TAC[`B`;`m`] terminal_endpoint;
39128   ASM_MESON_TAC[];
39129   THM_INTRO_TAC[`B`;`p`] terminal_endpoint;
39130   ASM_MESON_TAC[];
39131   ]);;
39132   (* }}} *)
39133
39134 let cls_h = prove_by_refinement(
39135   `!m. (cls {(h_edge m)} = {m, (right  m)})`,
39136   (* {{{ proof *)
39137   [
39138   REWRITE_TAC[cls];
39139   IMATCH_MP_TAC  EQ_EXT;
39140   REWRITE_TAC[INR in_pair;INR IN_SING;];
39141   CONV_TAC (dropq_conv "e");
39142   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;];
39143   MESON_TAC[];
39144   ]);;
39145   (* }}} *)
39146
39147 let cls_v = prove_by_refinement(
39148   `!m. (cls {(v_edge m)} = {m, (up  m)})`,
39149   (* {{{ proof *)
39150   [
39151   REWRITE_TAC[cls];
39152   IMATCH_MP_TAC  EQ_EXT;
39153   REWRITE_TAC[INR in_pair;INR IN_SING;];
39154   CONV_TAC (dropq_conv "e");
39155   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;];
39156   MESON_TAC[];
39157   ]);;
39158   (* }}} *)
39159
39160 let rectagon_rectangle_grid_sq = prove_by_refinement(
39161   `!p. rectagon ((rectangle_grid p (FST p +: &:1, SND p +: &:1)))`,
39162   (* {{{ proof *)
39163   [
39164   REP_BASIC_TAC;
39165   TYPE_THEN `E = rectagon (rectangle_grid p (FST p +: &:1,SND p +: &:1))` ABBREV_TAC ;
39166   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;
39167   (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 ;
39168   (* - *)
39169   THM_INTRO_TAC[`{(h_edge p)}`;`{(v_edge (right  p))}`;`p`;`right  p`;`right  (up p)`] segment_end_union;
39170   THM_INTRO_TAC[`p`] cls_h;
39171   THM_INTRO_TAC[`right  p`] cls_v;
39172   IMATCH_MP_TAC  EQ_EXT;
39173   REWRITE_TAC[INTER;INR IN_SING;];
39174   REWRITE_TAC[INR in_pair;right  ;up; PAIR_SPLIT ];
39175   INT_ARITH_TAC;
39176   (* - *)
39177   THM_INTRO_TAC[`{(v_edge p)}`;`{(h_edge (up p))}`;`p`;`up p`;`right  (up p)`] segment_end_union;
39178   THM_INTRO_TAC[`p`] cls_v;
39179   THM_INTRO_TAC[`up  p`] cls_h;
39180   IMATCH_MP_TAC  EQ_EXT;
39181   REWRITE_TAC[INTER;INR IN_SING;];
39182   REWRITE_TAC[INR in_pair;right  ;up; PAIR_SPLIT ];
39183   INT_ARITH_TAC;
39184   (* - *)
39185   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;
39186   CONJ_TAC;
39187   PROOF_BY_CONTR_TAC;
39188   FULL_REWRITE_TAC[EMPTY_EXISTS];
39189   USE 7(REWRITE_RULE[INTER;UNION;INR IN_SING]);
39190   FIRST_ASSUM DISJ_CASES_TAC;
39191   TYPE_THEN `u` UNABBREV_TAC;
39192   FULL_REWRITE_TAC[cell_clauses;up;PAIR_SPLIT ];
39193   UND 8 THEN INT_ARITH_TAC;
39194   TYPE_THEN `u` UNABBREV_TAC;
39195   FULL_REWRITE_TAC[cell_clauses;up; right  ;PAIR_SPLIT ];
39196   UND 8 THEN INT_ARITH_TAC;
39197   REWRITE_TAC[cls_h;cls_v;cls_union];
39198   IMATCH_MP_TAC  EQ_EXT;
39199   REWRITE_TAC[up; right ; INTER; UNION;];
39200   REWRITE_TAC[INR in_pair];
39201   REWRITE_TAC[PAIR_SPLIT];
39202   TYPE_THEN `FST x = FST p` ASM_CASES_TAC;
39203   REWRITE_TAC[INT_ARITH `~(FST p = FST p +: &:1)`];
39204   INT_ARITH_TAC;
39205   INT_ARITH_TAC;
39206   (* - *)
39207   TYPE_THEN `E` UNABBREV_TAC;
39208   REWRITE_TAC[rectangle_grid_sq];
39209   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;
39210   IMATCH_MP_TAC  EQ_EXT;
39211   REWRITE_TAC[UNION];
39212   REWRITE_TAC[INR IN_SING];
39213   REWRITE_TAC[INSERT];
39214   MESON_TAC[];
39215   ASM_REWRITE_TAC[];
39216   ]);;
39217   (* }}} *)
39218
39219 let conn2_union_edge = prove_by_refinement(
39220   `!A B. A SUBSET edge /\ B SUBSET edge /\ conn2 A /\ conn2 B /\
39221     (~(A INTER B = EMPTY)) ==> conn2 (A UNION B)`,
39222   (* {{{ proof *)
39223   [
39224   REP_BASIC_TAC;
39225   IMATCH_MP_TAC  conn2_union;
39226   USE 0 (REWRITE_RULE [EMPTY_EXISTS;INTER;]);
39227   TYPE_THEN `edge u` SUBAGOAL_TAC;
39228   ASM_MESON_TAC[ISUBSET];
39229   USE 6 (MATCH_MP cls_edge_size2);
39230   FULL_REWRITE_TAC[has_size2];
39231   TYPE_THEN `a` EXISTS_TAC;
39232   TYPE_THEN `b` EXISTS_TAC;
39233   USE 7 SYM;
39234   REWRITE_TAC[SUBSET_INTER];
39235   CONJ_TAC;
39236   IMATCH_MP_TAC  cls_subset;
39237   ASM_REWRITE_TAC[SUBSET;INR IN_SING];
39238   IMATCH_MP_TAC  cls_subset;
39239   ASM_REWRITE_TAC[SUBSET;INR IN_SING];
39240   ]);;
39241   (* }}} *)
39242
39243 let rectangle_grid_h_conn2 = prove_by_refinement(
39244   `!n p. conn2 (rectangle_grid p (FST p +: &:(SUC n), SND p +: &:1))`,
39245   (* {{{ proof *)
39246   [
39247   INDUCT_TAC;
39248   REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ;
39249   IMATCH_MP_TAC  conn2_rectagon;
39250   REWRITE_TAC[rectagon_rectangle_grid_sq];
39251   (* - *)
39252   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;
39253   IMATCH_MP_TAC  EQ_EXT;
39254   REWRITE_TAC[UNION];
39255   (* - *)
39256   IMATCH_MP_TAC  EQ_ANTISYM;
39257   CONJ_TAC;
39258   TYPE_THEN `edge x` SUBAGOAL_TAC;
39259   ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
39260   FULL_REWRITE_TAC [edge];
39261   FIRST_ASSUM DISJ_CASES_TAC;
39262   TYPE_THEN `x` UNABBREV_TAC;
39263   FULL_REWRITE_TAC[rectangle_grid_v];
39264   UND 4 THEN UND 5 THEN INT_ARITH_TAC;
39265   TYPE_THEN `x` UNABBREV_TAC;
39266   FULL_REWRITE_TAC[rectangle_grid_h];
39267   UND 4 THEN UND 5 THEN INT_ARITH_TAC;
39268   (* -- *)
39269   TYPE_THEN `edge x` SUBAGOAL_TAC;
39270   ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
39271   FULL_REWRITE_TAC [edge];
39272   FIRST_ASSUM DISJ_CASES_TAC;
39273   TYPE_THEN `x` UNABBREV_TAC;
39274   FULL_REWRITE_TAC[rectangle_grid_v];
39275   FIRST_ASSUM DISJ_CASES_TAC;
39276   FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
39277   UND 5 THEN INT_ARITH_TAC;
39278   TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC;
39279   int_le_tac;
39280   clean_int_le_tac;
39281   TYPE_THEN `x` UNABBREV_TAC;
39282   FULL_REWRITE_TAC[rectangle_grid_h];
39283   FIRST_ASSUM DISJ_CASES_TAC;
39284   FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
39285   UND 5 THEN INT_ARITH_TAC;
39286   TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC;
39287   int_le_tac;
39288   clean_int_le_tac;
39289   (* -A *)
39290   IMATCH_MP_TAC  conn2_union_edge;
39291   REWRITE_TAC[rectangle_grid_edge];
39292   CONJ_TAC;
39293   IMATCH_MP_TAC  conn2_rectagon;
39294   THM_INTRO_TAC[`FST p +: &:(SUC n),SND p`] rectagon_rectangle_grid_sq;
39295   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;
39296   REWRITE_TAC[PAIR_SPLIT;GSYM INT_OF_NUM_SUC];
39297   INT_ARITH_TAC;
39298   REWR 2;
39299   UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;];
39300   TYPE_THEN `v_edge (FST p +: &:(SUC n),SND p)` EXISTS_TAC;
39301   REWRITE_TAC[rectangle_grid_v];
39302   REPEAT CONJ_TAC THEN (TRY INT_ARITH_TAC);
39303   TYPE_THEN `FST p + (&:0)*(&:(SUC n)) <=: FST p + &: (SUC n)` SUBAGOAL_TAC;
39304   int_le_tac;
39305   clean_int_le_tac;
39306   REWRITE_TAC[GSYM INT_OF_NUM_SUC];
39307   INT_ARITH_TAC;
39308   ]);;
39309   (* }}} *)
39310
39311 let rectangle_grid_conn2 = prove_by_refinement(
39312   `!m n p. conn2
39313         (rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)))`,
39314   (* {{{ proof *)
39315   [
39316   INDUCT_TAC;
39317   REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ;
39318   REWRITE_TAC[rectangle_grid_h_conn2];
39319   (* - *)
39320   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;
39321   IMATCH_MP_TAC  EQ_EXT;
39322   REWRITE_TAC[UNION];
39323   (* - *)
39324   IMATCH_MP_TAC  EQ_ANTISYM;
39325   CONJ_TAC;
39326   TYPE_THEN `edge x` SUBAGOAL_TAC;
39327   ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
39328   FULL_REWRITE_TAC [edge];
39329   FIRST_ASSUM DISJ_CASES_TAC;
39330   TYPE_THEN `x` UNABBREV_TAC;
39331   FULL_REWRITE_TAC[rectangle_grid_v];
39332   UND 1 THEN UND 3 THEN INT_ARITH_TAC;
39333   TYPE_THEN `x` UNABBREV_TAC;
39334   FULL_REWRITE_TAC[rectangle_grid_h];
39335   UND 1 THEN UND 3 THEN INT_ARITH_TAC;
39336   (* -- *)
39337   TYPE_THEN `edge x` SUBAGOAL_TAC;
39338   ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
39339   FULL_REWRITE_TAC [edge];
39340   FIRST_ASSUM DISJ_CASES_TAC;
39341   TYPE_THEN `x` UNABBREV_TAC;
39342   FULL_REWRITE_TAC[rectangle_grid_v];
39343   FIRST_ASSUM DISJ_CASES_TAC;
39344   FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
39345   UND 3 THEN INT_ARITH_TAC;
39346   TYPE_THEN `(SND p +: (&:0)*((SND  m' - (SND  p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC;
39347   int_le_tac;
39348   clean_int_le_tac;
39349   (* -- *)
39350   TYPE_THEN `x` UNABBREV_TAC;
39351   FULL_REWRITE_TAC[rectangle_grid_h];
39352   FIRST_ASSUM DISJ_CASES_TAC;
39353   FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
39354   UND 3 THEN INT_ARITH_TAC;
39355   TYPE_THEN `(SND  p +: (&:0)*((SND  m' - (SND  p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC;
39356   int_le_tac;
39357   clean_int_le_tac;
39358   (* -A *)
39359   IMATCH_MP_TAC  conn2_union_edge;
39360   REWRITE_TAC[rectangle_grid_edge];
39361   CONJ_TAC;
39362   THM_INTRO_TAC[`n`;`(FST p,SND p +: &:(SUC m))` ] rectangle_grid_h_conn2;
39363   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;
39364   REWRITE_TAC[GSYM INT_OF_NUM_SUC;PAIR_SPLIT ];
39365   INT_ARITH_TAC;
39366   REWR 2;
39367   (* - // *)
39368   UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;];
39369   TYPE_THEN `h_edge (FST p ,SND p + &:(SUC m))` EXISTS_TAC;
39370   REWRITE_TAC[rectangle_grid_h];
39371   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);
39372   ]);;
39373   (* }}} *)
39374
39375 let conn2_has_rectagon = prove_by_refinement(
39376   `!E. (E SUBSET edge) /\ (conn2 E) ==> (?B. (B SUBSET E) /\ rectagon B)`,
39377   (* {{{ proof *)
39378   [
39379   REP_BASIC_TAC;
39380   TYPE_THEN `?e. E e` SUBAGOAL_TAC;
39381   FULL_REWRITE_TAC[conn2];
39382   THM_INTRO_TAC[`E`;`1`] card_has_subset;
39383   UND 2 THEN ARITH_TAC;
39384   FULL_REWRITE_TAC[has_size1;SING ];
39385   TYPE_THEN `B` UNABBREV_TAC;
39386   FULL_REWRITE_TAC[SUBSET;INR IN_SING];
39387   ASM_MESON_TAC[];
39388   (* - *)
39389   TYPE_THEN `edge e` SUBAGOAL_TAC;
39390   ASM_MESON_TAC[ISUBSET];
39391   USE 3 (MATCH_MP cls_edge_size2);
39392   FULL_REWRITE_TAC[has_size2];
39393   (* - *)
39394   TYPE_THEN `2 <=| num_closure E (pointI a)` SUBAGOAL_TAC;
39395   IMATCH_MP_TAC  (ARITH_RULE `~(x = 0) /\ ~(x = 1) ==> 2 <= x`);
39396   CONJ_TAC;
39397   THM_INTRO_TAC[`E`;`pointI a`] num_closure0;
39398   FULL_REWRITE_TAC[conn2];
39399   REWR 6;
39400   TYPE_THEN `cls {e} a` SUBAGOAL_TAC;
39401   REWRITE_TAC[INR in_pair];
39402   FULL_REWRITE_TAC[cls;INR IN_SING ];
39403   ASM_MESON_TAC[];
39404   ASM_MESON_TAC[conn2_no1];
39405   FULL_REWRITE_TAC[num_closure];
39406   THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI a)}`;`2`] card_has_subset;
39407   IMATCH_MP_TAC  FINITE_SUBSET;
39408   TYPE_THEN `E` EXISTS_TAC;
39409   FULL_REWRITE_TAC[conn2];
39410   REWRITE_TAC[SUBSET];
39411   FULL_REWRITE_TAC[has_size2];
39412   TYPE_THEN `B` UNABBREV_TAC;
39413   USE 7(REWRITE_RULE[SUBSET;INR in_pair ]);
39414   (* - *)
39415   TYPE_THEN `?e' . (E e' /\ closure top2 e' (pointI a) /\ ~(e = e'))` SUBAGOAL_TAC;
39416   TYPE_THEN `e = a'` ASM_CASES_TAC;
39417   TYPE_THEN `b'` EXISTS_TAC;
39418   TYPE_THEN `a'` UNABBREV_TAC;
39419   TSPEC `b'` 7;
39420   ASM_MESON_TAC[];
39421   TYPE_THEN `a'` EXISTS_TAC;
39422   ASM_MESON_TAC[];
39423   (* -A *)
39424   TYPE_THEN`?c. (cls {e'} = {a,c}) /\ ~(c = a) ` SUBAGOAL_TAC;
39425   TYPE_THEN `edge e'` SUBAGOAL_TAC;
39426   ASM_MESON_TAC[ISUBSET];
39427   USE 11 (MATCH_MP cls_edge_size2);
39428   FULL_REWRITE_TAC[has_size2];
39429   USE 12 SYM;
39430   TYPE_THEN `cls{e'} a` SUBAGOAL_TAC;
39431   REWRITE_TAC[cls;INR IN_SING ];
39432   ASM_MESON_TAC[];
39433   TYPE_THEN `cls {e'}` UNABBREV_TAC;
39434   FULL_REWRITE_TAC[INR in_pair];
39435   FIRST_ASSUM DISJ_CASES_TAC;
39436   TYPE_THEN `b''` UNABBREV_TAC;
39437   TYPE_THEN `a''` EXISTS_TAC;
39438   IMATCH_MP_TAC  EQ_EXT;
39439   REWRITE_TAC[INR in_pair];
39440   MESON_TAC[];
39441   TYPE_THEN `a''` UNABBREV_TAC;
39442   TYPE_THEN `b''` EXISTS_TAC;
39443   ASM_MESON_TAC[];
39444   (* -B *)
39445   TYPE_THEN `~(c = b)` SUBAGOAL_TAC;
39446   TYPE_THEN`c` UNABBREV_TAC;
39447   TYPE_THEN `cls{e} = cls{e'}` SUBAGOAL_TAC;
39448   ASM_MESON_TAC[cls_inj;ISUBSET];
39449   (* - *)
39450   TYPE_THEN `?S. S SUBSET E /\ segment_end S b c /\ ~cls S a` SUBAGOAL_TAC;
39451   FULL_REWRITE_TAC[conn2];
39452   FIRST_ASSUM IMATCH_MP_TAC ;
39453   TYPE_THEN `cls {e} b /\ cls {e'} c` SUBAGOAL_TAC;
39454   REWRITE_TAC[INR in_pair];
39455   USE 12 SYM;
39456   USE 4 SYM;
39457   TYPE_THEN `cls {e} SUBSET cls E /\ cls {e'} SUBSET cls E` SUBAGOAL_TAC;
39458   CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
39459   ASM_MESON_TAC[ISUBSET];
39460   (* -C *)
39461   THM_INTRO_TAC[`b`;`a`;`e`] segment_end_sing;
39462   TYPE_THEN `cls {e} a /\ cls {e} b` SUBAGOAL_TAC;
39463   REWRITE_TAC[INR in_pair];
39464   FULL_REWRITE_TAC[cls;INR IN_SING ];
39465   ASM_MESON_TAC[ISUBSET];
39466   THM_INTRO_TAC[`a`;`c`;`e'`] segment_end_sing;
39467   TYPE_THEN `cls {e'} a /\ cls {e'} c` SUBAGOAL_TAC;
39468   REWRITE_TAC[INR in_pair];
39469   FULL_REWRITE_TAC[cls;INR IN_SING ];
39470   ASM_MESON_TAC[ISUBSET];
39471   (* - *)
39472   THM_INTRO_TAC[`{e}`;`{e'}`;`b`;`a`;`c`] segment_end_union;
39473   IMATCH_MP_TAC  EQ_EXT;
39474   REWRITE_TAC[INTER;INR in_pair;INR IN_SING];
39475   ASM_MESON_TAC[];
39476   (* -D *)
39477   THM_INTRO_TAC[`S`;`{e} UNION {e'}`;`b`;`c`] segment_end_union_rectagon;
39478   REWRITE_TAC[cls_union; UNION_OVER_INTER; EMPTY_UNION; ];
39479   CONJ_TAC;
39480   REWRITE_TAC[EQ_EMPTY;INTER ;INR IN_SING ];
39481   CONJ_TAC ;
39482   TYPE_THEN `x` UNABBREV_TAC;
39483   USE 4 SYM;
39484   TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC;
39485   IMATCH_MP_TAC  cls_subset;
39486   ASM_MESON_TAC[ISUBSET;INR IN_SING];
39487   USE 20 (REWRITE_RULE[SUBSET]);
39488   TSPEC `a` 20;
39489   TYPE_THEN `cls {e}` UNABBREV_TAC;
39490   FULL_REWRITE_TAC[INR in_pair];
39491   ASM_MESON_TAC[];
39492   USE 12 SYM;
39493   TYPE_THEN `cls {e'} SUBSET cls S` SUBAGOAL_TAC;
39494   IMATCH_MP_TAC  cls_subset;
39495   ASM_MESON_TAC[ISUBSET;INR IN_SING];
39496   USE 22 (REWRITE_RULE[SUBSET]);
39497   TSPEC `a` 22;
39498   TYPE_THEN `cls {e'}` UNABBREV_TAC;
39499   FULL_REWRITE_TAC[INR in_pair];
39500   ASM_MESON_TAC[];
39501   (* --E *)
39502   REWRITE_TAC[GSYM UNION_OVER_INTER];
39503   IMATCH_MP_TAC  SUBSET_ANTISYM;
39504   CONJ_TAC;
39505   REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair];
39506   TYPE_THEN `((x = c) \/ (x = b)) \/ (x = a)` SUBAGOAL_TAC;
39507   ASM_MESON_TAC[];
39508   FIRST_ASSUM DISJ_CASES_TAC;
39509   ASM_MESON_TAC[];
39510   (* -- *)
39511   REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair];
39512   TYPE_THEN `cls S b /\ cls S c` SUBAGOAL_TAC;
39513   ASM_MESON_TAC[segment_end_cls2;segment_end_cls];
39514   ASM_MESON_TAC[];
39515   TYPE_THEN `(S UNION {e} UNION {e'})` EXISTS_TAC;
39516   REWRITE_TAC[union_subset];
39517   REWRITE_TAC[SUBSET;INR IN_SING];
39518   ]);;
39519   (* }}} *)
39520
39521 (* ------------------------------------------------------------------ *)
39522 (* SECTION T *)
39523 (* ------------------------------------------------------------------ *)
39524
39525
39526 (* 1.0.6 rectagon components *)
39527
39528 (* redo some results from E that USE the segment hypothesis *)
39529
39530 let curve_cell_h_ver2 = prove_by_refinement(
39531   `!G n.  (curve_cell G (h_edge n) = G (h_edge n))`,
39532   (* {{{ proof *)
39533
39534   [
39535   REP_BASIC_TAC;
39536   REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI];
39537   ]);;
39538
39539   (* }}} *)
39540
39541 let curve_cell_v_ver2 = prove_by_refinement(
39542   `!G n. (curve_cell G (v_edge n) = G (v_edge n))`,
39543   (* {{{ proof *)
39544   [
39545   DISCH_ALL_TAC;
39546   REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI];
39547   ]);;
39548   (* }}} *)
39549
39550 let curve_closure_ver2 = prove_by_refinement(
39551   `!G. (FINITE  G) /\ (G SUBSET edge)  ==>
39552     (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`,
39553   (* {{{ proof *)
39554   [
39555   REP_BASIC_TAC;
39556   ASSUME_TAC top2_top;
39557   IMATCH_MP_TAC  SUBSET_ANTISYM;
39558   CONJ_TAC;
39559   ASM_SIMP_TAC[closure_unions];
39560   REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ];
39561   TYPE_THEN `edge x'` SUBGOAL_TAC;
39562   ASM_MESON_TAC[ISUBSET];
39563   FULL_REWRITE_TAC [edge];
39564   FIRST_ASSUM DISJ_CASES_TAC;
39565   TYPE_THEN `x'` UNABBREV_TAC;
39566   TYPE_THEN `t` UNABBREV_TAC;
39567   FULL_REWRITE_TAC [v_edge_closure;vc_edge;UNION ;INR IN_SING ];
39568   UND 3 THEN   REP_CASES_TAC;
39569   TYPE_THEN `v_edge m` EXISTS_TAC;
39570   ASM_SIMP_TAC [curve_cell_v_ver2];
39571   TYPE_THEN `{(pointI m)}` EXISTS_TAC;
39572   (* ---- *)
39573   ASM_SIMP_TAC [curve_cell_point];
39574   REWRITE_TAC[INR IN_SING];
39575   UNIFY_EXISTS_TAC;
39576   REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ];
39577   TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC;
39578   ASM_SIMP_TAC [curve_cell_point];
39579   REWRITE_TAC[INR IN_SING;plus_e12];
39580   TYPE_THEN `v_edge m` EXISTS_TAC;
39581   REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ];
39582   (* dt2 , down to 2 goals *)
39583   TYPE_THEN `x'` UNABBREV_TAC;
39584   TYPE_THEN `t` UNABBREV_TAC;
39585   FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING];
39586   UND 3 THEN REP_CASES_TAC;
39587   TYPE_THEN `h_edge m` EXISTS_TAC;
39588   ASM_SIMP_TAC[curve_cell_h_ver2];
39589   TYPE_THEN `{(pointI m)}` EXISTS_TAC;
39590   ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
39591   TYPE_THEN `h_edge m` EXISTS_TAC;
39592   FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING];
39593   TYPE_THEN `{x}` EXISTS_TAC;
39594   ASM_REWRITE_TAC[INR IN_SING];
39595   ASM_SIMP_TAC[curve_cell_point ;INR IN_SING;plus_e12 ];
39596   TYPE_THEN `h_edge m` EXISTS_TAC;
39597   FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING;plus_e12];
39598   (* dt1 *)
39599   REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset];
39600   ASM_SIMP_TAC[closure_unions];
39601   CONJ_TAC;
39602   REWRITE_TAC[SUBSET;IMAGE;UNIONS];
39603   DISCH_ALL_TAC;
39604   CONV_TAC (dropq_conv "u");
39605   NAME_CONFLICT_TAC;
39606   TYPE_THEN `u` EXISTS_TAC;
39607   ASM_MESON_TAC[subset_closure;ISUBSET ];
39608   (* // *)
39609   TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ;
39610   REWRITE_TAC[UNIONS;SUBSET ];
39611   TYPE_THEN `u` UNABBREV_TAC;
39612   FULL_REWRITE_TAC [INR IN_SING];
39613   ASM_MESON_TAC [];
39614   ]);;
39615   (* }}} *)
39616
39617 let curve_cell_h_inter_ver2 = prove_by_refinement(
39618   `!G m.  (FINITE  G) /\ (G SUBSET edge) ==>
39619      (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
39620          (~(G (h_edge m))))`,
39621   (* {{{ proof *)
39622   [
39623   DISCH_ALL_TAC;
39624   ONCE_REWRITE_TAC [GSYM curve_cell_h_ver2];
39625   IMATCH_MP_TAC  cell_inter;
39626   ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
39627   ASM_MESON_TAC[segment;curve_cell_cell];
39628   ]);;
39629   (* }}} *)
39630
39631 let curve_cell_v_inter_ver2 = prove_by_refinement(
39632   `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
39633      (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
39634          (~(G (v_edge m))))`,
39635   (* {{{ proof *)
39636   [
39637   DISCH_ALL_TAC;
39638   ONCE_REWRITE_TAC [GSYM curve_cell_v_ver2];
39639   IMATCH_MP_TAC  cell_inter;
39640   ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
39641   ASM_MESON_TAC[segment;curve_cell_cell];
39642   ]);;
39643   (* }}} *)
39644
39645 let curve_cell_squ_ver2 = prove_by_refinement(
39646   `!G m. (FINITE  G) /\ (G SUBSET edge) ==> ~curve_cell G (squ m)`,
39647   (* {{{ proof *)
39648   [
39649   REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment];
39650   FULL_REWRITE_TAC [SUBSET; edge];
39651   TSPEC `squ m` 1;
39652   USE 0(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;cell_clauses]);
39653   ]);;
39654   (* }}} *)
39655
39656 let curve_cell_squ_inter_ver2 = prove_by_refinement(
39657   `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
39658      (((squ m) INTER (UNIONS (curve_cell G)) = {}))`,
39659   (* {{{ proof *)
39660   [
39661   DISCH_ALL_TAC;
39662   TYPE_THEN `cell (squ m)` SUBGOAL_TAC;
39663   REWRITE_TAC[cell_rules];
39664   TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC;
39665   ASM_MESON_TAC[curve_cell_cell;segment];
39666   ASM_SIMP_TAC [cell_inter];
39667   ASM_MESON_TAC [curve_cell_squ_ver2];
39668   ]);;
39669   (* }}} *)
39670
39671 let curve_point_unions_ver2 = prove_by_refinement(
39672   `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
39673      (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`,
39674   (* {{{ proof *)
39675   [
39676   DISCH_ALL_TAC;
39677   TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC;
39678   REWRITE_TAC[REWRITE_RULE[not_eq] single_inter];
39679   REWRITE_TAC [not_eq];
39680   IMATCH_MP_TAC  cell_inter;
39681   ASM_MESON_TAC[cell_rules;curve_cell_cell];
39682   ]);;
39683   (* }}} *)
39684
39685 let curve_cell_not_point_ver2 = prove_by_refinement(
39686   `!G m. (FINITE  G) /\ (G SUBSET edge) ==> ((curve_cell G {(pointI m)} <=>
39687      ~(num_closure G (pointI m) = 0)))`,
39688   (* {{{ proof *)
39689   [
39690   DISCH_ALL_TAC;
39691   ASM_SIMP_TAC[curve_cell_point;num_closure0];
39692   ASM_MESON_TAC[];
39693   ]);;
39694   (* }}} *)
39695
39696 let curve_closed_ver2 = prove_by_refinement(
39697   `!G. (FINITE  G) /\ (G SUBSET edge) ==>
39698        (closed_ top2 (UNIONS (curve_cell G)))`,
39699   (* {{{ proof *)
39700   [
39701   DISCH_ALL_TAC;
39702   ASM_SIMP_TAC[GSYM curve_closure_ver2];
39703   IMATCH_MP_TAC  closure_closed;
39704   REWRITE_TAC[top2_top];
39705   IMATCH_MP_TAC  UNIONS_SUBSET;
39706   FULL_REWRITE_TAC [SUBSET;top2_unions;edge;  ];
39707   ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid];
39708   ]);;
39709   (* }}} *)
39710
39711 let ctop_top2_ver2 = prove_by_refinement(
39712   `!G A. (FINITE  G) /\ (G SUBSET edge) /\ ctop G A ==> top2 A`,
39713   (* {{{ proof *)
39714   [
39715   REWRITE_TAC[ctop;induced_top;IMAGE ;];
39716   TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ;
39717   TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC;
39718   TYPE_THEN `U` UNABBREV_TAC;
39719   ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
39720   IMATCH_MP_TAC  top_inter;
39721   ASM_REWRITE_TAC[top2_top;];
39722   ASM_SIMP_TAC[GSYM curve_closure_ver2;top2];
39723   IMATCH_MP_TAC  (REWRITE_RULE[open_DEF] closed_open);
39724   IMATCH_MP_TAC  closure_closed;
39725   CONJ_TAC;
39726   TYPE_THEN `U` UNABBREV_TAC;
39727   ASM_MESON_TAC[top_of_metric_top;metric_euclid];
39728   USE 5(GSYM);
39729   ASM_REWRITE_TAC[];
39730   IMATCH_MP_TAC  UNIONS_SUBSET;
39731   FULL_REWRITE_TAC [edge;ISUBSET;];
39732   TSPEC `A'` 2;
39733   REWRITE_TAC[];
39734   FIRST_ASSUM  DISJ_CASES_TAC;
39735   ASM_MESON_TAC[ (REWRITE_RULE[ISUBSET;] v_edge_euclid)];
39736   ASM_MESON_TAC [(REWRITE_RULE[ISUBSET;] h_edge_euclid)];
39737   ]);;
39738   (* }}} *)
39739
39740 let convex_connected_ver2 = prove_by_refinement(
39741   `!G Z. (FINITE  G) /\ (G SUBSET edge) /\ convex Z /\
39742          (Z SUBSET (UNIONS (ctop G))) ==>
39743             (connected (ctop G) Z)`,
39744   (* {{{ proof *)
39745   [
39746   DISCH_ALL_TAC;
39747   REWRITE_TAC[connected];
39748   DISCH_ALL_TAC;
39749   ASM_REWRITE_TAC[];
39750   DISCH_ALL_TAC;
39751   PROOF_BY_CONTR_TAC;
39752   USE 8 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
39753   LEFT 8 "x";
39754   LEFT 9 "x";
39755   TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC;
39756   ASM_MESON_TAC[];
39757   TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC;
39758   FULL_REWRITE_TAC [convex];
39759   ASM_MESON_TAC[ISUBSET];
39760   TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC;
39761   IMATCH_MP_TAC  connected_mk_segment;
39762   USE 3(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]);
39763   (* - *)
39764   FULL_REWRITE_TAC [connected];
39765   TYPEL_THEN [`A`;`B`] (USE 13 o ISPECL);
39766   REWR 13;
39767   TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC;
39768   REWRITE_TAC[GSYM top2];
39769   ASM_MESON_TAC[ctop_top2_ver2;top2];
39770   UND 13 THEN   ASM_REWRITE_TAC[];
39771   FIRST_ASSUM DISJ_CASES_TAC;
39772   (* -- *)
39773   UND 9 THEN REWRITE_TAC[];
39774   UND 8 THEN ASM_REWRITE_TAC[];
39775   PROOF_BY_CONTR_TAC;
39776   ASM_MESON_TAC[mk_segment_end;ISUBSET];
39777   ASM_MESON_TAC [mk_segment_end;ISUBSET ];
39778   ]);;
39779   (* }}} *)
39780
39781 let convex_component_ver2 = prove_by_refinement(
39782   `!G Z x. (FINITE  G) /\ (G SUBSET edge) /\ convex Z /\
39783        (Z SUBSET (UNIONS (ctop G))) /\
39784      (~(Z INTER (component  (ctop G) x ) = EMPTY))  ==>
39785         (Z SUBSET (component  (ctop G) x))  `,
39786   (* {{{ proof *)
39787   [
39788   DISCH_ALL_TAC;
39789   TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC;
39790   ASM_SIMP_TAC[convex_connected_ver2];
39791   USE 4(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
39792   USE 4(MATCH_MP component_replace);
39793   IMATCH_MP_TAC  connected_component;
39794   ]);;
39795   (* }}} *)
39796
39797 let unions_cell_of_ver2 = prove_by_refinement(
39798   `!G x. ((FINITE  G) /\ (G SUBSET edge) ==>
39799      (UNIONS (cell_of (component  (ctop G) x)) =
39800            component  (ctop G) x))`,
39801   (* {{{ proof *)
39802   [
39803   DISCH_ALL_TAC;
39804   IMATCH_MP_TAC  SUBSET_ANTISYM;
39805   REWRITE_TAC [UNIONS;SUBSET;cell_of];
39806   CONJ_TAC;
39807   TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC;
39808   UND 2 THEN REWRITE_TAC[component_DEF   ;connected;SUBSET ;ctop_unions;DIFF ];
39809   USE 3 (MATCH_MP point_onto);
39810   TYPE_THEN `x'` UNABBREV_TAC;
39811   ASSUME_TAC cell_unions;
39812   TSPEC `p` 3;
39813   USE 3 (REWRITE_RULE[UNIONS]);
39814   TYPE_THEN `u` EXISTS_TAC;
39815   (* - *)
39816   DISCH_ALL_TAC;
39817   TYPE_THEN `u SUBSET (component  (ctop G) x)` SUBAGOAL_TAC;
39818   IMATCH_MP_TAC  convex_component_ver2 ;
39819   ASM_REWRITE_TAC[EMPTY_EXISTS];
39820   CONJ_TAC;
39821   ASM_MESON_TAC[cell_convex];
39822   CONJ_TAC;
39823   REWRITE_TAC[ctop_unions];
39824   REWRITE_TAC[DIFF;SUBSET ];
39825   CONJ_TAC;
39826   ASM_MESON_TAC[cell_euclid;ISUBSET];
39827   FULL_REWRITE_TAC[UNIONS];
39828   USE 1 (MATCH_MP   curve_cell_cell);
39829   USE 1 (REWRITE_RULE[ISUBSET]);
39830   TSPEC `u'` 1;
39831   TYPE_THEN `u = u'` SUBGOAL_TAC;
39832   IMATCH_MP_TAC  cell_partition;
39833   REWRITE_TAC[EMPTY_EXISTS;INTER];
39834   ASM_MESON_TAC[];
39835   (* --- *)
39836   USE 2 (REWRITE_RULE[component_DEF;connected;SUBSET ]);
39837   TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC;
39838   USE 12(REWRITE_RULE[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ]);
39839   ASM_MESON_TAC[];
39840   TYPE_THEN `point p` EXISTS_TAC;
39841   ASM_REWRITE_TAC [INTER];
39842   (* - *)
39843   FULL_REWRITE_TAC [ISUBSET];
39844   ]);;
39845   (* }}} *)
39846
39847 let unbounded = jordan_def `unbounded C <=>
39848   (?r. !s. (r <=. s) ==> C (point(s,&.0)))`;;
39849
39850 let curve_cell_empty = prove_by_refinement(
39851   `curve_cell EMPTY = EMPTY `,
39852   (* {{{ proof *)
39853   [
39854   REWRITE_TAC[curve_cell];
39855   REWRITE_TAC[EQ_EMPTY];
39856   THM_INTRO_TAC[`top2`] closure_empty;
39857   REWRITE_TAC[top2_top];
39858   REWR 0;
39859   ]);;
39860   (* }}} *)
39861
39862 let curve_cell_union = prove_by_refinement(
39863   `!A B. curve_cell (A UNION B) = curve_cell A UNION curve_cell B`,
39864   (* {{{ proof *)
39865   [
39866   REWRITE_TAC[curve_cell];
39867   FULL_REWRITE_TAC[UNIONS_UNION;];
39868   ASM_SIMP_TAC[top2_top;closure_union];
39869   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;
39870   IMATCH_MP_TAC  EQ_EXT;
39871   REWRITE_TAC[UNION];
39872   MESON_TAC[];
39873   TYPE_THEN `C = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}` ABBREV_TAC ;
39874   TYPE_THEN `D = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)}` ABBREV_TAC ;
39875   REWRITE_TAC[UNION_ACI];
39876   ]);;
39877   (* }}} *)
39878
39879 let insert_sing = prove_by_refinement(
39880   `!A (x:A). x INSERT A = {x} UNION A`,
39881   (* {{{ proof *)
39882   [
39883   REP_BASIC_TAC;
39884   IMATCH_MP_TAC  EQ_EXT;
39885   REWRITE_TAC[INSERT;UNION;INR IN_SING];
39886   MESON_TAC[];
39887   ]);;
39888   (* }}} *)
39889
39890 let curve_cell_sing = prove_by_refinement(
39891   `!e. (edge e) ==> (UNIONS (curve_cell {e}) = closure top2 e)`,
39892   (* {{{ proof *)
39893   [
39894   REP_BASIC_TAC;
39895   REWRITE_TAC[curve_cell;UNIONS_UNION];
39896   FULL_REWRITE_TAC[edge];
39897   FIRST_ASSUM DISJ_CASES_TAC;
39898   REWRITE_TAC[v_edge_closure;vc_edge;plus_e12];
39899   IMATCH_MP_TAC  EQ_EXT;
39900   REWRITE_TAC[UNION;UNIONS];
39901   CONV_TAC (dropq_conv "u");
39902   REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj];
39903   RIGHT_TAC "n";
39904   TYPE_THEN `v_edge m x` ASM_CASES_TAC;
39905   MESON_TAC[];
39906   (* - *)
39907   REWRITE_TAC[h_edge_closure;hc_edge;plus_e12];
39908   IMATCH_MP_TAC  EQ_EXT;
39909   REWRITE_TAC[UNION;UNIONS];
39910   CONV_TAC (dropq_conv "u");
39911   REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj];
39912   RIGHT_TAC "n";
39913   TYPE_THEN `h_edge m x` ASM_CASES_TAC;
39914   MESON_TAC[];
39915   ]);;
39916   (* }}} *)
39917
39918 let unbounded_elt = prove_by_refinement(
39919   `!G. (FINITE G) /\ (G SUBSET edge) ==>
39920      (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r))`,
39921   (* {{{ proof *)
39922   [
39923   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[]];
39924   (* - *)
39925   CONJ_TAC;
39926   REWRITE_TAC[curve_cell_empty];
39927   (* - *)
39928   ASSUME_TAC top2_top;
39929   ONCE_REWRITE_TAC[insert_sing];
39930   REWRITE_TAC[curve_cell_union;UNIONS_UNION];
39931   REWRITE_TAC[UNION;];
39932   NAME_CONFLICT_TAC;
39933   THM_INTRO_TAC[`x`] curve_cell_sing;
39934   FULL_REWRITE_TAC[INSERT;SUBSET];
39935   ASM_MESON_TAC[];
39936   (* - *)
39937   TYPE_THEN `G SUBSET edge` SUBAGOAL_TAC;
39938   FULL_REWRITE_TAC[ISUBSET;INSERT];
39939   ASM_MESON_TAC[];
39940   REP_BASIC_TAC;
39941   (* - *)
39942   TYPE_THEN `edge x` SUBAGOAL_TAC;
39943   FULL_REWRITE_TAC[INSERT;SUBSET;];
39944   ASM_MESON_TAC[];
39945   TYPE_THEN `?r. !x'. closure top2 x x' ==> x' 0 < r` SUBAGOAL_TAC;
39946   USE 7(REWRITE_RULE[edge]);
39947   FIRST_ASSUM DISJ_CASES_TAC;
39948   REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING;plus_e12 ];
39949   TYPE_THEN  `real_of_int (FST m) + (&1)`  EXISTS_TAC;
39950   FULL_REWRITE_TAC[pointI];
39951   UND 9 THEN REP_CASES_TAC THEN   FULL_REWRITE_TAC[v_edge;coord01];
39952   FULL_REWRITE_TAC[v_edge;coord01];
39953   REAL_ARITH_TAC;
39954   REWRITE_TAC[coord01];
39955   REAL_ARITH_TAC;
39956   REWRITE_TAC[coord01;pointI];
39957   REAL_ARITH_TAC;
39958   (* --A *)
39959   REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING;plus_e12 ];
39960   TYPE_THEN  `real_of_int (FST m) + (&2)`  EXISTS_TAC;
39961   UND 9 THEN REP_CASES_TAC;
39962   FULL_REWRITE_TAC[h_edge;coord01];
39963   FULL_REWRITE_TAC[h_edge;coord01];
39964   FULL_REWRITE_TAC[int_add_th;int_of_num_th];
39965   UND 10 THEN REAL_ARITH_TAC;
39966   REWRITE_TAC[pointI];
39967   REAL_ARITH_TAC;
39968   REWRITE_TAC[pointI];
39969   FULL_REWRITE_TAC[int_add_th;int_of_num_th];
39970   REAL_ARITH_TAC;
39971   (* - *)
39972   TYPE_THEN `max_real r r'` EXISTS_TAC;
39973   TSPEC `x'` 3;
39974   FIRST_ASSUM DISJ_CASES_TAC;
39975   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
39976   IMATCH_MP_TAC  REAL_LTE_TRANS;
39977   TYPE_THEN `r'` EXISTS_TAC;
39978   ASM_REWRITE_TAC[max_real_le];
39979   IMATCH_MP_TAC  REAL_LTE_TRANS;
39980   TYPE_THEN `r` EXISTS_TAC;
39981   REWRITE_TAC[max_real_le];
39982   ]);;
39983   (* }}} *)
39984
39985 let mk_segment_convex = prove_by_refinement(
39986   `!x y. convex (mk_segment x y)`,
39987   (* {{{ proof *)
39988   [
39989   REWRITE_TAC[convex];
39990   FULL_REWRITE_TAC[mk_segment;SUBSET;];
39991   REP_BASIC_TAC;
39992   REWRITE_TAC[euclid_ldistrib];
39993   ONCE_REWRITE_TAC[euclid_plus_pair];
39994   REWRITE_TAC[euclid_scale_act];
39995   REWRITE_TAC[GSYM euclid_rdistrib];
39996   TYPE_THEN `(a * a'' + (&1 - a) * a')` EXISTS_TAC;
39997   CONJ_TAC;
39998   ineq_le_tac `(&0) + (a * a'') + (&1 - a)* a' = (a * a'' + (&1 - a)*a')`;
39999   CONJ_TAC;
40000   ineq_le_tac `(a * a'' + (&1 - a) * a') + ((&1 - a)*(&1 - a')) + a*(&1 - a'') = &1`;
40001   AP_TERM_TAC;
40002   AP_THM_TAC;
40003   AP_TERM_TAC;
40004   real_poly_tac;
40005   ]);;
40006   (* }}} *)
40007
40008 let mk_segment_h = prove_by_refinement(
40009   `!r s b x. (r <= s) ==> (mk_segment (point(r,b)) (point(s,b)) x <=> (?t. (r <= t /\ t <= s /\ (x = point(t,b)))))`,
40010   (* {{{ proof *)
40011   [
40012   REP_BASIC_TAC;
40013   REWRITE_TAC[mk_segment];
40014   REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`];
40015   IMATCH_MP_TAC  EQ_ANTISYM;
40016   CONJ_TAC;
40017   TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC;
40018   CONJ_TAC;
40019   ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`;
40020   ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`;
40021   TYPE_THEN `s = r` ASM_CASES_TAC;
40022   REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`];
40023   TYPE_THEN `&0` EXISTS_TAC;
40024   UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC;
40025   REWRITE_TAC[point_inj;PAIR_SPLIT];
40026   TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ;
40027   TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC;
40028   TYPE_THEN `v` UNABBREV_TAC;
40029   REWRITE_TAC[GSYM real_div_assoc];
40030   REDUCE_TAC;
40031   IMATCH_MP_TAC  REAL_DIV_REFL;
40032   UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
40033   TYPE_THEN `v*(s - t)` EXISTS_TAC;
40034   TYPE_THEN `&0 < v` SUBAGOAL_TAC;
40035   TYPE_THEN `v` UNABBREV_TAC;
40036   IMATCH_MP_TAC  REAL_LT_DIV;
40037   UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
40038   (* - *)
40039   CONJ_TAC;
40040   IMATCH_MP_TAC  REAL_LE_MUL;
40041   UND 7 THEN UND 2 THEN REAL_ARITH_TAC;
40042   CONJ_TAC;
40043   IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
40044   TYPE_THEN `(s - r)` EXISTS_TAC;
40045   CONJ_TAC;
40046   UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
40047   REWRITE_TAC[REAL_MUL_ASSOC];
40048   REDUCE_TAC;
40049   UND 3 THEN REAL_ARITH_TAC;
40050   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];
40051   ASM_REWRITE_TAC[];
40052   REAL_ARITH_TAC;
40053
40054   ]);;
40055   (* }}} *)
40056
40057 let unbounded_comp = prove_by_refinement(
40058   `!G. (FINITE G) /\ (G SUBSET edge) ==>
40059       (?x. unbounded (component  (ctop G) x))` ,
40060   (* {{{ proof *)
40061   [
40062   REWRITE_TAC[unbounded];
40063   THM_INTRO_TAC[`G`] unbounded_elt;
40064   TYPE_THEN `point(r, &0)` EXISTS_TAC;
40065   TYPE_THEN `r` EXISTS_TAC;
40066   TYPE_THEN `Z = mk_segment (point(r, &0)) (point(s, &0))` ABBREV_TAC ;
40067   THM_INTRO_TAC[`G`;`Z`;`(point(r, &0))`] convex_component_ver2;
40068   CONJ_TAC;
40069   TYPE_THEN `Z` UNABBREV_TAC;
40070   REWRITE_TAC[mk_segment_convex];
40071   (* -- *)
40072   CONJ_TAC;
40073   TYPE_THEN `Z` UNABBREV_TAC;
40074   REWRITE_TAC[ctop_unions];
40075   REWRITE_TAC[SUBSET;DIFF];
40076   THM_INTRO_TAC[`r`;`s`;`&0`;`x`] mk_segment_h;
40077   REWR 5;
40078   REWRITE_TAC[euclid_point];
40079   TSPEC `(point (t ,&0))` 2;
40080   FULL_REWRITE_TAC[coord01];
40081   UND 2 THEN UND 7 THEN REAL_ARITH_TAC;
40082   UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
40083   TYPE_THEN `(point(r,&0))` EXISTS_TAC;
40084   REWRITE_TAC[INTER];
40085   (* -- *)
40086   CONJ_TAC;
40087   TYPE_THEN `Z` UNABBREV_TAC;
40088   THM_INTRO_TAC[`r`;`s`;`&0`;`point(r,&0)`] mk_segment_h;
40089   TYPE_THEN `r` EXISTS_TAC;
40090   UND 3 THEN REAL_ARITH_TAC;
40091   IMATCH_MP_TAC  component_refl;
40092   REWRITE_TAC[ctop_unions];
40093   REWRITE_TAC[DIFF;euclid_point];
40094   TSPEC  `(point(r,&0))` 2;
40095   FULL_REWRITE_TAC[coord01];
40096   UND 2 THEN REAL_ARITH_TAC;
40097   (* -A *)
40098   FULL_REWRITE_TAC[SUBSET];
40099   TSPEC  `(point(s,&0))` 5;
40100   FIRST_ASSUM IMATCH_MP_TAC ;
40101   TYPE_THEN `Z` UNABBREV_TAC;
40102   REWRITE_TAC[mk_segment_end];
40103   ]);;
40104   (* }}} *)
40105
40106 let unbounded_comp_unique = prove_by_refinement(
40107   `!G x y. (FINITE G) /\ (G SUBSET edge) /\
40108       (unbounded (component  (ctop G) x)) /\
40109        (unbounded(component  (ctop G) y)) ==>
40110          (component  (ctop G) x = component  (ctop G) y) `,
40111   (* {{{ proof *)
40112   [
40113   REWRITE_TAC[unbounded];
40114   TSPEC  `max_real r r'` 0;
40115   TSPEC `max_real r r'` 1;
40116   FULL_REWRITE_TAC[max_real_le];
40117   ASM_MESON_TAC[component_replace];
40118   ]);;
40119   (* }}} *)
40120
40121 let unbounded_set = jordan_def
40122   `unbounded_set G x = unbounded(component  (ctop G) x)`;;
40123
40124 let bounded_set = jordan_def
40125    `bounded_set G x <=> ~(component  (ctop G) x = EMPTY) /\
40126       ~(unbounded (component  (ctop G) x))`;;
40127
40128 let bounded_unbounded_disj = prove_by_refinement(
40129   `!G. bounded_set G INTER unbounded_set G = EMPTY `,
40130   (* {{{ proof *)
40131   [
40132   REP_BASIC_TAC;
40133   REWRITE_TAC[EQ_EMPTY];
40134   FULL_REWRITE_TAC[INTER;bounded_set;unbounded_set];
40135   ASM_MESON_TAC[];
40136   ]);;
40137   (* }}} *)
40138
40139 let bounded_unbounded_union = prove_by_refinement(
40140   `!G. bounded_set G UNION unbounded_set G = UNIONS (ctop G)`,
40141   (* {{{ proof *)
40142   [
40143   REP_BASIC_TAC;
40144   IMATCH_MP_TAC  EQ_EXT;
40145   REWRITE_TAC[UNION;bounded_set;unbounded_set];
40146   THM_INTRO_TAC[`G`] ctop_top;
40147   TYPE_THEN `component  (ctop G) x = EMPTY` ASM_CASES_TAC;
40148   THM_INTRO_TAC[`ctop G`;`x`] component_empty;
40149   REWR 2;
40150   REWRITE_TAC[unbounded];
40151   TSPEC `r + &1` 3;
40152   UND 3 THEN REAL_ARITH_TAC;
40153   REWRITE_TAC[TAUT `~A \/ A`];
40154   ASM_MESON_TAC[component_empty];
40155   ]);;
40156   (* }}} *)
40157
40158 let bounded_subset_unions = prove_by_refinement(
40159   `!G x. (bounded_set G x ==> UNIONS (ctop G) x) `,
40160   (* {{{ proof *)
40161   [
40162   REP_BASIC_TAC;
40163   REWRITE_TAC[GSYM bounded_unbounded_union;UNION];
40164   ]);;
40165   (* }}} *)
40166
40167 let unbounded_subset_unions = prove_by_refinement(
40168   `!G x. (unbounded_set G x ==> UNIONS (ctop G) x) `,
40169   (* {{{ proof *)
40170   [
40171   REP_BASIC_TAC;
40172   REWRITE_TAC[GSYM bounded_unbounded_union;UNION];
40173   ]);;
40174   (* }}} *)
40175
40176 let unbounded_set_nonempty = prove_by_refinement(
40177   `!G. (FINITE G) /\ (G SUBSET edge) ==>
40178         ~(unbounded_set G = EMPTY)`,
40179   (* {{{ proof *)
40180   [
40181   REWRITE_TAC[EMPTY_EXISTS];
40182   REWRITE_TAC[unbounded_set];
40183   THM_INTRO_TAC[`G`] unbounded_comp;
40184   ]);;
40185   (* }}} *)
40186
40187 let unbounded_set_comp = prove_by_refinement(
40188   `!G. (FINITE G) /\ (G SUBSET edge) ==>
40189       (?x. unbounded_set G = component  (ctop G) x)`,
40190   (* {{{ proof *)
40191   [
40192   REP_BASIC_TAC;
40193   THM_INTRO_TAC[`G`] unbounded_comp;
40194   TYPE_THEN `x` EXISTS_TAC;
40195   IMATCH_MP_TAC  SUBSET_ANTISYM;
40196   CONJ_TAC;
40197   PROOF_BY_CONTR_TAC;
40198   USE 3(REWRITE_RULE[SUBSET]);
40199   LEFT 3 "x'";
40200   UND 3 THEN REWRITE_TAC[];
40201   THM_INTRO_TAC[`G`;`x`;`x'`] unbounded_comp_unique;
40202   FULL_REWRITE_TAC[unbounded_set];
40203   IMATCH_MP_TAC  component_refl;
40204   FULL_REWRITE_TAC[unbounded_set];
40205   FULL_REWRITE_TAC[unbounded];
40206   TSPEC  `r` 3;
40207   FULL_REWRITE_TAC[ARITH_RULE `r <= r`];
40208   TYPE_THEN `~(component  (ctop G) x' = EMPTY)` SUBAGOAL_TAC;
40209   FULL_REWRITE_TAC[EQ_EMPTY];
40210   ASM_MESON_TAC[];
40211   THM_INTRO_TAC[`ctop G`;`x'`] component_empty;
40212   REWRITE_TAC[ctop_top];
40213   ASM_MESON_TAC[];
40214   (* - *)
40215   REWRITE_TAC[SUBSET];
40216   REWRITE_TAC[unbounded_set];
40217   TYPE_THEN `component  (ctop G) x = component  (ctop G) x'` SUBAGOAL_TAC;
40218   IMATCH_MP_TAC  component_replace;
40219   ASM_MESON_TAC[];
40220   ]);;
40221   (* }}} *)
40222
40223 let unbounded_set_comp_elt = prove_by_refinement(
40224   `!G x. (FINITE G) /\ (G SUBSET edge) /\
40225         (unbounded_set G = component  (ctop G) x) ==>
40226            (unbounded_set G x)`,
40227   (* {{{ proof *)
40228   [
40229   REP_BASIC_TAC ;
40230   THM_INTRO_TAC[`G`]unbounded_set_nonempty;
40231   FULL_REWRITE_TAC[EMPTY_EXISTS];
40232   REWR 3;
40233   TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBAGOAL_TAC;
40234   FULL_REWRITE_TAC[EQ_EMPTY ];
40235   ASM_MESON_TAC[];
40236   ASSUME_TAC ctop_top;
40237   TYPE_THEN `(UNIONS (ctop G) x)` SUBAGOAL_TAC;
40238   PROOF_BY_CONTR_TAC;
40239   THM_INTRO_TAC[`ctop G`;`x`] component_empty;
40240   ASM_MESON_TAC[];
40241   ASM_MESON_TAC[component_refl];
40242   ]);;
40243   (* }}} *)
40244
40245 let unbounded_even_subset = prove_by_refinement(
40246   `!G. rectagon G ==> (unbounded_set G SUBSET UNIONS (par_cell T G))`,
40247   (* {{{ proof *)
40248   [
40249   REP_BASIC_TAC;
40250   TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC;
40251   FULL_REWRITE_TAC[rectagon];
40252   THM_INTRO_TAC[`G`] unbounded_set_comp;
40253   THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp;
40254   FIRST_ASSUM DISJ_CASES_TAC;
40255   PROOF_BY_CONTR_TAC;
40256   KILL 6;
40257   KILL 4;
40258   THM_INTRO_TAC[`G`;`x`] unbounded_set_comp_elt;
40259   USE 4 (REWRITE_RULE[unbounded_set;unbounded]);
40260   THM_INTRO_TAC[`G`] unbounded_elt;
40261   TYPE_THEN `s =  floor (max_real r r') + &:1` ABBREV_TAC ;
40262   TYPE_THEN `r < real_of_int s /\ r' < real_of_int s` SUBAGOAL_TAC;
40263   TYPE_THEN `s` UNABBREV_TAC;
40264   TYPE_THEN `!t u. t <= u ==> t <. real_of_int( floor u + &:1)` SUBAGOAL_TAC;
40265   REWRITE_TAC[int_add_th ; int_of_num_th];
40266   IMATCH_MP_TAC  REAL_LET_TRANS;
40267   TYPE_THEN `u` EXISTS_TAC;
40268   REWRITE_TAC[floor_ineq];
40269   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[max_real_le] ;
40270   (* -A *)
40271   TYPE_THEN `~(UNIONS (curve_cell G) (pointI (s, &:0)))` SUBAGOAL_TAC;
40272   TSPEC `pointI (s, &:0)` 6;
40273   USE 6 (REWRITE_RULE[pointI;coord01]);
40274   UND 6 THEN UND 8 THEN REAL_ARITH_TAC;
40275   THM_INTRO_TAC[`G`] rectagon_segment;
40276   THM_INTRO_TAC[`G`;`(s,&:0)`] curve_point_unions;
40277   UND 12 THEN ASM_REWRITE_TAC[];
40278   PROOF_BY_CONTR_TAC;
40279   (* - *)
40280   TYPE_THEN `par_cell T G {(pointI (s, &:0))}` SUBAGOAL_TAC;
40281   THM_INTRO_TAC[`G`;`(s, &:0)`;`T`] par_cell_point;
40282   CONJ_TAC;
40283   ASM_MESON_TAC[curve_cell_not_point];
40284   REWRITE_TAC[num_lower];
40285   TYPE_THEN `{m | G (h_edge m) /\ (FST m = s) /\ SND m <=: &:0} = EMPTY` SUBAGOAL_TAC;
40286   PROOF_BY_CONTR_TAC;
40287   FULL_REWRITE_TAC[EMPTY_EXISTS];
40288   USE 6(REWRITE_RULE[UNIONS]);
40289   LEFT 6 "u";
40290   LEFT 6 "u";
40291   TSPEC  `h_edge u` 6;
40292   THM_INTRO_TAC[`G`;`u`] curve_cell_h;
40293   REWR 6;
40294   USE 6(REWRITE_RULE[h_edge]);
40295   REWR 6;
40296   USE 6 (CONV_RULE (dropq_conv "x"));
40297   USE 6 (REWRITE_RULE[coord01]);
40298   USE 6 (CONV_RULE (dropq_conv "v"));
40299   TSPEC `real_of_int s + &1/ (&2)` 6;
40300   USE 6(REWRITE_RULE[int_add_th;int_of_num_th; REAL_LT_ADDR; REAL_LT_LADD; ]);
40301   UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
40302   IMATCH_MP_TAC  half_pos;
40303   TYPE_THEN `real_of_int s < r'` SUBAGOAL_TAC;
40304   IMATCH_MP_TAC  REAL_LT_TRANS;
40305   TYPE_THEN `real_of_int s + &1 / &2` EXISTS_TAC;
40306   REWRITE_TAC[REAL_LT_ADDR; REAL_LT_HALF1];
40307   UND 18 THEN UND 8 THEN REAL_ARITH_TAC;
40308   REWRITE_TAC[CARD_CLAUSES;EVEN2];
40309   (* -B *)
40310   TYPE_THEN `UNIONS (par_cell F G) (pointI (s,&:0))` SUBAGOAL_TAC;
40311   USE 5 (REWRITE_RULE[SUBSET]);
40312   FIRST_ASSUM IMATCH_MP_TAC ;
40313   REWRITE_TAC[pointI;int_of_num_th];
40314   FIRST_ASSUM IMATCH_MP_TAC ;
40315   UND 9 THEN REAL_ARITH_TAC ;
40316   TYPE_THEN `UNIONS (par_cell T G) (pointI (s,&:0))` SUBAGOAL_TAC;
40317   REWRITE_TAC[UNIONS];
40318   TYPE_THEN `{(pointI (s,&:0))}` EXISTS_TAC ;
40319   REWRITE_TAC[INR IN_SING];
40320   (* - *)
40321   THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
40322   USE 16(REWRITE_RULE[INTER;EQ_EMPTY]);
40323   ASM_MESON_TAC[];
40324   ]);;
40325   (* }}} *)
40326
40327 let odd_bounded_subset = prove_by_refinement(
40328   `!G. rectagon G ==> (UNIONS (par_cell F G) SUBSET  bounded_set G)`,
40329   (* {{{ proof *)
40330   [
40331   REP_BASIC_TAC;
40332   (* - *)
40333   REWRITE_TAC[SUBSET];
40334   THM_INTRO_TAC[`G`] unbounded_even_subset;
40335   FULL_REWRITE_TAC[SUBSET];
40336   TSPEC `x` 2;
40337   PROOF_BY_CONTR_TAC;
40338   FULL_REWRITE_TAC[bounded_set;unbounded_set;DE_MORGAN_THM ];
40339   FIRST_ASSUM DISJ_CASES_TAC;
40340   THM_INTRO_TAC[`G`] ctop_top;
40341   THM_INTRO_TAC[`ctop G`;`x`] component_empty;
40342   UND 6 THEN ASM_REWRITE_TAC[];
40343   THM_INTRO_TAC[`G`]rectagon_segment;
40344   THM_INTRO_TAC[`G`;`T`] par_cell_partition;
40345   USE 7(ONCE_REWRITE_RULE[FUN_EQ_THM]);
40346   TSPEC `x` 7;
40347   FULL_REWRITE_TAC[UNION];
40348   ASM_MESON_TAC[];
40349   THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
40350   UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
40351   ASM_MESON_TAC[];
40352   ]);;
40353   (* }}} *)
40354
40355 let unique_bounded = prove_by_refinement(
40356   `!G x y. (rectagon G) /\ bounded_set G x /\ bounded_set G y ==>
40357    (component  (ctop G) x = component  (ctop G) y) `,
40358   (* {{{ proof *)
40359   [
40360   REP_BASIC_TAC;
40361   THM_INTRO_TAC[`G`;`x`] bounded_subset_unions;
40362   THM_INTRO_TAC[`G`;`y`] bounded_subset_unions;
40363   TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC;
40364   FULL_REWRITE_TAC[rectagon];
40365   THM_INTRO_TAC[`G`] unbounded_set_nonempty;
40366   FULL_REWRITE_TAC[EMPTY_EXISTS];
40367   THM_INTRO_TAC[`G`;`u`] unbounded_subset_unions;
40368   THM_INTRO_TAC[`G`] rectagon_h_edge;
40369   THM_INTRO_TAC[`G`] ctop_top;
40370   TYPE_THEN `~(component  (ctop G) x = EMPTY) /\ ~(component  (ctop G) u = EMPTY) /\ ~(component  (ctop G) y = EMPTY)` SUBAGOAL_TAC;
40371   ASM_MESON_TAC[component_empty];
40372   TYPE_THEN `segment G` SUBAGOAL_TAC;
40373   IMATCH_MP_TAC  rectagon_segment;
40374   THM_INTRO_TAC[`G`;`x`;`h_edge m`] along_lemma11;
40375   THM_INTRO_TAC[`G`;`y`;`h_edge m`] along_lemma11;
40376   THM_INTRO_TAC[`G`;`u`;`h_edge m`] along_lemma11;
40377   USE 16 (MATCH_MP squc_h);
40378   USE 18 (MATCH_MP squc_h);
40379   USE 20 (MATCH_MP squc_h);
40380   TYPE_THEN `(p'' = p) \/ (p'' = p') \/ (p' = p)` SUBAGOAL_TAC;
40381   ASM_MESON_TAC[];
40382   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;
40383   FULL_REWRITE_TAC[SUBSET];
40384   THM_INTRO_TAC[`squ p'''`] cell_nonempty;
40385   REWRITE_TAC[cell_rules];
40386   FULL_REWRITE_TAC[EMPTY_EXISTS];
40387   TSPEC `u'` 22;
40388   TSPEC `u'` 23;
40389   KILL 19 THEN KILL 17 THEN KILL 15 THEN KILL 5;
40390   ASM_MESON_TAC[component_replace];
40391   (* - *)
40392   TYPE_THEN `!a. bounded_set G a ==> ~(component  (ctop G) a = component  (ctop G) u)` SUBAGOAL_TAC;
40393   TYPE_THEN `unbounded_set G a` SUBAGOAL_TAC;
40394   REWRITE_TAC[unbounded_set];
40395   REWRITE_TAC[GSYM unbounded_set];
40396   THM_INTRO_TAC[`G`] bounded_unbounded_disj;
40397   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
40398   ASM_MESON_TAC[];
40399   (* - *)
40400   UND 21 THEN REP_CASES_TAC;
40401   TYPE_THEN `p''` UNABBREV_TAC;
40402   UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p`;`u`;`x`]);
40403   UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
40404   ASM_MESON_TAC[];
40405   TYPE_THEN `p''` UNABBREV_TAC;
40406   UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p'`;`u`;`y`]);
40407   UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`y`]);
40408   ASM_MESON_TAC[];
40409   TYPE_THEN `p'` UNABBREV_TAC;
40410   FIRST_ASSUM IMATCH_MP_TAC ;
40411   ASM_MESON_TAC[];
40412   ]);;
40413   (* }}} *)
40414
40415 let odd_bounded = prove_by_refinement(
40416   `!G. rectagon G ==> (UNIONS (par_cell F G) =  bounded_set G)`,
40417   (* {{{ proof *)
40418   [
40419   REP_BASIC_TAC;
40420   IMATCH_MP_TAC  SUBSET_ANTISYM;
40421   CONJ_TAC;
40422   IMATCH_MP_TAC  odd_bounded_subset;
40423   REWRITE_TAC[SUBSET];
40424   PROOF_BY_CONTR_TAC;
40425   THM_INTRO_TAC[`G`;`F`] par_cell_nonempty;
40426   FULL_REWRITE_TAC[EMPTY_EXISTS];
40427   TYPE_THEN `?y. UNIONS (par_cell F G) y` SUBAGOAL_TAC;
40428   REWRITE_TAC[UNIONS];
40429   LEFT_TAC "u";
40430   TYPE_THEN `u` EXISTS_TAC;
40431   TYPE_THEN `cell u` SUBAGOAL_TAC;
40432   THM_INTRO_TAC[`G`;`F`] par_cell_cell;
40433   ASM_MESON_TAC[ISUBSET];
40434   USE 4 (MATCH_MP cell_nonempty);
40435   FULL_REWRITE_TAC[EMPTY_EXISTS];
40436   ASM_MESON_TAC[];
40437   (* - *)
40438   THM_INTRO_TAC[`G`] odd_bounded_subset;
40439   TYPE_THEN `bounded_set G y` SUBAGOAL_TAC;
40440   ASM_MESON_TAC[ISUBSET];
40441   (* - *)
40442   THM_INTRO_TAC[`G`;`x`;`y`] unique_bounded;
40443   TYPE_THEN `component  (ctop G) y SUBSET UNIONS (par_cell F G)` SUBAGOAL_TAC;
40444   THM_INTRO_TAC[`G`;`F`;`y`] par_cell_comp;
40445   FIRST_ASSUM DISJ_CASES_TAC;
40446   USE 9 (REWRITE_RULE[SUBSET]);
40447   TSPEC `y` 9;
40448   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
40449   IMATCH_MP_TAC  component_refl;
40450   IMATCH_MP_TAC  bounded_subset_unions;
40451   THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
40452   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
40453   ASM_MESON_TAC[];
40454   (* - *)
40455   USE 7 SYM;
40456   REWR 8;
40457   USE 8 (REWRITE_RULE[SUBSET]);
40458   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
40459   IMATCH_MP_TAC  component_refl;
40460   IMATCH_MP_TAC  bounded_subset_unions;
40461   ASM_MESON_TAC[];
40462   ]);;
40463   (* }}} *)
40464
40465 let unbounded_even = prove_by_refinement(
40466   `!G. rectagon G ==> (unbounded_set G = UNIONS (par_cell T G))`,
40467   (* {{{ proof *)
40468   [
40469   REP_BASIC_TAC;
40470   IMATCH_MP_TAC  SUBSET_ANTISYM;
40471   THM_INTRO_TAC[`G`] unbounded_even_subset;
40472   REWRITE_TAC[SUBSET];
40473   PROOF_BY_CONTR_TAC;
40474   THM_INTRO_TAC[`G`] odd_bounded;
40475   USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
40476   TSPEC `x` 4;
40477   (* - *)
40478   TYPE_THEN `segment G` SUBAGOAL_TAC;
40479   IMATCH_MP_TAC  rectagon_segment;
40480   TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC;
40481   THM_INTRO_TAC[`G`;`T`] par_cell_partition;
40482   USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
40483   TSPEC `x` 6;
40484   USE 6 (REWRITE_RULE[UNION]);
40485   ASM_MESON_TAC[];
40486   (* - *)
40487   THM_INTRO_TAC[`G`] bounded_unbounded_union;
40488   USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
40489   FULL_REWRITE_TAC[UNION];
40490   TYPE_THEN `bounded_set G x` SUBAGOAL_TAC;
40491   ASM_MESON_TAC[];
40492   REWR 4;
40493   THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
40494   FULL_REWRITE_TAC[EQ_EMPTY;INTER];
40495   ASM_MESON_TAC[];
40496   ]);;
40497   (* }}} *)
40498
40499 let par_cell_union_comp = prove_by_refinement(
40500   `!G eps x. (rectagon G) /\ (UNIONS (par_cell eps G) x) ==>
40501       (UNIONS (par_cell eps G) = component  (ctop G) x)`,
40502   (* {{{ proof *)
40503   [
40504   REP_BASIC_TAC;
40505   TYPE_THEN `eps = T` ASM_CASES_TAC;
40506   TYPE_THEN `UNIONS (par_cell T G) = unbounded_set G` SUBAGOAL_TAC;
40507   ASM_MESON_TAC[unbounded_even];
40508   TYPE_THEN `eps` UNABBREV_TAC;
40509   REWR 0;
40510   THM_INTRO_TAC[`G`]unbounded_set_comp;
40511   FULL_REWRITE_TAC[rectagon];
40512   REWR 0;
40513   ASM_MESON_TAC[component_replace];
40514   (* - *)
40515   TYPE_THEN `eps = F` ASM_CASES_TAC;
40516   TYPE_THEN `eps` UNABBREV_TAC;
40517   IMATCH_MP_TAC  SUBSET_ANTISYM;
40518   CONJ_TAC;
40519   REWRITE_TAC[SUBSET];
40520   PROOF_BY_CONTR_TAC;
40521   THM_INTRO_TAC[`G`;`x`;`x'`] unique_bounded;
40522   ASM_MESON_TAC[odd_bounded];
40523   UND 4 THEN REWRITE_TAC[];
40524   IMATCH_MP_TAC  component_refl;
40525   IMATCH_MP_TAC  bounded_subset_unions;
40526   ASM_MESON_TAC[odd_bounded];
40527   THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp;
40528   FIRST_ASSUM DISJ_CASES_TAC;
40529   USE 4 (REWRITE_RULE [SUBSET]);
40530   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
40531   IMATCH_MP_TAC  component_refl;
40532   IMATCH_MP_TAC   bounded_subset_unions;
40533   ASM_MESON_TAC[odd_bounded];
40534   THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
40535   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
40536   ASM_MESON_TAC[];
40537   ASM_MESON_TAC[];
40538   ]);;
40539   (* }}} *)
40540
40541 (* 1.0.7 Adding segments *)
40542
40543 let edge_cell = prove_by_refinement(
40544   `!e. (edge e) ==> (cell e)`,
40545   (* {{{ proof *)
40546   [
40547   REWRITE_TAC[edge];
40548   ASM_MESON_TAC[cell_rules];
40549   ]);;
40550   (* }}} *)
40551
40552 let edge_subset_ctop = prove_by_refinement(
40553   `!G A. FINITE G /\ G SUBSET edge /\ A SUBSET edge /\
40554         (A INTER G = EMPTY) ==> (UNIONS A SUBSET UNIONS (ctop G))`,
40555   (* {{{ proof *)
40556   [
40557   REP_BASIC_TAC;
40558   REWRITE_TAC[ctop_unions;DIFF_SUBSET];
40559   CONJ_TAC;
40560   IMATCH_MP_TAC  SUBSET_TRANS;
40561   TYPE_THEN `UNIONS edge` EXISTS_TAC ;
40562   CONJ_TAC;
40563   IMATCH_MP_TAC  UNIONS_UNIONS;
40564   FULL_REWRITE_TAC[segment];
40565   REWRITE_TAC[UNIONS;SUBSET];
40566   USE 5 (MATCH_MP edge_euclid2);
40567   FULL_REWRITE_TAC[SUBSET];
40568   (* - *)
40569   REWRITE_TAC[UNIONS;INTER;EQ_EMPTY];
40570   FULL_REWRITE_TAC[EQ_EMPTY];
40571   TSPEC `u` 0;
40572   USE 0(REWRITE_RULE[INTER]);
40573   UND 0 THEN ASM_REWRITE_TAC[];
40574   (* - *)
40575   TYPE_THEN `cell u /\ cell u'` SUBAGOAL_TAC;
40576   THM_INTRO_TAC[`G`] curve_cell_cell;
40577   THM_INTRO_TAC[`u`] edge_cell;
40578   FULL_REWRITE_TAC[ISUBSET];
40579   FULL_REWRITE_TAC[ISUBSET];
40580   (* - *)
40581   TYPE_THEN `u = u'` SUBAGOAL_TAC ;
40582   IMATCH_MP_TAC  cell_partition;
40583   REWRITE_TAC[EMPTY_EXISTS;INTER ];
40584   ASM_MESON_TAC[];
40585   TYPE_THEN `u'` UNABBREV_TAC;
40586   TYPE_THEN `edge u` SUBAGOAL_TAC;
40587   ASM_MESON_TAC[ISUBSET];
40588   FULL_REWRITE_TAC[edge];
40589   ASM_MESON_TAC[curve_cell_h_ver2;curve_cell_v_ver2];
40590   ]);;
40591   (* }}} *)
40592
40593 let par_cell_pointI = prove_by_refinement(
40594   `!G eps m.
40595      (par_cell eps G {(pointI m)} =
40596          UNIONS (par_cell eps G) (pointI m))`,
40597   (* {{{ proof *)
40598   [
40599   REP_BASIC_TAC;
40600   REWRITE_TAC[UNIONS];
40601   TYPE_THEN `!u. cell u /\ u (pointI m) ==> ( u = {(pointI m)})` SUBAGOAL_TAC;
40602   FULL_REWRITE_TAC[cell];
40603   UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `u` UNABBREV_TAC) THEN (FULL_REWRITE_TAC[cell_clauses;INR IN_SING;pointI_inj]);
40604   IMATCH_MP_TAC  EQ_ANTISYM;
40605   CONJ_TAC;
40606   TYPE_THEN `{(pointI m)}` EXISTS_TAC;
40607   REWRITE_TAC[INR IN_SING];
40608   TYPE_THEN `u = {(pointI m)}` SUBAGOAL_TAC;
40609   FIRST_ASSUM IMATCH_MP_TAC ;
40610   ASM_MESON_TAC[par_cell_cell;subset_imp];
40611   ASM_MESON_TAC[];
40612   ]);;
40613   (* }}} *)
40614
40615 let par_cell_pointI_trichot = prove_by_refinement(
40616   `!G eps m. (rectagon G) ==>
40617     ((par_cell eps G {(pointI m)}) \/ (par_cell (~eps) G {(pointI m)})
40618         \/ (cls G m))`,
40619   (* {{{ proof *)
40620   [
40621   REP_BASIC_TAC;
40622   TYPE_THEN `UNIONS (ctop G) (pointI m)` ASM_CASES_TAC;
40623   THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
40624   IMATCH_MP_TAC  rectagon_segment;
40625   USE 2 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
40626   TSPEC  `pointI m` 2;
40627   REWR 2;
40628   USE 2(REWRITE_RULE[UNION]);
40629   USE 2 (REWRITE_RULE[GSYM par_cell_pointI]);
40630   ASM_MESON_TAC[];
40631   THM_INTRO_TAC[`G`] rectagon_segment;
40632   (* - *)
40633   DISJ2_TAC;
40634   DISJ2_TAC;
40635   REWRITE_TAC[cls];
40636   FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM ];
40637   THM_INTRO_TAC[`G`;`m`] curve_point_unions;
40638   REWR 1;
40639   FIRST_ASSUM DISJ_CASES_TAC;
40640   FULL_REWRITE_TAC[pointI;euclid_point];
40641   ASM_MESON_TAC[];
40642   THM_INTRO_TAC[`G`;`m`] curve_cell_not_point;
40643   REWR 4;
40644   THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
40645   FULL_REWRITE_TAC[rectagon];
40646   REWR 6;
40647   ASM_MESON_TAC[];
40648   ]);;
40649   (* }}} *)
40650
40651 let par_cell_nbd = prove_by_refinement(
40652   `!G eps m e. (rectagon G) /\ (par_cell eps G {(pointI m)}) /\ edge e
40653      /\ closure top2 e (pointI m) ==> (par_cell eps G e)`,
40654   (* {{{ proof *)
40655   [
40656   REP_BASIC_TAC;
40657   FULL_REWRITE_TAC[edge];
40658   FIRST_ASSUM DISJ_CASES_TAC;
40659   THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_v;
40660   TYPE_THEN `e` UNABBREV_TAC;
40661   FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;];
40662   FIRST_ASSUM DISJ_CASES_TAC;
40663   TYPE_THEN `m'` UNABBREV_TAC;
40664   TYPE_THEN `m` UNABBREV_TAC;
40665   TYPE_THEN `down (FST m',SND m' +: &:1) = m'` SUBAGOAL_TAC;
40666   REWRITE_TAC[down;PAIR_SPLIT];
40667   INT_ARITH_TAC;
40668   REWR 5;
40669   (* - *)
40670   TYPE_THEN `e` UNABBREV_TAC;
40671   THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_h;
40672   FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;];
40673   FIRST_ASSUM DISJ_CASES_TAC;
40674   TYPE_THEN `m'` UNABBREV_TAC;
40675   TYPE_THEN `m` UNABBREV_TAC;
40676   TYPE_THEN `left (FST m' +: &:1,SND m') = m'` SUBAGOAL_TAC;
40677   REWRITE_TAC[left  ;PAIR_SPLIT];
40678   INT_ARITH_TAC;
40679   REWR 4;
40680   ]);;
40681   (* }}} *)
40682
40683 let segment_in_comp = prove_by_refinement(
40684   `!G A. rectagon G /\ segment A /\ (A INTER G = EMPTY) /\
40685      (cls G INTER cls A SUBSET  endpoint A)
40686    ==> (?eps. A SUBSET par_cell eps G)`,
40687   (* {{{ proof *)
40688
40689   [
40690   REP_BASIC_TAC;
40691   TYPE_THEN `?e. A e` SUBAGOAL_TAC;
40692   FULL_REWRITE_TAC[segment;EMPTY_EXISTS ];
40693   ASM_MESON_TAC[];
40694   (* - *)
40695   THM_INTRO_TAC[`G`;`A`] edge_subset_ctop;
40696   FULL_REWRITE_TAC[segment;rectagon];
40697   (* - *)
40698   THM_INTRO_TAC[`G`] rectagon_segment;
40699   TYPE_THEN`edge e` SUBAGOAL_TAC;
40700   FULL_REWRITE_TAC[SUBSET;segment];
40701   THM_INTRO_TAC[`e`] edge_cell;
40702   THM_INTRO_TAC[`e`] cell_nonempty;
40703   FULL_REWRITE_TAC[EMPTY_EXISTS];
40704   (* - *)
40705   TYPE_THEN `?eps. ~(e INTER (UNIONS (par_cell eps G)) = EMPTY)` SUBAGOAL_TAC;
40706   REWRITE_TAC[EMPTY_EXISTS];
40707   THM_INTRO_TAC[`G`;`T`] par_cell_partition;
40708   USE 10(ONCE_REWRITE_RULE[FUN_EQ_THM]);
40709   TSPEC `u` 10;
40710   TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC;
40711   IMATCH_MP_TAC  subset_imp;
40712   TYPE_THEN `UNIONS A` EXISTS_TAC;
40713   REWRITE_TAC[UNIONS];
40714   ASM_MESON_TAC[];
40715   REWR 10;
40716   USE 10 (REWRITE_RULE[SUBSET ;UNION]);
40717   FIRST_ASSUM DISJ_CASES_TAC;
40718   TYPE_THEN `T` EXISTS_TAC;
40719   TYPE_THEN `u` EXISTS_TAC;
40720   REWRITE_TAC[INTER];
40721   REWRITE_TAC[INTER];
40722   ASM_MESON_TAC[];
40723   (* -A *)
40724   TYPE_THEN `eps` EXISTS_TAC;
40725   (* - *)
40726   USE 10 (REWRITE_RULE [EMPTY_EXISTS;INTER;UNIONS]);
40727   TYPE_THEN `u'' = e` SUBAGOAL_TAC;
40728   IMATCH_MP_TAC  cell_partition;
40729   REWRITE_TAC[EMPTY_EXISTS;INTER ];
40730   ASM_MESON_TAC[par_cell_cell;subset_imp ];
40731   TYPE_THEN `u''` UNABBREV_TAC;
40732   (* - *)
40733   TYPE_THEN `S = A INTER par_cell eps G` ABBREV_TAC ;
40734   TYPE_THEN `inductive_set A S` BACK_TAC ;  (* // *)
40735   FULL_REWRITE_TAC[inductive_set;segment];
40736   TYPE_THEN `S = A` SUBAGOAL_TAC;
40737   FIRST_ASSUM IMATCH_MP_TAC ;
40738   UND 2 THEN MESON_TAC[];
40739   KILL 15 THEN KILL 20 THEN KILL 16 THEN KILL 21;
40740   TYPE_THEN `S` UNABBREV_TAC;
40741   ASM_MESON_TAC[SUBSET_INTER_ABSORPTION];
40742   (* -// *)
40743   REWRITE_TAC[inductive_set];
40744   SUBCONJ_TAC;
40745   TYPE_THEN `S` UNABBREV_TAC ;
40746   REWRITE_TAC[INTER;SUBSET];
40747   REWRITE_TAC[EMPTY_EXISTS];
40748   CONJ_TAC;
40749   TYPE_THEN `e` EXISTS_TAC;
40750   TYPE_THEN `S` UNABBREV_TAC;
40751   REWRITE_TAC[INTER];
40752   (* -B *)
40753   USE 13(REWRITE_RULE[INTER]);
40754   TYPE_THEN `S` UNABBREV_TAC;
40755   THM_INTRO_TAC[`C`;`C'`] adjv_adj;
40756   FULL_REWRITE_TAC[segment];
40757   ASM_MESON_TAC[subset_imp];
40758   TYPE_THEN `m = adjv C C'` ABBREV_TAC ;
40759   (* - *)
40760   TYPE_THEN `FINITE G /\ FINITE A` SUBAGOAL_TAC;
40761   FULL_REWRITE_TAC[segment];
40762   TYPE_THEN `~endpoint A m` SUBAGOAL_TAC;
40763   FULL_REWRITE_TAC[endpoint];
40764   THM_INTRO_TAC[`A`;`pointI m`] num_closure1;
40765   REWR 23;
40766   COPY 23;
40767   TSPEC `C` 23;
40768   TSPEC `C'` 24;
40769   TYPE_THEN `e' = C` SUBAGOAL_TAC;
40770   ASM_MESON_TAC[];
40771   TYPE_THEN `e'` UNABBREV_TAC;
40772   THM_INTRO_TAC[`C`;`C'`] adjv_adj2;
40773   USE 2(REWRITE_RULE[segment]);
40774   ASM_MESON_TAC[subset_imp];
40775   TYPE_THEN `C = C'` SUBAGOAL_TAC;
40776   ASM_MESON_TAC[];
40777   FULL_REWRITE_TAC[adj];
40778   ASM_MESON_TAC[];
40779   (* - *)
40780   TYPE_THEN `cls A m` SUBAGOAL_TAC;
40781   REWRITE_TAC[cls];
40782   ASM_MESON_TAC[];
40783   (* - *)
40784   TYPE_THEN `~cls G m` SUBAGOAL_TAC;
40785   USE 0 (REWRITE_RULE[SUBSET;INTER]);
40786   ASM_MESON_TAC[];
40787   (* -C *)
40788   TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC;
40789   USE 2(REWRITE_RULE[segment]);
40790   ASM_MESON_TAC[subset_imp];
40791   THM_INTRO_TAC[`G`;`eps`;`m`] par_cell_pointI_trichot;
40792   REWR 27;
40793   FIRST_ASSUM DISJ_CASES_TAC;
40794   THM_INTRO_TAC[`G`;`eps`;`m`;`C'`] par_cell_nbd;
40795   TYPE_THEN `m` UNABBREV_TAC;
40796   IMATCH_MP_TAC  adjv_adj2;
40797   (* - *)
40798   THM_INTRO_TAC[`G`;`~eps`;`m`;`C`] par_cell_nbd;
40799   THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
40800   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
40801   ASM_MESON_TAC[];
40802   ]);;
40803
40804   (* }}} *)
40805
40806 let segment_end_select = prove_by_refinement(
40807   `!E A a b. (E SUBSET edge) /\ segment_end A a b /\
40808         ~cls E a /\ cls E b ==>
40809     (?B c. segment_end B a c /\ cls E c /\ B SUBSET A /\
40810             (cls B INTER cls E = {c}))`,
40811   (* {{{ proof *)
40812   [
40813   REP_BASIC_TAC;
40814   TYPE_THEN `EE  = { (B,c) | segment_end B a c /\ cls E c /\ B SUBSET A }` ABBREV_TAC ;
40815   (* - *)
40816   TYPE_THEN `~(EE = EMPTY)` SUBAGOAL_TAC;
40817   UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
40818   TYPE_THEN `(A,b)` EXISTS_TAC;
40819   TYPE_THEN `EE` UNABBREV_TAC;
40820   TYPE_THEN `A` EXISTS_TAC;
40821   TYPE_THEN `b` EXISTS_TAC;
40822   ASM_REWRITE_TAC[SUBSET_REFL];
40823   (* - *)
40824   THM_INTRO_TAC[`EE`;`(CARD o FST):((((num->real)->bool)->bool)#(int#int))->num`] select_image_num_min;
40825   ASM_MESON_TAC[];
40826   (* - *)
40827   TYPE_THEN `?Bm cm. (z = (Bm,cm))` SUBAGOAL_TAC;
40828   ONCE_REWRITE_TAC[PAIR_SPLIT];
40829   MESON_TAC[];
40830   TYPE_THEN `z` UNABBREV_TAC;
40831   TYPE_THEN `Bm` EXISTS_TAC;
40832   TYPE_THEN `cm` EXISTS_TAC;
40833   TYPE_THEN `EE` UNABBREV_TAC;
40834   FULL_REWRITE_TAC[o_DEF];
40835   USE 4(ONCE_REWRITE_RULE[PAIR_SPLIT]);
40836   USE 4(REWRITE_RULE[]);
40837   TYPE_THEN `c` UNABBREV_TAC;
40838   TYPE_THEN `B` UNABBREV_TAC;
40839   (* - *)
40840   IMATCH_MP_TAC  SUBSET_ANTISYM;
40841   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
40842   CONJ_TAC;
40843   FULL_REWRITE_TAC[SUBSET;INR IN_SING;INTER];
40844   IMATCH_MP_TAC  segment_end_cls2;
40845   ASM_MESON_TAC[];
40846   (* - *)
40847   REWRITE_TAC[SUBSET;INTER;INR IN_SING];
40848   PROOF_BY_CONTR_TAC;
40849   THM_INTRO_TAC[`Bm`;`a`;`cm`;`x`] cut_psegment;
40850   DISCH_TAC;
40851   ASM_MESON_TAC[];
40852   (* - *)
40853   TSPEC `(A',x)` 6;
40854   USE 6 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
40855   REWR 6;
40856   USE 6 (CONV_RULE (dropq_conv "B"));
40857   USE 6 (CONV_RULE (dropq_conv "c"));
40858   UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
40859   IMATCH_MP_TAC  SUBSET_TRANS;
40860   TYPE_THEN `Bm` EXISTS_TAC;
40861   REWRITE_TAC[SUBSET;UNION];
40862   USE 6(MATCH_MP (ARITH_RULE `x <=| y ==> ~( y < x)`));
40863   UND 6 THEN REWRITE_TAC[];
40864   (* - *)
40865   IMATCH_MP_TAC  card_subset_lt;
40866   CONJ_TAC;
40867   REWRITE_TAC[SUBSET;UNION];
40868   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
40869   CONJ_TAC;
40870   REWRITE_TAC[FINITE_UNION];
40871   FULL_REWRITE_TAC[segment_end;segment;psegment];
40872   (* - *)
40873   TYPE_THEN `~(B' = EMPTY)` SUBAGOAL_TAC;
40874   FULL_REWRITE_TAC[segment_end;segment;psegment];
40875   UND 17 THEN UND 19 THEN MESON_TAC[];
40876   FULL_REWRITE_TAC[EMPTY_EXISTS];
40877   FULL_REWRITE_TAC[EQ_EMPTY;INTER ];
40878   TSPEC `u` 15;
40879   USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
40880   TSPEC `u` 6;
40881   FULL_REWRITE_TAC[UNION];
40882   ASM_MESON_TAC[];
40883   ]);;
40884   (* }}} *)
40885
40886 let endpoint_cls = prove_by_refinement(
40887   `!G. FINITE G ==> (endpoint G SUBSET cls G)`,
40888   (* {{{ proof *)
40889   [
40890   REWRITE_TAC[endpoint;SUBSET;cls];
40891   THM_INTRO_TAC[`G`;`pointI x`] num_closure1;
40892   REWR 2;
40893   MESON_TAC[];
40894   ]);;
40895   (* }}} *)
40896
40897 let conn2_proper = prove_by_refinement(
40898   `!G H .  (G SUBSET edge) /\
40899         conn2 G /\ conn2 H /\ H SUBSET G /\ ~(H = G)  ==>
40900      (?A. A SUBSET G /\ (A INTER H = EMPTY) /\ psegment A /\
40901          (cls H INTER cls A = endpoint A))`,
40902   (* {{{ proof *)
40903   [
40904   REP_BASIC_TAC;
40905   (* - *)
40906   TYPE_THEN `cls G SUBSET cls H` ASM_CASES_TAC;
40907   TYPE_THEN `?e. G e /\ ~H e` SUBAGOAL_TAC;
40908   PROOF_BY_CONTR_TAC;
40909   UND 0 THEN REWRITE_TAC[];
40910   IMATCH_MP_TAC  SUBSET_ANTISYM;
40911   REWRITE_TAC[SUBSET];
40912   ASM_MESON_TAC[];
40913   (* -- *)
40914   TYPE_THEN `edge e` SUBAGOAL_TAC;
40915   ASM_MESON_TAC[subset_imp];
40916   TYPE_THEN `{e}` EXISTS_TAC;
40917   CONJ_TAC;
40918   ASM_REWRITE_TAC[SUBSET;INR IN_SING];
40919   CONJ_TAC;
40920   ASM_REWRITE_TAC[EQ_EMPTY;INR IN_SING;INTER];
40921   ASM_MESON_TAC[];
40922   CONJ_TAC;
40923   IMATCH_MP_TAC  psegment_edge;
40924   TYPE_THEN `endpoint{e} = cls{e}` SUBAGOAL_TAC;
40925   ASM_SIMP_TAC[endpoint_closure;cls_edge];
40926   ONCE_REWRITE_TAC[INTER_COMM];
40927   REWRITE_TAC[ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_INTER_ABSORPTION];
40928   IMATCH_MP_TAC  SUBSET_TRANS;
40929   TYPE_THEN `cls G` EXISTS_TAC;
40930   IMATCH_MP_TAC  cls_subset;
40931   REWRITE_TAC[SUBSET;INR IN_SING];
40932   (* -A *)
40933   TYPE_THEN `?a. cls G a /\ ~cls H a` SUBAGOAL_TAC;
40934   USE 5(REWRITE_RULE[SUBSET]);
40935   ASM_MESON_TAC[];
40936   (* - *)
40937   TYPE_THEN `FINITE H /\ H SUBSET edge` SUBAGOAL_TAC;
40938   CONJ_TAC;
40939   FULL_REWRITE_TAC[conn2];
40940   IMATCH_MP_TAC  SUBSET_TRANS;
40941   UNIFY_EXISTS_TAC;
40942   (* - *)
40943   TYPE_THEN `?b c. cls H b /\ cls H c /\ ~(b = c)` SUBAGOAL_TAC;
40944   THM_INTRO_TAC[`H`] conn2_cls3;
40945   THM_INTRO_TAC[`cls H`;`2`] card_has_subset;
40946   CONJ_TAC;
40947   ASM_MESON_TAC[finite_cls];
40948   UND 10 THEN ARITH_TAC;
40949   FULL_REWRITE_TAC[has_size2];
40950   TYPE_THEN `B` UNABBREV_TAC;
40951   FULL_REWRITE_TAC[SUBSET;INR in_pair];
40952   TYPE_THEN `a'` EXISTS_TAC;
40953   TYPE_THEN `b` EXISTS_TAC;
40954   ASM_MESON_TAC[];
40955   (* -B *)
40956   TYPE_THEN `cls H SUBSET cls G` SUBAGOAL_TAC;
40957   IMATCH_MP_TAC  cls_subset;
40958   TYPE_THEN `~(a = b) /\ ~(a = c)` SUBAGOAL_TAC;
40959   ASM_MESON_TAC[];
40960   (* - *)
40961   TYPE_THEN `(?U. U SUBSET G /\ segment_end U a b /\ ~cls U c)` SUBAGOAL_TAC;
40962   FULL_REWRITE_TAC[conn2];
40963   FIRST_ASSUM IMATCH_MP_TAC ;
40964   ASM_MESON_TAC[subset_imp];
40965   THM_INTRO_TAC[`H`;`U`;`a`;`b`] segment_end_select;
40966   TYPE_THEN `B SUBSET G` SUBAGOAL_TAC;
40967   IMATCH_MP_TAC  SUBSET_TRANS;
40968   TYPE_THEN `U` EXISTS_TAC;
40969   TYPE_THEN `~cls B c` SUBAGOAL_TAC;
40970   TYPE_THEN `cls B SUBSET cls U` SUBAGOAL_TAC;
40971   IMATCH_MP_TAC  cls_subset;
40972   USE 25 (REWRITE_RULE[SUBSET]);
40973   ASM_MESON_TAC[];
40974   KILL 20 THEN KILL 16 THEN KILL 17 THEN KILL 18 THEN KILL 15 THEN KILL 10;
40975   KILL 12;
40976   TYPE_THEN `~(a = c')` SUBAGOAL_TAC;
40977   ASM_MESON_TAC[];
40978   TYPE_THEN `~(c = c')` SUBAGOAL_TAC;
40979   TYPE_THEN`c'` UNABBREV_TAC;
40980   USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
40981   TSPEC  `c` 12;
40982   USE 12 (REWRITE_RULE[INTER;INR IN_SING]);
40983   ASM_MESON_TAC[];
40984   (* - *)
40985   TYPE_THEN `(?V. V SUBSET G /\ segment_end V a c /\ ~cls V c')` SUBAGOAL_TAC;
40986   FULL_REWRITE_TAC[conn2];
40987   FIRST_ASSUM IMATCH_MP_TAC ;
40988   ASM_MESON_TAC[subset_imp];
40989   THM_INTRO_TAC[`H`;`V`;`a`;`c`] segment_end_select;
40990   (* -C *)
40991   TYPE_THEN `B' SUBSET G` SUBAGOAL_TAC;
40992   IMATCH_MP_TAC  SUBSET_TRANS;
40993   TYPE_THEN `V` EXISTS_TAC;
40994   TYPE_THEN `~cls B' c'` SUBAGOAL_TAC;
40995   TYPE_THEN `cls B' SUBSET cls V` SUBAGOAL_TAC;
40996   IMATCH_MP_TAC  cls_subset;
40997   USE 29 (REWRITE_RULE[SUBSET]);
40998   ASM_MESON_TAC[];
40999   KILL 20 THEN KILL 16 THEN KILL 17;
41000   KILL 15;
41001   KILL 12 THEN KILL 24 THEN KILL 14;
41002   (* - *)
41003   TYPE_THEN `~(c'' = c')` SUBAGOAL_TAC;
41004   TYPE_THEN `c''` UNABBREV_TAC;
41005   USE 18 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
41006   TSPEC  `c'` 12;
41007   USE 12 (REWRITE_RULE[INTER;INR IN_SING]);
41008   ASM_MESON_TAC[];
41009   (* - *)
41010   TYPE_THEN `B INTER H = EMPTY` SUBAGOAL_TAC;
41011   PROOF_BY_CONTR_TAC;
41012   FULL_REWRITE_TAC[EMPTY_EXISTS];
41013   USE 14(REWRITE_RULE[INTER]);
41014   USE 19 SYM;
41015   TYPE_THEN `cls {u} SUBSET cls B INTER cls H` SUBAGOAL_TAC;
41016   REWRITE_TAC[SUBSET_INTER];
41017   CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
41018   USE 16 SYM;
41019   REWR 17;
41020   THM_INTRO_TAC[`u`] cls_edge_size2;
41021   FULL_REWRITE_TAC[SUBSET];
41022   FULL_REWRITE_TAC[has_size2];
41023   REWR 17;
41024   USE 17 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]);
41025   COPY 17;
41026   TSPEC `a'` 17;
41027   TSPEC `b` 24;
41028   ASM_MESON_TAC[];
41029   (* - *)
41030   TYPE_THEN `B' INTER H = EMPTY` SUBAGOAL_TAC;
41031   PROOF_BY_CONTR_TAC;
41032   FULL_REWRITE_TAC[EMPTY_EXISTS];
41033   USE 15(REWRITE_RULE[INTER]);
41034   USE 18 SYM;
41035   TYPE_THEN `cls {u} SUBSET cls B' INTER cls H` SUBAGOAL_TAC;
41036   REWRITE_TAC[SUBSET_INTER];
41037   CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
41038   USE 17 SYM;
41039   REWR 18;
41040   THM_INTRO_TAC[`u`] cls_edge_size2;
41041   FULL_REWRITE_TAC[SUBSET];
41042   FULL_REWRITE_TAC[has_size2];
41043   REWR 18;
41044   USE 18 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]);
41045   COPY 18;
41046   TSPEC `a'` 18;
41047   TSPEC `b` 29;
41048   ASM_MESON_TAC[];
41049   (* -D *)
41050   USE 22 (ONCE_REWRITE_RULE[segment_end_symm]);
41051   THM_INTRO_TAC[`B`;`B'`;`c'`;`a`;`c''`] segment_end_trans;
41052   TYPE_THEN `U` EXISTS_TAC;
41053   SUBCONJ_TAC;
41054   IMATCH_MP_TAC  SUBSET_TRANS;
41055   TYPE_THEN `B UNION B'` EXISTS_TAC;
41056   REWRITE_TAC[union_subset];
41057   (* - *)
41058   CONJ_TAC;
41059   PROOF_BY_CONTR_TAC;
41060   FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ];
41061   ASM_MESON_TAC[];
41062   (* - *)
41063   CONJ_TAC;
41064   USE 20(REWRITE_RULE[segment_end]);
41065   (* -// *)
41066   IMATCH_MP_TAC  SUBSET_ANTISYM;
41067   CONJ_TAC;
41068   REWRITE_TAC[INTER;SUBSET];
41069   USE 20 (REWRITE_RULE[segment_end]);
41070   REWRITE_TAC[INR in_pair];
41071   TYPE_THEN `cls U SUBSET cls(B UNION B')` SUBAGOAL_TAC;
41072   IMATCH_MP_TAC  cls_subset;
41073   USE 31(REWRITE_RULE[SUBSET;cls_union]);
41074   USE 31(REWRITE_RULE[UNION]);
41075   TSPEC `x` 31;
41076   FIRST_ASSUM DISJ_CASES_TAC;
41077   USE 19(ONCE_REWRITE_RULE[FUN_EQ_THM]);
41078   TSPEC `x` 19;
41079   USE 19 (REWRITE_RULE[INTER;INR IN_SING]);
41080   ASM_MESON_TAC[];
41081   USE 18(ONCE_REWRITE_RULE[FUN_EQ_THM]);
41082   TSPEC `x` 18;
41083   USE 18 (REWRITE_RULE[INTER;INR IN_SING]);
41084   ASM_MESON_TAC[];
41085   (* -E *)
41086   USE 20(REWRITE_RULE[segment_end]);
41087   REWRITE_TAC[SUBSET;INTER;INR in_pair];
41088   CONJ_TAC;
41089   FIRST_ASSUM DISJ_CASES_TAC;
41090   ASM_REWRITE_TAC[];
41091   ASM_REWRITE_TAC[];
41092   (* - *)
41093   TYPE_THEN `FINITE U` SUBAGOAL_TAC;
41094   FULL_REWRITE_TAC[segment_end;psegment;segment];
41095   (* - *)
41096   USE 20 SYM;
41097   TYPE_THEN `endpoint U SUBSET cls U` SUBAGOAL_TAC;
41098   IMATCH_MP_TAC  endpoint_cls;
41099   USE 31(REWRITE_RULE[SUBSET]);
41100   FIRST_ASSUM IMATCH_MP_TAC ;
41101   USE 20 SYM;
41102   REWRITE_TAC[INR in_pair];
41103   ]);;
41104   (* }}} *)
41105
41106 (* ------------------------------------------------------------------ *)
41107 (* SECTION U *)
41108 (* ------------------------------------------------------------------ *)
41109
41110
41111 (* EVEN and ODD components.  1.0.8, Nov 28, 2004, 9am *)
41112
41113 let parity_select  = jordan_def
41114   `parity G C = @eps. par_cell eps G C`;;
41115
41116 let cell_ununion = prove_by_refinement(
41117   `!V C u. cell C /\ C u /\ (V SUBSET cell) /\ (UNIONS V) u ==> V C`,
41118   (* {{{ proof *)
41119   [
41120   REWRITE_TAC[UNIONS];
41121   TYPE_THEN `u' = C` SUBAGOAL_TAC;
41122   IMATCH_MP_TAC  cell_partition;
41123   CONJ_TAC;
41124   ASM_MESON_TAC[subset_imp];
41125   UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
41126   ASM_MESON_TAC[];
41127   ASM_MESON_TAC[];
41128   ]);;
41129   (* }}} *)
41130
41131 let par_cell_cell_partition = prove_by_refinement(
41132   `!G eps C. segment G /\ cell C ==>
41133       (par_cell eps G C \/ par_cell (~eps) G C \/ curve_cell G C)`,
41134   (* {{{ proof *)
41135   [
41136   REP_BASIC_TAC;
41137   TYPE_THEN `curve_cell G C` ASM_CASES_TAC;
41138   THM_INTRO_TAC[`C`] cell_nonempty;
41139   FULL_REWRITE_TAC[EMPTY_EXISTS];
41140   TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC;
41141   REWRITE_TAC[ctop_unions;DIFF;UNIONS  ];
41142   CONJ_TAC;
41143   THM_INTRO_TAC[`C`] cell_euclid;
41144   ASM_MESON_TAC[subset_imp];
41145   THM_INTRO_TAC[`curve_cell G`;`C`;`u`] cell_ununion;
41146   CONJ_TAC;
41147   IMATCH_MP_TAC  curve_cell_cell;
41148   FULL_REWRITE_TAC[segment];
41149   REWRITE_TAC[UNIONS];
41150   ASM_MESON_TAC[];
41151   ASM_MESON_TAC[];
41152   (* - *)
41153   THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
41154   USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
41155   TSPEC `u` 5;
41156   REWR 5;
41157   USE 5(REWRITE_RULE[UNION]);
41158   THM_INTRO_TAC[`G`] par_cell_cell;
41159   FIRST_ASSUM DISJ_CASES_TAC;
41160   DISJ1_TAC;
41161   IMATCH_MP_TAC  cell_ununion;
41162   ASM_MESON_TAC[];
41163   DISJ2_TAC;
41164   IMATCH_MP_TAC  cell_ununion;
41165   ASM_MESON_TAC[];
41166   ]);;
41167   (* }}} *)
41168
41169 let par_cell_curve_cell_disj = prove_by_refinement(
41170   `!G  eps. (G SUBSET edge) ==>
41171    (par_cell eps G  INTER curve_cell G = EMPTY )`,
41172   (* {{{ proof *)
41173   [
41174   REP_BASIC_TAC;
41175   REWRITE_TAC[INTER;EQ_EMPTY];
41176   USE 2(MATCH_MP par_cell_curve_disj);
41177   UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;UNIONS ];
41178   TYPE_THEN `cell x` SUBAGOAL_TAC;
41179   ASM_MESON_TAC[curve_cell_cell;subset_imp];
41180   USE 2 (MATCH_MP cell_nonempty);
41181   FULL_REWRITE_TAC[EMPTY_EXISTS];
41182   TYPE_THEN `u` EXISTS_TAC;
41183   ASM_MESON_TAC[];
41184   ]);;
41185   (* }}} *)
41186
41187 let curve_cell_edge = prove_by_refinement(
41188   `!G e . edge e ==> (curve_cell G e = G e) `,
41189   (* {{{ proof *)
41190   [
41191   REWRITE_TAC[edge];
41192   FIRST_ASSUM DISJ_CASES_TAC;
41193   REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ];
41194   REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ];
41195   ]);;
41196   (* }}} *)
41197
41198 let parity = prove_by_refinement(
41199   `!G C. segment G /\ cell C /\ ~curve_cell G C ==>
41200         par_cell (parity G C) G C`,
41201   (* {{{ proof *)
41202   [
41203   REWRITE_TAC[parity_select];
41204   SELECT_TAC;
41205   THM_INTRO_TAC[`G`;`T`;`C`] par_cell_cell_partition;
41206   ASM_MESON_TAC[];
41207   ]);;
41208   (* }}} *)
41209
41210 let parity_unique = prove_by_refinement(
41211   `!G C eps. segment G  /\
41212         par_cell eps G C ==> (eps = parity G C)`,
41213   (* {{{ proof *)
41214   [
41215   REP_BASIC_TAC;
41216   TYPE_THEN `cell C /\ ~curve_cell G C` SUBAGOAL_TAC;
41217   SUBCONJ_TAC;
41218   ASM_MESON_TAC[par_cell_cell;subset_imp];
41219   THM_INTRO_TAC[`G`;`eps`] par_cell_curve_cell_disj;
41220   FULL_REWRITE_TAC[segment];
41221   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
41222   ASM_MESON_TAC[];
41223   THM_INTRO_TAC[`G`;`C`] parity;
41224   PROOF_BY_CONTR_TAC;
41225   TYPE_THEN`parity G C = ~eps` SUBAGOAL_TAC;
41226   ASM_MESON_TAC[];
41227   TYPE_THEN `parity G C` UNABBREV_TAC;
41228   THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
41229   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
41230   ASM_MESON_TAC[];
41231   ]);;
41232   (* }}} *)
41233
41234 let unions_curve_cell = prove_by_refinement(
41235   `!G C. (G SUBSET edge) /\ cell C ==>
41236      ((C INTER UNIONS (curve_cell G) = EMPTY) = (~curve_cell G C))`,
41237   (* {{{ proof *)
41238   [
41239   REP_BASIC_TAC;
41240   IMATCH_MP_TAC  EQ_ANTISYM;
41241   CONJ_TAC;
41242   USE 3(REWRITE_RULE[INTER;UNIONS;EQ_EMPTY]);
41243   USE 0 (MATCH_MP cell_nonempty);
41244   FULL_REWRITE_TAC[EMPTY_EXISTS];
41245   ASM_MESON_TAC[];
41246   (* - *)
41247   REWRITE_TAC[EQ_EMPTY;INTER];
41248   UND 2 THEN REWRITE_TAC[];
41249   IMATCH_MP_TAC  cell_ununion;
41250   UNIFY_EXISTS_TAC;
41251   IMATCH_MP_TAC  curve_cell_cell;
41252   ]);;
41253   (* }}} *)
41254
41255 let even_num_lower_union = prove_by_refinement(
41256   `!A B m. FINITE A /\ FINITE B /\ (A INTER B = EMPTY) ==>
41257     (EVEN (num_lower (A UNION B) m) <=>
41258         (EVEN (num_lower A m) = EVEN (num_lower B m)))`,
41259   (* {{{ proof *)
41260   [
41261   REWRITE_TAC[num_lower_set];
41262   THM_INTRO_TAC[`set_lower A m`;`set_lower B m`] even_card_even;
41263   REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC finite_set_lower));
41264   REWRITE_TAC[EQ_EMPTY;INTER;set_lower];
41265   FULL_REWRITE_TAC[EQ_EMPTY;INTER];
41266   ASM_MESON_TAC[];
41267   (* - *)
41268   AP_TERM_TAC;
41269   AP_TERM_TAC;
41270   IMATCH_MP_TAC  EQ_EXT;
41271   REWRITE_TAC[set_lower;UNION];
41272   TYPE_THEN `C <=> (FST x = FST m) /\ SND x <=: SND m` ABBREV_TAC ;
41273   USE 0 (REWRITE_RULE[INTER;EQ_EMPTY]);
41274   TSPEC `h_edge x` 0;
41275   UND 0 THEN MESON_TAC[];
41276   ]);;
41277   (* }}} *)
41278
41279 let eq_pair_exchange = prove_by_refinement(
41280   `!(a:bool) b c d. ((a = b) <=> (c = d)) <=> ((a = c) <=> (b = d))`,
41281   (* {{{ proof *)
41282   [
41283   MESON_TAC[];
41284   ]);;
41285   (* }}} *)
41286
41287 let parity_point = prove_by_refinement(
41288   `!A p. segment A /\ ~(curve_cell A {(pointI p)}) ==>
41289         (parity A {(pointI p)} = EVEN (num_lower A p))`,
41290   (* {{{ proof *)
41291   [
41292   REP_BASIC_TAC;
41293   ONCE_REWRITE_TAC[EQ_SYM_EQ];
41294   IMATCH_MP_TAC  parity_unique;
41295   REWRITE_TAC[par_cell;cell_clauses];
41296   THM_INTRO_TAC[`A`;`{(pointI p)}`] unions_curve_cell;
41297   FULL_REWRITE_TAC[cell_rules;segment];
41298   MESON_TAC[];
41299   ]);;
41300   (* }}} *)
41301
41302 let parity_h = prove_by_refinement(
41303   `!A p. segment A /\ ~A (h_edge p) ==>
41304        (parity A (h_edge p) <=> EVEN (num_lower A p))`,
41305   (* {{{ proof *)
41306   [
41307   REP_BASIC_TAC;
41308   ONCE_REWRITE_TAC[EQ_SYM_EQ];
41309   IMATCH_MP_TAC  parity_unique;
41310   REWRITE_TAC[par_cell;cell_clauses];
41311   THM_INTRO_TAC[`A`;`h_edge p`] unions_curve_cell;
41312   FULL_REWRITE_TAC[cell_rules;segment];
41313   THM_INTRO_TAC[`A`;`h_edge p`] curve_cell_edge;
41314   REWRITE_TAC[edge_h];
41315   MESON_TAC[];
41316   ]);;
41317   (* }}} *)
41318
41319 let parity_v = prove_by_refinement(
41320   `!A p. segment A /\ ~A (v_edge p) ==>
41321        (parity A (v_edge p) <=> EVEN (num_lower A p))`,
41322   (* {{{ proof *)
41323   [
41324   REP_BASIC_TAC;
41325   ONCE_REWRITE_TAC[EQ_SYM_EQ];
41326   IMATCH_MP_TAC  parity_unique;
41327   REWRITE_TAC[par_cell;cell_clauses];
41328   THM_INTRO_TAC[`A`;`v_edge p`] unions_curve_cell;
41329   FULL_REWRITE_TAC[cell_rules;segment];
41330   THM_INTRO_TAC[`A`;`v_edge p`] curve_cell_edge;
41331   REWRITE_TAC[edge_v];
41332   MESON_TAC[];
41333   ]);;
41334   (* }}} *)
41335
41336 let parity_squ = prove_by_refinement(
41337   `!A p. segment A  ==>
41338        (parity A (squ p) <=> EVEN (num_lower A p))`,
41339   (* {{{ proof *)
41340   [
41341   REP_BASIC_TAC;
41342   ONCE_REWRITE_TAC[EQ_SYM_EQ];
41343   IMATCH_MP_TAC  parity_unique;
41344   REWRITE_TAC[par_cell;cell_clauses];
41345   THM_INTRO_TAC[`A`;`squ p`] unions_curve_cell;
41346   FULL_REWRITE_TAC[cell_rules;segment];
41347   THM_INTRO_TAC[`A`;`p`] curve_cell_squ;
41348   MESON_TAC[];
41349   ]);;
41350   (* }}} *)
41351
41352 let parity_union = prove_by_refinement(
41353   `!A B C. segment A /\ segment B /\ segment (A UNION B) /\
41354     (A INTER B = EMPTY) /\
41355     cell C /\ ~curve_cell A C /\  ~curve_cell B C ==>
41356          (parity (A UNION B) C  <=> (parity A C = parity B C))`,
41357   (* {{{ proof *)
41358
41359   [
41360   REP_BASIC_TAC;
41361   ONCE_REWRITE_TAC[EQ_SYM_EQ];
41362   IMATCH_MP_TAC  parity_unique;
41363   REWRITE_TAC[par_cell];
41364   TYPE_THEN `A UNION B SUBSET edge` SUBAGOAL_TAC;
41365   REWRITE_TAC[union_subset];
41366   FULL_REWRITE_TAC[segment];
41367   ASM_SIMP_TAC[unions_curve_cell];
41368   TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
41369   FULL_REWRITE_TAC[segment];
41370   ASM_SIMP_TAC[even_num_lower_union];
41371   ONCE_REWRITE_TAC[eq_pair_exchange];
41372   (* -A *)
41373   REWRITE_TAC[curve_cell_union];
41374   REWRITE_TAC[UNION];
41375   (* - *)
41376   WITH 2(REWRITE_RULE[cell_mem]);
41377   UND 10 THEN REP_CASES_TAC ;
41378   (* --cases-- *)
41379   REWRITE_TAC[cell_clauses];
41380   TYPE_THEN`p` EXISTS_TAC;
41381   IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
41382   TYPE_THEN `C` UNABBREV_TAC;
41383   CONJ_TAC THEN (IMATCH_MP_TAC  parity_point);
41384   REWRITE_TAC[cell_clauses];
41385   TYPE_THEN`p` EXISTS_TAC;
41386   IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
41387   TYPE_THEN `C` UNABBREV_TAC;
41388   CONJ_TAC THEN (IMATCH_MP_TAC  parity_h) THEN ASM_MESON_TAC[curve_cell_h_ver2];
41389   REWRITE_TAC[cell_clauses];
41390   TYPE_THEN`p` EXISTS_TAC;
41391   IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
41392   TYPE_THEN `C` UNABBREV_TAC;
41393   CONJ_TAC THEN (IMATCH_MP_TAC  parity_v) THEN ASM_MESON_TAC[curve_cell_v_ver2];
41394   REWRITE_TAC[cell_clauses];
41395   TYPE_THEN`p` EXISTS_TAC;
41396   IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
41397   TYPE_THEN `C` UNABBREV_TAC;
41398   CONJ_TAC THEN (IMATCH_MP_TAC  parity_squ) ;
41399   ]);;
41400
41401   (* }}} *)
41402
41403 (* extraneous fact *)
41404 let component_simple_arc = prove_by_refinement(
41405   `!G x y. (FINITE G /\ G SUBSET edge ) /\ ~(x = y) ==>
41406       ((component  (ctop G) x y) <=>
41407         (?C. simple_arc_end C x y /\
41408              (C INTER (UNIONS (curve_cell G)) = EMPTY)))`,
41409   (* {{{ proof *)
41410   [
41411   (*
41412    string together :component-imp-connected, connected-induced2,
41413                     p_conn_conn, p_conn_hv_finite;
41414    other_direction : simple_arc_connected, connected-induced,
41415                     connected-component; *)
41416   REP_BASIC_TAC;
41417   THM_INTRO_TAC[`G`] ctop_top;
41418   ASSUME_TAC top2_top;
41419   THM_INTRO_TAC[`G`] curve_closed_ver2;
41420   TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC;
41421   USE 5 (MATCH_MP closed_open);
41422   FULL_REWRITE_TAC[top2_unions;open_DEF ];
41423   TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ;
41424   TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC;
41425   TYPE_THEN`A` UNABBREV_TAC;
41426   REWRITE_TAC[ctop_unions];
41427   TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC;
41428   REWRITE_TAC[ctop];
41429   (* - *)
41430   IMATCH_MP_TAC  EQ_ANTISYM;
41431   CONJ_TAC;
41432   THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected;
41433   THM_INTRO_TAC[`(top2)`;`A`;`(component  (ctop G) x)`] connected_induced2;
41434   REWRITE_TAC[top2_unions];
41435   IMATCH_MP_TAC  SUBSET_TRANS;
41436   TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
41437   CONJ_TAC;
41438   KILL 7;
41439   TYPE_THEN `A` UNABBREV_TAC;
41440   REWRITE_TAC[component_unions];
41441   TYPE_THEN `A` UNABBREV_TAC;
41442   REWRITE_TAC[DIFF;SUBSET];
41443   REWR 12;
41444   (* --A *)
41445   TYPE_THEN `B = component  (ctop G) x` ABBREV_TAC ;
41446   TYPE_THEN `B x /\ B y` SUBAGOAL_TAC;
41447   TYPE_THEN `B` UNABBREV_TAC;
41448   THM_INTRO_TAC[`(ctop G)`;`x`;`y`] component_replace;
41449   IMATCH_MP_TAC  component_symm;
41450   (* -- *)
41451   ASSUME_TAC loc_path_conn_top2;
41452   TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC;
41453   REWRITE_TAC[ctop];
41454   REWRITE_TAC[top2];
41455   ONCE_REWRITE_TAC[EQ_SYM_EQ];
41456   IMATCH_MP_TAC  top_of_metric_induced;
41457   TYPE_THEN `A` UNABBREV_TAC;
41458   REWRITE_TAC[DIFF;SUBSET];
41459   (* -- *)
41460   TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC;
41461   THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
41462   FULL_REWRITE_TAC[top2];
41463   ASM_MESON_TAC[];
41464   (* -- *)
41465   THM_INTRO_TAC[`top2`] loc_path_conn;
41466   REWR 20;
41467   TSPEC `A` 20;
41468   REWR 20;
41469   TSPEC `x` 20;
41470   TYPE_THEN `A x` SUBAGOAL_TAC;
41471   ASM_MESON_TAC[subset_imp];
41472   TYPE_THEN `top2 B` SUBAGOAL_TAC;
41473   TYPE_THEN `B` UNABBREV_TAC;
41474   ASM_MESON_TAC[path_eq_conn];
41475   (* --B *)
41476   THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn;
41477   (* -- *)
41478   THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite;
41479   ASM_MESON_TAC[];
41480   REWR 24;
41481   TYPE_THEN `C` EXISTS_TAC;
41482   PROOF_BY_CONTR_TAC;
41483   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
41484   USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
41485   TSPEC `u` 7;
41486   FULL_REWRITE_TAC[DIFF];
41487   TYPE_THEN `B u` SUBAGOAL_TAC;
41488   ASM_MESON_TAC[subset_imp];
41489   TYPE_THEN `A u` SUBAGOAL_TAC;
41490   ASM_MESON_TAC[subset_imp];
41491   REWR 7;
41492   (* -C *)
41493   (* other_direction : simple_arc_connected, connected-induced,
41494                     connected-component; *)
41495   THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple;
41496   THM_INTRO_TAC[`C`] simple_arc_connected;
41497   TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC;
41498   IMATCH_MP_TAC  simple_arc_euclid;
41499   THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
41500   REWRITE_TAC[top2_unions];
41501   REWR 15;
41502   (* - *)
41503   TYPE_THEN `C SUBSET A` SUBAGOAL_TAC;
41504   TYPE_THEN `A` UNABBREV_TAC;
41505   REWRITE_TAC[DIFF_SUBSET];
41506   REWR 15;
41507   (* - *)
41508   THM_INTRO_TAC[`(ctop G)`;`C`;`x`] connected_component;
41509   IMATCH_MP_TAC  simple_arc_end_end;
41510   ASM_MESON_TAC[];
41511   USE 17(REWRITE_RULE[SUBSET]);
41512   TSPEC `y` 17;
41513   FIRST_ASSUM IMATCH_MP_TAC ;
41514   IMATCH_MP_TAC  simple_arc_end_end2;
41515   ASM_MESON_TAC[];
41516   ]);;
41517   (* }}} *)
41518
41519 let ctop_comp_open = prove_by_refinement(
41520   `!G x . (FINITE G /\ G SUBSET edge ) ==>
41521          top2 (component  (ctop G) x)`,
41522   (* {{{ proof *)
41523   [
41524   REP_BASIC_TAC;
41525   THM_INTRO_TAC[`G`] ctop_top;
41526   ASSUME_TAC top2_top;
41527   THM_INTRO_TAC[`G`] curve_closed_ver2;
41528   TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC;
41529   USE 4 (MATCH_MP closed_open);
41530   FULL_REWRITE_TAC[top2_unions;open_DEF ];
41531   TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ;
41532   TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC;
41533   TYPE_THEN`A` UNABBREV_TAC;
41534   REWRITE_TAC[ctop_unions];
41535   TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC;
41536   REWRITE_TAC[ctop];
41537   (* - *)
41538   TYPE_THEN `B = component  (ctop G) x` ABBREV_TAC ;
41539   TYPE_THEN `B = EMPTY` ASM_CASES_TAC;
41540   THM_INTRO_TAC[`top2`] open_EMPTY;
41541   FULL_REWRITE_TAC[open_DEF];
41542   FULL_REWRITE_TAC[EMPTY_EXISTS];
41543   (* - *)
41544   THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected;
41545   THM_INTRO_TAC[`(top2)`;`A`;`(component  (ctop G) x)`] connected_induced2;
41546   REWRITE_TAC[top2_unions];
41547   IMATCH_MP_TAC  SUBSET_TRANS;
41548   TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
41549   CONJ_TAC;
41550   KILL 6;
41551   TYPE_THEN `A` UNABBREV_TAC;
41552   TYPE_THEN `B` UNABBREV_TAC;
41553   REWRITE_TAC[component_unions];
41554   TYPE_THEN `A` UNABBREV_TAC;
41555   REWRITE_TAC[DIFF;SUBSET];
41556   REWR 12;
41557   (* --A *)
41558   TYPE_THEN `B x /\ B u` SUBAGOAL_TAC;
41559   TYPE_THEN `B` UNABBREV_TAC;
41560   THM_INTRO_TAC[`(ctop G)`;`x`;`u`] component_replace;
41561   IMATCH_MP_TAC  component_symm;
41562   (* -- *)
41563   ASSUME_TAC loc_path_conn_top2;
41564   TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC;
41565   REWRITE_TAC[ctop];
41566   REWRITE_TAC[top2];
41567   ONCE_REWRITE_TAC[EQ_SYM_EQ];
41568   IMATCH_MP_TAC  top_of_metric_induced;
41569   TYPE_THEN `A` UNABBREV_TAC;
41570   REWRITE_TAC[DIFF;SUBSET];
41571   (* -- *)
41572   TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC;
41573   THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
41574   FULL_REWRITE_TAC[top2];
41575   ASM_MESON_TAC[];
41576   (* -- *)
41577   THM_INTRO_TAC[`top2`] loc_path_conn;
41578   REWR 18;
41579   TSPEC `A` 18;
41580   REWR 18;
41581   TSPEC `x` 18;
41582   TYPE_THEN `A x` SUBAGOAL_TAC;
41583   ASM_MESON_TAC[subset_imp];
41584   TYPE_THEN `B` UNABBREV_TAC;
41585   ASM_MESON_TAC[path_eq_conn];
41586   (* --B *)
41587   ]);;
41588   (* }}} *)
41589
41590 let psegment_triple = jordan_def
41591   `psegment_triple A B C <=>
41592        psegment A /\ psegment B /\ psegment C /\
41593            rectagon (A UNION B) /\ rectagon (A UNION C) /\
41594              rectagon(B UNION C) /\
41595           (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\
41596           (B INTER C = EMPTY) /\
41597           (cls A INTER cls B = endpoint A) /\
41598           (cls B INTER cls C = endpoint A) /\
41599           (cls A INTER cls C = endpoint A) /\
41600           (endpoint A = endpoint B) /\ (endpoint B = endpoint C)`;;
41601
41602 let psegment_triple3 = prove_by_refinement(
41603   `!A B C. psegment_triple A B C ==> psegment_triple B C A`,
41604   (* {{{ proof *)
41605   [
41606   REP_BASIC_TAC;
41607   FULL_REWRITE_TAC[psegment_triple];
41608   FULL_REWRITE_TAC[UNION_COMM;INTER_COMM];
41609   ASM_MESON_TAC[];
41610   ]);;
41611   (* }}} *)
41612
41613 let psegment_triple2 = prove_by_refinement(
41614   `!A B C. psegment_triple A B C ==> psegment_triple C B A`,
41615   (* {{{ proof *)
41616   [
41617   FULL_REWRITE_TAC[psegment_triple];
41618   FULL_REWRITE_TAC[UNION_COMM;INTER_COMM];
41619   ASM_MESON_TAC[];
41620   ]);;
41621   (* }}} *)
41622
41623 let unions_empty_imp_empty  = prove_by_refinement(
41624   `!(A:(A->bool)->bool) B. (UNIONS A INTER UNIONS B = EMPTY) /\
41625        (!C. A C ==> ~(C = EMPTY)) ==>
41626            (A INTER B = EMPTY)  `,
41627   (* {{{ proof *)
41628   [
41629   REWRITE_TAC[EQ_EMPTY;INTER;UNIONS];
41630   ASM_MESON_TAC[];
41631   ]);;
41632   (* }}} *)
41633
41634 let par_cell_closure = prove_by_refinement(
41635   `!G A eps.
41636        FINITE A /\ A SUBSET edge /\ rectagon G /\
41637          A SUBSET par_cell eps G ==>
41638        (curve_cell A INTER par_cell (~eps) G = EMPTY)`,
41639   (* {{{ proof *)
41640   [
41641   REP_BASIC_TAC;
41642   IMATCH_MP_TAC  unions_empty_imp_empty;
41643   ASSUME_TAC top2_top;
41644   TYPE_THEN `(par_cell (~eps) G) = EMPTY` ASM_CASES_TAC;
41645   REWRITE_TAC[INTER_EMPTY];
41646   FULL_REWRITE_TAC[curve_cell;UNION];
41647   TYPE_THEN `C` UNABBREV_TAC;
41648   FIRST_ASSUM DISJ_CASES_TAC;
41649   FULL_REWRITE_TAC[SUBSET];
41650   TYPE_THEN `edge {}` SUBAGOAL_TAC;
41651   TYPE_THEN `cell {}` SUBAGOAL_TAC;
41652   IMATCH_MP_TAC  edge_cell;
41653   USE 9 (MATCH_MP cell_nonempty);
41654   ASM_MESON_TAC[];
41655   USE 8 SYM;
41656   FULL_REWRITE_TAC[EQ_EMPTY;INR IN_SING ];
41657   ASM_MESON_TAC[];
41658   (* - *)
41659   FULL_REWRITE_TAC[EMPTY_EXISTS];
41660   TYPE_THEN `~(UNIONS (par_cell (~eps) G)  = EMPTY)` SUBAGOAL_TAC;
41661   FULL_REWRITE_TAC[UNIONS;EQ_EMPTY];
41662   TYPE_THEN `~ (u = EMPTY)` SUBAGOAL_TAC;
41663   TYPE_THEN `u` UNABBREV_TAC;
41664   THM_INTRO_TAC[`G`;`~eps`] par_cell_cell;
41665   FULL_REWRITE_TAC[SUBSET];
41666   TYPE_THEN `cell {}` SUBAGOAL_TAC;
41667   ASM_MESON_TAC[];
41668   USE 8 (MATCH_MP cell_nonempty);
41669   ASM_MESON_TAC[];
41670   FULL_REWRITE_TAC[EMPTY_EXISTS];
41671   TSPEC `u'` 6;
41672   ASM_MESON_TAC[];
41673   (* -A *)
41674   TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC;
41675   THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed;
41676   REWRITE_TAC[open_DEF];
41677   FULL_REWRITE_TAC[EMPTY_EXISTS];
41678   THM_INTRO_TAC[`G`;`~eps`;`u'`] par_cell_union_comp;
41679   IMATCH_MP_TAC ctop_comp_open ;
41680   ASM_MESON_TAC[rectagon];
41681   FULL_REWRITE_TAC[top2_unions];
41682   (* -B *)
41683   THM_INTRO_TAC[`A`] curve_closure_ver2;
41684   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
41685   CONJ_TAC;
41686   THM_INTRO_TAC[`A`] curve_cell_cell;
41687   USE 10 (REWRITE_RULE[SUBSET]);
41688   TSPEC `C` 10;
41689   USE 9 (MATCH_MP cell_nonempty);
41690   FULL_REWRITE_TAC[EMPTY_EXISTS];
41691   ASM_MESON_TAC[];
41692   (* - *)
41693   TYPE_THEN`UNIONS (curve_cell A) SUBSET (euclid 2 DIFF UNIONS (par_cell (~eps) G))` SUBAGOAL_TAC;
41694   USE 8 GSYM;
41695   IMATCH_MP_TAC  closure_subset;
41696   REWRITE_TAC[DIFF_SUBSET];
41697   CONJ_TAC;
41698   IMATCH_MP_TAC  SUBSET_TRANS;
41699   TYPE_THEN `UNIONS edge` EXISTS_TAC;
41700   CONJ_TAC;
41701   IMATCH_MP_TAC  UNIONS_UNIONS;
41702   REWRITE_TAC[UNIONS;SUBSET];
41703   THM_INTRO_TAC[`u'`] edge_euclid2;
41704   ASM_MESON_TAC[subset_imp];
41705   REWRITE_TAC[INTER;EQ_EMPTY];
41706   COPY 10;
41707   USE 11(REWRITE_RULE[UNIONS]);
41708   THM_INTRO_TAC[`par_cell (~eps) G`;`u'`;`x`] cell_ununion;
41709   TYPE_THEN`edge u'` SUBAGOAL_TAC;
41710   ASM_MESON_TAC[subset_imp];
41711   ASM_MESON_TAC [par_cell_cell;edge_cell];
41712   USE 0 (REWRITE_RULE[SUBSET]);
41713   TSPEC `u'` 0;
41714   THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
41715   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
41716   ASM_MESON_TAC[];
41717   (* - *)
41718   FULL_REWRITE_TAC[DIFF_SUBSET];
41719   ]);;
41720   (* }}} *)
41721
41722 let cell_unions_disj = prove_by_refinement(
41723   `!U V. U SUBSET cell /\ V SUBSET cell ==> ((U INTER V = EMPTY) <=>
41724       (UNIONS U INTER UNIONS V = EMPTY))`,
41725   (* {{{ proof *)
41726   [
41727   REP_BASIC_TAC;
41728   IMATCH_MP_TAC  EQ_ANTISYM;
41729   CONJ_TAC;
41730   PROOF_BY_CONTR_TAC;
41731   FULL_REWRITE_TAC[EMPTY_EXISTS];
41732   USE 3(REWRITE_RULE[INTER]);
41733   TYPE_THEN `?C. V C /\ C u` SUBAGOAL_TAC;
41734   FULL_REWRITE_TAC[UNIONS];
41735   ASM_MESON_TAC[];
41736   TYPE_THEN `cell C` SUBAGOAL_TAC;
41737   ASM_MESON_TAC[subset_imp];
41738   TYPE_THEN `U C` SUBAGOAL_TAC;
41739   IMATCH_MP_TAC  cell_ununion;
41740   ASM_MESON_TAC[];
41741   USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
41742   ASM_MESON_TAC[];
41743   (* - *)
41744   IMATCH_MP_TAC  unions_empty_imp_empty;
41745   REP_BASIC_TAC;
41746   TYPE_THEN `C` UNABBREV_TAC;
41747   TYPE_THEN `cell EMPTY ` SUBAGOAL_TAC;
41748   ASM_MESON_TAC[subset_imp];
41749   ASM_MESON_TAC[cell_nonempty];
41750   ]);;
41751   (* }}} *)
41752
41753 let unions_curve_cell_par_cell_disj = prove_by_refinement(
41754   `!G eps. (G SUBSET edge) ==>
41755     (UNIONS (par_cell eps G) INTER UNIONS (curve_cell G) = EMPTY)`,
41756   (* {{{ proof *)
41757   [
41758   REP_BASIC_TAC;
41759   THM_INTRO_TAC[`par_cell eps G`;`curve_cell G`] cell_unions_disj;
41760   THM_INTRO_TAC[`G`] curve_cell_cell;
41761   REWRITE_TAC[par_cell_cell];
41762   USE 1 SYM;
41763   IMATCH_MP_TAC  par_cell_curve_cell_disj;
41764   ]);;
41765   (* }}} *)
41766
41767 let par_cell_simple_arc = prove_by_refinement(
41768   `!G eps x y. rectagon G /\ ~(x = y) ==>
41769       ((UNIONS (par_cell eps G) x /\ UNIONS (par_cell eps G) y) <=>
41770         (?C. simple_arc_end C x y /\
41771              (C SUBSET (UNIONS (par_cell eps G)))) )`,
41772   (* {{{ proof *)
41773   [
41774   REP_BASIC_TAC;
41775   IMATCH_MP_TAC  EQ_ANTISYM;
41776   CONJ_TAC;
41777   THM_INTRO_TAC[`G`;`eps`;`x`] par_cell_union_comp;
41778   THM_INTRO_TAC[`G`;`x`;`y`] component_simple_arc;
41779   FULL_REWRITE_TAC[rectagon];
41780   REWR 2;
41781   TYPE_THEN `C` EXISTS_TAC;
41782   USE 4 SYM;
41783   REWRITE_TAC[SUBSET];
41784   PROOF_BY_CONTR_TAC;
41785   (* -- *)
41786   THM_INTRO_TAC[`C`;`x`;`y`;`x'`] simple_arc_end_cut;
41787   CONJ_TAC;
41788   TYPE_THEN `x'` UNABBREV_TAC;
41789   ASM_MESON_TAC[];
41790   TYPE_THEN `x'` UNABBREV_TAC;
41791   ASM_MESON_TAC[];
41792   (* -- *)
41793   THM_INTRO_TAC[`G`;`x`;`x'`] component_simple_arc;
41794   FULL_REWRITE_TAC[rectagon];
41795   REWRITE_TAC[];
41796   ASM_MESON_TAC[];
41797   (* -- *)
41798   TYPE_THEN `~component (ctop G) x x'` SUBAGOAL_TAC;
41799   ASM_MESON_TAC[];
41800   UND 13 THEN ASM_REWRITE_TAC[];
41801   TYPE_THEN `C'` EXISTS_TAC;
41802   FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ]SUBSET_EMPTY];
41803   IMATCH_MP_TAC  SUBSET_TRANS;
41804   TYPE_THEN `C INTER UNIONS (curve_cell G)` EXISTS_TAC;
41805   IMATCH_MP_TAC subset_inter_pair;
41806   REWRITE_TAC[SUBSET_REFL];
41807   TYPE_THEN `C` UNABBREV_TAC;
41808   REWRITE_TAC[SUBSET;UNION];
41809   (* -A *)
41810   TYPE_THEN `C x /\ C y` SUBAGOAL_TAC;
41811   CONJ_TAC THEN   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
41812   ASM_MESON_TAC[subset_imp];
41813   ]);;
41814   (* }}} *)
41815
41816 let trap_triple_seg = prove_by_refinement(
41817   `!A B C eps eps'. psegment_triple A B C /\
41818       C SUBSET par_cell (~eps) (A UNION B)
41819       ==>
41820      (par_cell eps (A UNION B) SUBSET par_cell eps' (A UNION C) \/
41821       par_cell eps (A UNION B) SUBSET par_cell (~eps') (A UNION C))`,
41822   (* {{{ proof *)
41823   [
41824   REP_BASIC_TAC;
41825   PROOF_BY_CONTR_TAC;
41826   USE 2 (REWRITE_RULE[SUBSET]);
41827   FULL_REWRITE_TAC[DE_MORGAN_THM];
41828   LEFT 2 "x";
41829   LEFT 3 "x";
41830   UND 2 THEN REWRITE_TAC[];
41831   PROOF_BY_CONTR_TAC;
41832   UND 3 THEN REWRITE_TAC[];
41833   PROOF_BY_CONTR_TAC;
41834   TYPE_THEN`cell x' /\ cell x` SUBAGOAL_TAC;
41835   ASM_MESON_TAC[par_cell_cell;subset_imp];
41836   (* - *)
41837   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;
41838   THM_INTRO_TAC[`A UNION C`;`eps'`;`x''`] par_cell_cell_partition;
41839   IMATCH_MP_TAC  rectagon_segment;
41840   FULL_REWRITE_TAC[psegment_triple];
41841   USE 10 (REWRITE_RULE[curve_cell_union]);
41842   UND 10 THEN REP_CASES_TAC;
41843   USE 10 (REWRITE_RULE[UNION]);
41844   (* -- *)
41845   FIRST_ASSUM DISJ_CASES_TAC;
41846   THM_INTRO_TAC[`A UNION B`;`eps`] par_cell_curve_cell_disj;
41847   FULL_REWRITE_TAC[psegment_triple];
41848   USE 21 (REWRITE_RULE[rectagon]);
41849   USE 12 (REWRITE_RULE[INTER;EQ_EMPTY;curve_cell_union;DE_MORGAN_THM ]);
41850   TSPEC `x''` 12;
41851   REWR 12;
41852   USE 12 (REWRITE_RULE[UNION;DE_MORGAN_THM ]);
41853   ASM_MESON_TAC[];
41854   (* -- *)
41855   THM_INTRO_TAC[`A UNION B`;`C`;`~eps`;] par_cell_closure;
41856   FULL_REWRITE_TAC[psegment_triple];
41857   USE 22(REWRITE_RULE[psegment;segment]);
41858   USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]);
41859   ASM_MESON_TAC[];
41860   (* - *)
41861   COPY 8;
41862   TSPEC `x` 8;
41863   TSPEC `x'` 9;
41864   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
41865   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
41866   REWR 8;
41867   REWR 9;
41868   (* - *)
41869   USE 6 (MATCH_MP cell_nonempty);
41870   USE 7(MATCH_MP cell_nonempty);
41871   FULL_REWRITE_TAC[EMPTY_EXISTS];
41872   TYPE_THEN `UNIONS (par_cell eps (A UNION B)) u /\ UNIONS (par_cell eps (A UNION B)) u'` SUBAGOAL_TAC;
41873   REWRITE_TAC[UNIONS];
41874   ASM_MESON_TAC[];
41875   (* - *)
41876   TYPE_THEN `u = u'` ASM_CASES_TAC;
41877   TYPE_THEN `u'` UNABBREV_TAC;
41878   TYPE_THEN `cell x /\ cell x'` SUBAGOAL_TAC;
41879   ASM_MESON_TAC[par_cell_cell;subset_imp];
41880   TYPE_THEN `x = x'` SUBAGOAL_TAC;
41881   IMATCH_MP_TAC  cell_partition;
41882   REWRITE_TAC[INTER;EMPTY_EXISTS];
41883   ASM_MESON_TAC[];
41884   TYPE_THEN `x'` UNABBREV_TAC;
41885   ASM_MESON_TAC[];
41886   (* -B *)
41887   THM_INTRO_TAC[`A UNION B`;`eps`;`u`;`u'`]par_cell_simple_arc;
41888   FULL_REWRITE_TAC[psegment_triple];
41889   REWR 13;
41890   (* - *)
41891   TYPE_THEN `C' INTER UNIONS (curve_cell A) = EMPTY` SUBAGOAL_TAC;
41892   REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY];
41893   IMATCH_MP_TAC  SUBSET_TRANS;
41894   TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC;
41895   CONJ_TAC;
41896   IMATCH_MP_TAC subset_inter_pair;
41897   REWRITE_TAC[SUBSET_REFL;curve_cell_union;UNIONS_UNION];
41898   REWRITE_TAC[SUBSET;UNION];
41899   IMATCH_MP_TAC  SUBSET_TRANS;
41900   TYPE_THEN `UNIONS (par_cell eps (A UNION B)) INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC;
41901   CONJ_TAC;
41902   IMATCH_MP_TAC  subset_inter_pair;
41903   REWRITE_TAC[SUBSET_REFL];
41904   REWRITE_TAC[SUBSET_EMPTY];
41905   IMATCH_MP_TAC  unions_curve_cell_par_cell_disj ;
41906   FULL_REWRITE_TAC[psegment_triple];
41907   USE 24 (REWRITE_RULE[rectagon]);
41908   (* -C *)
41909   THM_INTRO_TAC[`A UNION B`;`C`;`~eps`] par_cell_closure;
41910   FULL_REWRITE_TAC[psegment_triple];
41911   USE 26(REWRITE_RULE[psegment;segment]);
41912   REWR 16;
41913   THM_INTRO_TAC[`curve_cell C`;`par_cell eps (A UNION B)`] cell_unions_disj;
41914   CONJ_TAC;
41915   IMATCH_MP_TAC  curve_cell_cell;
41916   FULL_REWRITE_TAC[psegment_triple];
41917   USE 27(REWRITE_RULE[psegment;segment]);
41918   REWRITE_TAC[par_cell_cell];
41919   REWR 17;
41920   TYPE_THEN `UNIONS (curve_cell C) INTER C' = EMPTY` SUBAGOAL_TAC ;
41921     REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY];
41922   USE 17 SYM;
41923   IMATCH_MP_TAC  subset_inter_pair;
41924   REWRITE_TAC[SUBSET_REFL];
41925   (* - *)
41926   TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION C)) = EMPTY` SUBAGOAL_TAC;
41927   REWRITE_TAC[curve_cell_union;UNIONS_UNION];
41928   REWRITE_TAC[UNION_OVER_INTER; UNION_EMPTY];
41929   REWRITE_TAC[UNION_EMPTY];
41930   ONCE_REWRITE_TAC[INTER_COMM];
41931   (* -D *)
41932   THM_INTRO_TAC[`A UNION C`;`u`;`u'`] component_simple_arc;
41933   FULL_REWRITE_TAC[psegment_triple];
41934   USE 28(REWRITE_RULE[rectagon]);
41935   (* - *)
41936   TYPE_THEN `component  (ctop (A UNION C)) u u'` SUBAGOAL_TAC;
41937   TYPE_THEN `C'` EXISTS_TAC;
41938   REWR 20;
41939   TYPE_THEN `UNIONS (par_cell (eps') (A UNION C)) u'` SUBAGOAL_TAC;
41940   REWRITE_TAC[UNIONS];
41941   ASM_MESON_TAC[];
41942   TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C)) u` SUBAGOAL_TAC;
41943   REWRITE_TAC[UNIONS];
41944   ASM_MESON_TAC[];
41945   (* - *)
41946   THM_INTRO_TAC [`A UNION C`;`eps'`]  par_cell_union_disjoint;
41947   THM_INTRO_TAC[`A UNION C`;`eps'`;`u'`] par_cell_union_comp;
41948   FULL_REWRITE_TAC[psegment_triple];
41949   THM_INTRO_TAC[`A UNION C`;`~eps'`;`u`] par_cell_union_comp;
41950   FULL_REWRITE_TAC[psegment_triple];
41951   TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C))` UNABBREV_TAC;
41952   TYPE_THEN `UNIONS (par_cell eps' (A UNION C))` UNABBREV_TAC;
41953   USE 25 (REWRITE_RULE[INTER;EQ_EMPTY]);
41954   TSPEC  `u'` 25;
41955   REWR 25;
41956   ]);;
41957   (* }}} *)
41958
41959 let parity_even_cell = prove_by_refinement(
41960   `!G m. (rectagon G) ==> (parity G (squ m) = even_cell G (squ m))`,
41961   (* {{{ proof *)
41962   [
41963   REP_BASIC_TAC;
41964   THM_INTRO_TAC[`G`;`m`] parity_squ;
41965   IMATCH_MP_TAC  rectagon_segment;
41966   REWRITE_TAC[parity_squ;even_cell_squ];
41967   ]);;
41968   (* }}} *)
41969
41970 let par_cell_squ_neg = prove_by_refinement(
41971   `!G m eps. segment G ==>
41972     (par_cell (~eps) G (squ m) <=> ~(par_cell eps G (squ m)))`,
41973   (* {{{ proof *)
41974   [
41975   REP_BASIC_TAC;
41976   IMATCH_MP_TAC  EQ_ANTISYM;
41977   CONJ_TAC;
41978   THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
41979   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
41980   ASM_MESON_TAC[];
41981   THM_INTRO_TAC[`G`;`eps`;`squ m`] par_cell_cell_partition;
41982   REWRITE_TAC[cell_rules];
41983   ASM_MESON_TAC[curve_cell_squ];
41984   ]);;
41985   (* }}} *)
41986
41987 let triple_par_cell_distinct = prove_by_refinement(
41988   `!A B C eps eps'. psegment_triple A B C ==>
41989      ~(par_cell eps (A UNION B) = par_cell eps' (A UNION C))`,
41990   (* {{{ proof *)
41991   [
41992   REP_BASIC_TAC;
41993   TYPE_THEN `s = (eps = eps')` ABBREV_TAC ;
41994   TYPE_THEN `!m. (parity (A UNION B) (squ m) = parity(A UNION C) (squ m)) = s` SUBAGOAL_TAC;
41995   TYPE_THEN `s` UNABBREV_TAC;
41996   REWRITE_TAC[EQ_SYM_EQ];
41997   ONCE_REWRITE_TAC[eq_pair_exchange];
41998   TYPE_THEN `eps = parity (A UNION B) (squ m)` ASM_CASES_TAC;
41999   IMATCH_MP_TAC  parity_unique;
42000   USE 0 SYM;
42001   CONJ_TAC;
42002   FULL_REWRITE_TAC[psegment_triple];
42003   IMATCH_MP_TAC  rectagon_segment;
42004   IMATCH_MP_TAC  parity;
42005   REWRITE_TAC[cell_rules;];
42006   SUBCONJ_TAC;
42007   FULL_REWRITE_TAC[psegment_triple];
42008   IMATCH_MP_TAC  rectagon_segment;
42009   ASM_MESON_TAC[curve_cell_squ];
42010   (* -- *)
42011   TYPE_THEN `!m. par_cell (~eps) (A UNION B) (squ m)  = par_cell (~eps') (A UNION C) (squ m)` SUBAGOAL_TAC;
42012   TYPE_THEN `segment (A UNION B) /\ segment(A UNION C)` SUBAGOAL_TAC;
42013   FULL_REWRITE_TAC[psegment_triple];
42014   CONJ_TAC THEN IMATCH_MP_TAC  rectagon_segment;
42015   ASM_SIMP_TAC [par_cell_squ_neg];
42016   TYPE_THEN `~eps = parity (A UNION B) (squ m)` SUBAGOAL_TAC;
42017   ASM_MESON_TAC[];
42018   KILL 2;
42019   TYPE_THEN `~(~eps' = parity (A UNION C) (squ m))` SUBAGOAL_TAC;
42020   TYPE_THEN `eps'` UNABBREV_TAC;
42021   ASM_MESON_TAC[];
42022   KILL 3;
42023   UND 2 THEN REWRITE_TAC[];
42024   IMATCH_MP_TAC  parity_unique;
42025   TSPEC `m` 4;
42026   USE 2 SYM;
42027   CONJ_TAC;
42028   FULL_REWRITE_TAC[psegment_triple];
42029   IMATCH_MP_TAC  rectagon_segment;
42030   IMATCH_MP_TAC  parity;
42031   REWRITE_TAC[cell_rules;];
42032   SUBCONJ_TAC;
42033   FULL_REWRITE_TAC[psegment_triple];
42034   IMATCH_MP_TAC  rectagon_segment;
42035   ASM_MESON_TAC[curve_cell_squ];
42036   (* -A *)
42037   THM_INTRO_TAC[`A UNION B`] parity_even_cell;
42038   RIGHT 4 "m";
42039   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]);
42040   FULL_REWRITE_TAC[psegment_triple];
42041   REWR 3;
42042   THM_INTRO_TAC[`A UNION C`] parity_even_cell;
42043   RIGHT 5 "m";
42044   UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]);
42045   FULL_REWRITE_TAC[psegment_triple];
42046   REWR 3;
42047   (* - *)
42048   TYPE_THEN `?e. B e /\ ~C e /\ ~A e` SUBAGOAL_TAC;
42049   TYPE_THEN `~(B = EMPTY)` SUBAGOAL_TAC ;
42050   TYPE_THEN `B` UNABBREV_TAC;
42051   FULL_REWRITE_TAC[psegment_triple];
42052   USE 17( REWRITE_RULE[psegment;segment]);
42053   FULL_REWRITE_TAC[EMPTY_EXISTS];
42054   TYPE_THEN `u` EXISTS_TAC;
42055   REWRITE_TAC[GSYM DE_MORGAN_THM];
42056   FULL_REWRITE_TAC[psegment_triple];
42057   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
42058   ASM_MESON_TAC[];
42059   (* - *)
42060   TYPE_THEN `edge e` SUBAGOAL_TAC;
42061   FULL_REWRITE_TAC[psegment_triple];
42062   USE 20 (REWRITE_RULE[psegment;segment]);
42063   ASM_MESON_TAC[subset_imp];
42064   FULL_REWRITE_TAC[edge];
42065   TYPE_THEN `rectagon (A UNION B) /\ rectagon (A UNION C)` SUBAGOAL_TAC;
42066   FULL_REWRITE_TAC[psegment_triple];
42067   (* - *)
42068   KILL 5;
42069   KILL 4;
42070   KILL 0;
42071   KILL 2;
42072   TYPE_THEN `~(A UNION C) e /\ (A UNION B) e` SUBAGOAL_TAC;
42073   ASM_REWRITE_TAC[UNION];
42074   FIRST_ASSUM DISJ_CASES_TAC;
42075   TYPE_THEN `e` UNABBREV_TAC;
42076   THM_INTRO_TAC[`(A UNION B)`;`m`] squ_left_odd;
42077   THM_INTRO_TAC[`(A UNION C)`;`m`] squ_left_even;
42078   ASM_MESON_TAC[];
42079   TYPE_THEN `e` UNABBREV_TAC;
42080   THM_INTRO_TAC[`A UNION B`;`m`] squ_down;
42081   FULL_REWRITE_TAC[rectagon];
42082   THM_INTRO_TAC[`A UNION C`;`m`] squ_down;
42083   FULL_REWRITE_TAC[rectagon];
42084   FULL_REWRITE_TAC[set_lower_n];
42085   ASM_MESON_TAC[];
42086   ]);;
42087   (* }}} *)
42088
42089 let triple_in_comp = prove_by_refinement(
42090   `!A B C eps. psegment_triple A B C /\
42091      ~(C SUBSET par_cell eps (A UNION B)) ==>
42092     (C SUBSET par_cell (~eps) (A UNION B)) `,
42093   (* {{{ proof *)
42094   [
42095   REP_BASIC_TAC;
42096   THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
42097   FULL_REWRITE_TAC[psegment_triple];
42098   USE 12 (REWRITE_RULE[psegment]);
42099   REWRITE_TAC[cls_union;];
42100   CONJ_TAC;
42101   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
42102   ONCE_REWRITE_TAC[INTER_COMM];
42103   ONCE_REWRITE_TAC[INTER_COMM];
42104   REWRITE_TAC[UNION_OVER_INTER];
42105   REWRITE_TAC[union_subset];
42106   TYPE_THEN `endpoint A` UNABBREV_TAC;
42107   TYPE_THEN `endpoint B` UNABBREV_TAC;
42108   TYPE_THEN `endpoint C` UNABBREV_TAC;
42109   FULL_REWRITE_TAC[INTER_COMM];
42110   REWRITE_TAC[SUBSET_REFL];
42111   TYPE_THEN `eps' = eps` ASM_CASES_TAC;
42112   TYPE_THEN`eps'` UNABBREV_TAC;
42113   ASM_MESON_TAC[];
42114   TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
42115   ASM_MESON_TAC[];
42116   TYPE_THEN `eps'` UNABBREV_TAC;
42117   ]);;
42118   (* }}} *)
42119
42120 let trap_odd_cell = prove_by_refinement(
42121   `!A B C. psegment_triple A B C ==>
42122    (A SUBSET par_cell F (B UNION C)) \/
42123    (B SUBSET par_cell F (A UNION C)) \/
42124    (C SUBSET par_cell F (A UNION B))`,
42125   (* {{{ proof *)
42126
42127   [
42128   REP_BASIC_TAC;
42129   PROOF_BY_CONTR_TAC;
42130   FULL_REWRITE_TAC[DE_MORGAN_THM];
42131   TYPE_THEN `C SUBSET par_cell (~F) (A UNION B)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
42132   TYPE_THEN `A SUBSET par_cell (~F) (B UNION C)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
42133   IMATCH_MP_TAC  psegment_triple3;
42134   TYPE_THEN `B SUBSET par_cell (~F) (C UNION A)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
42135   CONJ_TAC;
42136   IMATCH_MP_TAC  psegment_triple3;
42137   IMATCH_MP_TAC  psegment_triple3;
42138   USE 6(ONCE_REWRITE_RULE[UNION_COMM]);
42139   ASM_MESON_TAC[];
42140   FULL_REWRITE_TAC[];
42141   (* - *)
42142   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;
42143   THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`T`] trap_triple_seg;
42144   FULL_REWRITE_TAC[UNION_COMM];
42145   IMATCH_MP_TAC  psegment_triple3;
42146   IMATCH_MP_TAC  psegment_triple2;
42147   FULL_REWRITE_TAC[UNION_COMM];
42148   FIRST_ASSUM DISJ_CASES_TAC;
42149   THM_INTRO_TAC[`B'`;`C`;`A'`;`F`;`F`] trap_triple_seg;
42150     IMATCH_MP_TAC  psegment_triple3;
42151   FIRST_ASSUM DISJ_CASES_TAC;
42152   FULL_REWRITE_TAC[UNION_COMM];
42153   TYPE_THEN `par_cell F (B' UNION C) = par_cell F (A' UNION B')` SUBAGOAL_TAC;
42154   IMATCH_MP_TAC  SUBSET_ANTISYM;
42155   THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`F`] triple_par_cell_distinct;
42156     IMATCH_MP_TAC  psegment_triple3;
42157   IMATCH_MP_TAC  psegment_triple2;
42158   FULL_REWRITE_TAC[UNION_COMM];
42159   ASM_MESON_TAC[];
42160   (* -- *)
42161   TYPE_THEN `par_cell F (B' UNION A') SUBSET par_cell T (B' UNION A')` SUBAGOAL_TAC;
42162   FULL_REWRITE_TAC[UNION_COMM];
42163   IMATCH_MP_TAC  SUBSET_TRANS;
42164   TYPE_THEN `par_cell F (B' UNION C)` EXISTS_TAC;
42165   (* -- *)
42166   THM_INTRO_TAC[`A' UNION B'`;`F` ] par_cell_nonempty;
42167   USE 9(REWRITE_RULE[psegment_triple]);
42168   FULL_REWRITE_TAC[EMPTY_EXISTS];
42169   THM_INTRO_TAC[`A' UNION B'`;`F`] par_cell_disjoint;
42170   FULL_REWRITE_TAC[EQ_EMPTY;INTER];
42171   TSPEC `u` 16;
42172   REWR 16;
42173   USE 14(REWRITE_RULE[SUBSET]);
42174   FULL_REWRITE_TAC[UNION_COMM];
42175   ASM_MESON_TAC[];
42176   (* -A *)
42177   COPY 7;
42178   UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`B`]);
42179    UND 8  THEN DISCH_THEN (THM_INTRO_TAC[`B`;`A`]);
42180   FULL_REWRITE_TAC[UNION_COMM];
42181     IMATCH_MP_TAC  psegment_triple3;
42182   IMATCH_MP_TAC  psegment_triple2;
42183   (* - *)
42184   FULL_REWRITE_TAC[UNION_COMM];
42185   THM_INTRO_TAC[`A UNION B`;`F`] par_cell_nonempty;
42186   FULL_REWRITE_TAC[psegment_triple];
42187   FULL_REWRITE_TAC[EMPTY_EXISTS];
42188   THM_INTRO_TAC[`A UNION B`;`u`;`F`] parity_unique;
42189   FULL_REWRITE_TAC[psegment_triple];
42190   IMATCH_MP_TAC  rectagon_segment;
42191   TYPE_THEN `par_cell T (A UNION C) u /\ par_cell T (B UNION C) u` SUBAGOAL_TAC;
42192   ASM_MESON_TAC[subset_imp];
42193   THM_INTRO_TAC[`A UNION C`;`u`;`T`] parity_unique;
42194   FULL_REWRITE_TAC[psegment_triple];
42195   IMATCH_MP_TAC  rectagon_segment;
42196   THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique;
42197   FULL_REWRITE_TAC[psegment_triple];
42198   IMATCH_MP_TAC  rectagon_segment;
42199   (* -B *)
42200   TYPE_THEN `cell u` SUBAGOAL_TAC;
42201   ASM_MESON_TAC[par_cell_cell;subset_imp];
42202   TYPE_THEN `!A B eps. rectagon (A UNION B) /\ (par_cell eps (A UNION B) u) ==> ~curve_cell A u` SUBAGOAL_TAC;
42203   THM_INTRO_TAC[`A' UNION B'`;`eps`] par_cell_curve_cell_disj;
42204   FULL_REWRITE_TAC[rectagon];
42205   FULL_REWRITE_TAC[EQ_EMPTY;INTER];
42206   TSPEC `u` 19;
42207   USE 19 (REWRITE_RULE[curve_cell_union;DE_MORGAN_THM ]);
42208   FIRST_ASSUM DISJ_CASES_TAC;
42209   ASM_MESON_TAC[];
42210   USE 20 (REWRITE_RULE[UNION]);
42211   ASM_MESON_TAC[];
42212   (* - *)
42213   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;
42214   FULL_REWRITE_TAC[psegment_triple];
42215   FULL_REWRITE_TAC[psegment];
42216   FULL_REWRITE_TAC[UNION_COMM];
42217   REPEAT CONJ_TAC THEN (IMATCH_MP_TAC  rectagon_segment);
42218   (* -C *)
42219   THM_INTRO_TAC[`A`;`B`;`u`] parity_union;
42220   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
42221   TYPE_THEN `B` EXISTS_TAC;
42222   TYPE_THEN `F` EXISTS_TAC;
42223   FULL_REWRITE_TAC[psegment_triple];
42224   TYPE_THEN `A` EXISTS_TAC;
42225   USE 10 SYM;
42226   TYPE_THEN `F` EXISTS_TAC;
42227   FULL_REWRITE_TAC[UNION_COMM];
42228   FULL_REWRITE_TAC[psegment_triple];
42229   (* - *)
42230   THM_INTRO_TAC[`B`;`C`;`u`] parity_union;
42231   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
42232   TYPE_THEN `C` EXISTS_TAC;
42233   TYPE_THEN `T` EXISTS_TAC;
42234   FULL_REWRITE_TAC[psegment_triple];
42235   TYPE_THEN `B` EXISTS_TAC;
42236   TYPE_THEN `T` EXISTS_TAC;
42237   FULL_REWRITE_TAC[UNION_COMM];
42238   FULL_REWRITE_TAC[psegment_triple];
42239   (* - *)
42240   THM_INTRO_TAC[`A`;`C`;`u`] parity_union;
42241   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
42242   TYPE_THEN `C` EXISTS_TAC;
42243   TYPE_THEN `T` EXISTS_TAC;
42244   FULL_REWRITE_TAC[psegment_triple];
42245   TYPE_THEN `A` EXISTS_TAC;
42246   TYPE_THEN `T` EXISTS_TAC;
42247   FULL_REWRITE_TAC[UNION_COMM];
42248   FULL_REWRITE_TAC[psegment_triple];
42249   REWR 28;
42250   REWR 27;
42251   ]);;
42252
42253     (* }}} *)
42254
42255
42256 (* ------------------------------------------------------------------ *)
42257 (* SECTION V *)
42258 (* ------------------------------------------------------------------ *)
42259
42260 (* -- more on 2-connectedness, etc. *)
42261
42262 let euclid_diff_par_cell = prove_by_refinement(
42263   `!G eps. (segment G) ==>
42264     (euclid 2 DIFF UNIONS(par_cell (~eps) G) =
42265          UNIONS(par_cell eps G) UNION UNIONS (curve_cell G))`,
42266   (* {{{ proof *)
42267   [
42268   REP_BASIC_TAC;
42269   IMATCH_MP_TAC  EQ_EXT;
42270   REWRITE_TAC[DIFF;UNION];
42271   IMATCH_MP_TAC  EQ_ANTISYM;
42272   CONJ_TAC;
42273   PROOF_BY_CONTR_TAC;
42274   USE 3(REWRITE_RULE[DE_MORGAN_THM]);
42275   TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC;
42276   ASM_REWRITE_TAC[ctop_unions;DIFF];
42277   (* -- *)
42278   THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
42279   USE 6 SYM;
42280   REWR 5;
42281   FULL_REWRITE_TAC[UNION];
42282   ASM_MESON_TAC[];
42283   (* - *)
42284   CONJ_TAC;
42285   USE 1(REWRITE_RULE[UNIONS]);
42286   LEFT 1 "u";
42287   THM_INTRO_TAC[`u`] cell_euclid;
42288   THM_INTRO_TAC[`G`;`eps`] par_cell_cell;
42289   THM_INTRO_TAC[`G`] curve_cell_cell;
42290   FULL_REWRITE_TAC[segment];
42291   ASM_MESON_TAC[subset_imp];
42292   ASM_MESON_TAC[subset_imp];
42293   (* - *)
42294   THM_INTRO_TAC[`G`;`eps`] par_cell_union_disjoint;
42295   USE 3(REWRITE_RULE[INTER;EQ_EMPTY]);
42296   FIRST_ASSUM DISJ_CASES_TAC;
42297   ASM_MESON_TAC[];
42298   (* - *)
42299   THM_INTRO_TAC[`G`] ctop_unions;
42300   USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
42301   TSPEC `x` 5;
42302   FULL_REWRITE_TAC[DIFF];
42303   TYPE_THEN `~UNIONS (ctop G )x` SUBAGOAL_TAC;
42304   ASM_MESON_TAC[];
42305   THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
42306   USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
42307   FULL_REWRITE_TAC[UNION];
42308   ASM_MESON_TAC[];
42309   ]);;
42310   (* }}} *)
42311
42312 let par_cell_closure_cell = prove_by_refinement(
42313   `!G C d eps.
42314        cell C /\ cell d /\ rectagon G /\ (d SUBSET closure top2 C) /\
42315           par_cell eps G C ==>
42316        (par_cell eps G d \/ curve_cell G d)`,
42317   (* {{{ proof *)
42318   [
42319   REP_BASIC_TAC;
42320   ASSUME_TAC top2_top;
42321   TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC;
42322   THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed;
42323   REWRITE_TAC[open_DEF];
42324   TYPE_THEN `UNIONS (par_cell (~eps) G) = EMPTY ` ASM_CASES_TAC;
42325   USE 5 (MATCH_MP   (REWRITE_RULE[open_DEF]open_EMPTY));
42326   FULL_REWRITE_TAC[EMPTY_EXISTS];
42327   THM_INTRO_TAC[`G`;`~eps`;`u`] par_cell_union_comp;
42328   IMATCH_MP_TAC ctop_comp_open ;
42329   ASM_MESON_TAC[rectagon];
42330   FULL_REWRITE_TAC[top2_unions];
42331   THM_INTRO_TAC[`G`;`eps`] euclid_diff_par_cell;
42332   IMATCH_MP_TAC  rectagon_segment;
42333   REWR 6;
42334   KILL 7;
42335   (* -A *)
42336   TYPE_THEN `closure top2 C SUBSET (UNIONS (par_cell eps G) UNION UNIONS (curve_cell G))` SUBAGOAL_TAC;
42337   IMATCH_MP_TAC  closure_subset;
42338   IMATCH_MP_TAC  in_union;
42339   DISJ1_TAC;
42340   IMATCH_MP_TAC  sub_union;
42341   (* - *)
42342   TYPE_THEN `d SUBSET UNIONS (par_cell eps G) UNION UNIONS (curve_cell G)` SUBAGOAL_TAC;
42343   IMATCH_MP_TAC  SUBSET_TRANS;
42344   ASM_MESON_TAC[];
42345   FULL_REWRITE_TAC[GSYM UNIONS_UNION];
42346   (* - *)
42347   THM_INTRO_TAC[`d`] cell_nonempty;
42348   FULL_REWRITE_TAC[EMPTY_EXISTS];
42349   (* - *)
42350   THM_INTRO_TAC[`par_cell eps G UNION curve_cell G`;`d`;`u`] cell_ununion;
42351   CONJ_TAC;
42352   REWRITE_TAC[union_subset];
42353   REWRITE_TAC [par_cell_cell];
42354   THM_INTRO_TAC[`G`] curve_cell_cell;
42355   FULL_REWRITE_TAC[rectagon];
42356   REWRITE_TAC[UNIONS;UNION];
42357   USE 8(REWRITE_RULE[SUBSET;UNIONS]);
42358   TSPEC `u` 8;
42359   USE 8 (REWRITE_RULE[UNION]);
42360   TYPE_THEN `u'` EXISTS_TAC;
42361   ASM_REWRITE_TAC[];
42362   FULL_REWRITE_TAC[UNION];
42363   (* Thu Dec  2 09:50:25 EST 2004 *)
42364   ]);;
42365   (* }}} *)
42366
42367 let rectagon_curve = prove_by_refinement(
42368   `!G C a b. FINITE G /\ G SUBSET edge /\ simple_arc_end C a b /\
42369       (C INTER UNIONS (curve_cell G) = EMPTY) ==>
42370       (C SUBSET (component  (ctop G) a))`,
42371   (* {{{ proof *)
42372   [
42373   REP_BASIC_TAC;
42374   REWRITE_TAC[SUBSET];
42375   TYPE_THEN `a = x` ASM_CASES_TAC;
42376   TYPE_THEN `x` UNABBREV_TAC;
42377   IMATCH_MP_TAC  component_refl;
42378   FULL_REWRITE_TAC[ctop_unions;DIFF;EQ_EMPTY ;INTER ];
42379   CONJ_TAC;
42380   USE 1 (MATCH_MP simple_arc_end_simple);
42381   USE 1 (MATCH_MP simple_arc_euclid);
42382   ASM_MESON_TAC[subset_imp];
42383   ASM_MESON_TAC[];
42384   (* - *)
42385   THM_INTRO_TAC[`G`;`a`;`x`] component_simple_arc;
42386   TYPE_THEN `x = b` ASM_CASES_TAC;
42387   TYPE_THEN `C` EXISTS_TAC;
42388   (* - *)
42389   THM_INTRO_TAC[`C`;`a`;`b`;`x`] simple_arc_end_cut;
42390   TYPE_THEN `C'` EXISTS_TAC;
42391   TYPE_THEN `C` UNABBREV_TAC;
42392   FULL_REWRITE_TAC[GSYM SUBSET_EMPTY];
42393   IMATCH_MP_TAC  SUBSET_TRANS;
42394   TYPE_THEN `(C' UNION C'') INTER UNIONS (curve_cell G)` EXISTS_TAC;
42395   IMATCH_MP_TAC  subset_inter_pair;
42396   REWRITE_TAC[SUBSET_REFL];
42397   REWRITE_TAC[SUBSET;UNION];
42398   (* Thu Dec  2 10:11:45 EST 2004 *)
42399
42400   ]);;
42401   (* }}} *)
42402
42403 (*  *)
42404 let star_avoidance_lemma1 = prove_by_refinement(
42405   `!E E' R B x. bounded_set E x /\ E SUBSET E' /\ FINITE E' /\
42406        E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
42407        ~(UNIONS (curve_cell B) x) /\
42408        B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
42409         (bounded_set (E' DIFF B) x \/ unbounded_set (E' DIFF B) x)`,
42410   (* {{{ proof *)
42411   [
42412   REP_BASIC_TAC;
42413   THM_INTRO_TAC[`ctop E`;`x`] component_empty;
42414   REWRITE_TAC[ctop_top];
42415   (* - *)
42416   TYPE_THEN `UNIONS (ctop E) x` SUBAGOAL_TAC;
42417   USE 9 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] not_eq]);
42418   FULL_REWRITE_TAC[EMPTY_EXISTS;bounded_set];
42419   ASM_MESON_TAC[];
42420   KILL 9;
42421   (* - *)
42422   TYPE_THEN `UNIONS (ctop (E' DIFF B)) x` SUBAGOAL_TAC;
42423   REWRITE_TAC[ctop_unions];
42424   TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ;
42425   REWRITE_TAC[DIFF];
42426   CONJ_TAC;
42427   USE 10(REWRITE_RULE[ctop_unions;DIFF]);
42428   TYPE_THEN `E' = E'' UNION E'` SUBAGOAL_TAC;
42429   IMATCH_MP_TAC  EQ_EXT;
42430   TYPE_THEN `E''` UNABBREV_TAC;
42431   REWRITE_TAC[DIFF;UNION];
42432   MESON_TAC[];
42433   THM_INTRO_TAC[`E''`;`E'`] curve_cell_union;
42434   USE 12 SYM;
42435   REWR 13;
42436   TYPE_THEN `UNIONS (curve_cell E') = UNIONS (curve_cell E'') UNION UNIONS(curve_cell E')` SUBAGOAL_TAC;
42437   REWRITE_TAC[GSYM UNIONS_UNION];
42438   AP_TERM_TAC;
42439   ASM_MESON_TAC[];
42440   USE 14(ONCE_REWRITE_RULE[FUN_EQ_THM]);
42441   TSPEC `x` 14;
42442   USE 14(REWRITE_RULE[UNION]);
42443   ASM_MESON_TAC[];
42444   (* -A *)
42445   THM_INTRO_TAC[`E' DIFF B`] bounded_unbounded_union;
42446   USE 11(ONCE_REWRITE_RULE[FUN_EQ_THM]);
42447   TSPEC `x` 11;
42448   REWR 11;
42449   USE 11(REWRITE_RULE[UNION]);
42450   (* - *)
42451   ]);;
42452   (* }}} *)
42453
42454 let curve_cell_imp_subset = prove_by_refinement(
42455   `!A B. A SUBSET B ==> curve_cell A SUBSET curve_cell B`,
42456   (* {{{ proof *)
42457   [
42458   REP_BASIC_TAC;
42459   TYPE_THEN `B = A UNION (B DIFF A)` SUBAGOAL_TAC;
42460   IMATCH_MP_TAC EQ_EXT;
42461   FULL_REWRITE_TAC [UNION;DIFF;SUBSET ];
42462   ASM_MESON_TAC [];
42463   TYPE_THEN `C = B DIFF A` ABBREV_TAC ;
42464   REWRITE_TAC[curve_cell_union];
42465   REWRITE_TAC[SUBSET;UNION];
42466   ]);;
42467   (* }}} *)
42468
42469 let unbound_set_x_axis = prove_by_refinement(
42470   `!G. (FINITE G /\ G SUBSET edge ) ==>
42471        (?r. !s. (r <= s) ==> unbounded_set G (point(s,&0)))`,
42472   (* {{{ proof *)
42473   [
42474   REP_BASIC_TAC;
42475   REWRITE_TAC[unbounded_set;unbounded;];
42476   NAME_CONFLICT_TAC;
42477   LEFT_TAC "r'";
42478   LEFT_TAC "r'";
42479   THM_INTRO_TAC[`G`] unbounded_set_nonempty;
42480   FULL_REWRITE_TAC[EMPTY_EXISTS;unbounded_set;unbounded];
42481   TYPE_THEN `r` EXISTS_TAC;
42482   TYPE_THEN `(\ (s:real). r)` EXISTS_TAC;
42483   COPY 2;
42484   TSPEC `s'` 2;
42485   TSPEC  `s''` 5;
42486   USE 4 (MATCH_MP component_symm);
42487   USE 4 (MATCH_MP component_replace);
42488   ASM_REWRITE_TAC[];
42489   ]);;
42490   (* }}} *)
42491
42492 let star_avoidance = prove_by_refinement(
42493   `!E E' R B x. unbounded_set (E' DIFF B) x /\ E SUBSET E' /\ FINITE E' /\
42494        E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
42495        FINITE B /\ B SUBSET edge /\
42496        ~(UNIONS (curve_cell B) x) /\
42497        B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
42498         ( unbounded_set (E) x)`,
42499   (* {{{ proof *)
42500   [
42501   REP_BASIC_TAC;
42502   TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ;
42503   RULE_ASSUM_TAC (REWRITE_RULE[unbounded_set;unbounded]);
42504   (* - *)
42505   THM_INTRO_TAC[`R`] unbound_set_x_axis;
42506   FULL_REWRITE_TAC[rectagon];
42507   (* - *)
42508   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;
42509   TYPE_THEN `r'' = &1 + (||. r') + (||. r) + ||. (x 0)` ABBREV_TAC ;
42510   TYPE_THEN `r''` EXISTS_TAC;
42511   TYPE_THEN `r <= s` SUBAGOAL_TAC;
42512   UNDF `r'' <= s` THEN UND 13 THEN REAL_ARITH_TAC;
42513   CONJ_TAC;
42514   TYPE_THEN `x` UNABBREV_TAC;
42515   FULL_REWRITE_TAC[coord01];
42516   UND 13 THEN UND 14 THEN REAL_ARITH_TAC;
42517   FIRST_ASSUM IMATCH_MP_TAC ;
42518   UND 13 THEN UND 14 THEN REAL_ARITH_TAC;
42519   KILL 12;
42520   KILL 10;
42521   (* - *)
42522   TYPE_THEN `FINITE E'' /\ E'' SUBSET edge` SUBAGOAL_TAC;
42523   TYPE_THEN `E''` UNABBREV_TAC;
42524   CONJ_TAC;
42525   IMATCH_MP_TAC  FINITE_DIFF;
42526   IMATCH_MP_TAC  SUBSET_TRANS;
42527   UNIFY_EXISTS_TAC;
42528   REWRITE_TAC[SUBSET_DIFF];
42529   (* - *)
42530   TYPE_THEN `!s. ?C. (r'' <= s) ==> (simple_arc_end C x (point(s,&0))  /\ (C INTER UNIONS (curve_cell E'') = {}))` SUBAGOAL_TAC;
42531   TSPEC `s` 13;
42532   RIGHT_TAC "C";
42533   THM_INTRO_TAC[`E''`;`x`;`point(s,&0)`] component_simple_arc;
42534   ASM_MESON_TAC[];
42535   (* -A *)
42536   REWRITE_TAC[unbounded_set;unbounded];
42537   TYPE_THEN `r''` EXISTS_TAC;
42538   TSPEC `s` 13;
42539   TSPEC `s` 14;
42540   THM_INTRO_TAC[`E`;`x`;`point(s,&0)`] component_simple_arc;
42541   CONJ_TAC;
42542   IMATCH_MP_TAC  FINITE_SUBSET;
42543   ASM_MESON_TAC[];
42544   IMATCH_MP_TAC  SUBSET_TRANS;
42545   ASM_MESON_TAC[];
42546   TYPE_THEN `C` EXISTS_TAC;
42547   (* - *)
42548   TYPE_THEN `R SUBSET E''` SUBAGOAL_TAC;
42549   TYPE_THEN `E''` UNABBREV_TAC;
42550   REWRITE_TAC[DIFF_SUBSET];
42551   CONJ_TAC;
42552   IMATCH_MP_TAC  SUBSET_TRANS;
42553   ASM_MESON_TAC[];
42554   PROOF_BY_CONTR_TAC;
42555   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
42556   THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
42557   FULL_REWRITE_TAC[rectagon];
42558   USE 21(REWRITE_RULE[INTER;EQ_EMPTY]);
42559   TSPEC `u` 21;
42560   UND 21 THEN ASM_REWRITE_TAC[];
42561   CONJ_TAC;
42562   ASM_MESON_TAC[subset_imp];
42563   ASM_MESON_TAC[curve_cell_subset;subset_imp];
42564   (* -B *)
42565   TYPE_THEN `C INTER UNIONS(curve_cell R) = EMPTY` SUBAGOAL_TAC;
42566   FULL_REWRITE_TAC[GSYM SUBSET_EMPTY];
42567   IMATCH_MP_TAC  SUBSET_TRANS;
42568   TYPE_THEN `C INTER UNIONS (curve_cell E'')` EXISTS_TAC;
42569   IMATCH_MP_TAC subset_inter_pair;
42570   REWRITE_TAC[SUBSET_REFL];
42571   IMATCH_MP_TAC  UNIONS_UNIONS;
42572   IMATCH_MP_TAC  curve_cell_imp_subset;
42573   (* - *)
42574   THM_INTRO_TAC[`R`;`C`;`x`;`point(s,&0)`] rectagon_curve;
42575   FULL_REWRITE_TAC[rectagon];
42576   (* - *)
42577   THM_INTRO_TAC[`R`]unbounded_set_comp;
42578   FULL_REWRITE_TAC[rectagon];
42579   TYPE_THEN `component  (ctop R) x' = component  (ctop R) (point(s,&0))` SUBAGOAL_TAC;
42580   IMATCH_MP_TAC  component_replace;
42581   USE 23 SYM;
42582   ASM_REWRITE_TAC[];
42583   TYPE_THEN `component  (ctop R) x'` UNABBREV_TAC;
42584   TYPE_THEN `component  (ctop R) x = component  (ctop R) (point(s,&0))` SUBAGOAL_TAC;
42585   IMATCH_MP_TAC  component_replace;
42586   USE 22(REWRITE_RULE[SUBSET]);
42587   FIRST_ASSUM IMATCH_MP_TAC ;
42588   IMATCH_MP_TAC  simple_arc_end_end2;
42589   ASM_MESON_TAC[];
42590   (* -C *)
42591   THM_INTRO_TAC[`R`;`B`;`F`] par_cell_closure;
42592   (* - *)
42593   TYPE_THEN `C INTER UNIONS (curve_cell B) = EMPTY` SUBAGOAL_TAC;
42594   FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ];
42595   IMATCH_MP_TAC  SUBSET_TRANS;
42596   TYPE_THEN `UNIONS (par_cell T R) INTER UNIONS (curve_cell B)` EXISTS_TAC;
42597   CONJ_TAC;
42598   IMATCH_MP_TAC  subset_inter_pair;
42599   REWRITE_TAC[SUBSET_REFL];
42600   THM_INTRO_TAC[`R`] unbounded_even;
42601   USE 26 SYM;
42602   ASM_MESON_TAC[];
42603   ONCE_REWRITE_TAC[INTER_COMM];
42604   FULL_REWRITE_TAC[SUBSET_EMPTY ];
42605   THM_INTRO_TAC[`curve_cell B`;`par_cell T R`] cell_unions_disj;
42606   THM_INTRO_TAC[`B`]curve_cell_cell;
42607   THM_INTRO_TAC[`R`]par_cell_cell;
42608   USE 26 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
42609   ASM_REWRITE_TAC[];
42610   (* - *)
42611   TYPE_THEN `E SUBSET E'' UNION B` SUBAGOAL_TAC;
42612   TYPE_THEN `E''` UNABBREV_TAC;
42613   REWRITE_TAC[SUBSET;DIFF;UNION];
42614   ASM_MESON_TAC[subset_imp];
42615   (* - *)
42616   FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ];
42617   IMATCH_MP_TAC  SUBSET_TRANS;
42618   TYPE_THEN `C INTER UNIONS (curve_cell (E'' UNION B))` EXISTS_TAC;
42619   CONJ_TAC;
42620   IMATCH_MP_TAC  subset_inter_pair;
42621   REWRITE_TAC[SUBSET_REFL];
42622   IMATCH_MP_TAC  UNIONS_UNIONS;
42623   IMATCH_MP_TAC  curve_cell_imp_subset;
42624   (* - *)
42625   REWRITE_TAC[curve_cell_union;UNIONS_UNION];
42626   REWRITE_TAC[UNION_OVER_INTER];
42627   REWRITE_TAC[union_subset];
42628   (* Thu Dec  2 16:12:59 EST 2004 *)
42629
42630   ]);;
42631   (* }}} *)
42632
42633 let star_avoidance_contrp = prove_by_refinement(
42634   `!E E' R B x. bounded_set (E) x /\ E SUBSET E' /\ FINITE E' /\
42635        E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
42636        FINITE B /\ B SUBSET edge /\
42637        ~(UNIONS (curve_cell B) x) /\
42638        B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
42639         ( bounded_set (E' DIFF B) x)`,
42640   (* {{{ proof *)
42641   [
42642   REP_BASIC_TAC;
42643   THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance_lemma1;
42644   FIRST_ASSUM DISJ_CASES_TAC;
42645   THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance;
42646   THM_INTRO_TAC[`E`] bounded_unbounded_disj;
42647   FULL_REWRITE_TAC[EQ_EMPTY;INTER];
42648   ASM_MESON_TAC[];
42649   ]);;
42650   (* }}} *)
42651
42652 let bounded_avoidance_subset = prove_by_refinement(
42653   `!E E' x. bounded_set E x /\ E SUBSET E' /\ (E' SUBSET edge) /\
42654      (FINITE E') /\
42655            conn2 E /\
42656         ~(UNIONS (curve_cell E') x) ==>
42657        (bounded_set E' x)`,
42658   (* {{{ proof *)
42659   [
42660   REP_BASIC_TAC;
42661   THM_INTRO_TAC[`E`] conn2_has_rectagon;
42662   IMATCH_MP_TAC  SUBSET_TRANS;
42663   ASM_MESON_TAC[];
42664   THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance_contrp;
42665   ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty];
42666   FULL_REWRITE_TAC[DIFF_EMPTY];
42667   ]);;
42668   (* }}} *)
42669
42670 let unbounded_avoidance_subset = prove_by_refinement(
42671   `!E E' x.  (unbounded_set E' x) /\ E SUBSET E' /\ (E' SUBSET edge) /\
42672      (FINITE E') /\
42673            conn2 E /\
42674         ~(UNIONS (curve_cell E') x) ==> unbounded_set E x
42675        `,
42676   (* {{{ proof *)
42677   [
42678   REP_BASIC_TAC;
42679   THM_INTRO_TAC[`E`] conn2_has_rectagon;
42680   IMATCH_MP_TAC  SUBSET_TRANS;
42681   ASM_MESON_TAC[];
42682   THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance;
42683   ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty;DIFF_EMPTY];
42684   ]);;
42685   (* }}} *)
42686
42687 let diff_unchange = prove_by_refinement(
42688   `! (A:A -> bool) B. (A DIFF B = A) <=> (A INTER B = EMPTY)`,
42689   (* {{{ proof *)
42690   [
42691   REP_BASIC_TAC;
42692   IMATCH_MP_TAC  EQ_ANTISYM;
42693   CONJ_TAC;
42694   USE 0(ONCE_REWRITE_RULE[FUN_EQ_THM]);
42695   USE 0(REWRITE_RULE[DIFF]);
42696   IMATCH_MP_TAC  EQ_EXT;
42697   REWRITE_TAC[EQ_EMPTY;INTER];
42698   ASM_MESON_TAC[];
42699   USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
42700   IMATCH_MP_TAC  EQ_EXT;
42701   FULL_REWRITE_TAC[DIFF;INTER];
42702   ASM_MESON_TAC[];
42703   ]);;
42704   (* }}} *)
42705
42706 let union_diff2 = prove_by_refinement(
42707   `!(A:A->bool) B. (A UNION B) DIFF A = (B DIFF A)`,
42708   (* {{{ proof *)
42709   [
42710   REP_BASIC_TAC;
42711   IMATCH_MP_TAC  EQ_EXT;
42712   REWRITE_TAC[UNION;DIFF;];
42713   MESON_TAC[];
42714   ]);;
42715   (* }}} *)
42716
42717 let unbounded_triple_avoidance = prove_by_refinement(
42718   `!A B C x. psegment_triple A B C /\
42719        A SUBSET par_cell F (B UNION C) /\
42720        unbounded_set (B UNION C) x ==>
42721        unbounded_set (A UNION B UNION C) x`,
42722   (* {{{ proof *)
42723   [
42724   REP_BASIC_TAC;
42725   THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance;
42726   CONJ_TAC;
42727   TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC;
42728   ONCE_REWRITE_TAC [union_diff2];
42729   REWRITE_TAC[diff_unchange];
42730   ONCE_REWRITE_TAC[INTER_COMM];
42731   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
42732   FULL_REWRITE_TAC[psegment_triple];
42733   ASM_REWRITE_TAC[];
42734   (* -- *)
42735   REWRITE_TAC[SUBSET_REFL];
42736   CONJ_TAC;
42737   REWRITE_TAC[FINITE_UNION];
42738   FULL_REWRITE_TAC[psegment_triple];
42739   FULL_REWRITE_TAC[psegment;segment];
42740   (* -- *)
42741   CONJ_TAC;
42742   REWRITE_TAC[union_subset];
42743   FULL_REWRITE_TAC[psegment_triple];
42744   FULL_REWRITE_TAC[psegment;segment];
42745   CONJ_TAC;
42746   FULL_REWRITE_TAC[psegment_triple];
42747   CONJ_TAC;
42748   REWRITE_TAC[SUBSET;UNION];
42749   CONJ_TAC;
42750   FULL_REWRITE_TAC[psegment_triple];
42751   USE 15 (REWRITE_RULE[segment;psegment]);
42752   CONJ_TAC;
42753   FULL_REWRITE_TAC[psegment_triple];
42754   USE 15 (REWRITE_RULE[segment;psegment]);
42755   SUBCONJ_TAC;
42756   THM_INTRO_TAC[`(B UNION C)`;`A`;`F`] par_cell_closure;
42757   FULL_REWRITE_TAC[psegment_triple];
42758   USE 16 (REWRITE_RULE[psegment;segment]);
42759   THM_INTRO_TAC[`B UNION C`] unbounded_even;
42760   FULL_REWRITE_TAC[psegment_triple];
42761   REWR 0;
42762   KILL 5;
42763   FULL_REWRITE_TAC[UNIONS];
42764   TYPE_THEN `u = u'` SUBAGOAL_TAC;
42765   IMATCH_MP_TAC  cell_partition;
42766   REWRITE_TAC[EMPTY_EXISTS;INTER ];
42767   THM_INTRO_TAC[`A`] curve_cell_cell;
42768   FULL_REWRITE_TAC[psegment_triple];
42769   USE 19 (REWRITE_RULE[psegment;segment;]);
42770   REPEAT CONJ_TAC THEN (TRY (ASM_MESON_TAC[par_cell_cell;subset_imp]));
42771   TYPE_THEN`u'` UNABBREV_TAC;
42772   USE 4 (REWRITE_RULE [EQ_EMPTY;INTER]);
42773   ASM_MESON_TAC[];
42774   (* -A *)
42775   USE 3(ONCE_REWRITE_RULE[curve_cell_union; ]);
42776   USE 3(REWRITE_RULE[UNIONS_UNION]);
42777   TYPE_THEN `D =  B UNION C` ABBREV_TAC ;
42778   USE 3(REWRITE_RULE[UNION]);
42779   REWR 3;
42780   TYPE_THEN `D` UNABBREV_TAC;
42781   THM_INTRO_TAC[`B UNION C`;`T`] unions_curve_cell_par_cell_disj;
42782   FULL_REWRITE_TAC[psegment_triple];
42783   USE 12(REWRITE_RULE[rectagon]);
42784   THM_INTRO_TAC[`B UNION C`] unbounded_even;
42785   FULL_REWRITE_TAC[psegment_triple];
42786   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
42787   ASM_MESON_TAC[];
42788   ]);;
42789   (* }}} *)
42790
42791 let unbounded_set_comp_elt_eq = prove_by_refinement(
42792   `! G x. FINITE G /\
42793           G SUBSET edge /\ unbounded_set G x ==>
42794           (unbounded_set G = component (ctop G) x)
42795           `,
42796   (* {{{ proof *)
42797   [
42798   REP_BASIC_TAC;
42799   THM_INTRO_TAC[`G`] unbounded_set_comp;
42800   IMATCH_MP_TAC  component_replace;
42801   REWR 0;
42802   ]);;
42803   (* }}} *)
42804
42805 let outer_segment_even = prove_by_refinement(
42806   `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C)
42807      ==> C SUBSET par_cell T (A UNION B)`,
42808   (* {{{ proof *)
42809   [
42810   REP_BASIC_TAC;
42811   TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
42812   FULL_REWRITE_TAC[psegment_triple;psegment;segment];
42813   TYPE_THEN `C` UNABBREV_TAC;
42814   FULL_REWRITE_TAC[EMPTY_EXISTS];
42815   (* - *)
42816   THM_INTRO_TAC[`B UNION C`] unbounded_set_nonempty;
42817   FULL_REWRITE_TAC[psegment_triple];
42818   USE 10(REWRITE_RULE [rectagon]);
42819   FULL_REWRITE_TAC[EMPTY_EXISTS];
42820   (* - *)
42821   THM_INTRO_TAC[`B UNION C`;`u'`] unbounded_set_comp_elt_eq;
42822   FULL_REWRITE_TAC[psegment_triple];
42823   USE 11 (REWRITE_RULE[rectagon]);
42824   THM_INTRO_TAC[`B UNION C`;`u'`;`u`] along_lemma11;
42825   CONJ_TAC;
42826   FULL_REWRITE_TAC[psegment_triple];
42827   IMATCH_MP_TAC  rectagon_segment;
42828   REWRITE_TAC[EMPTY_EXISTS];
42829   CONJ_TAC;
42830   ASM_MESON_TAC[];
42831   REWRITE_TAC[UNION];
42832   (* - *)
42833   THM_INTRO_TAC[`squ p`] cell_nonempty;
42834   REWRITE_TAC[cell_rules];
42835   FULL_REWRITE_TAC[EMPTY_EXISTS];
42836   TYPE_THEN `unbounded_set (B UNION C) u''` SUBAGOAL_TAC;
42837   ASM_MESON_TAC[subset_imp];
42838   (* -A *)
42839   THM_INTRO_TAC[`A`;`B`;`C`;`u''`] unbounded_triple_avoidance;
42840   THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`u''`] unbounded_avoidance_subset;
42841   (* -- *)
42842   CONJ_TAC;
42843   REWRITE_TAC[SUBSET;UNION];
42844   FIRST_ASSUM DISJ_CASES_TAC;
42845   CONJ_TAC;
42846   REWRITE_TAC[union_subset];
42847   FULL_REWRITE_TAC[psegment_triple];
42848   FULL_REWRITE_TAC[psegment;segment];
42849   CONJ_TAC;
42850   REWRITE_TAC[FINITE_UNION];
42851   FULL_REWRITE_TAC[psegment_triple];
42852   FULL_REWRITE_TAC[psegment;segment];
42853   CONJ_TAC;
42854   IMATCH_MP_TAC  conn2_rectagon;
42855   FULL_REWRITE_TAC[psegment_triple];
42856   (* --B *)
42857   TYPE_THEN `D = B UNION C` ABBREV_TAC ;
42858   USE 10(REWRITE_RULE[curve_cell_union;]);
42859   USE 10(REWRITE_RULE[UNIONS_UNION]);
42860   USE 10(REWRITE_RULE[UNION]);
42861   THM_INTRO_TAC[`D`] unbounded_even;
42862   TYPE_THEN `D` UNABBREV_TAC;
42863   FULL_REWRITE_TAC[psegment_triple];
42864   KILL 4;
42865   TYPE_THEN `unbounded_set D` UNABBREV_TAC;
42866   FIRST_ASSUM DISJ_CASES_TAC;
42867   THM_INTRO_TAC[`D`;`A`;`F`] par_cell_closure;
42868   TYPE_THEN `D` UNABBREV_TAC;
42869   FULL_REWRITE_TAC[psegment_triple];
42870   USE 23(REWRITE_RULE[psegment;segment]);
42871   THM_INTRO_TAC[`curve_cell A`;`par_cell T D`] cell_unions_disj;
42872   THM_INTRO_TAC[`A`] curve_cell_cell;
42873   FULL_REWRITE_TAC[psegment_triple];
42874   USE 25(REWRITE_RULE[psegment;segment]);
42875   THM_INTRO_TAC[`D`] par_cell_cell;
42876   REWR 12;
42877   REWR 13;
42878   USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]);
42879   ASM_MESON_TAC[];
42880   (* -- *)
42881   THM_INTRO_TAC[`D`;`T`]unions_curve_cell_par_cell_disj;
42882   FULL_REWRITE_TAC[psegment_triple];
42883   TYPE_THEN `D` UNABBREV_TAC;
42884   USE 19 (REWRITE_RULE[rectagon]);
42885   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
42886   ASM_MESON_TAC[];
42887   (* -C *)
42888   THM_INTRO_TAC[`A UNION B`] unbounded_even;
42889   FULL_REWRITE_TAC[psegment_triple];
42890   KILL 4;
42891   TYPE_THEN `unbounded_set (A UNION B)` UNABBREV_TAC;
42892   THM_INTRO_TAC[`par_cell T (A UNION B)`;`squ p`;`u''`] cell_ununion;
42893   REWRITE_TAC[par_cell_cell;cell_rules];
42894   THM_INTRO_TAC[`A UNION B`;`squ p`;`u`;`T`] par_cell_closure_cell;
42895   REWRITE_TAC[cell_rules;squ_closure];
42896   CONJ_TAC;
42897   IMATCH_MP_TAC  edge_cell;
42898   FULL_REWRITE_TAC[psegment_triple];
42899   USE 21 (REWRITE_RULE[psegment;segment]);
42900   ASM_MESON_TAC[subset_imp];
42901   FULL_REWRITE_TAC[psegment_triple];
42902   (* - *)
42903   THM_INTRO_TAC[`A UNION B`;`u`] curve_cell_edge;
42904   FULL_REWRITE_TAC[psegment_triple];
42905   USE 22 (REWRITE_RULE[psegment;segment]);
42906   ASM_MESON_TAC[subset_imp];
42907   REWR 11;
42908   KILL 12;
42909   (* - *)
42910   FIRST_ASSUM DISJ_CASES_TAC ;
42911   THM_INTRO_TAC[`A UNION B`;`C`] segment_in_comp;
42912   CONJ_TAC;
42913   FULL_REWRITE_TAC[psegment_triple];
42914   CONJ_TAC;
42915   FULL_REWRITE_TAC[psegment_triple];
42916   FULL_REWRITE_TAC[psegment];
42917   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
42918   CONJ_TAC;
42919     FULL_REWRITE_TAC[psegment_triple];
42920   FULL_REWRITE_TAC[INTER_COMM];
42921   REWRITE_TAC[cls_union];
42922   ONCE_REWRITE_TAC[INTER_COMM];
42923     REWRITE_TAC[UNION_OVER_INTER;union_subset];
42924      FULL_REWRITE_TAC[psegment_triple];
42925   FULL_REWRITE_TAC[INTER_COMM];
42926   ASM_MESON_TAC[SUBSET_REFL];
42927   (* -- *)
42928   TYPE_THEN `eps = T` ASM_CASES_TAC;
42929   TYPE_THEN `eps` UNABBREV_TAC;
42930   TYPE_THEN `eps = F` SUBAGOAL_TAC;
42931   ASM_MESON_TAC[];
42932   TYPE_THEN `eps` UNABBREV_TAC;
42933   THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint;
42934   USE 15(REWRITE_RULE[INTER;EQ_EMPTY]);
42935   TSPEC `u` 15;
42936   USE 13 (REWRITE_RULE[SUBSET]);
42937   ASM_MESON_TAC[];
42938   (* - *)
42939   USE 12 (REWRITE_RULE[UNION]);
42940   FULL_REWRITE_TAC[psegment_triple];
42941   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
42942   ASM_MESON_TAC[];
42943   ]);;
42944   (* }}} *)
42945
42946 let meeting_lemma = prove_by_refinement(
42947   `!R B C v eps. rectagon R /\ B SUBSET par_cell eps R /\
42948     (C INTER R = EMPTY) /\ cls R INTER cls C SUBSET endpoint C /\
42949      cls C v /\ cls B v /\ ~cls R v /\ segment C /\ B SUBSET edge ==>
42950     C SUBSET par_cell eps R`,
42951   (* {{{ proof *)
42952   [
42953   REP_BASIC_TAC;
42954   THM_INTRO_TAC[`R`;`C`] segment_in_comp;
42955   TYPE_THEN `eps' = eps` ASM_CASES_TAC ;
42956   TYPE_THEN `eps'` UNABBREV_TAC;
42957   TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
42958   ASM_MESON_TAC[];
42959   TYPE_THEN `eps'` UNABBREV_TAC;
42960   KILL 10;
42961   (* - *)
42962   TYPE_THEN `~(C INTER par_cell eps R = EMPTY)` BACK_TAC ;
42963   USE 10(REWRITE_RULE[INTER;EMPTY_EXISTS ]);
42964   THM_INTRO_TAC[`R`;`eps`] par_cell_disjoint;
42965   USE 12(REWRITE_RULE[INTER;EQ_EMPTY]);
42966   USE 9 (REWRITE_RULE[SUBSET]);
42967   ASM_MESON_TAC[];
42968   (* - *)
42969   TYPE_THEN `?eC. closure top2 eC (pointI v) /\ C eC` SUBAGOAL_TAC;
42970   FULL_REWRITE_TAC[cls];
42971   ASM_MESON_TAC[];
42972   TYPE_THEN `?eB. closure top2 eB (pointI v) /\ B eB` SUBAGOAL_TAC;
42973   FULL_REWRITE_TAC[cls];
42974   ASM_MESON_TAC[];
42975   (* - *)
42976   UND 10 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
42977   TYPE_THEN `eC` EXISTS_TAC;
42978   IMATCH_MP_TAC  par_cell_nbd;
42979   TYPE_THEN `v` EXISTS_TAC;
42980   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
42981   CONJ_TAC;
42982   FULL_REWRITE_TAC[segment];
42983   ASM_MESON_TAC[subset_imp];
42984   (* - *)
42985   THM_INTRO_TAC[`R`;`eB`;`{(pointI v)}`;`eps`] par_cell_closure_cell;
42986   REWRITE_TAC[cell_rules;SUBSET;INR IN_SING];
42987   CONJ_TAC;
42988   IMATCH_MP_TAC  edge_cell;
42989   ASM_MESON_TAC[subset_imp];
42990   ASM_MESON_TAC[subset_imp];
42991   PROOF_BY_CONTR_TAC;
42992   REWR 10;
42993   THM_INTRO_TAC[`R`;`v`] curve_cell_not_point;
42994   IMATCH_MP_TAC  rectagon_segment;
42995   UND 16 THEN ASM_REWRITE_TAC[];
42996   THM_INTRO_TAC[`R`;`pointI v`] num_closure0;
42997   FULL_REWRITE_TAC[rectagon];
42998   USE 2(REWRITE_RULE[cls]);
42999   ASM_MESON_TAC[];
43000   ]);;
43001   (* }}} *)
43002
43003 let parity_union_triple = prove_by_refinement(
43004   `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\
43005       (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
43006      /\ (A SUBSET edge) /\  A e ==>
43007        (parity (B UNION C) e = (parity B e = parity C e))`,
43008   (* {{{ proof *)
43009   [
43010   REP_BASIC_TAC;
43011   TYPE_THEN `edge e` SUBAGOAL_TAC;
43012   ASM_MESON_TAC[subset_imp];
43013   THM_INTRO_TAC[`B`;`C`;`e`] parity_union;
43014   CONJ_TAC;
43015   IMATCH_MP_TAC  edge_cell;
43016   (* - *)
43017   TYPE_THEN `~B e /\ ~C e` SUBAGOAL_TAC;
43018   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
43019   ASM_MESON_TAC[];
43020   ASM_SIMP_TAC[curve_cell_edge];
43021   ]);;
43022   (* }}} *)
43023
43024 let parity_union_triple_even = prove_by_refinement(
43025   `!A B C e.  segment B /\ segment C /\ (segment (B UNION C)) /\
43026       (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
43027      /\ (segment A ) /\  A e /\
43028    A SUBSET par_cell T (B UNION C) ==> (parity B e = parity C e)`,
43029   (* {{{ proof *)
43030   [
43031   REP_BASIC_TAC;
43032   THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple;
43033   FULL_REWRITE_TAC[segment];
43034   USE 9(ONCE_REWRITE_RULE[EQ_SYM_EQ]);
43035   THM_INTRO_TAC[`B UNION C`;`e`;`T`] parity_unique;
43036   ASM_MESON_TAC[subset_imp];
43037   ]);;
43038   (* }}} *)
43039
43040 let parity_union_triple_odd = prove_by_refinement(
43041   `!A B C e.  segment B /\ segment C /\ (segment (B UNION C)) /\
43042       (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
43043      /\ (A SUBSET edge) /\ A e /\
43044    A SUBSET par_cell F (B UNION C) ==> ~(parity B e = parity C e)`,
43045   (* {{{ proof *)
43046   [
43047   REP_BASIC_TAC;
43048   THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple;
43049   REWR 10;
43050   THM_INTRO_TAC[`B UNION C`;`e`;`F`] parity_unique;
43051   ASM_MESON_TAC[subset_imp];
43052   ASM_MESON_TAC[];
43053   ]);;
43054   (* }}} *)
43055
43056 let par_cell_even_imp = prove_by_refinement(
43057   `!A B C D. psegment_triple A B D /\ segment C /\
43058     cls (A UNION B) INTER cls C SUBSET endpoint C /\
43059     (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY)
43060     /\ C SUBSET par_cell T (B UNION D) /\ C SUBSET par_cell T (A UNION D)
43061    ==> C SUBSET par_cell T (A UNION B)`,
43062   (* {{{ proof *)
43063   [
43064   REP_BASIC_TAC;
43065   THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
43066   REWRITE_TAC[cls_union];
43067   CONJ_TAC;
43068   FULL_REWRITE_TAC[psegment_triple];
43069   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
43070   FULL_REWRITE_TAC[INTER_COMM];
43071   (* - *)
43072   TYPE_THEN `eps = T` ASM_CASES_TAC;
43073   TYPE_THEN `eps` UNABBREV_TAC;
43074   TYPE_THEN `eps = F` SUBAGOAL_TAC;
43075   ASM_MESON_TAC[];
43076   TYPE_THEN `eps` UNABBREV_TAC;
43077   KILL 9;
43078   PROOF_BY_CONTR_TAC;
43079   (* - *)
43080   TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC;
43081   FULL_REWRITE_TAC[segment];
43082   FULL_REWRITE_TAC[EMPTY_EXISTS];
43083   TYPE_THEN  `u` EXISTS_TAC;
43084   ASM_MESON_TAC[subset_imp];
43085   (* - *)
43086   THM_INTRO_TAC[`C`;`A`;`D`;`e`]  parity_union_triple_even;
43087   FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
43088   IMATCH_MP_TAC  rectagon_segment;
43089   THM_INTRO_TAC[`C`;`B`;`D`;`e`]  parity_union_triple_even;
43090   FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
43091   IMATCH_MP_TAC  rectagon_segment;
43092   TYPE_THEN `parity D e` UNABBREV_TAC;
43093   USE 12 SYM;
43094   (* - *)
43095   THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple;
43096   FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
43097   CONJ_TAC;
43098   IMATCH_MP_TAC  rectagon_segment;
43099   USE 6(REWRITE_RULE[segment]);
43100   REWR 13;
43101   (* - *)
43102   THM_INTRO_TAC[`(A UNION B)`;`e`] parity;
43103   ASM_SIMP_TAC[curve_cell_edge];
43104   FULL_REWRITE_TAC[psegment_triple];
43105   CONJ_TAC;
43106   IMATCH_MP_TAC  rectagon_segment;
43107   CONJ_TAC;
43108   IMATCH_MP_TAC  edge_cell;
43109   USE 27 (REWRITE_RULE[UNION]);
43110   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
43111   ASM_MESON_TAC[];
43112   (* - *)
43113   THM_INTRO_TAC[`A UNION B`;`parity(A UNION B) e`] par_cell_disjoint;
43114   USE 15(REWRITE_RULE[INTER;EQ_EMPTY]);
43115   TSPEC `e` 15;
43116   UND 15 THEN ASM_REWRITE_TAC[];
43117   ASM_MESON_TAC[subset_imp];
43118   ]);;
43119   (* }}} *)
43120
43121 let par_cell_odd_imp = prove_by_refinement(
43122   `!A B C D. psegment_triple A B D /\ segment C /\
43123     cls (A UNION B) INTER cls C SUBSET endpoint C /\
43124     (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY)
43125     /\ C SUBSET par_cell F (B UNION D) /\ C SUBSET par_cell T (A UNION D)
43126    ==> C SUBSET par_cell F (A UNION B)`,
43127   (* {{{ proof *)
43128
43129   [
43130   REP_BASIC_TAC;
43131   THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
43132   REWRITE_TAC[cls_union];
43133   CONJ_TAC;
43134   FULL_REWRITE_TAC[psegment_triple];
43135   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
43136   FULL_REWRITE_TAC[INTER_COMM];
43137   (* - *)
43138   TYPE_THEN `eps = F` ASM_CASES_TAC;
43139   TYPE_THEN `eps` UNABBREV_TAC;
43140   TYPE_THEN `eps = T` SUBAGOAL_TAC;
43141   ASM_MESON_TAC[];
43142   TYPE_THEN `eps` UNABBREV_TAC;
43143   KILL 9;
43144   PROOF_BY_CONTR_TAC;
43145   (* - *)
43146   TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC;
43147   FULL_REWRITE_TAC[segment];
43148   FULL_REWRITE_TAC[EMPTY_EXISTS];
43149   TYPE_THEN  `u` EXISTS_TAC;
43150   ASM_MESON_TAC[subset_imp];
43151   (* - *)
43152   THM_INTRO_TAC[`C`;`A`;`D`;`e`]  parity_union_triple_even;
43153   FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
43154   IMATCH_MP_TAC  rectagon_segment;
43155   THM_INTRO_TAC[`C`;`B`;`D`;`e`]  parity_union_triple_odd;
43156   FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
43157   CONJ_TAC;
43158   IMATCH_MP_TAC  rectagon_segment;
43159   USE 6 (REWRITE_RULE[segment]);
43160   TYPE_THEN `parity D e` UNABBREV_TAC;
43161   USE 13 GSYM;
43162   (* - *)
43163   THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple;
43164   FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
43165   CONJ_TAC;
43166   IMATCH_MP_TAC  rectagon_segment;
43167   USE 6(REWRITE_RULE[segment]);
43168   (* - *)
43169   THM_INTRO_TAC[`(A UNION B)`;`e`] parity;
43170   ASM_SIMP_TAC[curve_cell_edge];
43171   FULL_REWRITE_TAC[psegment_triple];
43172   CONJ_TAC;
43173   IMATCH_MP_TAC  rectagon_segment;
43174   CONJ_TAC;
43175   IMATCH_MP_TAC  edge_cell;
43176   USE 27 (REWRITE_RULE[UNION]);
43177   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
43178   ASM_MESON_TAC[];
43179   (* - *)
43180   TYPE_THEN `parity(A UNION B) e = F` SUBAGOAL_TAC;
43181   ASM_MESON_TAC[];
43182   KILL 13 THEN REWR 14;
43183   UND 9 THEN ASM_REWRITE_TAC[];
43184   THM_INTRO_TAC[`A UNION B`;`F`] par_cell_disjoint;
43185   USE 9(REWRITE_RULE[INTER;EQ_EMPTY]);
43186   TSPEC `e` 9;
43187   ASM_MESON_TAC[subset_imp];
43188   ]);;
43189
43190   (* }}} *)
43191
43192 let curve_cell_cls = prove_by_refinement(
43193   `!G m. segment G ==> (curve_cell G {(pointI m)} = cls G m)`,
43194   (* {{{ proof *)
43195   [
43196   REP_BASIC_TAC;
43197   ASM_SIMP_TAC[curve_cell_not_point];
43198   THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
43199   FULL_REWRITE_TAC[segment];
43200   REWRITE_TAC[cls];
43201   ASM_MESON_TAC[];
43202   ]);;
43203   (* }}} *)
43204
43205 let conn2_rect_diff_inner = prove_by_refinement(
43206   `!E R. conn2 E /\ (E SUBSET edge) /\ rectagon R /\ R SUBSET E ==>
43207      conn2 (E DIFF (E INTER par_cell F R))`,
43208   (* {{{ proof *)
43209   [
43210   REWRITE_TAC[conn2];
43211   TYPE_THEN `J = E INTER par_cell F R` ABBREV_TAC ;
43212   SUBCONJ_TAC;
43213   IMATCH_MP_TAC  FINITE_SUBSET;
43214   UNIFY_EXISTS_TAC;
43215   REWRITE_TAC[DIFF;SUBSET];
43216   (* - *)
43217   TYPE_THEN `R SUBSET E DIFF J` SUBAGOAL_TAC;
43218   REWRITE_TAC[DIFF_SUBSET];
43219   PROOF_BY_CONTR_TAC;
43220   FULL_REWRITE_TAC [EMPTY_EXISTS;INTER];
43221   TYPE_THEN `J` UNABBREV_TAC;
43222   THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
43223   FULL_REWRITE_TAC[rectagon];
43224   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
43225   TSPEC `u` 10;
43226   THM_INTRO_TAC[`R`;`u`] curve_cell_edge;
43227   FULL_REWRITE_TAC[rectagon];
43228   ASM_MESON_TAC[subset_imp];
43229   REWR 10;
43230   (* -/ *)
43231   THM_INTRO_TAC[`R`] conn2_rectagon;
43232   CONJ_TAC;
43233   THM_INTRO_TAC[`R`;`E DIFF J`] CARD_SUBSET;
43234   FULL_REWRITE_TAC[conn2];
43235   UND 10 THEN UND 11 THEN ARITH_TAC;
43236   TYPE_THEN `(E DIFF J) UNION J = E` SUBAGOAL_TAC;
43237   TYPE_THEN `J` UNABBREV_TAC;
43238   IMATCH_MP_TAC  EQ_EXT;
43239   REWRITE_TAC[DIFF;INTER;UNION];
43240   MESON_TAC[];
43241   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]);
43242   UND 15 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
43243   REWRITE_TAC[cls_union];
43244   REWRITE_TAC[UNION];
43245   (* -A *)
43246   TYPE_THEN `S SUBSET E DIFF J` ASM_CASES_TAC;
43247   TYPE_THEN `S` EXISTS_TAC;
43248   TYPE_THEN `~(S INTER J = EMPTY)` SUBAGOAL_TAC;
43249   TYPE_THEN `~(S = EMPTY)` SUBAGOAL_TAC;
43250   FULL_REWRITE_TAC[segment_end;segment;psegment];
43251   TYPE_THEN `S` UNABBREV_TAC ;
43252   USE 20 (REWRITE_RULE[EMPTY_EXISTS]);
43253   UND 20 THEN UND 19 THEN UND 18 THEN UND 17 THEN REWRITE_TAC[EQ_EMPTY;SUBSET;INTER;DIFF] THEN MESON_TAC[];
43254   (* -/ *)
43255   THM_INTRO_TAC[`R`;`T`;`{(pointI a)}`] par_cell_cell_partition;
43256   REWRITE_TAC[cell_rules];
43257   IMATCH_MP_TAC  rectagon_segment;
43258   TYPE_THEN `par_cell T R {(pointI a)} \/ cls R a` SUBAGOAL_TAC;
43259   FIRST_ASSUM DISJ_CASES_TAC;
43260   FIRST_ASSUM DISJ_CASES_TAC;
43261   FULL_REWRITE_TAC[cls];
43262   USE 14 (REWRITE_RULE[DIFF]);
43263   THM_INTRO_TAC[`R`;`F`;`a`;`e'`] par_cell_nbd;
43264   ASM_MESON_TAC[subset_imp];
43265   TYPE_THEN `J` UNABBREV_TAC;
43266   USE 14(REWRITE_RULE[INTER]);
43267   ASM_MESON_TAC[];
43268   THM_INTRO_TAC[`R`;`a`]curve_cell_cls;
43269   IMATCH_MP_TAC  rectagon_segment;
43270   ASM_MESON_TAC[];
43271   (* -B/ *)
43272   KILL 20;
43273   THM_INTRO_TAC[`R`;`T`;`{(pointI b)}`] par_cell_cell_partition;
43274   REWRITE_TAC[cell_rules];
43275   IMATCH_MP_TAC  rectagon_segment;
43276   (* - *)
43277   TYPE_THEN `par_cell T R {(pointI b)} \/ cls R b` SUBAGOAL_TAC;
43278   FIRST_ASSUM DISJ_CASES_TAC;
43279   FIRST_ASSUM DISJ_CASES_TAC;
43280   FULL_REWRITE_TAC[cls];
43281   USE 25 (REWRITE_RULE[DIFF]);
43282   THM_INTRO_TAC[`R`;`F`;`b`;`e`] par_cell_nbd;
43283   ASM_MESON_TAC[subset_imp];
43284   TYPE_THEN `J` UNABBREV_TAC;
43285   USE 25(REWRITE_RULE[INTER]);
43286   ASM_MESON_TAC[];
43287   THM_INTRO_TAC[`R`;`b`]curve_cell_cls;
43288   IMATCH_MP_TAC  rectagon_segment;
43289   ASM_MESON_TAC[];
43290   KILL 20;
43291   KILL 18;
43292   USE 19 (REWRITE_RULE [EMPTY_EXISTS;INTER]);
43293   (* -C/ *)
43294   TYPE_THEN `~cls J a \/ cls R a` SUBAGOAL_TAC;
43295   UND 21 THEN DISCH_THEN DISJ_CASES_TAC;
43296   DISJ1_TAC;
43297   USE 21(REWRITE_RULE[cls]);
43298   THM_INTRO_TAC[`R`;`T`;`a`;`e`] par_cell_nbd;
43299   TYPE_THEN `J` UNABBREV_TAC;
43300   USE 23(REWRITE_RULE[INTER]);
43301   ASM_MESON_TAC[subset_imp];
43302   TYPE_THEN `J` UNABBREV_TAC;
43303   USE 23(REWRITE_RULE[INTER]);
43304   THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
43305   USE 25(REWRITE_RULE[INTER;EQ_EMPTY]);
43306   ASM_MESON_TAC[];
43307   (* -/ *)
43308   TYPE_THEN `~cls J b \/ cls R b` SUBAGOAL_TAC;
43309   UND 22 THEN DISCH_THEN DISJ_CASES_TAC;
43310   DISJ1_TAC;
43311   USE 23(REWRITE_RULE[cls]);
43312   THM_INTRO_TAC[`R`;`T`;`b`;`e`] par_cell_nbd;
43313   TYPE_THEN `J` UNABBREV_TAC;
43314   USE 24(REWRITE_RULE[INTER]);
43315   ASM_MESON_TAC[subset_imp];
43316   TYPE_THEN `J` UNABBREV_TAC;
43317   USE 24(REWRITE_RULE[INTER]);
43318   THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
43319   USE 26(REWRITE_RULE[INTER;EQ_EMPTY]);
43320   ASM_MESON_TAC[];
43321   (* -D/ *)
43322   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;
43323   TYPE_THEN `S' INTER (R UNION J) = EMPTY` SUBAGOAL_TAC;
43324   PROOF_BY_CONTR_TAC;
43325   FULL_REWRITE_TAC[EMPTY_EXISTS];
43326   USE 27 (REWRITE_RULE[INTER;UNION ]);
43327   THM_INTRO_TAC[`u'`] two_endpoint;
43328   FULL_REWRITE_TAC[segment_end;psegment;segment];
43329   UND 28 THEN UND 31 THEN MESON_TAC[subset_imp];
43330   TYPE_THEN `!n. closure top2 u' (pointI n) ==> (n = b')` SUBAGOAL_TAC;
43331   USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
43332   TSPEC `n` 24;
43333   USE 24 (REWRITE_RULE[INTER;INR IN_SING]);
43334   USE 24 SYM;
43335   TYPE_THEN `{u'} SUBSET S' /\ {u'} SUBSET (R UNION J)` SUBAGOAL_TAC;
43336   REWRITE_TAC[SUBSET;INR IN_SING;UNION ];
43337   USE 31(MATCH_MP cls_subset);
43338   USE 32(MATCH_MP cls_subset);
43339   FULL_REWRITE_TAC[cls_edge];
43340   FULL_REWRITE_TAC[SUBSET];
43341   USE 29 (REWRITE_RULE[has_size2]);
43342   USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]);
43343   USE 31(REWRITE_RULE[INR in_pair]);
43344   COPY 31;
43345   TSPEC `a''` 32;
43346   TSPEC `b''` 31;
43347   REWR 31;
43348   REWR 32;
43349   UND 29 THEN REWRITE_TAC[];
43350   (* --E *)
43351   PROOF_BY_CONTR_TAC;
43352   TYPE_THEN `cls J b'` SUBAGOAL_TAC;
43353   USE 24(ONCE_REWRITE_RULE[FUN_EQ_THM]);
43354   USE 24(REWRITE_RULE[INTER;INR IN_SING]);
43355   TSPEC `b'` 24;
43356   USE 24(REWRITE_RULE[cls_union]);
43357   USE 24(REWRITE_RULE[UNION]);
43358   REWR 24;
43359   (* --/ *)
43360   TYPE_THEN`par_cell F R {(pointI b')}` SUBAGOAL_TAC;
43361   THM_INTRO_TAC[`R`;`T`;`{(pointI b')}`] par_cell_cell_partition;
43362   CONJ_TAC;
43363   IMATCH_MP_TAC  rectagon_segment;
43364   REWRITE_TAC[cell_rules];
43365   UND 30 THEN REP_CASES_TAC;
43366   USE 29 (REWRITE_RULE[cls]);
43367   THM_INTRO_TAC[`R`;`e`;`{(pointI b')}`;`F`] par_cell_closure_cell;
43368   REWRITE_TAC[cell_rules];
43369   REWRITE_TAC[SUBSET;INR IN_SING];
43370   TYPE_THEN `J` UNABBREV_TAC;
43371   USE 31 (REWRITE_RULE[INTER]);
43372   IMATCH_MP_TAC  edge_cell;
43373   UND 31 THEN UND 2 THEN MESON_TAC[subset_imp];
43374   FIRST_ASSUM DISJ_CASES_TAC  ;
43375   THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
43376   FULL_REWRITE_TAC[rectagon];
43377   THM_INTRO_TAC[`R`;`b'`] curve_cell_cls;
43378   IMATCH_MP_TAC  rectagon_segment;
43379   REWR 33;
43380   THM_INTRO_TAC[`R`;`b'`] curve_cell_cls;
43381   IMATCH_MP_TAC  rectagon_segment;
43382   REWR 30;
43383   (* --/ *)
43384   USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
43385   USE 24 (REWRITE_RULE[INR IN_SING;cls_union]);
43386   TSPEC `b'` 24;
43387   USE 24 (REWRITE_RULE[INTER;UNION]);
43388   USE 31(REWRITE_RULE[cls]);
43389   THM_INTRO_TAC[`R`;`F`;`b'`;`e`] par_cell_nbd;
43390   USE 16 (REWRITE_RULE[segment_end;segment;psegment]);
43391   UND 36 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43392   USE 27(REWRITE_RULE[EQ_EMPTY;INTER;UNION]);
43393   TSPEC `e` 27;
43394   UND 27 THEN ASM_REWRITE_TAC[];
43395   DISJ2_TAC;
43396   TYPE_THEN `J` UNABBREV_TAC;
43397   REWRITE_TAC[INTER];
43398   UND 17 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43399   (* -F *)
43400   TYPE_THEN `?m. (cls R m /\ cls S m)` SUBAGOAL_TAC;
43401   PROOF_BY_CONTR_TAC;
43402   THM_INTRO_TAC[`R`;`S`] segment_in_comp;
43403   FULL_REWRITE_TAC[segment_end;psegment];
43404   LEFT 25  "m" ;
43405   CONJ_TAC;
43406   PROOF_BY_CONTR_TAC;
43407   USE 28(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
43408   THM_INTRO_TAC[`u'`] two_endpoint;
43409   UND 29 THEN UND 17 THEN UND 2 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43410   USE 30(REWRITE_RULE[has_size2]);
43411   USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]);
43412   TSPEC `a'` 31;
43413   USE 31(REWRITE_RULE[INR in_pair]);
43414   TSPEC `a'` 25;
43415   USE 25(REWRITE_RULE[cls]);
43416   ASM_MESON_TAC[];
43417   IMATCH_MP_TAC  SUBSET_TRANS;
43418   TYPE_THEN `EMPTY:((int#int)->bool)` EXISTS_TAC;
43419   REWRITE_TAC[SUBSET_EMPTY;EQ_EMPTY;INTER;];
43420   TSPEC `x` 25;
43421   UND 25 THEN ASM_REWRITE_TAC[];
43422   TYPE_THEN `eps = T` ASM_CASES_TAC ;
43423   TYPE_THEN `eps` UNABBREV_TAC;
43424   THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
43425   USE 27(REWRITE_RULE[INTER;EQ_EMPTY]);
43426   TSPEC `u` 27;
43427   USE 26(REWRITE_RULE[SUBSET]);
43428   TYPE_THEN`J` UNABBREV_TAC;
43429   USE 18 (REWRITE_RULE[INTER]);
43430   UND 6 THEN UND 26 THEN UND 27 THEN UND 19 THEN MESON_TAC[];
43431   TYPE_THEN `eps = F` SUBAGOAL_TAC;
43432   ASM_MESON_TAC[];
43433   KILL 27;
43434   TYPE_THEN `eps` UNABBREV_TAC;
43435   USE 16 (REWRITE_RULE[segment_end]);
43436   THM_INTRO_TAC[`S`;`a`] terminal_endpoint;
43437   USE 16 (REWRITE_RULE[FUN_EQ_THM]);
43438   TSPEC `a` 16;
43439   FULL_REWRITE_TAC[psegment;segment;INR in_pair];
43440   TYPE_THEN `e = terminal_edge S a` ABBREV_TAC ;
43441   USE 20 (REWRITE_RULE[cls]);
43442   FIRST_ASSUM DISJ_CASES_TAC;
43443   LEFT 31 "e";
43444   TSPEC `e` 31;
43445   TYPE_THEN `J` UNABBREV_TAC;
43446   USE 31(REWRITE_RULE[INTER]);
43447   UND 6 THEN ASM_REWRITE_TAC[];
43448   UND 29 THEN UND 26 THEN UND 17 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43449   LEFT 25 "m";
43450   TSPEC `a` 25;
43451   USE 25 (REWRITE_RULE[cls]);
43452   KILL 24;
43453   ASM_MESON_TAC[];
43454   (* -G/ *)
43455   TYPE_THEN `conn2 R` SUBAGOAL_TAC;
43456   USE 27(REWRITE_RULE[conn2]);
43457   TSPEC `m` 27;
43458   LEFT 27 "c";
43459   TSPEC `c` 27;
43460   (* - a case *)
43461   TYPE_THEN `(~(a = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' a m /\ ~cls S' c)` SUBAGOAL_TAC;
43462   TYPE_THEN `cls R a` ASM_CASES_TAC;
43463   UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`a`]);
43464   KILL 24;
43465   ASM_MESON_TAC[];
43466   TYPE_THEN `S'` EXISTS_TAC;
43467   ONCE_REWRITE_TAC[segment_end_symm];
43468   IMATCH_MP_TAC  SUBSET_TRANS;
43469   TYPE_THEN `R` EXISTS_TAC;
43470   (* -- *)
43471   TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' a m` SUBAGOAL_TAC;
43472   TYPE_THEN `m = b` ASM_CASES_TAC;
43473   TYPE_THEN `S` EXISTS_TAC;
43474   REWRITE_TAC[SUBSET_REFL];
43475   THM_INTRO_TAC[`S`;`a`;`b`;`m`] cut_psegment;
43476   TYPE_THEN `A` EXISTS_TAC;
43477   REWRITE_TAC[SUBSET_UNION];
43478   THM_INTRO_TAC[`R UNION J`;`S'`;`a`;`m`] segment_end_select;
43479   REWRITE_TAC[cls_union;union_subset];
43480   ASM_REWRITE_TAC[UNION];
43481   IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
43482   CONJ_TAC;
43483   REWR 20;
43484   CONJ_TAC;
43485   FULL_REWRITE_TAC [rectagon];
43486   TYPE_THEN `J` UNABBREV_TAC;
43487   UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[];
43488   (* -- *)
43489   UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`c'`;`B`]);
43490   UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43491   TYPE_THEN `c' = m` ASM_CASES_TAC;
43492   TYPE_THEN `B` EXISTS_TAC;
43493   CONJ_TAC;
43494   USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
43495   UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
43496   TYPE_THEN `c'` UNABBREV_TAC;
43497   TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
43498   IMATCH_MP_TAC  cls_subset;
43499   UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43500   UND 39 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43501   (* -- *)
43502   TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC;
43503   CONJ_TAC;
43504   USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
43505   UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
43506   TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
43507   IMATCH_MP_TAC  cls_subset;
43508   UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43509   UND 41 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43510   (* -- *)
43511   UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]);
43512   CONJ_TAC;
43513   TYPE_THEN `c'` UNABBREV_TAC;
43514   USE 37(MATCH_MP segment_end_cls2);
43515   UND 40 THEN ASM_REWRITE_TAC[];
43516   TYPE_THEN `c` UNABBREV_TAC;
43517   USE 32 (MATCH_MP segment_end_cls2);
43518   TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC;
43519   IMATCH_MP_TAC  cls_subset;
43520   UND 25 THEN UND 3 THEN MESON_TAC[];
43521   USE 42 (ONCE_REWRITE_RULE[segment_end_symm]);
43522   (* -- *)
43523   TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC;
43524   IMATCH_MP_TAC  SUBSET_TRANS;
43525   TYPE_THEN `R` EXISTS_TAC;
43526   THM_INTRO_TAC[`B`;`S''`;`a`;`c'`;`m`] segment_end_trans;
43527   TYPE_THEN `U` EXISTS_TAC;
43528   CONJ_TAC;
43529   IMATCH_MP_TAC  SUBSET_TRANS;
43530   TYPE_THEN `B UNION S''` EXISTS_TAC;
43531   REWRITE_TAC[union_subset];
43532   TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC;
43533   IMATCH_MP_TAC  cls_subset;
43534   USE 48(REWRITE_RULE[cls_union]);
43535   UND 48 THEN UND 47 THEN UND 40 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
43536   (* -H *)
43537     TYPE_THEN `(~(b = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' b m /\ ~cls S' c)` SUBAGOAL_TAC;
43538   TYPE_THEN `cls R b` ASM_CASES_TAC;
43539   UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`b`]);
43540   KILL 24;
43541   ASM_MESON_TAC[];
43542   TYPE_THEN `S'` EXISTS_TAC;
43543   USE 33(ONCE_REWRITE_RULE[segment_end_symm]);
43544   IMATCH_MP_TAC  SUBSET_TRANS;
43545   TYPE_THEN `R` EXISTS_TAC;
43546   (* -- *)
43547   TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' b m` SUBAGOAL_TAC;
43548   TYPE_THEN `m = a` ASM_CASES_TAC;
43549   TYPE_THEN `S` EXISTS_TAC;
43550   REWRITE_TAC[SUBSET_REFL];
43551   USE 16 (ONCE_REWRITE_RULE[segment_end_symm]);
43552   THM_INTRO_TAC[`S`;`b`;`a`;`m`] cut_psegment;
43553   USE 16 (ONCE_REWRITE_RULE[segment_end_symm]);
43554   TYPE_THEN `A` EXISTS_TAC;
43555   REWRITE_TAC[SUBSET_UNION];
43556   (* -- *)
43557   THM_INTRO_TAC[`R UNION J`;`S'`;`b`;`m`] segment_end_select;
43558   REWRITE_TAC[cls_union;union_subset];
43559   ASM_REWRITE_TAC[UNION];
43560   IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
43561   CONJ_TAC;
43562   REWR 23;
43563   CONJ_TAC;
43564   FULL_REWRITE_TAC [rectagon];
43565   TYPE_THEN `J` UNABBREV_TAC;
43566   UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[];
43567   (* -- *)
43568   UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`b`;`c'`;`B`]);
43569   UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43570   TYPE_THEN `c' = m` ASM_CASES_TAC;
43571   TYPE_THEN `B` EXISTS_TAC;
43572   CONJ_TAC;
43573   USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
43574   UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
43575   TYPE_THEN `c'` UNABBREV_TAC;
43576   TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
43577   IMATCH_MP_TAC  cls_subset;
43578   UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43579   UND 40 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43580   (* -- *)
43581   TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC;
43582   CONJ_TAC;
43583   USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
43584   UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
43585   TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
43586   IMATCH_MP_TAC  cls_subset;
43587   UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43588   UND 42 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
43589   (* -- *)
43590   UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]);
43591   CONJ_TAC;
43592   TYPE_THEN `c'` UNABBREV_TAC;
43593   USE 38(MATCH_MP segment_end_cls2);
43594   UND 41 THEN ASM_REWRITE_TAC[];
43595   TYPE_THEN `c` UNABBREV_TAC;
43596   USE 33 (MATCH_MP segment_end_cls2);
43597   TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC;
43598   IMATCH_MP_TAC  cls_subset;
43599   UND 25 THEN UND 3 THEN MESON_TAC[];
43600   (* -- *)
43601   TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC;
43602   IMATCH_MP_TAC  SUBSET_TRANS;
43603   TYPE_THEN `R` EXISTS_TAC;
43604   THM_INTRO_TAC[`B`;`S''`;`b`;`c'`;`m`] segment_end_trans;
43605   ONCE_REWRITE_TAC[segment_end_symm];
43606   TYPE_THEN `U` EXISTS_TAC;
43607   CONJ_TAC;
43608   IMATCH_MP_TAC  SUBSET_TRANS;
43609   TYPE_THEN `B UNION S''` EXISTS_TAC;
43610   REWRITE_TAC[union_subset];
43611   TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC;
43612   IMATCH_MP_TAC  cls_subset;
43613   USE 49(REWRITE_RULE[cls_union]);
43614   UND 49 THEN UND 48 THEN UND 41 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
43615   (* -I *)
43616   TYPE_THEN `b = m` ASM_CASES_TAC;
43617   TYPE_THEN`m` UNABBREV_TAC;
43618   TYPE_THEN `a = m` ASM_CASES_TAC;
43619   TYPE_THEN `m` UNABBREV_TAC;
43620   TYPE_THEN `S'` EXISTS_TAC;
43621   ONCE_REWRITE_TAC[segment_end_symm];
43622   ASM_REWRITE_TAC[];
43623   (* - *)
43624   THM_INTRO_TAC[`S''`;`S'`;`a`;`m`;`b`] segment_end_trans;
43625   ONCE_REWRITE_TAC[segment_end_symm];
43626   TYPE_THEN `U` EXISTS_TAC;
43627   CONJ_TAC;
43628   IMATCH_MP_TAC  SUBSET_TRANS;
43629   TYPE_THEN `S'' UNION S'` EXISTS_TAC;
43630   REWRITE_TAC[union_subset];
43631   TYPE_THEN `cls U SUBSET cls (S'' UNION S')` SUBAGOAL_TAC;
43632   IMATCH_MP_TAC  cls_subset;
43633   USE 41(REWRITE_RULE[SUBSET;cls_union]);
43634   UND 41 THEN UND 40 THEN UND 30 THEN UND 33 THEN REWRITE_TAC[UNION] THEN MESON_TAC[];
43635   (* Sat Dec  4 18:57:41 EST 2004 *)
43636
43637   ]);;
43638   (* }}} *)
43639
43640 let conn2_psegment_triple = prove_by_refinement(
43641   `!E. conn2 E /\ (E SUBSET edge) /\
43642       ~(rectagon E) ==> (?A B C. psegment_triple A B C
43643         /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\
43644             A SUBSET par_cell F (B UNION C))`,
43645   (* {{{ proof *)
43646   [
43647   REP_BASIC_TAC;
43648   TYPE_THEN `(?A B C. psegment_triple A B C /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E)` BACK_TAC;
43649   THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell;
43650   FIRST_ASSUM DISJ_CASES_TAC;
43651   ASM_MESON_TAC[];
43652   FIRST_ASSUM DISJ_CASES_TAC;
43653   USE 6 (MATCH_MP psegment_triple3);
43654   USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]);
43655   ASM_MESON_TAC[];
43656   USE 6 (MATCH_MP psegment_triple2);
43657   USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]);
43658   ASM_MESON_TAC[];
43659   (* - *)
43660   THM_INTRO_TAC[`E`] conn2_has_rectagon;
43661   THM_INTRO_TAC[`E`;`B`] conn2_proper;
43662   CONJ_TAC;
43663   IMATCH_MP_TAC  conn2_rectagon;
43664   ASM_MESON_TAC[];
43665   THM_INTRO_TAC[`A`] endpoint_size2;
43666   FULL_REWRITE_TAC[has_size2];
43667   THM_INTRO_TAC[`B`;`a`;`b`] cut_rectagon_cls;
43668   REWR 5;
43669   USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
43670   USE 5 (REWRITE_RULE[INTER;INR in_pair]);
43671   ASM_MESON_TAC[];
43672   TYPE_THEN `C = A'` ABBREV_TAC ;
43673   TYPE_THEN `A'` UNABBREV_TAC;
43674   TYPE_THEN`A` EXISTS_TAC;
43675   TYPE_THEN `B` UNABBREV_TAC;
43676   TYPE_THEN `B'` EXISTS_TAC;
43677   TYPE_THEN `C` EXISTS_TAC;
43678   REWRITE_TAC[psegment_triple];
43679   TYPE_THEN `psegment B' /\ psegment C` SUBAGOAL_TAC;
43680   FULL_REWRITE_TAC[segment_end];
43681   TYPE_THEN`(A INTER B' = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC;
43682   FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
43683   FULL_REWRITE_TAC[INTER_COMM];
43684   USE 5 (REWRITE_RULE[cls_union]);
43685   FULL_REWRITE_TAC[UNION_OVER_INTER;];
43686   TYPE_THEN `(endpoint B' = {a,b}) /\ (endpoint C = {a,b})` SUBAGOAL_TAC;
43687   FULL_REWRITE_TAC[segment_end];
43688   TYPE_THEN `(cls A INTER cls B' = {a, b}) /\ (cls A INTER cls C = {a, b})` SUBAGOAL_TAC;
43689   TYPE_THEN `endpoint A` UNABBREV_TAC;
43690
43691   USE 10 (REWRITE_RULE[FUN_EQ_THM]);
43692   USE 5 (REWRITE_RULE[INTER;UNION;INR in_pair]);
43693   CONJ_TAC THEN IMATCH_MP_TAC  EQ_EXT THEN REWRITE_TAC[INTER;INR in_pair];
43694   ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
43695   ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
43696   (* - *)
43697   FULL_REWRITE_TAC[UNION_COMM];
43698   (* - *)
43699   TYPE_THEN`segment_end A a b` SUBAGOAL_TAC;
43700   REWRITE_TAC[segment_end];
43701   CONJ_TAC ;
43702   ASM_MESON_TAC[segment_end_union_rectagon;segment_end_symm;INTER_COMM;UNION_COMM];
43703   ASM_MESON_TAC[union_subset];
43704   ]);;
43705   (* }}} *)
43706
43707 let rectagon_surround_conn2 = prove_by_refinement(
43708   `!G. conn2 G /\ G SUBSET edge ==>
43709      (?C. rectagon C /\ C SUBSET G /\
43710           (!x. bounded_set G x ==> bounded_set C x))`,
43711   (* {{{ proof *)
43712   [
43713   REP_BASIC_TAC;
43714   TYPE_THEN `EE = {C | conn2 C /\ (C SUBSET G) /\ (!x. bounded_set G x ==> bounded_set C x)}` ABBREV_TAC ;
43715   TYPE_THEN `EE G` SUBAGOAL_TAC;
43716   TYPE_THEN `EE` UNABBREV_TAC;
43717   REWRITE_TAC[SUBSET_REFL];
43718   THM_INTRO_TAC[`EE`] select_card_min;
43719   UND 4 THEN REWRITE_TAC[EMPTY_EXISTS];
43720   ASM_MESON_TAC[];
43721   TYPE_THEN `C = z` ABBREV_TAC ;
43722   TYPE_THEN `z` UNABBREV_TAC;
43723   TYPE_THEN `rectagon C` BACK_TAC ;
43724   TYPE_THEN  `C` EXISTS_TAC;
43725   TYPE_THEN `EE` UNABBREV_TAC;
43726   PROOF_BY_CONTR_TAC;
43727   TYPE_THEN `!R. rectagon R /\ R SUBSET C ==> (C INTER par_cell F R = EMPTY)` SUBAGOAL_TAC;
43728   PROOF_BY_CONTR_TAC;
43729   TYPE_THEN `J = (C INTER par_cell F R )` ABBREV_TAC ;
43730   TYPE_THEN `EE (C DIFF J)` SUBAGOAL_TAC;
43731   TYPE_THEN `EE` UNABBREV_TAC;
43732   CONJ_TAC;
43733   TYPE_THEN `J` UNABBREV_TAC;
43734   IMATCH_MP_TAC  conn2_rect_diff_inner;
43735   IMATCH_MP_TAC  SUBSET_TRANS;
43736   ASM_MESON_TAC[];
43737   CONJ_TAC;
43738   IMATCH_MP_TAC  SUBSET_TRANS;
43739   TYPE_THEN `C` EXISTS_TAC;
43740   REWRITE_TAC[DIFF;SUBSET];
43741   TSPEC  `x` 2;
43742   THM_INTRO_TAC[`C`;`C`;`R`;`J`;`x`] star_avoidance_contrp;
43743   REWRITE_TAC[SUBSET_REFL];
43744   (* --- *)
43745   TYPE_THEN `FINITE G` SUBAGOAL_TAC;
43746   FULL_REWRITE_TAC[conn2];
43747   TYPE_THEN `J SUBSET G` SUBAGOAL_TAC;
43748   TYPE_THEN `J` UNABBREV_TAC;
43749   UND 3 THEN REWRITE_TAC[SUBSET;INTER] THEN MESON_TAC[];
43750   TYPE_THEN `FINITE C /\ FINITE J` SUBAGOAL_TAC;
43751   CONJ_TAC THEN IMATCH_MP_TAC  FINITE_SUBSET THEN ASM_MESON_TAC[];
43752   TYPE_THEN `C SUBSET edge /\ J SUBSET edge` SUBAGOAL_TAC;
43753   CONJ_TAC THEN IMATCH_MP_TAC  SUBSET_TRANS THEN ASM_MESON_TAC[];
43754   TYPE_THEN `J SUBSET par_cell F R` SUBAGOAL_TAC;
43755   TYPE_THEN`J` UNABBREV_TAC;
43756   REWRITE_TAC[INTER;SUBSET];
43757   TYPE_THEN `~(UNIONS (curve_cell G) x)` SUBAGOAL_TAC;
43758   THM_INTRO_TAC[`G`;`x`] bounded_subset_unions;
43759   USE 22(REWRITE_RULE[ctop_unions;DIFF ]);
43760   ASM_MESON_TAC[];
43761   TYPE_THEN `!A. A SUBSET G ==> UNIONS (curve_cell A) SUBSET UNIONS(curve_cell G)` SUBAGOAL_TAC;
43762   IMATCH_MP_TAC  UNIONS_UNIONS;
43763   IMATCH_MP_TAC  curve_cell_imp_subset;
43764   ASM_MESON_TAC[subset_imp];
43765   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`C DIFF J`]);
43766   USE 4(MATCH_MP (ARITH_RULE  `x <=| y ==> ~(y < x)`));
43767   UND 4 THEN ASM_REWRITE_TAC[];
43768   IMATCH_MP_TAC  card_subset_lt;
43769   CONJ_TAC;
43770   REWRITE_TAC[DIFF;SUBSET];
43771   CONJ_TAC;
43772   TYPE_THEN `J` UNABBREV_TAC;
43773   USE 9(REWRITE_RULE[EMPTY_EXISTS]);
43774   USE 4 (REWRITE_RULE[diff_unchange]);
43775   USE 4(REWRITE_RULE[EQ_EMPTY]);
43776   FULL_REWRITE_TAC[INTER];
43777   ASM_MESON_TAC[];
43778   IMATCH_MP_TAC  FINITE_SUBSET;
43779   TYPE_THEN `G` EXISTS_TAC;
43780   FULL_REWRITE_TAC[conn2];
43781   TYPE_THEN `EE` UNABBREV_TAC;
43782   (* -A *)
43783   THM_INTRO_TAC[`C`] conn2_psegment_triple;
43784   TYPE_THEN `EE` UNABBREV_TAC;
43785   IMATCH_MP_TAC  SUBSET_TRANS;
43786   ASM_MESON_TAC[];
43787   TSPEC `(B UNION C')` 7;
43788   UND 7 THEN DISCH_THEN (THM_INTRO_TAC[]);
43789   CONJ_TAC;
43790   FULL_REWRITE_TAC[psegment_triple];
43791   REWRITE_TAC[union_subset];
43792   UND 7 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
43793   TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC;
43794   FULL_REWRITE_TAC[psegment_triple];
43795   TYPE_THEN `A` UNABBREV_TAC;
43796   USE 25 (REWRITE_RULE[psegment;segment]);
43797   FULL_REWRITE_TAC[EMPTY_EXISTS];
43798   TYPE_THEN `u` EXISTS_TAC;
43799   ASM_MESON_TAC[subset_imp];
43800   ]);;
43801   (* }}} *)
43802
43803 let curve_cell_subset = prove_by_refinement(
43804   `!H G. (H SUBSET G) ==>
43805       UNIONS (curve_cell H) SUBSET UNIONS (curve_cell G)`,
43806   (* {{{ proof *)
43807   [
43808   REP_BASIC_TAC;
43809   IMATCH_MP_TAC  UNIONS_UNIONS;
43810   TYPE_THEN `G = H UNION (G DIFF H)` SUBAGOAL_TAC;
43811   IMATCH_MP_TAC  EQ_EXT;
43812   UND 0 THEN REWRITE_TAC[SUBSET;UNION;DIFF] THEN MESON_TAC[];
43813   UND 1 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
43814   REWRITE_TAC[curve_cell_union];
43815   REWRITE_TAC[SUBSET;UNION];
43816   ]);;
43817   (* }}} *)
43818
43819 let bounded_set_curve_cell_empty = prove_by_refinement(
43820   `!H G x. bounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`,
43821   (* {{{ proof *)
43822   [
43823   REP_BASIC_TAC;
43824   THM_INTRO_TAC[`H`;`G`]curve_cell_subset;
43825   THM_INTRO_TAC[`G`] bounded_unbounded_union;
43826   USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
43827   TSPEC `x` 4;
43828   USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]);
43829   FULL_REWRITE_TAC[SUBSET];
43830   ASM_MESON_TAC[];
43831   ]);;
43832   (* }}} *)
43833
43834 let unbounded_set_curve_cell_empty = prove_by_refinement(
43835   `!H G x. unbounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`,
43836   (* {{{ proof *)
43837   [
43838   REP_BASIC_TAC;
43839   THM_INTRO_TAC[`H`;`G`]curve_cell_subset;
43840   THM_INTRO_TAC[`G`] bounded_unbounded_union;
43841   USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
43842   TSPEC `x` 4;
43843   USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]);
43844   FULL_REWRITE_TAC[SUBSET];
43845   ASM_MESON_TAC[];
43846   ]);;
43847   (* }}} *)
43848
43849 let bounded_triple_avoidance = prove_by_refinement(
43850   `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) ==>
43851        bounded_set (A UNION B UNION C) SUBSET bounded_set (B UNION C)`,
43852   (* {{{ proof *)
43853   [
43854   REP_BASIC_TAC;
43855   REWRITE_TAC[SUBSET];
43856   PROOF_BY_CONTR_TAC;
43857   THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance_lemma1;
43858   REWRITE_TAC[SUBSET_REFL];
43859   REWRITE_TAC[FINITE_UNION;union_subset];
43860   CONJ_TAC;
43861   FULL_REWRITE_TAC[psegment_triple];
43862   FULL_REWRITE_TAC[psegment;segment];
43863   CONJ_TAC;
43864   FULL_REWRITE_TAC[psegment_triple];
43865   FULL_REWRITE_TAC[psegment;segment];
43866   CONJ_TAC;
43867   FULL_REWRITE_TAC[psegment_triple];
43868   CONJ_TAC;
43869   REWRITE_TAC[SUBSET;UNION];
43870   CONJ_TAC;
43871   THM_INTRO_TAC[`A`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
43872   REWRITE_TAC[SUBSET;UNION];
43873   ASM_MESON_TAC[];
43874   THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
43875   REWRITE_TAC[SUBSET_REFL ];
43876   ASM_MESON_TAC[];
43877   (* -A *)
43878   TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC;
43879   FULL_REWRITE_TAC[psegment_triple];
43880   IMATCH_MP_TAC  EQ_EXT;
43881   UND 10 THEN UND 11 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION;DIFF] THEN MESON_TAC[];
43882   FIRST_ASSUM DISJ_CASES_TAC;
43883   REWR 6;
43884   REWR 6;
43885   (* - *)
43886   THM_INTRO_TAC[`A`;`B`;`C`;`x`] unbounded_triple_avoidance;
43887   THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj;
43888   FULL_REWRITE_TAC[INTER;EQ_EMPTY ];
43889   ASM_MESON_TAC[];
43890   ]);;
43891   (* }}} *)
43892
43893 let bounded_euclid = prove_by_refinement(
43894   `!G x. bounded_set G x ==> euclid 2 x`,
43895   (* {{{ proof *)
43896   [
43897   REP_BASIC_TAC;
43898   USE 0(MATCH_MP bounded_subset_unions);
43899   FULL_REWRITE_TAC[ctop_unions;DIFF ];
43900   ]);;
43901   (* }}} *)
43902
43903 let unbounded_euclid = prove_by_refinement(
43904   `!G x. unbounded_set G x ==> euclid 2 x`,
43905   (* {{{ proof *)
43906   [
43907   REP_BASIC_TAC;
43908   USE 0(MATCH_MP unbounded_subset_unions);
43909   FULL_REWRITE_TAC[ctop_unions;DIFF ];
43910   ]);;
43911   (* }}} *)
43912
43913 let bounded_triple_inner_union = prove_by_refinement(
43914   `!A B C. psegment_triple A B C ==> bounded_set (A UNION B UNION C)
43915        SUBSET (bounded_set (A UNION B) UNION bounded_set (B UNION C))`,
43916   (* {{{ proof *)
43917   [
43918   REP_BASIC_TAC;
43919   THM_INTRO_TAC[`C`;`A`;`B`] trap_odd_cell;
43920   IMATCH_MP_TAC  psegment_triple3;
43921   IMATCH_MP_TAC  psegment_triple3;
43922   UND 1 THEN REP_CASES_TAC;
43923   THM_INTRO_TAC[`C`;`A`;`B`] bounded_triple_avoidance;
43924   IMATCH_MP_TAC  psegment_triple3;
43925   IMATCH_MP_TAC  psegment_triple3;
43926   FULL_REWRITE_TAC[UNION_ACI;];
43927   IMATCH_MP_TAC  in_union;
43928   THM_INTRO_TAC[`A`;`B`;`C`] bounded_triple_avoidance;
43929   FULL_REWRITE_TAC[UNION_ACI;];
43930   IMATCH_MP_TAC  in_union;
43931   (* - *)
43932   REWRITE_TAC[SUBSET];
43933   ONCE_REWRITE_TAC[UNION];
43934   PROOF_BY_CONTR_TAC;
43935   FULL_REWRITE_TAC[DE_MORGAN_THM];
43936   THM_INTRO_TAC[`B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
43937   REWRITE_TAC[UNION;SUBSET];
43938   THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
43939   REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
43940   TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
43941   ASM_MESON_TAC[bounded_euclid];
43942   THM_INTRO_TAC[`A UNION B`] bounded_unbounded_union;
43943   USE 8(ONCE_REWRITE_RULE[FUN_EQ_THM]);
43944   USE 8(REWRITE_RULE[ctop_unions;DIFF]);
43945   TSPEC `x` 8;
43946   TYPE_THEN `R = A UNION B` ABBREV_TAC ;
43947   USE 8(REWRITE_RULE[UNION]);
43948   REWR 8;
43949   TYPE_THEN `R` UNABBREV_TAC;
43950   (* -A *)
43951   THM_INTRO_TAC[`B UNION C`] bounded_unbounded_union;
43952   USE 9(ONCE_REWRITE_RULE[FUN_EQ_THM]);
43953   USE 9(REWRITE_RULE[ctop_unions;DIFF]);
43954   TSPEC `x` 9;
43955   TYPE_THEN `R = B UNION C` ABBREV_TAC ;
43956   USE 9(REWRITE_RULE[UNION]);
43957   REWR 9;
43958   TYPE_THEN `R'` UNABBREV_TAC;
43959   KILL 5;
43960   KILL 6;
43961   KILL 3;
43962   KILL 4;
43963   (* - *)
43964   THM_INTRO_TAC[`x`] point_onto;
43965   TYPE_THEN `x` UNABBREV_TAC;
43966   THM_INTRO_TAC[`p`] cell_unions;
43967   USE 3(REWRITE_RULE[UNIONS]);
43968   THM_INTRO_TAC[`B UNION C`] unbounded_even;
43969   FULL_REWRITE_TAC[psegment_triple];
43970   REWR 9;
43971   KILL 5;
43972   THM_INTRO_TAC[`par_cell T (B UNION C)`;`u`;`point p`] cell_ununion;
43973   REWRITE_TAC[par_cell_cell];
43974   KILL 6;
43975   (* - *)
43976   THM_INTRO_TAC[`A UNION B`] unbounded_even;
43977   FULL_REWRITE_TAC[psegment_triple];
43978   REWR 8;
43979   KILL 6;
43980   THM_INTRO_TAC[`par_cell T (A UNION B)`;`u`;`point p`] cell_ununion;
43981   REWRITE_TAC[par_cell_cell];
43982   KILL 8;
43983   (* - *)
43984   TYPE_THEN `unbounded_set (A UNION B UNION C) (point p)` ASM_CASES_TAC;
43985   THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj;
43986   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
43987   ASM_MESON_TAC[];
43988   (* -B *)
43989   TYPE_THEN `~unbounded_set (B UNION C UNION A) (point p)` SUBAGOAL_TAC;
43990   FULL_REWRITE_TAC[UNION_ACI];
43991   ASM_MESON_TAC[];
43992   UND 9 THEN REWRITE_TAC[];
43993   IMATCH_MP_TAC  unbounded_triple_avoidance;
43994   CONJ_TAC;
43995   IMATCH_MP_TAC  psegment_triple3;
43996   (* - *)
43997   FULL_REWRITE_TAC[UNION_ACI];
43998   KILL 8;
43999   KILL 2;
44000   THM_INTRO_TAC[`A UNION C`] unbounded_even;
44001   FULL_REWRITE_TAC[psegment_triple];
44002   REWRITE_TAC[UNIONS];
44003   TYPE_THEN `u` EXISTS_TAC;
44004   KILL 2;
44005   (* - *)
44006   THM_INTRO_TAC[`A UNION B`;`u`;`T`] parity_unique;
44007   IMATCH_MP_TAC  rectagon_segment;
44008   FULL_REWRITE_TAC[psegment_triple];
44009   THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique;
44010   IMATCH_MP_TAC  rectagon_segment;
44011   FULL_REWRITE_TAC[psegment_triple];
44012   (* - *)
44013   TYPE_THEN `!A B. rectagon (A UNION B) /\ par_cell T (A UNION B) u ==> ~curve_cell A u` SUBAGOAL_TAC;
44014   THM_INTRO_TAC[`A' UNION B'`;`T`] par_cell_curve_cell_disj;
44015   FULL_REWRITE_TAC[rectagon];
44016   UND 12 THEN ASM_REWRITE_TAC[EMPTY_EXISTS];
44017   TYPE_THEN `u` EXISTS_TAC;
44018   REWRITE_TAC[INTER];
44019   THM_INTRO_TAC[`A'`;`A' UNION B'`] curve_cell_imp_subset;
44020   REWRITE_TAC[SUBSET;UNION];
44021   ASM_MESON_TAC[subset_imp];
44022   (* - *)
44023   TYPE_THEN `~curve_cell A u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
44024   TYPE_THEN `B` EXISTS_TAC;
44025   FULL_REWRITE_TAC[psegment_triple;psegment;];
44026   TYPE_THEN `~curve_cell B u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
44027   TYPE_THEN `A` EXISTS_TAC;
44028   REWRITE_TAC[UNION_ACI];
44029   FULL_REWRITE_TAC[psegment_triple;psegment;];
44030   TYPE_THEN `~curve_cell C u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
44031   TYPE_THEN `B` EXISTS_TAC;
44032   REWRITE_TAC[UNION_ACI];
44033   FULL_REWRITE_TAC[psegment_triple;psegment;];
44034   (* -C *)
44035   THM_INTRO_TAC[`A`;`B`;`u`] parity_union;
44036   FULL_REWRITE_TAC[psegment_triple;psegment;];
44037   IMATCH_MP_TAC  rectagon_segment;
44038   REWR 13;
44039   (* - *)
44040   THM_INTRO_TAC[`B`;`C`;`u`] parity_union;
44041   FULL_REWRITE_TAC[psegment_triple;psegment;];
44042   IMATCH_MP_TAC  rectagon_segment;
44043   REWR 14;
44044   (* - *)
44045   TYPE_THEN `parity A u = parity C u` SUBAGOAL_TAC;
44046   ASM_MESON_TAC[];
44047   KILL 13;
44048   KILL 14;
44049   THM_INTRO_TAC[`A`;`C`;`u`] parity_union;
44050   FULL_REWRITE_TAC[psegment_triple;psegment;];
44051   IMATCH_MP_TAC  rectagon_segment;
44052   REWR 13;
44053   TYPE_THEN `parity (A UNION C) u = T` SUBAGOAL_TAC;
44054   USE 14 SYM;
44055   IMATCH_MP_TAC  parity;
44056   REWRITE_TAC[curve_cell_union];
44057   CONJ_TAC;
44058   FULL_REWRITE_TAC[psegment_triple;psegment;];
44059   IMATCH_MP_TAC  rectagon_segment;
44060   USE 16(REWRITE_RULE[UNION]);
44061   ASM_MESON_TAC[];
44062   ]);;
44063   (* }}} *)
44064
44065 (* ------------------------------------------------------------------ *)
44066 (* SECTION W *)
44067 (* ------------------------------------------------------------------ *)
44068
44069
44070 (* back to the K3 graph *)
44071
44072 let rectagon_graph = jordan_def
44073   `rectagon_graph G  <=>
44074        graph G /\
44075        graph_edge G SUBSET psegment /\
44076        (!e. graph_edge G e ==> (graph_inc G e = endpoint e)) /\
44077        (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
44078              (e INTER e' = EMPTY)) /\
44079        (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
44080              (cls e INTER cls e' = endpoint e INTER endpoint e'))`;;
44081
44082 let rectagonal_graph = jordan_def
44083   `rectagonal_graph (G:(A,B)graph_t) <=>
44084     (?H. rectagon_graph H /\ graph_isomorphic H G)`;;
44085
44086 let k33_rectagon_hyp  = jordan_def
44087    `k33_rectagon_hyp R f <=>  rectagon R /\
44088    (!(i:three_t) j. ~(i = j) ==> (cls (f i) INTER (cls (f j)) = EMPTY)) /\
44089    (!i j. ~(i = j) ==> ((f i) INTER (f j) = EMPTY)) /\
44090    (!i. ?A B. (R = A UNION B) /\ psegment_triple A B (f i) /\
44091        (!j. ~(cls (f j) INTER cls A = EMPTY) /\
44092                ~(cls (f j) INTER cls B = EMPTY)) /\
44093        (!j. ~(i = j) ==> (cls (f j) INTER cls A INTER cls B = EMPTY)))`;;
44094
44095 let k33_rectagon_two_even = prove_by_refinement(
44096   `!R f i. k33_rectagon_hyp R f /\
44097       f i SUBSET par_cell F R  ==>
44098        (!j. ~(j = i) ==> (f j SUBSET par_cell T R))`,
44099   (* {{{ proof *)
44100   [
44101   REP_BASIC_TAC;
44102   FULL_REWRITE_TAC [k33_rectagon_hyp];
44103   COPY 2;
44104   TSPEC `i` 2;
44105   TYPE_THEN `R` UNABBREV_TAC;
44106   (* - *)
44107   THM_INTRO_TAC[`f i`;`A`;`B`] outer_segment_even;
44108   IMATCH_MP_TAC  psegment_triple3;
44109   IMATCH_MP_TAC  psegment_triple3;
44110   THM_INTRO_TAC[`f i`;`B`;`A`] outer_segment_even;
44111   FULL_REWRITE_TAC[UNION_ACI];
44112   IMATCH_MP_TAC  psegment_triple2;
44113   (* - *)
44114   TSPEC `j` 7;
44115   FULL_REWRITE_TAC[EMPTY_EXISTS];
44116   USE 7 (REWRITE_RULE[INTER]);
44117   USE 11(REWRITE_RULE[INTER]);
44118   (* -A *)
44119   THM_INTRO_TAC[`f i UNION A`;`B`;`f j`;`u`;`T`] meeting_lemma;
44120   CONJ_TAC;
44121   FULL_REWRITE_TAC[psegment_triple];
44122   FULL_REWRITE_TAC[UNION_COMM];
44123   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
44124   CONJ_TAC;
44125   CONJ_TAC;
44126   FIRST_ASSUM IMATCH_MP_TAC ;
44127   TYPE_THEN `j` UNABBREV_TAC;
44128   FULL_REWRITE_TAC[psegment_triple];
44129   FULL_REWRITE_TAC[UNION_COMM];
44130   TSPEC `j` 6;
44131   REWRITE_TAC[GSYM SUBSET_EMPTY];
44132   IMATCH_MP_TAC  SUBSET_TRANS;
44133   TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC;
44134   CONJ_TAC;
44135   USE 42 SYM;
44136   IMATCH_MP_TAC  subset_inter_pair;
44137   REWRITE_TAC[SUBSET_REFL];
44138   REWRITE_TAC[SUBSET;UNION];
44139   REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
44140   FULL_REWRITE_TAC[INTER_COMM];
44141   REWRITE_TAC[cls_union];
44142   (* -- *)
44143   TSPEC `j` 2;
44144   REWR 2;
44145   USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
44146   TSPEC `u` 2;
44147   REWR 2;
44148   COPY 4;
44149   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
44150   TYPE_THEN `i` UNABBREV_TAC;
44151   USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
44152   TSPEC `u` 4;
44153   REWR 4;
44154   (* -- *)
44155   TYPE_THEN `B SUBSET edge` SUBAGOAL_TAC;
44156   USE 8 (REWRITE_RULE[psegment_triple]);
44157   USE 26(REWRITE_RULE[psegment;segment]);
44158   (* -- *)
44159   TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
44160   TSPEC `j` 6;
44161   USE 17 (REWRITE_RULE[psegment_triple]);
44162   FULL_REWRITE_TAC[psegment];
44163   (* -- *)
44164   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
44165   CONJ_TAC;
44166   USE 17 (REWRITE_RULE[UNION]);
44167   REWR 17;
44168   (* -- *)
44169   ONCE_REWRITE_TAC[INTER_COMM];
44170   REWRITE_TAC[UNION_OVER_INTER];
44171   REWRITE_TAC[union_subset];
44172   CONJ_TAC;
44173   UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
44174   TYPE_THEN `j` UNABBREV_TAC;
44175   (* -- *)
44176   TSPEC `j` 6;
44177   IMATCH_MP_TAC  SUBSET_TRANS;
44178   TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC;
44179   CONJ_TAC;
44180   IMATCH_MP_TAC  subset_inter_pair;
44181   REWRITE_TAC[SUBSET_REFL];
44182   USE 19 SYM;
44183   IMATCH_MP_TAC  cls_subset;
44184   REWRITE_TAC[SUBSET;UNION];
44185   USE 18(REWRITE_RULE[psegment_triple]);
44186   REWRITE_TAC[cls_union;UNION_OVER_INTER];
44187   REWRITE_TAC[union_subset];
44188   FULL_REWRITE_TAC[INTER_COMM];
44189   TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
44190   REWRITE_TAC[SUBSET_REFL];
44191   (* -B *)
44192   THM_INTRO_TAC[`f i UNION B`;`A`;`f j`;`u'`;`T`] meeting_lemma;
44193   CONJ_TAC;
44194   FULL_REWRITE_TAC[psegment_triple];
44195   FULL_REWRITE_TAC[UNION_COMM];
44196   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
44197   CONJ_TAC;
44198   CONJ_TAC;
44199   FIRST_ASSUM IMATCH_MP_TAC ;
44200   TYPE_THEN `j` UNABBREV_TAC;
44201   FULL_REWRITE_TAC[psegment_triple];
44202   FULL_REWRITE_TAC[UNION_COMM];
44203   TSPEC `j` 6;
44204   REWRITE_TAC[GSYM SUBSET_EMPTY];
44205   IMATCH_MP_TAC  SUBSET_TRANS;
44206   TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC;
44207   CONJ_TAC;
44208   USE 43 SYM;
44209   IMATCH_MP_TAC  subset_inter_pair;
44210   REWRITE_TAC[SUBSET_REFL];
44211   REWRITE_TAC[SUBSET;UNION];
44212   REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
44213   FULL_REWRITE_TAC[INTER_COMM];
44214   REWRITE_TAC[cls_union];
44215   (* -- *)
44216   TSPEC `j` 2;
44217   REWR 2;
44218   USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
44219   TSPEC `u'` 2;
44220   REWR 2;
44221   COPY 4;
44222   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
44223   TYPE_THEN `i` UNABBREV_TAC;
44224   USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
44225   TSPEC `u'` 4;
44226   REWR 4;
44227   (* -- *)
44228   TYPE_THEN `A SUBSET edge` SUBAGOAL_TAC;
44229   USE 8 (REWRITE_RULE[psegment_triple]);
44230   USE 28(REWRITE_RULE[psegment;segment]);
44231   (* -- *)
44232   TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
44233   TSPEC `j` 6;
44234   USE 18 (REWRITE_RULE[psegment_triple]);
44235   FULL_REWRITE_TAC[psegment];
44236   (* -- *)
44237   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
44238   CONJ_TAC;
44239   USE 18 (REWRITE_RULE[UNION]);
44240   REWR 18;
44241   (* -- *)
44242   ONCE_REWRITE_TAC[INTER_COMM];
44243   REWRITE_TAC[UNION_OVER_INTER];
44244   REWRITE_TAC[union_subset];
44245   CONJ_TAC;
44246   UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
44247   TYPE_THEN `j` UNABBREV_TAC;
44248   (* -- *)
44249   TSPEC `j` 6;
44250   IMATCH_MP_TAC  SUBSET_TRANS;
44251   TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC;
44252   CONJ_TAC;
44253   IMATCH_MP_TAC  subset_inter_pair;
44254   REWRITE_TAC[SUBSET_REFL];
44255   USE 20 SYM;
44256   IMATCH_MP_TAC  cls_subset;
44257   REWRITE_TAC[SUBSET;UNION];
44258   USE 19(REWRITE_RULE[psegment_triple]);
44259   REWRITE_TAC[cls_union;UNION_OVER_INTER];
44260   REWRITE_TAC[union_subset];
44261   FULL_REWRITE_TAC[INTER_COMM];
44262   TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
44263   REWRITE_TAC[SUBSET_REFL];
44264   (* -C *)
44265   IMATCH_MP_TAC  par_cell_even_imp;
44266   TYPE_THEN `f i` EXISTS_TAC;
44267   FULL_REWRITE_TAC[UNION_ACI];
44268   CONJ_TAC;
44269   TSPEC `j` 6;
44270   USE 17 (REWRITE_RULE [psegment_triple]);
44271   USE 29(REWRITE_RULE[psegment]);
44272   (* - *)
44273   CONJ_TAC;
44274   TSPEC `j` 6;
44275   FULL_REWRITE_TAC[psegment_triple];
44276   REWRITE_TAC[cls_union ;];
44277   ONCE_REWRITE_TAC[INTER_COMM];
44278   REWRITE_TAC[UNION_OVER_INTER];
44279   REWRITE_TAC[union_subset];
44280   FULL_REWRITE_TAC[INTER_COMM];
44281   TYPE_THEN `endpoint A'` UNABBREV_TAC;
44282   TYPE_THEN `endpoint B'` UNABBREV_TAC;
44283   REWRITE_TAC[SUBSET_REFL];
44284   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
44285   TYPE_THEN `j` UNABBREV_TAC;
44286   (* - *)
44287   TSPEC `j` 6;
44288   UND 17 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC));
44289   TYPE_THEN `!C. C SUBSET (A' UNION B') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC;
44290   FULL_REWRITE_TAC[psegment_triple];
44291   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
44292   FULL_REWRITE_TAC[SUBSET;UNION ];
44293   ASM_MESON_TAC[];
44294   USE 1 SYM;
44295   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION];
44296   ]);;
44297   (* }}} *)
44298
44299 let psegment_triple_odd_even = prove_by_refinement(
44300   `!A B C. psegment_triple A B C /\ C SUBSET par_cell T (A UNION B) ==>
44301     (?A' B'. psegment_triple A' B' C /\ C SUBSET par_cell T (A' UNION B')
44302          /\ A' SUBSET par_cell F (B' UNION C)
44303          /\ B' SUBSET par_cell T (A' UNION C)
44304          /\ (A UNION B = A' UNION B')
44305          /\ (cls A INTER cls B = cls A' INTER cls B') /\
44306          (!P. (P A  /\ P B ) ==> P A' /\ P B'))`,
44307   (* {{{ proof *)
44308   [
44309   REP_BASIC_TAC;
44310   TYPE_THEN `A SUBSET par_cell F (B UNION C)` ASM_CASES_TAC;
44311   TYPE_THEN `A` EXISTS_TAC;
44312   TYPE_THEN `B` EXISTS_TAC;
44313   IMATCH_MP_TAC  outer_segment_even;
44314   FULL_REWRITE_TAC[UNION_COMM];
44315   IMATCH_MP_TAC  psegment_triple3;
44316   IMATCH_MP_TAC  psegment_triple3;
44317   IMATCH_MP_TAC  psegment_triple2;
44318   THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell;
44319   UND 3 THEN REP_CASES_TAC;
44320   ASM_MESON_TAC[];
44321   TYPE_THEN `B` EXISTS_TAC;
44322   TYPE_THEN `A` EXISTS_TAC;
44323   FULL_REWRITE_TAC[UNION_COMM;INTER_COMM;];
44324   CONJ_TAC;
44325   IMATCH_MP_TAC  psegment_triple3;
44326   IMATCH_MP_TAC  psegment_triple2;
44327   IMATCH_MP_TAC  outer_segment_even;
44328   FULL_REWRITE_TAC[UNION_COMM];
44329   IMATCH_MP_TAC  psegment_triple3;
44330   (* - *)
44331   TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
44332   FULL_REWRITE_TAC[psegment_triple];
44333   TYPE_THEN `C` UNABBREV_TAC;
44334   USE 15 (REWRITE_RULE[psegment;segment]);
44335   (* - *)
44336   FULL_REWRITE_TAC[EMPTY_EXISTS];
44337   THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint;
44338   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
44339   ASM_MESON_TAC[subset_imp];
44340   ]);;
44341   (* }}} *)
44342
44343 let k33_rectagon_two_odd = prove_by_refinement(
44344   `!R f i. k33_rectagon_hyp R f /\
44345       f i SUBSET par_cell T R  ==>
44346        (!j. ~(j = i) ==> (f j SUBSET par_cell F R))`,
44347   (* {{{ proof *)
44348   [
44349   REP_BASIC_TAC;
44350   FULL_REWRITE_TAC [k33_rectagon_hyp];
44351   COPY 2;
44352   TSPEC `i` 2;
44353   TYPE_THEN `R` UNABBREV_TAC;
44354   (* - *)
44355   THM_INTRO_TAC[`A`;`B`;`f i`] psegment_triple_odd_even;
44356   TYPE_THEN `A UNION B` UNABBREV_TAC;
44357   TYPE_THEN `cls A INTER cls B` UNABBREV_TAC;
44358   TYPE_THEN `!j. ~(cls (f j) INTER cls A' = {}) /\ ~(cls (f j) INTER cls B' = {})` SUBAGOAL_TAC;
44359   FIRST_ASSUM IMATCH_MP_TAC ;
44360   KILL 7; (* 7 -> 10 *)
44361   KILL 9;
44362   KILL 8;
44363   (* - *)
44364   TSPEC `j` 10;
44365   FULL_REWRITE_TAC[EMPTY_EXISTS];
44366   USE 7 (REWRITE_RULE[INTER]);
44367   USE 8(REWRITE_RULE[INTER]);
44368   (* -A *)
44369   THM_INTRO_TAC[`f i UNION A'`;`B'`;`f j`;`u`;`T`] meeting_lemma;
44370   CONJ_TAC;
44371   FULL_REWRITE_TAC[psegment_triple];
44372   FULL_REWRITE_TAC[UNION_COMM];
44373   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
44374   FULL_REWRITE_TAC[UNION_COMM];
44375   CONJ_TAC;
44376   CONJ_TAC;
44377   FIRST_ASSUM IMATCH_MP_TAC ;
44378   TYPE_THEN `j` UNABBREV_TAC;
44379   FULL_REWRITE_TAC[psegment_triple];
44380   FULL_REWRITE_TAC[UNION_COMM];
44381   TSPEC `j` 6;
44382   FULL_REWRITE_TAC[UNION_COMM];
44383   REWRITE_TAC[GSYM SUBSET_EMPTY];
44384   IMATCH_MP_TAC  SUBSET_TRANS;
44385   TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC;
44386   CONJ_TAC;
44387   USE 43 SYM;
44388   IMATCH_MP_TAC  subset_inter_pair;
44389   REWRITE_TAC[SUBSET_REFL];
44390   REWRITE_TAC[SUBSET;UNION];
44391   REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
44392   FULL_REWRITE_TAC[INTER_COMM];
44393   REWRITE_TAC[cls_union];
44394   (* -- *)
44395   TSPEC `j` 2;
44396   REWR 2;
44397   USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
44398   TSPEC `u` 2;
44399   REWR 2;
44400   COPY 4;
44401   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
44402   TYPE_THEN `i` UNABBREV_TAC;
44403   USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
44404   TSPEC `u` 4;
44405   REWR 4;
44406   (* -- *)
44407   TYPE_THEN `B' SUBSET edge` SUBAGOAL_TAC;
44408   USE 15 (REWRITE_RULE[psegment_triple]);
44409   USE 27(REWRITE_RULE[psegment;segment]);
44410   (* -- *)
44411   TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
44412   TSPEC `j` 6;
44413   USE 18 (REWRITE_RULE[psegment_triple]);
44414   FULL_REWRITE_TAC[psegment];
44415   (* -- *)
44416   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
44417   CONJ_TAC;
44418   USE 18 (REWRITE_RULE[UNION]);
44419   REWR 18;
44420   (* -- *)
44421   ONCE_REWRITE_TAC[INTER_COMM];
44422   REWRITE_TAC[UNION_OVER_INTER];
44423   REWRITE_TAC[union_subset];
44424   UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
44425   TYPE_THEN `j` UNABBREV_TAC;
44426   (* -- *)
44427   TSPEC `j` 6;
44428   IMATCH_MP_TAC  SUBSET_TRANS;
44429   TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC;
44430   CONJ_TAC;
44431   IMATCH_MP_TAC  subset_inter_pair;
44432   REWRITE_TAC[SUBSET_REFL];
44433   USE 20 SYM;
44434   IMATCH_MP_TAC  cls_subset;
44435   REWRITE_TAC[SUBSET;UNION];
44436   USE 19(REWRITE_RULE[psegment_triple]);
44437   REWRITE_TAC[cls_union;UNION_OVER_INTER];
44438   REWRITE_TAC[union_subset];
44439   FULL_REWRITE_TAC[INTER_COMM];
44440   TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
44441   REWRITE_TAC[SUBSET_REFL];
44442   (* -B *)
44443   THM_INTRO_TAC[`f i UNION B'`;`A'`;`f j`;`u'`;`F`] meeting_lemma;
44444   CONJ_TAC;
44445   FULL_REWRITE_TAC[psegment_triple];
44446   FULL_REWRITE_TAC[UNION_COMM];
44447   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
44448   FULL_REWRITE_TAC[UNION_COMM];
44449   CONJ_TAC;
44450   CONJ_TAC;
44451   FIRST_ASSUM IMATCH_MP_TAC ;
44452   TYPE_THEN `j` UNABBREV_TAC;
44453   FULL_REWRITE_TAC[psegment_triple];
44454   FULL_REWRITE_TAC[UNION_COMM];
44455   TSPEC `j` 6;
44456   REWRITE_TAC[GSYM SUBSET_EMPTY];
44457   IMATCH_MP_TAC  SUBSET_TRANS;
44458   TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC;
44459   CONJ_TAC;
44460   USE 44 SYM;
44461   IMATCH_MP_TAC  subset_inter_pair;
44462   REWRITE_TAC[SUBSET_REFL];
44463   REWRITE_TAC[SUBSET;UNION];
44464   REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
44465   FULL_REWRITE_TAC[INTER_COMM];
44466   REWRITE_TAC[cls_union];
44467   (* -- *)
44468   TSPEC `j` 2;
44469   REWR 2;
44470   USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
44471   TSPEC `u'` 2;
44472   REWR 2;
44473   COPY 4;
44474   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
44475   TYPE_THEN `i` UNABBREV_TAC;
44476   USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
44477   TSPEC `u'` 4;
44478   REWR 4;
44479   (* -- *)
44480   TYPE_THEN `A' SUBSET edge` SUBAGOAL_TAC;
44481   USE 15 (REWRITE_RULE[psegment_triple]);
44482   USE 29(REWRITE_RULE[psegment;segment]);
44483   (* -- *)
44484   TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
44485   TSPEC `j` 6;
44486   USE 19 (REWRITE_RULE[psegment_triple]);
44487   FULL_REWRITE_TAC[psegment];
44488   (* -- *)
44489   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
44490   CONJ_TAC;
44491   USE 19 (REWRITE_RULE[UNION]);
44492   REWR 19;
44493   (* -- *)
44494   ONCE_REWRITE_TAC[INTER_COMM];
44495   REWRITE_TAC[UNION_OVER_INTER];
44496   REWRITE_TAC[union_subset];
44497   UND 16 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
44498   TYPE_THEN `j` UNABBREV_TAC;
44499   (* -- *)
44500   TSPEC `j` 6;
44501   IMATCH_MP_TAC  SUBSET_TRANS;
44502   TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC;
44503   CONJ_TAC;
44504   IMATCH_MP_TAC  subset_inter_pair;
44505   REWRITE_TAC[SUBSET_REFL];
44506   USE 21 SYM;
44507   IMATCH_MP_TAC  cls_subset;
44508   REWRITE_TAC[SUBSET;UNION];
44509   USE 20(REWRITE_RULE[psegment_triple]);
44510   REWRITE_TAC[cls_union;UNION_OVER_INTER];
44511   REWRITE_TAC[union_subset];
44512   FULL_REWRITE_TAC[INTER_COMM];
44513   TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
44514   REWRITE_TAC[SUBSET_REFL];
44515   (* -C *)
44516   IMATCH_MP_TAC  par_cell_odd_imp;
44517   TYPE_THEN `f i` EXISTS_TAC;
44518   FULL_REWRITE_TAC[UNION_ACI];
44519   CONJ_TAC;
44520   TSPEC `j` 6;
44521   USE 18 (REWRITE_RULE [psegment_triple]);
44522   USE 30(REWRITE_RULE[psegment]);
44523   (* - *)
44524   CONJ_TAC;
44525   TSPEC `j` 6;
44526   FULL_REWRITE_TAC[psegment_triple];
44527   REWRITE_TAC[cls_union ;];
44528   ONCE_REWRITE_TAC[INTER_COMM];
44529   REWRITE_TAC[UNION_OVER_INTER];
44530   REWRITE_TAC[union_subset];
44531   FULL_REWRITE_TAC[INTER_COMM];
44532   TYPE_THEN `endpoint A''` UNABBREV_TAC;
44533   TYPE_THEN `endpoint B''` UNABBREV_TAC;
44534   REWRITE_TAC[SUBSET_REFL];
44535   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
44536   TYPE_THEN `j` UNABBREV_TAC;
44537   (* - *)
44538   TSPEC `j` 6;
44539   UND 19 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC));
44540   TYPE_THEN `!C. C SUBSET (A'' UNION B'') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC;
44541   FULL_REWRITE_TAC[psegment_triple];
44542   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
44543   FULL_REWRITE_TAC[SUBSET;UNION ];
44544   ASM_MESON_TAC[];
44545   USE 0 SYM;
44546   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION];
44547   ]);;
44548   (* }}} *)
44549
44550 let ABS3_012 = prove_by_refinement(
44551   `(REP3 (ABS3 0) = 0) /\ (REP3(ABS3 1) = 1) /\ (REP3(ABS3 2) = 2)`,
44552   (* {{{ proof *)
44553   [
44554   ASSUME_TAC three_t;
44555   USE 0(ONCE_REWRITE_RULE[EQ_SYM_EQ]);
44556   ARITH_TAC;
44557   ]);;
44558   (* }}} *)
44559
44560 let three_t_not_sing = prove_by_refinement(
44561   `!i. ?(j:three_t). ~(i = j)`,
44562   (* {{{ proof *)
44563   [
44564   REP_BASIC_TAC;
44565   TYPE_THEN `i = ABS3 0` ASM_CASES_TAC;
44566   TYPE_THEN `ABS3 1` EXISTS_TAC;
44567   USE 1(AP_TERM `REP3`);
44568   FULL_REWRITE_TAC[ABS3_012];
44569   UND 1 THEN ARITH_TAC;
44570   TYPE_THEN `ABS3 0` EXISTS_TAC;
44571   ASM_MESON_TAC[];
44572   ]);;
44573   (* }}} *)
44574
44575 let ABS3_onto = prove_by_refinement(
44576   `!(i:three_t). ?j. (i = ABS3 j) /\ (j < 3)`,
44577   (* {{{ proof *)
44578   [
44579   REP_BASIC_TAC;
44580   TYPE_THEN `REP3 i` EXISTS_TAC;
44581   REWRITE_TAC[BETA_RULE three_t];
44582   ]);;
44583   (* }}} *)
44584
44585 let three_t_eq = prove_by_refinement(
44586   `!i j. (i = j) <=> (REP3 i = REP3 j)`,
44587   (* {{{ proof *)
44588   [
44589   REP_BASIC_TAC;
44590   IMATCH_MP_TAC  EQ_ANTISYM;
44591   DISCH_TAC;
44592   USE 0(AP_TERM `ABS3`);
44593   FULL_REWRITE_TAC[three_t];
44594   ]);;
44595   (* }}} *)
44596
44597 let rep3_lt = prove_by_refinement(
44598   `!i. (REP3 i < 3)`,
44599   (* {{{ proof *)
44600   [
44601   REP_BASIC_TAC;
44602   REWRITE_TAC[BETA_RULE three_t];
44603   ]);;
44604   (* }}} *)
44605
44606 let three_t_not_pair = prove_by_refinement(
44607   `!i j. ?(k:three_t). ~(k = i) /\ ~(k = j)`,
44608   (* {{{ proof *)
44609   [
44610   REP_BASIC_TAC;
44611   REWRITE_TAC[three_t_eq];
44612   TYPE_THEN `?k'. (k' < 3) /\ ~(k' = REP3 i) /\ ~(k' = REP3 j)` SUBAGOAL_TAC;
44613   TYPE_THEN `  ~(0 = REP3 i) /\ ~(0 = REP3 j)` ASM_CASES_TAC;
44614   ASM_MESON_TAC[ARITH_RULE `0 < 3`];
44615   TYPE_THEN `  ~(1 = REP3 i) /\ ~(1 = REP3 j)` ASM_CASES_TAC;
44616   ASM_MESON_TAC[ARITH_RULE `1 < 3`];
44617   TYPE_THEN `  ~(2 = REP3 i) /\ ~(2 = REP3 j)` ASM_CASES_TAC;
44618   ASM_MESON_TAC[ARITH_RULE `2 < 3`];
44619   FULL_REWRITE_TAC[DE_MORGAN_THM];
44620   PROOF_BY_CONTR_TAC;
44621   UND 0 THEN UND 1 THEN UND 2 THEN ARITH_TAC;
44622   TYPE_THEN` ABS3 k'` EXISTS_TAC;
44623   ASM_MESON_TAC [BETA_RULE three_t];
44624   ]);;
44625   (* }}} *)
44626
44627 let bool_size = prove_by_refinement(
44628   `(UNIV:bool->bool) HAS_SIZE 2`,
44629   (* {{{ proof *)
44630   [
44631   REWRITE_TAC[has_size_bij2];
44632   TYPE_THEN `\ u.  if u then 0 else 1` EXISTS_TAC;
44633   REWRITE_TAC[BIJ];
44634   SUBCONJ_TAC;
44635   REWRITE_TAC[INJ];
44636   CONJ_TAC;
44637   COND_CASES_TAC THEN ARITH_TAC ;
44638   UND 0 THEN COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[ARITH_RULE `~(0 =1) /\ ~(1 = 0)`];
44639   FULL_REWRITE_TAC[SURJ;INJ];
44640   REP_BASIC_TAC;
44641   USE 2 (REWRITE_RULE[ARITH_RULE `x <| 2 <=> (x = 0)\/ (x = 1)`]);
44642   FIRST_ASSUM DISJ_CASES_TAC;
44643   TYPE_THEN `T` EXISTS_TAC;
44644   TYPE_THEN `F` EXISTS_TAC;
44645   ]);;
44646   (* }}} *)
44647
44648 let three_delete_size = prove_by_refinement(
44649   `!(i:three_t). (UNIV DELETE i) HAS_SIZE 2`,
44650   (* {{{ proof *)
44651   [
44652   REWRITE_TAC[HAS_SIZE;FINITE_DELETE];
44653   THM_INTRO_TAC[] thr_finite;
44654   FULL_REWRITE_TAC[HAS_SIZE];
44655   IMATCH_MP_TAC  (ARITH_RULE `(SUC x = 3) ==> (x = 2)`);
44656   USE 0 SYM;
44657   IMATCH_MP_TAC  CARD_SUC_DELETE;
44658   ASM_REWRITE_TAC[];
44659   ]);;
44660   (* }}} *)
44661
44662 let has_size_bij_set = prove_by_refinement(
44663   `!(A:A->bool) (B:B->bool) n. A HAS_SIZE n /\ B HAS_SIZE n ==>
44664           (?f. BIJ f A B)`,
44665   (* {{{ proof *)
44666   [
44667   REP_BASIC_TAC;
44668   USE 0(REWRITE_RULE [has_size_bij]);
44669   USE 1(REWRITE_RULE[has_size_bij2]);
44670   TYPE_THEN `compose f  f'` EXISTS_TAC;
44671   IMATCH_MP_TAC  COMP_BIJ;
44672   UNIFY_EXISTS_TAC;
44673   ]);;
44674   (* }}} *)
44675
44676 let bool_three_delete_bij = prove_by_refinement(
44677   `!i. ?b. BIJ b (UNIV:bool->bool) ((UNIV:three_t->bool) DELETE i)`,
44678   (* {{{ proof *)
44679   [
44680   REP_BASIC_TAC;
44681   IMATCH_MP_TAC  has_size_bij_set;
44682   TYPE_THEN`2` EXISTS_TAC;
44683   REWRITE_TAC[bool_size;three_delete_size];
44684   ]);;
44685   (* }}} *)
44686
44687 let k33_rectagon_hyp_odd_exist = prove_by_refinement(
44688   `!R f. k33_rectagon_hyp R f ==>
44689       (?i. (f i SUBSET par_cell F R))`,
44690   (* {{{ proof *)
44691   [
44692   REWRITE_TAC[k33_rectagon_hyp];
44693   TYPE_THEN `j = ABS3 0` ABBREV_TAC ;
44694   TYPE_THEN `f j SUBSET par_cell F R` ASM_CASES_TAC;
44695   ASM_MESON_TAC[];
44696   TYPE_THEN `k = ABS3 1` ABBREV_TAC ;
44697   TYPE_THEN `k` EXISTS_TAC;
44698   THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd;
44699   CONJ_TAC;
44700   ASM_REWRITE_TAC[k33_rectagon_hyp];
44701   THM_INTRO_TAC[`R`;`f j`] segment_in_comp;
44702   TSPEC `j` 0;
44703   USE 8 (REWRITE_RULE[psegment_triple]);
44704   CONJ_TAC;
44705   USE 20(REWRITE_RULE[psegment]);
44706   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
44707   FULL_REWRITE_TAC[INTER_COMM];
44708   REWRITE_TAC[cls_union];
44709   REWRITE_TAC[UNION_OVER_INTER;union_subset];
44710   FULL_REWRITE_TAC[INTER_COMM];
44711   TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
44712   REWRITE_TAC[SUBSET_REFL];
44713   TYPE_THEN `eps = F` ASM_CASES_TAC;
44714   REWR 7;
44715   TYPE_THEN `eps = T` SUBAGOAL_TAC;
44716   ASM_MESON_TAC[];
44717   TYPE_THEN `eps` UNABBREV_TAC;
44718   (* - *)
44719   TSPEC `k` 7;
44720   FIRST_ASSUM IMATCH_MP_TAC ;
44721   TYPE_THEN `j` UNABBREV_TAC;
44722   TYPE_THEN `k` UNABBREV_TAC;
44723   USE 4 (AP_TERM `REP3`);
44724   FULL_REWRITE_TAC[ABS3_012];
44725   UND 4 THEN ARITH_TAC;
44726   ]);;
44727   (* }}} *)
44728
44729 let k33_rectagon_hyp_false = prove_by_refinement(
44730   `!R f. ~k33_rectagon_hyp R f`,
44731   (* {{{ proof *)
44732   [
44733   REP_BASIC_TAC;
44734   THM_INTRO_TAC[`R`;`f`] k33_rectagon_hyp_odd_exist;
44735   THM_INTRO_TAC[`R`;`f`;`i`] k33_rectagon_two_even;
44736   THM_INTRO_TAC[`i`] three_t_not_sing;
44737   COPY 2;
44738   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
44739   TYPE_THEN `j` UNABBREV_TAC;
44740   (* - *)
44741   THM_INTRO_TAC[`i`;`j`] three_t_not_pair;
44742   TSPEC `k` 2;
44743   THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd;
44744   TSPEC `k` 7;
44745   TYPE_THEN `~(f k = EMPTY)` SUBAGOAL_TAC;
44746   FULL_REWRITE_TAC[k33_rectagon_hyp];
44747   TSPEC `k` 0;
44748   FULL_REWRITE_TAC[psegment_triple];
44749   USE 25(REWRITE_RULE[psegment;segment]);
44750   TYPE_THEN `f k` UNABBREV_TAC;
44751   FULL_REWRITE_TAC[EMPTY_EXISTS];
44752   THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
44753   FULL_REWRITE_TAC[EQ_EMPTY;INTER ];
44754   FULL_REWRITE_TAC[SUBSET];
44755   ASM_MESON_TAC[];
44756   ]);;
44757   (* }}} *)
44758
44759 let k33_graph_edge = prove_by_refinement(
44760   `graph_edge (k33_graph) = cartesian UNIV UNIV`,
44761   (* {{{ proof *)
44762   [
44763   REWRITE_TAC[k33_graph;graph_edge_mk_graph];
44764   ]);;
44765   (* }}} *)
44766
44767 let k33_graph_vertex = prove_by_refinement(
44768   `graph_vertex (k33_graph) = cartesian UNIV UNIV`,
44769   (* {{{ proof *)
44770   [
44771   REWRITE_TAC[k33_graph;graph_vertex_mk_graph];
44772   ]);;
44773   (* }}} *)
44774
44775 let k33_graph_inc = prove_by_refinement(
44776   `!e v. graph_inc (k33_graph) e v <=> (v = (FST e,T)) \/ (v = (SND e,F))`,
44777   (* {{{ proof *)
44778   [
44779   REWRITE_TAC[k33_graph;graph_inc_mk_graph;INR in_pair ];
44780   MESON_TAC[];
44781   ]);;
44782   (* }}} *)
44783
44784 let cartesian_univ = prove_by_refinement(
44785   `!x. cartesian (UNIV:A->bool) (UNIV:B->bool) x`,
44786   (* {{{ proof *)
44787   [
44788   REWRITE_TAC[cartesian;PAIR_SPLIT];
44789   MESON_TAC[];
44790   ]);;
44791   (* }}} *)
44792
44793 let rectagonal_graph_k33 = prove_by_refinement(
44794   `rectagonal_graph k33_graph <=> (?f uA uB.
44795      INJ uA UNIV UNIV /\
44796      INJ uB UNIV UNIV /\
44797      (!(i:three_t#three_t).
44798           segment_end (f i) (uA (FST i)) (uB (SND i))) /\
44799      (!i j. ~(f i INTER f j = EMPTY) ==> (i = j)) /\
44800      (!i j. ~(i = j) ==> (cls (f i) INTER cls (f j) =
44801            endpoint (f i) INTER endpoint (f j))))
44802      `,
44803   (* {{{ proof *)
44804   [
44805   REWRITE_TAC[rectagonal_graph];
44806   IMATCH_MP_TAC  EQ_ANTISYM;
44807   (* - *)
44808   CONJ_TAC;
44809   THM_INTRO_TAC[`H`;`k33_graph`] graph_isomorphic_symm;
44810   FULL_REWRITE_TAC[rectagon_graph];
44811   KILL 0;
44812   FULL_REWRITE_TAC [graph_isomorphic;graph_iso];
44813   FULL_REWRITE_TAC[rectagon_graph];
44814   FULL_REWRITE_TAC[k33_graph_edge;k33_graph_vertex;k33_graph_inc];
44815   KILL 4;
44816   TYPE_THEN `v` EXISTS_TAC;
44817   TYPE_THEN `uA = (\ i. u (i,T))` ABBREV_TAC ;
44818   TYPE_THEN `uB = (\ i. u (i,F))` ABBREV_TAC ;
44819   TYPE_THEN  `uA` EXISTS_TAC;
44820   TYPE_THEN `uB` EXISTS_TAC;
44821   (* -- *)
44822   CONJ_TAC;
44823   REWRITE_TAC[INJ];
44824   TYPE_THEN `uA` UNABBREV_TAC;
44825   USE 3(REWRITE_RULE[BIJ;INJ]);
44826   TYPE_THEN`(x,T) = (y,T)` BACK_TAC;
44827   USE 12 (REWRITE_RULE[PAIR_SPLIT]);
44828   FIRST_ASSUM IMATCH_MP_TAC ;
44829   REWRITE_TAC[cartesian_univ];
44830   (* -- *)
44831   CONJ_TAC;
44832   REWRITE_TAC[INJ];
44833   TYPE_THEN `uB` UNABBREV_TAC;
44834   USE 3(REWRITE_RULE[BIJ;INJ]);
44835   TYPE_THEN`(x,F) = (y,F)` BACK_TAC;
44836   USE 12 (REWRITE_RULE[PAIR_SPLIT]);
44837   FIRST_ASSUM IMATCH_MP_TAC ;
44838   REWRITE_TAC[cartesian_univ];
44839   (* --A *)
44840   TYPE_THEN `!i. graph_edge H (v i)` SUBAGOAL_TAC;
44841   FULL_REWRITE_TAC[BIJ;SURJ];
44842   FIRST_ASSUM IMATCH_MP_TAC ;
44843   REWRITE_TAC[cartesian_univ];
44844   FULL_REWRITE_TAC[cartesian_univ];
44845   (* -- *)
44846   SUBCONJ_TAC;
44847   REWRITE_TAC[segment_end];
44848   CONJ_TAC;
44849   USE 7(REWRITE_RULE[SUBSET]);
44850   USE 6 GSYM;
44851   ASM_REWRITE_TAC[];
44852   IMATCH_MP_TAC  EQ_EXT;
44853   REWRITE_TAC[IMAGE;k33_graph_inc;INR in_pair];
44854   TYPE_THEN `uA` UNABBREV_TAC;
44855   TYPE_THEN `uB` UNABBREV_TAC;
44856   NAME_CONFLICT_TAC;
44857   IMATCH_MP_TAC  EQ_ANTISYM;
44858   CONJ_TAC;
44859   FIRST_ASSUM DISJ_CASES_TAC;
44860   FIRST_ASSUM DISJ_CASES_TAC;
44861   TYPE_THEN `(SND i,F)` EXISTS_TAC;
44862   TYPE_THEN `(FST i,T)` EXISTS_TAC;
44863   (* --B *)
44864   CONJ_TAC;
44865   PROOF_BY_CONTR_TAC;
44866   UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`v i`;`v j`]);
44867   PROOF_BY_CONTR_TAC;
44868   UND 13 THEN REWRITE_TAC[];
44869   USE 2 (REWRITE_RULE[BIJ;INJ]);
44870   FIRST_ASSUM IMATCH_MP_TAC ;
44871   ASM_MESON_TAC[cartesian_univ];
44872   ASM_MESON_TAC[];
44873   (* -- *)
44874   FIRST_ASSUM IMATCH_MP_TAC ;
44875   DISCH_TAC;
44876   UND 12 THEN REWRITE_TAC[];
44877   USE 2 (REWRITE_RULE[BIJ;INJ]);
44878   FIRST_ASSUM IMATCH_MP_TAC ;
44879   ASM_MESON_TAC[cartesian_univ];
44880   (* -C *)
44881   TYPE_THEN `?H. rectagon_graph H /\ graph_isomorphic k33_graph H` BACK_TAC;
44882   TYPE_THEN `H` EXISTS_TAC;
44883   IMATCH_MP_TAC  graph_isomorphic_symm;
44884   REWRITE_TAC[k33_isgraph];
44885   REWRITE_TAC[rectagon_graph;graph_isomorphic;graph_iso];
44886   REWRITE_TAC[k33_graph_vertex;k33_graph_edge];
44887   TYPE_THEN `H = mk_graph_t (IMAGE uA UNIV UNION IMAGE uB UNIV ,IMAGE f (cartesian UNIV UNIV), endpoint)` ABBREV_TAC ;
44888   TYPE_THEN `H` EXISTS_TAC;
44889   TYPE_THEN `graph_edge H = IMAGE f (cartesian UNIV UNIV)` SUBAGOAL_TAC;
44890   TYPE_THEN `H` UNABBREV_TAC;
44891   REWRITE_TAC[graph_edge_mk_graph];
44892   TYPE_THEN `graph_vertex H = IMAGE uA UNIV UNION IMAGE uB UNIV ` SUBAGOAL_TAC;
44893   TYPE_THEN `H` UNABBREV_TAC;
44894   REWRITE_TAC[graph_vertex_mk_graph];
44895   TYPE_THEN `graph_inc H = endpoint` SUBAGOAL_TAC;
44896   TYPE_THEN `H` UNABBREV_TAC;
44897   REWRITE_TAC[graph_inc_mk_graph];
44898   (* - *)
44899   REWRITE_TAC[GSYM CONJ_ASSOC];
44900   CONJ_TAC;
44901   REWRITE_TAC[graph];
44902   REWRITE_TAC[SUBSET];
44903   NAME_CONFLICT_TAC;
44904   REWRITE_TAC[UNION];
44905   USE 9(REWRITE_RULE[IMAGE]);
44906   TYPE_THEN `x'` UNABBREV_TAC;
44907   CONJ_TAC;
44908   TSPEC `x''` 2;
44909   USE 2(REWRITE_RULE[segment_end]);
44910   REWR 10;
44911   USE 10 (REWRITE_RULE[INR in_pair]);
44912   FIRST_ASSUM DISJ_CASES_TAC;
44913   REWRITE_TAC[IMAGE];
44914   MESON_TAC[];
44915   REWRITE_TAC[IMAGE];
44916   MESON_TAC[];
44917   IMATCH_MP_TAC  endpoint_size2;
44918   TSPEC `x''` 2;
44919   USE 2(REWRITE_RULE[segment_end]);
44920   (* -D *)
44921   CONJ_TAC;
44922   REWRITE_TAC[IMAGE;SUBSET;cartesian_univ];
44923   USE 2(REWRITE_RULE[segment_end]);
44924   (* - *)
44925   KILL 5;
44926   KILL 6;
44927   KILL 7;
44928   KILL 8;
44929   CONJ_TAC;
44930   FULL_REWRITE_TAC[IMAGE;cartesian_univ];
44931   PROOF_BY_CONTR_TAC;
44932   UND 5 THEN REWRITE_TAC[];
44933   AP_TERM_TAC;
44934   FIRST_ASSUM IMATCH_MP_TAC ;
44935   ASM_MESON_TAC[];
44936   (* - *)
44937   CONJ_TAC;
44938   FULL_REWRITE_TAC[IMAGE;cartesian_univ];
44939   FIRST_ASSUM IMATCH_MP_TAC ;
44940   TYPE_THEN `x'` UNABBREV_TAC;
44941   TYPE_THEN `e'` UNABBREV_TAC;
44942   ASM_MESON_TAC[];
44943   LEFT_TAC "u";
44944   TYPE_THEN `u = (\ x. (if (SND x) then (uA (FST x)) else uB(FST x)))` ABBREV_TAC ;
44945   TYPE_THEN `u` EXISTS_TAC;
44946   LEFT_TAC "v";
44947   TYPE_THEN `f` EXISTS_TAC;
44948   TYPE_THEN `(u,f)` EXISTS_TAC;
44949   (* -E *)
44950   TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC;
44951   TSPEC `(i,j)` 2;
44952   USE 2(MATCH_MP segment_end_disj);
44953   UND 2 THEN ASM_REWRITE_TAC[];
44954   (* - *)
44955   SUBCONJ_TAC;
44956   REWRITE_TAC[BIJ];
44957   SUBCONJ_TAC;
44958   REWRITE_TAC[INJ;cartesian_univ];
44959   CONJ_TAC;
44960   TYPE_THEN `u` UNABBREV_TAC;
44961   COND_CASES_TAC;
44962   REWRITE_TAC[IMAGE;UNION];
44963   MESON_TAC[];
44964   REWRITE_TAC[IMAGE;UNION];
44965   MESON_TAC[];
44966   REWRITE_TAC[PAIR_SPLIT];
44967   PROOF_BY_CONTR_TAC;
44968   FULL_REWRITE_TAC[DE_MORGAN_THM];
44969   (* ---// *)
44970   TYPE_THEN `u` UNABBREV_TAC;
44971   TYPE_THEN `!x y. (uA (x) = uA (y)) ==> (x = y)` SUBAGOAL_TAC;
44972   USE 4 (REWRITE_RULE[INJ]);
44973   FIRST_ASSUM IMATCH_MP_TAC ;
44974   TYPE_THEN `!x y. (uB (x) = uB (y)) ==> (x = y)` SUBAGOAL_TAC;
44975   USE 3 (REWRITE_RULE[INJ]);
44976   FIRST_ASSUM IMATCH_MP_TAC ;
44977   UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
44978   KILL 0 THEN KILL 1 THEN KILL 2;
44979   UND 7 THEN  COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[];
44980   (* -- *)
44981   REWRITE_TAC[SURJ];
44982   CONJ_TAC;
44983   USE 7(REWRITE_RULE[INJ]);
44984   REWRITE_TAC[cartesian_univ];
44985   TYPE_THEN `u` UNABBREV_TAC;
44986   USE 8 (REWRITE_RULE[UNION]);
44987   FIRST_ASSUM DISJ_CASES_TAC;
44988   USE 8(REWRITE_RULE[IMAGE]);
44989   TYPE_THEN `(x',T)` EXISTS_TAC;
44990   USE 8(REWRITE_RULE[IMAGE]);
44991   TYPE_THEN `(x',F)` EXISTS_TAC;
44992   (* -F *)
44993   CONJ_TAC;
44994   IMATCH_MP_TAC  inj_bij;
44995   REWRITE_TAC[INJ];
44996   FIRST_ASSUM IMATCH_MP_TAC ;
44997   TYPE_THEN `f x` UNABBREV_TAC;
44998   FULL_REWRITE_TAC[INTER_IDEMPOT];
44999   TSPEC `y` 2;
45000   FULL_REWRITE_TAC[segment_end;psegment;segment];
45001   ASM_MESON_TAC[];
45002   (* - *)
45003   TSPEC `e` 2;
45004   FULL_REWRITE_TAC[segment_end];
45005   IMATCH_MP_TAC  EQ_EXT;
45006   REWRITE_TAC[INR in_pair;IMAGE;k33_graph_inc];
45007   NAME_CONFLICT_TAC;
45008   THM_INTRO_TAC[`u`;`cartesian (UNIV:three_t->bool) (UNIV:bool->bool)`;`(IMAGE uA UNIV UNION IMAGE uB UNIV)`] bij_imp_image;
45009   USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
45010   USE 10 (REWRITE_RULE[IMAGE ;cartesian_univ;UNION]);
45011   USE 10 (CONV_RULE (NAME_CONFLICT_CONV));
45012   IMATCH_MP_TAC  EQ_ANTISYM;
45013   CONJ_TAC;
45014   FIRST_ASSUM DISJ_CASES_TAC;
45015   TYPE_THEN `x` UNABBREV_TAC;
45016   TSPEC `uB (SND e)` 10;
45017   USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (c ==> a)`));
45018   UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
45019   MESON_TAC[];
45020   TYPE_THEN`(SND e,F)` EXISTS_TAC;
45021   TYPE_THEN `u x'` UNABBREV_TAC;
45022   TYPE_THEN `u` UNABBREV_TAC;
45023   (* -- *)
45024   TYPE_THEN `x` UNABBREV_TAC;
45025   TSPEC `uA (FST  e)` 10;
45026   USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (b ==> a)`));
45027   UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
45028   MESON_TAC[];
45029   TYPE_THEN`(FST  e,T)` EXISTS_TAC;
45030   TYPE_THEN `u x'` UNABBREV_TAC;
45031   TYPE_THEN `u` UNABBREV_TAC;
45032   (* - *)
45033   FIRST_ASSUM DISJ_CASES_TAC ;
45034   TYPE_THEN `u` UNABBREV_TAC;
45035   TYPE_THEN `u` UNABBREV_TAC;
45036   ]);;
45037   (* }}} *)
45038
45039 let eq_exchange = prove_by_refinement(
45040   `!x a (b:A). (x = a) /\ (x = b) <=> (x = a) /\ (a = b)`,
45041   (* {{{ proof *)
45042   [
45043   REP_BASIC_TAC;
45044   MESON_TAC[];
45045   ]);;
45046   (* }}} *)
45047
45048 let rectagon_graph_k33_false = prove_by_refinement(
45049   `~(rectagonal_graph k33_graph)`,
45050   (* {{{ proof *)
45051   [
45052   DISCH_TAC;
45053   FULL_REWRITE_TAC[rectagonal_graph_k33];
45054   ASSUME_TAC k33_rectagon_hyp_false;
45055   LEFT 5 "f";
45056   TYPE_THEN `diag  = (\ (i:three_t). f (i,i))` ABBREV_TAC ;
45057   TYPE_THEN `!i. diag i = f(i,i)` SUBAGOAL_TAC;
45058   TYPE_THEN `diag` UNABBREV_TAC;
45059   KILL 6;
45060   TSPEC `diag` 5;
45061   RIGHT 5 "R";
45062   UND 5 THEN REWRITE_TAC[];
45063   REWRITE_TAC[k33_rectagon_hyp];
45064   TYPE_THEN `R = UNIONS { e | (?i j. ~(i = j) /\ (e = f (i,j)) ) }` ABBREV_TAC ;
45065   TYPE_THEN  `R` EXISTS_TAC;
45066   (* - *)
45067   TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC;
45068   TSPEC `i,j` 2;
45069   USE 2(MATCH_MP segment_end_disj);
45070   REWR 2;
45071   (* - *)
45072   TYPE_THEN `!i j. (uA i = uA j) <=> (i = j)` SUBAGOAL_TAC;
45073   IMATCH_MP_TAC  EQ_ANTISYM ;
45074   USE 4 (REWRITE_RULE[INJ]);
45075   FIRST_ASSUM IMATCH_MP_TAC ;
45076   (* - *)
45077   TYPE_THEN `!i j. (uB i = uB j) <=> (i = j)` SUBAGOAL_TAC;
45078   IMATCH_MP_TAC  EQ_ANTISYM ;
45079   USE 3 (REWRITE_RULE[INJ]);
45080   FIRST_ASSUM IMATCH_MP_TAC ;
45081   (* -A *)
45082   TYPE_THEN `(!i j. ~(i = j) ==> (cls (f (i,i)) INTER cls (f (j,j)) = {}))` SUBAGOAL_TAC;
45083   UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,i)`;`j,j`]);
45084   USE 0 (REWRITE_RULE[PAIR_SPLIT]);
45085   ASM_MESON_TAC[];
45086   COPY 2;
45087   TSPEC `i,i` 11;
45088   TSPEC `j,j` 2;
45089   FULL_REWRITE_TAC[segment_end];
45090   IMATCH_MP_TAC  EQ_EXT;
45091   REWRITE_TAC[INTER;INR in_pair];
45092   FIRST_ASSUM DISJ_CASES_TAC THEN (TYPE_THEN `x` UNABBREV_TAC);
45093   REWR 15;
45094   REWR 15;
45095   ASM_REWRITE_TAC[];
45096   (* - *)
45097   TYPE_THEN `(!i j. ~(i = j) ==> (f (i,i) INTER f (j,j) = {}))` SUBAGOAL_TAC;
45098   PROOF_BY_CONTR_TAC;
45099   UND 11 THEN ASM_REWRITE_TAC[];
45100   TYPE_THEN `(i,i) = (j,j)` BACK_TAC;
45101   USE 11(REWRITE_RULE[PAIR_SPLIT]);
45102   FIRST_ASSUM IMATCH_MP_TAC ;
45103   ASM_MESON_TAC[];
45104   ASM_REWRITE_TAC[];
45105   LEFT_TAC "i";
45106   (* -B start main reduction *)
45107   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;
45108   LEFT_TAC "A";
45109   LEFT_TAC "B";
45110   TYPE_THEN `A T` EXISTS_TAC;
45111   TYPE_THEN `A F` EXISTS_TAC;
45112   TYPE_THEN `(!j. ~(i = j) ==> (cls (f (j,j)) INTER cls (A T) INTER cls (A F) = {}))` SUBAGOAL_TAC;
45113   REWRITE_TAC[GSYM SUBSET_EMPTY];
45114   IMATCH_MP_TAC  SUBSET_TRANS;
45115   TYPE_THEN `cls (f (j,j)) INTER cls(f (i,i))` EXISTS_TAC;
45116   REWRITE_TAC[SUBSET_EMPTY];
45117   CONJ_TAC;
45118   IMATCH_MP_TAC  subset_inter_pair;
45119   ASM_REWRITE_TAC[SUBSET_REFL];
45120   IMATCH_MP_TAC  SUBSET_TRANS;
45121   TYPE_THEN `endpoint (f (i,i))` EXISTS_TAC;
45122   IMATCH_MP_TAC  endpoint_cls;
45123   USE 2(REWRITE_RULE[segment_end;psegment;segment]);
45124   FIRST_ASSUM IMATCH_MP_TAC ;
45125   TYPE_THEN `j` UNABBREV_TAC;
45126   ASM_REWRITE_TAC[];
45127   (* -- *)
45128   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
45129   SUBCONJ_TAC;
45130   ASM_REWRITE_TAC[psegment_triple];
45131   TYPE_THEN `cls (A T) INTER cls (A F) = endpoint (f (i,i))` SUBAGOAL_TAC;
45132   IMATCH_MP_TAC  SUBSET_ANTISYM ;
45133   COPY 13;
45134   TSPEC `T` 21;
45135   TSPEC `F` 13;
45136   REWRITE_TAC[SUBSET_INTER];
45137   TYPE_THEN `FINITE (f(i,i))` SUBAGOAL_TAC;
45138   USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
45139   CONJ_TAC;
45140   USE 21 SYM;
45141   IMATCH_MP_TAC  endpoint_cls;
45142   USE 16(REWRITE_RULE[psegment;segment]);
45143   USE 13 SYM;
45144   IMATCH_MP_TAC  endpoint_cls;
45145   USE 16(REWRITE_RULE[psegment;segment]);
45146   SUBCONJ_TAC;
45147   FULL_REWRITE_TAC[segment_end];
45148   (* ---C *)
45149   TYPE_THEN `endpoint (f (i,i)) = {(uA (i)), (uB(i))}` SUBAGOAL_TAC;
45150   USE 2 (REWRITE_RULE[segment_end]);
45151   CONJ_TAC;
45152   TYPE_THEN `R` UNABBREV_TAC;
45153   USE 5 SYM;
45154   IMATCH_MP_TAC  segment_end_union_rectagon;
45155   TYPE_THEN `uA i` EXISTS_TAC;
45156   TYPE_THEN `uB i` EXISTS_TAC;
45157   ASM_REWRITE_TAC[segment_end];
45158   (* --- *)
45159   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];
45160   (* -- *)
45161   FULL_REWRITE_TAC[psegment_triple];
45162   KILL 5;
45163   TYPE_THEN `R` UNABBREV_TAC;
45164   (* -D *)
45165   THM_INTRO_TAC[`i`] bool_three_delete_bij;
45166   TYPE_THEN `!e. ~(b e = i)` SUBAGOAL_TAC;
45167   USE 12(REWRITE_RULE[BIJ;SURJ;DELETE ]);
45168   ASM_MESON_TAC[];
45169   TYPE_THEN `!e e'. (b e = b e') <=> (e = e')` SUBAGOAL_TAC;
45170   USE 12 (REWRITE_RULE[BIJ;INJ]);
45171   IMATCH_MP_TAC  EQ_ANTISYM;
45172   ASM_REWRITE_TAC[];
45173   TYPE_THEN `!j. ~(j = i) ==> (?e. (j = b e))` SUBAGOAL_TAC;
45174   USE 12(REWRITE_RULE[BIJ;SURJ]);
45175   USE 12 (GSYM);
45176   FIRST_ASSUM IMATCH_MP_TAC ;
45177   REWRITE_TAC[DELETE];
45178   TYPE_THEN `j` UNABBREV_TAC;
45179   (* - *)
45180   TYPE_THEN `A = (\ (e: bool). f(i, b e) UNION f (b (~e),b e) UNION f (b(~e),i))` ABBREV_TAC ;
45181   TYPE_THEN `A` EXISTS_TAC;
45182   (* - now satisfy constraints *)
45183   TYPE_THEN `(!eps. A eps INTER f (i,i) = {})` SUBAGOAL_TAC;
45184   TYPE_THEN `A` UNABBREV_TAC;
45185   ONCE_REWRITE_TAC[INTER_COMM];
45186   REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
45187   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[];
45188   (* -E *)
45189   TYPE_THEN `(!eps. cls (A eps) INTER cls (f (i,i)) = endpoint (f (i,i)))` SUBAGOAL_TAC ;
45190   TYPE_THEN `A` UNABBREV_TAC;
45191   ONCE_REWRITE_TAC[INTER_COMM];
45192   FULL_REWRITE_TAC[UNION_OVER_INTER;cls_union];
45193   COPY 0;
45194   UND 0 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(i, b eps)`]);
45195   USE 0 (REWRITE_RULE[PAIR_SPLIT]);
45196   ASM_MESON_TAC[];
45197   COPY 16;
45198   UND 16 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(b (~eps),i)`]);
45199   USE 16 (REWRITE_RULE[PAIR_SPLIT]);
45200   ASM_MESON_TAC[];
45201   COPY 18;
45202   UND 18 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(b (~eps),b eps)`]);
45203   USE 18 (REWRITE_RULE[PAIR_SPLIT]);
45204   ASM_MESON_TAC[];
45205   REWRITE_TAC[GSYM UNION_OVER_INTER];
45206   REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] SUBSET_INTER_ABSORPTION];
45207   USE 2 (REWRITE_RULE[segment_end]);
45208   REWRITE_TAC[SUBSET;UNION;INR in_pair  ];
45209   FIRST_ASSUM DISJ_CASES_TAC;
45210   (* - *)
45211   TYPE_THEN `(!j eps. ~(cls (f (j,j)) INTER cls (A eps) = {}))` SUBAGOAL_TAC;
45212   TYPE_THEN `j = i` ASM_CASES_TAC;
45213   TYPE_THEN `i` UNABBREV_TAC;
45214   USE 19 (ONCE_REWRITE_RULE[INTER_COMM]);
45215   TSPEC  `eps` 18;
45216   REWR 19;
45217   TSPEC `(j,j)` 2;
45218   FULL_REWRITE_TAC[segment_end];
45219   REWR 2;
45220   USE 2 SYM;
45221   USE 2(REWRITE_RULE[EQ_EMPTY;INR in_pair]);
45222   ASM_MESON_TAC[];
45223   TYPE_THEN `A` UNABBREV_TAC;
45224   FULL_REWRITE_TAC[cls_union];
45225   FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
45226   UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
45227   TYPE_THEN `j` UNABBREV_TAC;
45228   TYPE_THEN `j` UNABBREV_TAC;
45229   TYPE_THEN `(e = eps) \/ (e = ~eps)` SUBAGOAL_TAC;
45230   MESON_TAC[];
45231   FIRST_ASSUM DISJ_CASES_TAC;
45232   TYPE_THEN `e` UNABBREV_TAC;
45233   UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(b eps,b eps)`;`(i,b eps)`] );
45234   USE 0 (REWRITE_RULE[PAIR_SPLIT]);
45235   TYPE_THEN `i` UNABBREV_TAC;
45236   REWR 21;
45237   UND 21 THEN REWRITE_TAC[EMPTY_EXISTS ];
45238   REWRITE_TAC[INTER];
45239   FULL_REWRITE_TAC[segment_end;INR in_pair];
45240   FULL_REWRITE_TAC[segment_end;INR in_pair];
45241   TYPE_THEN `uB (b eps)` EXISTS_TAC;
45242   (* -- *)
45243     TYPE_THEN `e` UNABBREV_TAC;
45244   UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(b (~eps),b (~eps))`;`(b (~eps),i)`] );
45245   USE 0 (REWRITE_RULE[PAIR_SPLIT]);
45246   TYPE_THEN `i` UNABBREV_TAC;
45247   REWR 16;
45248   UND 16 THEN REWRITE_TAC[EMPTY_EXISTS ];
45249   REWRITE_TAC[INTER];
45250   FULL_REWRITE_TAC[segment_end;INR in_pair];
45251   FULL_REWRITE_TAC[segment_end;INR in_pair];
45252   TYPE_THEN `uA (b (~eps))` EXISTS_TAC;
45253   (* -F *)
45254   TYPE_THEN `A T INTER A F = EMPTY ` SUBAGOAL_TAC;
45255   TYPE_THEN `A` UNABBREV_TAC;
45256   REWRITE_TAC[UNION_OVER_INTER];
45257   ONCE_REWRITE_TAC[INTER_COMM];
45258   REWRITE_TAC[UNION_OVER_INTER];
45259   REWRITE_TAC[EMPTY_UNION];
45260   TYPE_THEN `!i j. (f i INTER f j = EMPTY) <=> ~( i = j)` SUBAGOAL_TAC;
45261   IMATCH_MP_TAC  EQ_ANTISYM;
45262   CONJ_TAC;
45263   TYPE_THEN `i'` UNABBREV_TAC;
45264   FULL_REWRITE_TAC[INTER_IDEMPOT];
45265   TSPEC `j` 2;
45266   TYPE_THEN `f j` UNABBREV_TAC;
45267   FULL_REWRITE_TAC[segment_end;psegment;segment];
45268   PROOF_BY_CONTR_TAC;
45269   UND 16 THEN REWRITE_TAC[];
45270   FIRST_ASSUM IMATCH_MP_TAC ;
45271   ASM_MESON_TAC[];
45272   REWRITE_TAC[PAIR_SPLIT];
45273   (* - *)
45274   TYPE_THEN `A T UNION A F = R` SUBAGOAL_TAC;
45275   TYPE_THEN `A` UNABBREV_TAC;
45276   TYPE_THEN `R` UNABBREV_TAC;
45277   IMATCH_MP_TAC  SUBSET_ANTISYM;
45278   CONJ_TAC;
45279   REWRITE_TAC[SUBSET;UNION;UNIONS];
45280   CONV_TAC (dropq_conv "u");
45281   UND 5 THEN REP_CASES_TAC THEN UNIFY_EXISTS_TAC;
45282   REWRITE_TAC[SUBSET;UNION;UNIONS];
45283   TYPE_THEN `u` UNABBREV_TAC;
45284   TYPE_THEN `!i'. (i' = i) \/ (i' = b T) \/ (i' = b F)` SUBAGOAL_TAC;
45285   TYPE_THEN`i'' = i` ASM_CASES_TAC;
45286   UND 15 THEN DISCH_THEN (  THM_INTRO_TAC[`i''`]);
45287   ASM_MESON_TAC[];
45288   TYPE_THEN `e = T` ASM_CASES_TAC;
45289   MESON_TAC[];
45290   MESON_TAC[];
45291   COPY 16;
45292   TSPEC `i'` 16;
45293   TSPEC `j` 22;
45294   JOIN 16 22 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
45295   UND 16 THEN REP_CASES_TAC THEN REWR 5 ;
45296   TYPE_THEN `j` UNABBREV_TAC;
45297   TYPE_THEN `i'` UNABBREV_TAC;
45298   ASM_MESON_TAC[];
45299   TYPE_THEN `j` UNABBREV_TAC;
45300   TYPE_THEN `i'` UNABBREV_TAC;
45301   ASM_MESON_TAC[];
45302   TYPE_THEN `j` UNABBREV_TAC;
45303   TYPE_THEN `i'` UNABBREV_TAC;
45304   ASM_MESON_TAC[];
45305   (* -G *)
45306   SUBCONJ_TAC;
45307   TYPE_THEN `A` UNABBREV_TAC;
45308   REWRITE_TAC[cls_union];
45309   REWRITE_TAC[UNION_OVER_INTER];
45310   ONCE_REWRITE_TAC[INTER_COMM];
45311   REWRITE_TAC[UNION_OVER_INTER];
45312   REWRITE_TAC[union_subset];
45313   USE 2(REWRITE_RULE[segment_end]);
45314   USE 0 (REWRITE_RULE[PAIR_SPLIT]);
45315   ASM_SIMP_TAC[];
45316   REWRITE_TAC[INTER;SUBSET;INR in_pair];
45317   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
45318   ONCE_REWRITE_TAC[eq_exchange];
45319   ASM_REWRITE_TAC[];
45320   (* -H *)
45321   KILL 21;
45322   KILL 20;
45323   KILL 17;
45324   KILL 19;
45325   KILL 18;
45326   TYPE_THEN `!eps. segment_end (A eps) (uA i) (uB i)` SUBAGOAL_TAC;
45327   TYPE_THEN `A` UNABBREV_TAC;
45328   THM_INTRO_TAC[`f (b (~eps),i)`;`f (b (~eps),b eps)`;`uB i`;`uA(b (~eps))`;`uB(b eps)`] segment_end_union;
45329   CONJ_TAC;
45330   ONCE_REWRITE_TAC[segment_end_symm];
45331   TSPEC `(b (~eps),i)` 2;
45332   REWR 2;
45333   CONJ_TAC;
45334   TSPEC `(b (~eps),b eps)` 2;
45335   REWR 2;
45336   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`(b (~eps),i)`;`(b (~eps),b eps)`]);
45337   USE 0(REWRITE_RULE[PAIR_SPLIT]);
45338   ASM_MESON_TAC[];
45339   USE 2(REWRITE_RULE[segment_end]);
45340   IMATCH_MP_TAC  EQ_EXT;
45341   REWRITE_TAC[INTER;INR in_pair;INR IN_SING;];
45342   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
45343   ONCE_REWRITE_TAC[eq_exchange];
45344   ASM_REWRITE_TAC[];
45345   (* -- *)
45346   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;
45347   CONJ_TAC;
45348   TSPEC `(i,b eps)` 2;
45349   REWR 2;
45350   CONJ_TAC;
45351   ONCE_REWRITE_TAC[segment_end_symm];
45352   REWRITE_TAC[cls_union];
45353   COPY 0;
45354   UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,b eps)`;`b (~eps),i`]);
45355   USE 0 (REWRITE_RULE[PAIR_SPLIT]);
45356   ASM_MESON_TAC[];
45357   ASM_REWRITE_TAC[];
45358   REWRITE_TAC[UNION_OVER_INTER];
45359   UND 17 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,b eps)`;`b (~eps),(b eps)`]);
45360   USE 17 (REWRITE_RULE[PAIR_SPLIT]);
45361   ASM_MESON_TAC[];
45362   USE 2(REWRITE_RULE[segment_end]);
45363   IMATCH_MP_TAC  EQ_EXT;
45364   REWRITE_TAC[INTER;UNION;INR in_pair;INR IN_SING;];
45365   REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
45366   ONCE_REWRITE_TAC[eq_exchange];
45367   ASM_REWRITE_TAC[];
45368   FULL_REWRITE_TAC[UNION_COMM];
45369   (* - *)
45370   USE 17(REWRITE_RULE[segment_end]);
45371   USE 2 (REWRITE_RULE[segment_end]);
45372   ]);;
45373   (* }}} *)
45374
45375 (* --- *)
45376
45377
45378 (* ------------------------------------------------------------------ *)
45379 (* SECTION X *)
45380 (* ------------------------------------------------------------------ *)
45381
45382
45383 (* Continue from SECTION Q.
45384    1.0.2 Rational approximation.  *)
45385
45386 (* work out homeo on graph_support_set properties *)
45387 (* apply h_translate (-- &1) o r_scale (&1/z) *)
45388
45389
45390 (* Let's go back and do it in a symmetric way for both cases. *)
45391
45392 let eps_translate_def = jordan_def `eps_translate eps  =
45393   if eps then h_translate else v_translate`;;
45394
45395 let eps_translate = prove_by_refinement(
45396   `!eps r. eps_translate eps r = if eps then h_translate r else
45397      v_translate r`,
45398   (* {{{ proof *)
45399   [
45400   REWRITE_TAC[eps_translate_def];
45401   COND_CASES_TAC;
45402   ]);;
45403   (* }}} *)
45404
45405 let homeomorphism_eps_translate = prove_by_refinement(
45406   `!eps r. homeomorphism (eps_translate eps r) top2 top2`,
45407   (* {{{ proof *)
45408   [
45409   REP_BASIC_TAC;
45410   REWRITE_TAC[eps_translate];
45411   COND_CASES_TAC THEN REWRITE_TAC[h_translate_hom;v_translate_hom];
45412   ]);;
45413   (* }}} *)
45414
45415 let eps_hyper = jordan_def `eps_hyper eps z =
45416   if eps then hyperplane 2 e1 z else hyperplane 2 e2 z`;;
45417
45418 let eps_hyper_translate = prove_by_refinement(
45419   `!eps r z. IMAGE (eps_translate eps r) (eps_hyper eps z) =
45420          (eps_hyper eps (z + r)) `,
45421   (* {{{ proof *)
45422   [
45423   REP_BASIC_TAC;
45424   REWRITE_TAC[eps_translate;eps_hyper];
45425   COND_CASES_TAC THEN REWRITE_TAC[hyperplane1_h_translate;hyperplane2_v_translate];
45426   ]);;
45427   (* }}} *)
45428
45429 let eps_hyper_translate_perp = prove_by_refinement(
45430   `!eps r z. IMAGE (eps_translate eps r) (eps_hyper (~eps) z) =
45431          (eps_hyper (~eps) z) `,
45432   (* {{{ proof *)
45433   [
45434   REP_BASIC_TAC;
45435   REWRITE_TAC[eps_translate;eps_hyper];
45436   COND_CASES_TAC THEN REWRITE_TAC[hyperplane2_h_translate;hyperplane1_v_translate];
45437   ]);;
45438   (* }}} *)
45439
45440 let eps_scale = jordan_def `eps_scale eps r =
45441   if eps then r_scale r else u_scale r`;;
45442
45443 let eps_hyper_scale_perp = prove_by_refinement(
45444   `!eps r z. (&0 < r) ==>
45445          (IMAGE (eps_scale eps r) (eps_hyper (~eps) z) =
45446             (eps_hyper (~eps) z)) `,
45447   (* {{{ proof *)
45448   [
45449   REWRITE_TAC[eps_scale;eps_hyper];
45450   COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane1_u_scale;hyperplane2_r_scale];
45451   ]);;
45452   (* }}} *)
45453
45454 let eps_hyper_scale = prove_by_refinement(
45455   `!eps r z. (&0 < r) ==>
45456          (IMAGE (eps_scale eps r) (eps_hyper (eps) z) =
45457             (eps_hyper (eps) (if (&0 < z) then r*z else z))) `,
45458   (* {{{ proof *)
45459   [
45460   REWRITE_TAC[eps_scale;eps_hyper];
45461   COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane2_u_scale;hyperplane1_r_scale];
45462   ]);;
45463   (* }}} *)
45464
45465 let homeomorphism_eps_scale = prove_by_refinement(
45466   `!eps r. (&0 < r) ==> homeomorphism (eps_scale eps r) top2 top2`,
45467   (* {{{ proof *)
45468   [
45469   REWRITE_TAC[eps_scale];
45470   COND_CASES_TAC THEN ASM_SIMP_TAC [u_scale_hom;r_scale_hom];
45471   ]);;
45472   (* }}} *)
45473
45474 let graph_support_eps = jordan_def `graph_support_eps G E <=>
45475   good_plane_graph G /\  FINITE E /\
45476   (!e. (graph_edge G e ==> e SUBSET UNIONS E)) /\
45477   (!v. (graph_vertex G v ==>
45478          E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\
45479   (!e. (E e ==> (?z eps. (e = eps_hyper eps z)))) /\
45480   (!z eps. (z <= &0 /\ E (eps_hyper eps z) ==> (?j. z = -- &j)))`;;
45481
45482 let iso_support_eps_pair = jordan_def
45483  `iso_support_eps_pair (G:(A,B)graph_t) =
45484   { (H,E) | (graph_isomorphic G H) /\  graph_support_eps H E }`;;
45485
45486 let eps_hyper_ne = prove_by_refinement(
45487   `!z z' eps. ~(eps_hyper eps z = eps_hyper (~eps) z')`,
45488   (* {{{ proof *)
45489   [
45490   REWRITE_TAC[eps_hyper];
45491   UND 0 THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[hyperplane_ne;GSYM hyperplane_ne] ;
45492   ASM_MESON_TAC[];
45493   ]);;
45494   (* }}} *)
45495
45496 let eps_hyper_inj = prove_by_refinement(
45497   `!z z' eps eps'. (eps_hyper eps z = eps_hyper eps' z') <=>
45498      ((eps = eps') /\ (z = z'))`,
45499   (* {{{ proof *)
45500   [
45501   REP_BASIC_TAC;
45502   TYPE_THEN`eps' = ~eps` ASM_CASES_TAC;
45503   TYPE_THEN `eps'` UNABBREV_TAC;
45504   REWRITE_TAC [eps_hyper_ne];
45505   ASM_MESON_TAC[];
45506   TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
45507   ASM_MESON_TAC[];
45508   TYPE_THEN `eps'` UNABBREV_TAC;
45509   REWRITE_TAC[eps_hyper];
45510   COND_CASES_TAC THEN IMATCH_MP_TAC  EQ_ANTISYM THEN CONJ_TAC;
45511   IMATCH_MP_TAC  hyperplane1_inj;
45512   IMATCH_MP_TAC  hyperplane2_inj;
45513   ]);;
45514   (* }}} *)
45515
45516 let iso_support_eps_nonempty = prove_by_refinement(
45517   `!(G:(A,B)graph_t). (planar_graph G) /\
45518          FINITE (graph_edge G) /\
45519          FINITE (graph_vertex G) /\
45520          ~(graph_edge G = {}) /\
45521          (!v. CARD (graph_edge_around G v) <=| 4) ==>
45522      ~(iso_support_eps_pair G = EMPTY) `,
45523   (* {{{ proof *)
45524   [
45525   REWRITE_TAC[iso_support_eps_pair];
45526   TH_INTRO_TAC [`G`] graph_support_init;
45527   UND 0 THEN REWRITE_TAC[EMPTY_EXISTS];
45528   CONV_TAC (dropq_conv "u");
45529   REWRITE_TAC[graph_support_eps];
45530   UNIFY_EXISTS_TAC;
45531   (* - *)
45532   CONJ_TAC;
45533   REWRITE_TAC[eps_hyper];
45534   (* - *)
45535   TYPE_THEN `(!e. E e ==> (?z eps. (&0 < z) /\ (e = eps_hyper eps z)))` SUBAGOAL_TAC;
45536   UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
45537   FIRST_ASSUM DISJ_CASES_TAC  ;
45538   TYPE_THEN`z` EXISTS_TAC;
45539   TYPE_THEN `T` EXISTS_TAC;
45540   REWRITE_TAC[eps_hyper];
45541   TYPE_THEN`z` EXISTS_TAC;
45542   TYPE_THEN `F` EXISTS_TAC;
45543   REWRITE_TAC[eps_hyper];
45544   (* - *)
45545   CONJ_TAC;
45546   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
45547   MESON_TAC[];
45548   (* - *)
45549   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`eps_hyper eps z`]);
45550   FULL_REWRITE_TAC[eps_hyper_inj];
45551   TYPE_THEN `z'` UNABBREV_TAC;
45552   PROOF_BY_CONTR_TAC;
45553   UND 14 THEN UND 13 THEN REAL_ARITH_TAC;
45554   ]);;
45555   (* }}} *)
45556
45557 let count_iso_eps_pair = jordan_def
45558   `count_iso_eps_pair ((H:(A,B)graph_t),E) =
45559    CARD { e | (?z eps. (&0 < z) /\ E e /\  (e  = eps_hyper eps z)) }`;;
45560
45561 let iso_support_eps_finite = prove_by_refinement(
45562   `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) ==> FINITE
45563    { e | (?z eps. (&0 < z) /\ E e /\  (e  = eps_hyper eps z)) }`,
45564   (* {{{ proof *)
45565   [
45566   REWRITE_TAC[iso_support_eps_pair ;PAIR_SPLIT; graph_support_eps;];
45567   TYPE_THEN `E'` UNABBREV_TAC;
45568   IMATCH_MP_TAC  FINITE_SUBSET;
45569   TYPE_THEN `E` EXISTS_TAC;
45570   REWRITE_TAC[SUBSET];
45571   ]);;
45572   (* }}} *)
45573
45574 let iso_eps_support0 = prove_by_refinement(
45575   `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\
45576    (count_iso_eps_pair (H,E) = 0) ==>
45577   good_plane_graph H /\  FINITE E /\
45578   (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
45579   (!v. (graph_vertex H v ==>
45580          E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\
45581   (!e. (E e ==> (?z eps. (e = eps_hyper eps z) ))) /\
45582   (!z eps. (E (eps_hyper eps z) ==> (?j. z = -- &j)))
45583     `,
45584   (* {{{ proof *)
45585   [
45586   REWRITE_TAC[count_iso_eps_pair;];
45587   TYPE_THEN `A = { e | (?z eps. (&0 < z) /\ E e /\  (e  =  eps_hyper eps z)) }` ABBREV_TAC ;
45588   TYPE_THEN `A HAS_SIZE 0` SUBAGOAL_TAC;
45589   REWRITE_TAC[HAS_SIZE];
45590   TYPE_THEN `A` UNABBREV_TAC;
45591   TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite;
45592   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;graph_support_eps;iso_support_eps_pair]);
45593   TYPE_THEN `E'` UNABBREV_TAC;
45594   TYPE_THEN `H'` UNABBREV_TAC;
45595   FIRST_ASSUM IMATCH_MP_TAC ;
45596   TYPE_THEN`eps` EXISTS_TAC;
45597   FULL_REWRITE_TAC[HAS_SIZE_0];
45598   TYPE_THEN `A` UNABBREV_TAC;
45599   PROOF_BY_CONTR_TAC;
45600   USE 2 (MATCH_MP (REAL_ARITH `~( z <= &0) ==> (&0 < z)`));
45601   UND 3 THEN REWRITE_TAC[EMPTY_EXISTS];
45602   CONV_TAC (dropq_conv "u");
45603   UNIFY_EXISTS_TAC;
45604   ]);;
45605   (* }}} *)
45606
45607 let iso_support_eps_min = prove_by_refinement(
45608   `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\
45609     (0 < count_iso_eps_pair (H,E)) ==>
45610     (?z eps. (&0 < z) /\ E (eps_hyper eps z) /\
45611       (!w. (&0 < w /\ w < z) ==> ~(E (eps_hyper eps w))))`,
45612   (* {{{ proof *)
45613   [
45614   REWRITE_TAC[count_iso_eps_pair];
45615   TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ;
45616   TYPE_THEN `FINITE A` SUBAGOAL_TAC;
45617   TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite;
45618   TYPE_THEN `A` UNABBREV_TAC;
45619   TYPE_THEN `~(A HAS_SIZE 0) ` SUBAGOAL_TAC;
45620   RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
45621   UND 4 THEN UND 0 THEN ARITH_TAC;
45622   RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE_0;EMPTY_EXISTS]);
45623   TYPE_THEN `?r eps. (u = eps_hyper eps r)` SUBAGOAL_TAC;
45624   TYPE_THEN `A` UNABBREV_TAC;
45625   MESON_TAC[];
45626   TYPE_THEN `u` UNABBREV_TAC;
45627   (* - *)
45628   TH_INTRO_TAC[`{z | &0 < z}`;`eps_hyper eps`;`{e | ?z. (&0 < z) /\ E e /\ (e = eps_hyper eps z)}`] finite_subset;
45629   REWRITE_TAC[SUBSET;IMAGE];
45630   CONJ_TAC;
45631   TYPE_THEN `z` EXISTS_TAC;
45632   ASM_REWRITE_TAC[];
45633   IMATCH_MP_TAC  FINITE_SUBSET;
45634   TYPE_THEN `A` EXISTS_TAC;
45635   TYPE_THEN `A` UNABBREV_TAC;
45636   REWRITE_TAC[SUBSET];
45637   ASM_MESON_TAC[];
45638   (* - *)
45639   TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
45640   TYPE_THEN `C` UNABBREV_TAC;
45641   RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]);
45642   UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
45643   TYPE_THEN `A` UNABBREV_TAC;
45644   UNIFY_EXISTS_TAC;
45645   FULL_REWRITE_TAC[eps_hyper_inj];
45646   TYPE_THEN `inf C` EXISTS_TAC;
45647   (* - *)
45648   TYPE_THEN `C (inf C)` SUBAGOAL_TAC;
45649   IMATCH_MP_TAC  finite_inf;
45650   (* - *)
45651   TYPE_THEN `(!z. C z ==> inf C <= z)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  finite_inf_min;ALL_TAC ];
45652   TYPE_THEN `z = inf C` ABBREV_TAC ;
45653   KILL 11;
45654   KILL 8;
45655   (* - *)
45656   TYPE_THEN `eps` EXISTS_TAC;
45657   USE 5(REWRITE_RULE[IMAGE]);
45658   USE 5(ONCE_REWRITE_RULE[FUN_EQ_THM]);
45659   COPY 5;
45660   TSPEC `eps_hyper eps z` 5;
45661   USE 5(REWRITE_RULE[INR IN_SING]);
45662   USE 5(MATCH_MP (TAUT `(a <=> b) ==> (b ==> a)`));
45663   UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]);
45664   UNIFY_EXISTS_TAC;
45665   ASM_REWRITE_TAC[];
45666   FULL_REWRITE_TAC[eps_hyper_inj];
45667   TYPE_THEN `z'` UNABBREV_TAC;
45668   REP_BASIC_TAC;
45669   (* - *)
45670   TSPEC `eps_hyper eps w` 8;
45671   USE 8(MATCH_MP (TAUT `(a <=> b) ==> (a ==> b)`));
45672   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
45673   TYPE_THEN `w` EXISTS_TAC;
45674   ASM_REWRITE_TAC[];
45675   FULL_REWRITE_TAC[eps_hyper_inj];
45676   TYPE_THEN `x` UNABBREV_TAC;
45677   UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`w`]);
45678   UND 8 THEN UND 13 THEN REAL_ARITH_TAC;
45679   ]);;
45680   (* }}} *)
45681
45682 let graph_eps_scale_image = prove_by_refinement(
45683   `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps
45684        (plane_graph_image (eps_scale eps r)G)
45685        (IMAGE2 (eps_scale eps r) E)
45686           `,
45687   (* {{{ proof *)
45688   [
45689   REWRITE_TAC[graph_support_eps];
45690   THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale;
45691   SUBCONJ_TAC;
45692   IMATCH_MP_TAC  plane_graph_image_plane;
45693   (* - *)
45694   REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
45695   SUBCONJ_TAC;
45696   REWRITE_TAC[IMAGE2];
45697   IMATCH_MP_TAC  FINITE_IMAGE;
45698   (* - *)
45699   SUBCONJ_TAC;
45700   FULL_REWRITE_TAC[IMAGE2];
45701   TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45702   USE 10 (REWRITE_RULE[IMAGE]);
45703   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45704   FULL_REWRITE_TAC [SUBSET;UNIONS];
45705   REWRITE_TAC[IMAGE];
45706   CONV_TAC (dropq_conv "u");
45707   TYPE_THEN `im` UNABBREV_TAC;
45708   USE 3(CONV_RULE NAME_CONFLICT_CONV);
45709   USE 13 (REWRITE_RULE[IMAGE]);
45710   TYPE_THEN `x'` UNABBREV_TAC;
45711   TSPEC `x''` 3;
45712   REP_BASIC_TAC;
45713   TYPE_THEN `u'` EXISTS_TAC;
45714   REWRITE_TAC[IMAGE];
45715   UNIFY_EXISTS_TAC;
45716   ASM_REWRITE_TAC[];
45717   (* -A *)
45718   SUBCONJ_TAC;
45719   FULL_REWRITE_TAC[IMAGE2];
45720   TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45721   REWRITE_TAC[IMAGE];
45722   TYPE_THEN `im` UNABBREV_TAC;
45723   USE 11(REWRITE_RULE[IMAGE]);
45724   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45725   CONJ_TAC;
45726   UNIFY_EXISTS_TAC;
45727   (* ? *)
45728   TYPE_THEN `eps = T` ASM_CASES_TAC;
45729   ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
45730   REWRITE_TAC[eps_scale;r_scale];
45731   COND_CASES_TAC;
45732   TYPE_THEN `eps = F` SUBAGOAL_TAC;
45733   ASM_MESON_TAC[];
45734   TYPE_THEN `eps` UNABBREV_TAC;
45735   THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp;
45736   AP_TERM_TAC;
45737   REWRITE_TAC[eps_scale;u_scale];
45738   COND_CASES_TAC;
45739   (* -- *)
45740   TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
45741   TYPE_THEN `eps = F` ASM_CASES_TAC;
45742   ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
45743   REWRITE_TAC[eps_scale;u_scale];
45744   COND_CASES_TAC;
45745   TYPE_THEN `eps = T` SUBAGOAL_TAC;
45746   ASM_MESON_TAC[];
45747   TYPE_THEN `eps` UNABBREV_TAC;
45748   THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp;
45749   AP_TERM_TAC;
45750   REWRITE_TAC[eps_scale;r_scale];
45751   COND_CASES_TAC;
45752   (* -B *)
45753   CONJ_TAC;
45754   USE 12(REWRITE_RULE[IMAGE2]);
45755   TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45756   USE 12(REWRITE_RULE[IMAGE]);
45757   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45758   TYPE_THEN `im` UNABBREV_TAC;
45759   LEFT_TAC  "eps''";
45760   TYPE_THEN `eps'` EXISTS_TAC;
45761   TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
45762   ASM_SIMP_TAC [eps_hyper_scale_perp];
45763   MESON_TAC[];
45764   TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
45765   UND 13 THEN MESON_TAC[];
45766   ASM_SIMP_TAC[eps_hyper_scale];
45767   MESON_TAC[];
45768   (* - *)
45769   FIRST_ASSUM IMATCH_MP_TAC ;
45770   TYPE_THEN `eps'` EXISTS_TAC;
45771   FULL_REWRITE_TAC[IMAGE2];
45772   TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45773   USE 12 (REWRITE_RULE[IMAGE]);
45774   TYPE_THEN `im` UNABBREV_TAC;
45775   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45776   REWR 12;
45777   TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
45778   UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp];
45779   TYPE_THEN `x` UNABBREV_TAC;
45780   TYPE_THEN `eps''` UNABBREV_TAC;
45781   TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
45782   UND 14 THEN MESON_TAC[];
45783   TYPE_THEN `eps''` UNABBREV_TAC;
45784   UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale];
45785   FULL_REWRITE_TAC[eps_hyper_inj];
45786   UND 12 THEN COND_CASES_TAC;
45787   TYPE_THEN `z` UNABBREV_TAC;
45788   TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC;
45789   IMATCH_MP_TAC  REAL_LT_MUL;
45790   PROOF_BY_CONTR_TAC;
45791   UND 12 THEN UND 13 THEN REAL_ARITH_TAC;
45792   TYPE_THEN `z'` UNABBREV_TAC;
45793   TYPE_THEN `x` UNABBREV_TAC;
45794   ]);;
45795   (* }}} *)
45796
45797 let graph_eps_scale_image = prove_by_refinement(
45798   `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps
45799        (plane_graph_image (eps_scale eps r)G)
45800        (IMAGE2 (eps_scale eps r) E)
45801           `,
45802   (* {{{ proof *)
45803   [
45804   REWRITE_TAC[graph_support_eps];
45805   THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale;
45806   SUBCONJ_TAC;
45807   IMATCH_MP_TAC  plane_graph_image_plane;
45808   (* - *)
45809   REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
45810   SUBCONJ_TAC;
45811   REWRITE_TAC[IMAGE2];
45812   IMATCH_MP_TAC  FINITE_IMAGE;
45813   (* - *)
45814   SUBCONJ_TAC;
45815   FULL_REWRITE_TAC[IMAGE2];
45816   TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45817   USE 10 (REWRITE_RULE[IMAGE]);
45818   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45819   FULL_REWRITE_TAC [SUBSET;UNIONS];
45820   REWRITE_TAC[IMAGE];
45821   CONV_TAC (dropq_conv "u");
45822   TYPE_THEN `im` UNABBREV_TAC;
45823   USE 3(CONV_RULE NAME_CONFLICT_CONV);
45824   USE 13 (REWRITE_RULE[IMAGE]);
45825   TYPE_THEN `x'` UNABBREV_TAC;
45826   TSPEC `x''` 3;
45827   REP_BASIC_TAC;
45828   TYPE_THEN `u'` EXISTS_TAC;
45829   REWRITE_TAC[IMAGE];
45830   UNIFY_EXISTS_TAC;
45831   ASM_REWRITE_TAC[];
45832   (* -A *)
45833   SUBCONJ_TAC;
45834   FULL_REWRITE_TAC[IMAGE2];
45835   TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45836   REWRITE_TAC[IMAGE];
45837   TYPE_THEN `im` UNABBREV_TAC;
45838   USE 11(REWRITE_RULE[IMAGE]);
45839   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45840   CONJ_TAC;
45841   UNIFY_EXISTS_TAC;
45842   (* ? *)
45843   TYPE_THEN `eps = T` ASM_CASES_TAC;
45844   ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
45845   REWRITE_TAC[eps_scale;r_scale];
45846   COND_CASES_TAC;
45847   TYPE_THEN `eps = F` SUBAGOAL_TAC;
45848   ASM_MESON_TAC[];
45849   TYPE_THEN `eps` UNABBREV_TAC;
45850   THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp;
45851   AP_TERM_TAC;
45852   REWRITE_TAC[eps_scale;u_scale];
45853   COND_CASES_TAC;
45854   (* -- *)
45855   TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
45856   TYPE_THEN `eps = F` ASM_CASES_TAC;
45857   ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
45858   REWRITE_TAC[eps_scale;u_scale];
45859   COND_CASES_TAC;
45860   TYPE_THEN `eps = T` SUBAGOAL_TAC;
45861   ASM_MESON_TAC[];
45862   TYPE_THEN `eps` UNABBREV_TAC;
45863   THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp;
45864   AP_TERM_TAC;
45865   REWRITE_TAC[eps_scale;r_scale];
45866   COND_CASES_TAC;
45867   (* -B *)
45868   CONJ_TAC;
45869   USE 12(REWRITE_RULE[IMAGE2]);
45870   TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45871   USE 12(REWRITE_RULE[IMAGE]);
45872   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45873   TYPE_THEN `im` UNABBREV_TAC;
45874   LEFT_TAC  "eps''";
45875   TYPE_THEN `eps'` EXISTS_TAC;
45876   TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
45877   ASM_SIMP_TAC [eps_hyper_scale_perp];
45878   MESON_TAC[];
45879   TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
45880   UND 13 THEN MESON_TAC[];
45881   ASM_SIMP_TAC[eps_hyper_scale];
45882   MESON_TAC[];
45883   (* - *)
45884   FIRST_ASSUM IMATCH_MP_TAC ;
45885   TYPE_THEN `eps'` EXISTS_TAC;
45886   FULL_REWRITE_TAC[IMAGE2];
45887   TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
45888   USE 12 (REWRITE_RULE[IMAGE]);
45889   TYPE_THEN `im` UNABBREV_TAC;
45890   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45891   REWR 12;
45892   TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
45893   UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp];
45894   TYPE_THEN `x` UNABBREV_TAC;
45895   TYPE_THEN `eps''` UNABBREV_TAC;
45896   TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
45897   UND 14 THEN MESON_TAC[];
45898   TYPE_THEN `eps''` UNABBREV_TAC;
45899   UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale];
45900   FULL_REWRITE_TAC[eps_hyper_inj];
45901   UND 12 THEN COND_CASES_TAC;
45902   TYPE_THEN `z` UNABBREV_TAC;
45903   TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC;
45904   IMATCH_MP_TAC  REAL_LT_MUL;
45905   PROOF_BY_CONTR_TAC;
45906   UND 12 THEN UND 13 THEN REAL_ARITH_TAC;
45907   TYPE_THEN `z'` UNABBREV_TAC;
45908   TYPE_THEN `x` UNABBREV_TAC;
45909   ]);;
45910   (* }}} *)
45911
45912 let graph_eps_translate_image = prove_by_refinement(
45913   `!G E eps r.  (?j.  -- &j = r) /\
45914       (!w. (&0 < w /\ w < -- r) ==> ~(E (eps_hyper eps w)))  /\
45915        graph_support_eps G E ==>
45916        graph_support_eps
45917        (plane_graph_image (eps_translate eps r)G)
45918        (IMAGE2 (eps_translate eps r) E)
45919           `,
45920   (* {{{ proof *)
45921   [
45922   REWRITE_TAC[graph_support_eps];
45923   THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_translate;
45924   SUBCONJ_TAC;
45925   IMATCH_MP_TAC  plane_graph_image_plane;
45926   (* - *)
45927   REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
45928   SUBCONJ_TAC;
45929   REWRITE_TAC[IMAGE2];
45930   IMATCH_MP_TAC  FINITE_IMAGE;
45931   (* - *)
45932   SUBCONJ_TAC;
45933   FULL_REWRITE_TAC[IMAGE2];
45934   TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
45935   USE 11 (REWRITE_RULE[IMAGE]);
45936   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45937   FULL_REWRITE_TAC [SUBSET;UNIONS];
45938   REWRITE_TAC[IMAGE];
45939   CONV_TAC (dropq_conv "u");
45940   TYPE_THEN `im` UNABBREV_TAC;
45941   USE 3(CONV_RULE NAME_CONFLICT_CONV);
45942   USE 14 (REWRITE_RULE[IMAGE]);
45943   TYPE_THEN `x'` UNABBREV_TAC;
45944   TSPEC `x''` 3;
45945   REP_BASIC_TAC;
45946   TYPE_THEN `u'` EXISTS_TAC;
45947   REWRITE_TAC[IMAGE];
45948   UNIFY_EXISTS_TAC;
45949   ASM_REWRITE_TAC[];
45950   (* -A *)
45951   SUBCONJ_TAC;
45952   FULL_REWRITE_TAC[IMAGE2];
45953   TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
45954   REWRITE_TAC[IMAGE];
45955   TYPE_THEN `im` UNABBREV_TAC;
45956   USE 12(REWRITE_RULE[IMAGE]);
45957   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45958   CONJ_TAC;
45959   UNIFY_EXISTS_TAC;
45960   (* --- *)
45961   TYPE_THEN `eps = T` ASM_CASES_TAC;
45962   ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj];
45963   REWRITE_TAC[eps_translate;h_translate];
45964   REWRITE_TAC[euclid_plus;e1;point_scale];
45965   REAL_ARITH_TAC;
45966   TYPE_THEN `eps = F` SUBAGOAL_TAC;
45967   ASM_MESON_TAC[];
45968   TYPE_THEN `eps` UNABBREV_TAC;
45969   THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_translate_perp;
45970   FULL_REWRITE_TAC [];
45971   AP_TERM_TAC;
45972   REWRITE_TAC[eps_translate;v_translate];
45973    REWRITE_TAC[euclid_plus;e2;point_scale];
45974   REAL_ARITH_TAC;
45975   (* -- *)
45976   TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
45977   TYPE_THEN `eps = F` ASM_CASES_TAC;
45978   ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj];
45979   REWRITE_TAC[eps_translate;v_translate];
45980    REWRITE_TAC[euclid_plus;e2;point_scale];
45981   REAL_ARITH_TAC;
45982   TYPE_THEN `eps = T` SUBAGOAL_TAC;
45983   ASM_MESON_TAC[];
45984   TYPE_THEN `eps` UNABBREV_TAC;
45985   THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_translate_perp;
45986   FULL_REWRITE_TAC[];
45987   AP_TERM_TAC;
45988   REWRITE_TAC[eps_translate;h_translate];
45989    REWRITE_TAC[euclid_plus;e1;point_scale];
45990   REAL_ARITH_TAC;
45991   (* -B *)
45992   CONJ_TAC;
45993   USE 13(REWRITE_RULE[IMAGE2]);
45994   TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
45995   USE 13(REWRITE_RULE[IMAGE]);
45996   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
45997   TYPE_THEN `im` UNABBREV_TAC;
45998   LEFT_TAC  "eps''";
45999   TYPE_THEN `eps'` EXISTS_TAC;
46000   TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
46001   ASM_SIMP_TAC [eps_hyper_translate_perp];
46002   MESON_TAC[];
46003   TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
46004   UND 14 THEN MESON_TAC[];
46005   ASM_SIMP_TAC[eps_hyper_translate];
46006   MESON_TAC[];
46007   (* -C *)
46008   TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
46009   TYPE_THEN `eps'` UNABBREV_TAC;
46010   FIRST_ASSUM IMATCH_MP_TAC ;
46011   TYPE_THEN `~eps` EXISTS_TAC;
46012   FULL_REWRITE_TAC[IMAGE2];
46013   TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
46014   USE 13 (REWRITE_RULE[IMAGE]);
46015   TYPE_THEN `im` UNABBREV_TAC;
46016   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
46017   REWR 13;
46018   TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
46019   UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp];
46020   TYPE_THEN `x` UNABBREV_TAC;
46021   TYPE_THEN `eps'` UNABBREV_TAC;
46022   TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
46023   UND 15 THEN MESON_TAC[];
46024   TYPE_THEN `eps'` UNABBREV_TAC;
46025   UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate];
46026   FULL_REWRITE_TAC[eps_hyper_inj];
46027   UND 17 THEN MESON_TAC[];
46028   (* -D *)
46029   TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
46030   UND 15 THEN MESON_TAC[];
46031   TYPE_THEN`eps'` UNABBREV_TAC;
46032   TYPE_THEN `E(eps_hyper eps (z + &j))` SUBAGOAL_TAC;
46033   FULL_REWRITE_TAC[IMAGE2];
46034   TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
46035   USE 13 (REWRITE_RULE[IMAGE]);
46036   TYPE_THEN `im` UNABBREV_TAC;
46037   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
46038   REWR 13;
46039   TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
46040   UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp];
46041   FULL_REWRITE_TAC[eps_hyper_inj];
46042   UND 18 THEN MESON_TAC[];
46043   TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
46044   UND 16 THEN MESON_TAC[];
46045   TYPE_THEN `eps''` UNABBREV_TAC;
46046   FULL_REWRITE_TAC[eps_hyper_translate;eps_hyper_inj];
46047   TYPE_THEN `r` UNABBREV_TAC;
46048   TYPE_THEN `x` UNABBREV_TAC;
46049   TYPE_THEN `!a. (z' + (-- a)) + a = z'` SUBAGOAL_TAC;
46050   REAL_ARITH_TAC;
46051   ASM_REWRITE_TAC[];
46052   TYPE_THEN `z = &0` ASM_CASES_TAC;
46053   TYPE_THEN  `0` EXISTS_TAC;
46054   REAL_ARITH_TAC;
46055   UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`z + &j`;`eps`]);
46056   IMATCH_MP_TAC  (REAL_ARITH `~(&0 < z + &j) ==> (z + &j <= &0)`);
46057   UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`z + &j`]);
46058   TYPE_THEN `r` UNABBREV_TAC;
46059   UND 17 THEN UND 14 THEN REAL_ARITH_TAC;
46060   UND 6 THEN REWRITE_TAC[];
46061   TYPE_THEN `j +| j'` EXISTS_TAC;
46062   UND 0 THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
46063   ]);;
46064   (* }}} *)
46065
46066 let count_iso_scale = prove_by_refinement(
46067   `!G E eps r. (&0 < r) /\ graph_support_eps G E ==>
46068      (count_iso_eps_pair (G,E) = count_iso_eps_pair
46069        ((plane_graph_image(eps_scale eps r) G),
46070                 (IMAGE2 (eps_scale eps r) E))) `,
46071   (* {{{ proof *)
46072   [
46073   REWRITE_TAC[count_iso_eps_pair];
46074   THM_INTRO_TAC[`G`;`E`;`eps`;`r`] graph_eps_scale_image;
46075   FULL_REWRITE_TAC[graph_support_eps];
46076   IMATCH_MP_TAC  BIJ_CARD;
46077   TYPE_THEN `IMAGE (eps_scale eps r)` EXISTS_TAC;
46078   CONJ_TAC;
46079   IMATCH_MP_TAC  FINITE_SUBSET ;
46080   TYPE_THEN `E` EXISTS_TAC;
46081   REWRITE_TAC[SUBSET];
46082   (* - *)
46083   FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v];
46084   FULL_REWRITE_TAC[IMAGE2];
46085   TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
46086   (* - *)
46087   REWRITE_TAC[BIJ];
46088   SUBCONJ_TAC;
46089   REWRITE_TAC[INJ];
46090   CONJ_TAC;
46091   TYPE_THEN `if (eps = eps') then r* z else z` EXISTS_TAC;
46092   TYPE_THEN `eps'` EXISTS_TAC;
46093   CONJ_TAC;
46094   COND_CASES_TAC;
46095   IMATCH_MP_TAC  REAL_LT_MUL;
46096   CONJ_TAC;
46097   IMATCH_MP_TAC  image_imp;
46098   TYPE_THEN `x` UNABBREV_TAC;
46099   TYPE_THEN `im` UNABBREV_TAC;
46100   COND_CASES_TAC;
46101   ASM_SIMP_TAC[eps_hyper_scale];
46102   TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
46103   UND 13 THEN MESON_TAC[];
46104   ASM_SIMP_TAC[eps_hyper_scale_perp];
46105   TYPE_THEN `x` UNABBREV_TAC;
46106   TYPE_THEN `y` UNABBREV_TAC;
46107   TYPE_THEN `im` UNABBREV_TAC;
46108   TYPE_THEN `(eps' = eps) \/ (eps' = ~eps)` SUBAGOAL_TAC;
46109   MESON_TAC[];
46110   TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC;
46111   MESON_TAC[];
46112   REWRITE_TAC[eps_hyper_inj];
46113   JOIN 13 15 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR];
46114   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)`];
46115   IMATCH_MP_TAC  REAL_EQ_LCANCEL_IMP;
46116   TYPE_THEN `r` EXISTS_TAC;
46117   UND 1 THEN REAL_ARITH_TAC;
46118   (* - *)
46119   REWRITE_TAC[SURJ];
46120   CONJ_TAC;
46121   FULL_REWRITE_TAC[INJ];
46122   FIRST_ASSUM IMATCH_MP_TAC ;
46123   ASM_MESON_TAC[];
46124   (* - *)
46125   CONV_TAC (dropq_conv "y");
46126   TYPE_THEN `x` UNABBREV_TAC;
46127   LEFT_TAC "eps";
46128   TYPE_THEN `eps'` EXISTS_TAC;
46129   USE 16 (REWRITE_RULE[IMAGE]);
46130   UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
46131   TYPE_THEN `x` UNABBREV_TAC;
46132   TYPE_THEN `z'` EXISTS_TAC;
46133   TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then r*z' else z')` SUBAGOAL_TAC;
46134   TYPE_THEN `im` UNABBREV_TAC;
46135   COND_CASES_TAC;
46136   TYPE_THEN `eps''` UNABBREV_TAC;
46137   UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
46138   COND_CASES_TAC;
46139   REWR 17;
46140   TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
46141   UND 8 THEN MESON_TAC[];
46142   TYPE_THEN `eps''` UNABBREV_TAC;
46143   UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale_perp;eps_hyper_inj];
46144   (* - *)
46145   TYPE_THEN `eps''` UNABBREV_TAC;
46146   REWR 17;
46147   UND 17 THEN COND_CASES_TAC;
46148   THM_INTRO_TAC[`r`;`z'`] REAL_LT_LMUL_0;
46149   USE 19 SYM;
46150   ASM_REWRITE_TAC[];
46151   ]);;
46152   (* }}} *)
46153
46154 let count_iso_translate = prove_by_refinement(
46155   `!G E eps .  graph_support_eps G E /\
46156        (!w. (&0 < w /\ w <  &1) ==> ~(E (eps_hyper eps w))) /\
46157       E (eps_hyper eps (&1))  ==>
46158      (count_iso_eps_pair (G,E) = SUC(count_iso_eps_pair
46159        ((plane_graph_image(eps_translate eps (-- &1)) G),
46160                 (IMAGE2 (eps_translate eps (-- &1)) E)))) `,
46161   (* {{{ proof *)
46162   [
46163   REWRITE_TAC[count_iso_eps_pair];
46164   TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ;
46165   TYPE_THEN `A (eps_hyper eps (&1))` SUBAGOAL_TAC;
46166   TYPE_THEN`A` UNABBREV_TAC;
46167   TYPE_THEN `&1` EXISTS_TAC;
46168   MESON_TAC[];
46169   (* - *)
46170   TYPE_THEN`FINITE A` SUBAGOAL_TAC;
46171   FULL_REWRITE_TAC[graph_support_eps];
46172   IMATCH_MP_TAC  FINITE_SUBSET;
46173   TYPE_THEN `E` EXISTS_TAC;
46174   TYPE_THEN `A` UNABBREV_TAC;
46175   REWRITE_TAC[SUBSET];
46176   (* - *)
46177   THM_INTRO_TAC[`(eps_hyper eps (&1))`;`A`]CARD_SUC_DELETE;
46178   TYPE_THEN `CARD A` UNABBREV_TAC;
46179   REWRITE_TAC[SUC_INJ];
46180   THM_INTRO_TAC[`G`;`E`;`eps`;`-- &1`] graph_eps_translate_image;
46181   CONJ_TAC;
46182   MESON_TAC[];
46183   FULL_REWRITE_TAC[REAL_ARITH `-- -- x = x`];
46184   ASM_MESON_TAC[];
46185   FULL_REWRITE_TAC[graph_support_eps];
46186   (* -A0 *)
46187   IMATCH_MP_TAC  BIJ_CARD;
46188   TYPE_THEN `IMAGE (eps_translate eps (-- &1))` EXISTS_TAC;
46189   CONJ_TAC;
46190   IMATCH_MP_TAC  FINITE_DELETE_IMP;
46191   (* - *)
46192   FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v];
46193   FULL_REWRITE_TAC[IMAGE2];
46194   TYPE_THEN `im = IMAGE (eps_translate eps (-- &1))` ABBREV_TAC ;
46195   (* -A *)
46196   REWRITE_TAC[BIJ];
46197   SUBCONJ_TAC;
46198   REWRITE_TAC[INJ];
46199   CONJ_TAC;
46200   TYPE_THEN `A` UNABBREV_TAC;
46201   FULL_REWRITE_TAC[DELETE];
46202   TYPE_THEN `x` UNABBREV_TAC;
46203   FULL_REWRITE_TAC[eps_hyper_inj];
46204   TYPE_THEN `z` UNABBREV_TAC;
46205   TYPE_THEN `if (eps = eps'') then  z' - &1 else z'` EXISTS_TAC;
46206   TYPE_THEN `eps''` EXISTS_TAC;
46207   TYPE_THEN `eps'` UNABBREV_TAC;
46208   CONJ_TAC;
46209   COND_CASES_TAC;
46210   TYPE_THEN `eps''` UNABBREV_TAC;
46211   IMATCH_MP_TAC  (REAL_ARITH `~((z' = &1) \/ (z' < &1)) ==> (&0 < z' - &1)`);
46212   REWR 3;
46213   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`z'`]);
46214   UND 1 THEN ASM_REWRITE_TAC[];
46215   (* --- *)
46216   CONJ_TAC;
46217   IMATCH_MP_TAC  image_imp;
46218   TYPE_THEN `im` UNABBREV_TAC;
46219   COND_CASES_TAC;
46220   ASM_SIMP_TAC[eps_hyper_translate];
46221   AP_TERM_TAC;
46222   REAL_ARITH_TAC;
46223   TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
46224   UND 3 THEN MESON_TAC[];
46225   ASM_SIMP_TAC[eps_hyper_translate_perp];
46226   TYPE_THEN `A` UNABBREV_TAC;
46227   FULL_REWRITE_TAC[DELETE];
46228   TYPE_THEN `x` UNABBREV_TAC;  (* -// *)
46229   TYPE_THEN `y` UNABBREV_TAC;
46230   TYPE_THEN `im` UNABBREV_TAC;
46231   TYPE_THEN `(eps''' = eps) \/ (eps''' = ~eps)` SUBAGOAL_TAC;
46232   MESON_TAC[];
46233   TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC;
46234   MESON_TAC[];
46235   REWRITE_TAC[eps_hyper_inj];
46236   JOIN 17 20 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR];
46237   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)`];
46238   UND 17 THEN REAL_ARITH_TAC;
46239   (* -B *)
46240   REWRITE_TAC[SURJ];
46241   FULL_REWRITE_TAC[INJ];
46242   (* - *)
46243   REP_BASIC_TAC;
46244   TYPE_THEN `x` UNABBREV_TAC;
46245   TYPE_THEN `A` UNABBREV_TAC;
46246   REWRITE_TAC[DELETE];
46247   CONV_TAC (dropq_conv "y");  (* -// *)
46248   LEFT_TAC "eps";
46249   TYPE_THEN `eps'` EXISTS_TAC;
46250   KILL 18;
46251   KILL 19;
46252   FULL_REWRITE_TAC[eps_hyper_inj];
46253   TYPE_THEN `z'` UNABBREV_TAC;
46254   TYPE_THEN `eps''` UNABBREV_TAC;
46255   (* - *)
46256   USE 21 (REWRITE_RULE[IMAGE]);
46257   UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
46258   TYPE_THEN `x` UNABBREV_TAC;
46259   TYPE_THEN `z''` EXISTS_TAC;
46260   TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then z'' - &1  else z'')` SUBAGOAL_TAC;
46261   TYPE_THEN `im` UNABBREV_TAC;
46262   COND_CASES_TAC;
46263   TYPE_THEN `eps''` UNABBREV_TAC;
46264   USE 3 (REWRITE_RULE  [eps_hyper_translate;eps_hyper_inj]);
46265   REAL_ARITH_TAC;
46266   TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
46267   UND 12 THEN MESON_TAC[];
46268   TYPE_THEN `eps''` UNABBREV_TAC;
46269   USE 3 (REWRITE_RULE[   eps_hyper_translate_perp;eps_hyper_inj]);
46270   (* - *)
46271   TYPE_THEN `eps''` UNABBREV_TAC;
46272   TYPE_THEN `z` UNABBREV_TAC;
46273   CONJ_TAC;
46274   UND 22 THEN COND_CASES_TAC;
46275   UND 12 THEN REAL_ARITH_TAC;
46276   TYPE_THEN `z''` UNABBREV_TAC;
46277   TYPE_THEN `eps'` UNABBREV_TAC;
46278   UND 22 THEN REAL_ARITH_TAC;
46279   ]);;
46280   (* }}} *)
46281
46282 let iso_support_min_int = prove_by_refinement(
46283   `!G:(A,B)graph_t H E. iso_support_eps_pair G (H,E) /\
46284     (0 <| count_iso_eps_pair (H,E)) ==>
46285     (?H' E'. iso_support_eps_pair G (H',E') /\
46286        (count_iso_eps_pair(H',E') = count_iso_eps_pair(H,E)) /\
46287        (?eps. E' (eps_hyper eps (&1)) /\
46288          (!w. (&0 < w /\ w < &1) ==> ~(E'(eps_hyper eps w)))))`,
46289   (* {{{ proof *)
46290   [
46291   REP_BASIC_TAC;
46292   THM_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_min;
46293   TYPE_THEN `z' = &1/z` ABBREV_TAC ;
46294   TYPE_THEN `H' = plane_graph_image (eps_scale eps z') H` ABBREV_TAC ;
46295   TYPE_THEN `E' = IMAGE2 (eps_scale eps z') E` ABBREV_TAC ;
46296   TYPE_THEN `H'` EXISTS_TAC;
46297   TYPE_THEN `E'` EXISTS_TAC;
46298   (* - *)
46299   TYPE_THEN `&0 < z'` SUBAGOAL_TAC;
46300   TYPE_THEN `z'` UNABBREV_TAC;
46301   (* - *)
46302   TYPE_THEN `z' * z = &1` SUBAGOAL_TAC;
46303   TYPE_THEN `z'` UNABBREV_TAC;
46304   IMATCH_MP_TAC  REAL_DIV_RMUL;
46305   UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
46306   (* - *)
46307   SUBCONJ_TAC;
46308   FULL_REWRITE_TAC[iso_support_eps_pair];
46309   FULL_REWRITE_TAC[PAIR_SPLIT];
46310   TYPE_THEN `E''` UNABBREV_TAC;
46311   TYPE_THEN `H''` UNABBREV_TAC;
46312   TYPE_THEN `H'` EXISTS_TAC;
46313   TYPE_THEN `E'` EXISTS_TAC;
46314   TYPE_THEN `H'` UNABBREV_TAC;
46315   TYPE_THEN `E'` UNABBREV_TAC;
46316   CONJ_TAC;
46317   THM_INTRO_TAC[`eps_scale eps z'`;`H`] plane_graph_image_iso;
46318   ASM_SIMP_TAC [homeomorphism_eps_scale];
46319   FULL_REWRITE_TAC[graph_support_eps;good_plane_graph];
46320   THM_INTRO_TAC[`G`;`H`;`(plane_graph_image (eps_scale eps z') H)`] graph_isomorphic_trans;
46321   IMATCH_MP_TAC  graph_eps_scale_image;
46322   (* - *)
46323   SUBCONJ_TAC;
46324   ONCE_REWRITE_TAC[EQ_SYM_EQ];
46325   TYPE_THEN `E'` UNABBREV_TAC;
46326   TYPE_THEN `H'` UNABBREV_TAC;
46327   IMATCH_MP_TAC  count_iso_scale;
46328   FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
46329   ASM_MESON_TAC[];
46330   TYPE_THEN `eps` EXISTS_TAC;
46331   TYPE_THEN `E'` UNABBREV_TAC;
46332   (* - *)
46333   SUBCONJ_TAC;
46334   REWRITE_TAC[IMAGE2];
46335   TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ;
46336   REWRITE_TAC[IMAGE];
46337   TYPE_THEN `eps_hyper eps z` EXISTS_TAC;
46338   TYPE_THEN `im` UNABBREV_TAC;
46339   ASM_SIMP_TAC [eps_hyper_scale];
46340   (* - *)
46341   FULL_REWRITE_TAC[IMAGE2];
46342   TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ;
46343   USE 7(REWRITE_RULE[IMAGE]);
46344   TYPE_THEN `im` UNABBREV_TAC;
46345   UND 2 THEN  DISCH_THEN (THM_INTRO_TAC[ `z*w`  ]);
46346   CONJ_TAC;
46347   IMATCH_MP_TAC  REAL_LT_MUL;
46348   IMATCH_MP_TAC  (REAL_ARITH `z * w < z* &1 ==> z*w < z`);
46349   IMATCH_MP_TAC  REAL_LT_LMUL;
46350   TYPE_THEN `x = eps_hyper eps (z * w)` SUBAGOAL_TAC;
46351   USE 1 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
46352   TYPE_THEN `E''` UNABBREV_TAC;
46353   USE 17 (REWRITE_RULE[graph_support_eps]);
46354   UND 17 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
46355   TYPE_THEN `x` UNABBREV_TAC;
46356   REWRITE_TAC[eps_hyper_inj];
46357   TYPE_THEN `eps' = eps` ASM_CASES_TAC;
46358   TYPE_THEN `eps'` UNABBREV_TAC;
46359   UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_inj];
46360   COND_CASES_TAC;
46361   UND 9 THEN REWRITE_TAC[REAL_MUL_AC];
46362   ASM_REWRITE_TAC [REAL_MUL_ASSOC];
46363   REAL_ARITH_TAC;
46364   REWR 13;
46365   TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
46366   UND 17 THEN MESON_TAC[];
46367   TYPE_THEN `eps'` UNABBREV_TAC;
46368   UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale_perp;eps_hyper_inj];
46369   TYPE_THEN `x` UNABBREV_TAC;
46370   UND 2 THEN ASM_REWRITE_TAC[];
46371
46372
46373   ]);;
46374   (* }}} *)
46375
46376 let iso_int_model_lemma = prove_by_refinement(
46377   `!(G:(A,B)graph_t) . (planar_graph G) /\
46378          FINITE (graph_edge G) /\
46379          FINITE (graph_vertex G) /\
46380          ~(graph_edge G = {}) /\
46381          (!v. CARD (graph_edge_around G v) <=| 4) ==>
46382   (?H E. iso_support_eps_pair G (H,E) /\
46383      (count_iso_eps_pair (H,E) = 0))`,
46384   (* {{{ proof *)
46385   [
46386   REP_BASIC_TAC;
46387   TYPE_THEN `c  = count_iso_eps_pair:((num->real,(num->real)->bool)graph_t#(((num->real)->bool)->bool))->num` ABBREV_TAC ;
46388   THM_INTRO_TAC[`G`] iso_support_eps_nonempty;
46389   THM_INTRO_TAC[`iso_support_eps_pair G`;`c`] select_image_num_min;
46390   UND 6 THEN ASM_REWRITE_TAC[];
46391   TYPE_THEN `?H E. z = H,E` SUBAGOAL_TAC ;
46392   REWRITE_TAC[PAIR_SPLIT];
46393   MESON_TAC[];
46394   TYPE_THEN `z` UNABBREV_TAC;
46395   TYPE_THEN `H` EXISTS_TAC;
46396   TYPE_THEN `E` EXISTS_TAC;
46397   TYPE_THEN `c` UNABBREV_TAC;
46398   IMATCH_MP_TAC  (ARITH_RULE `~(0 < x) ==> (x = 0)`);
46399   THM_INTRO_TAC[`G`;`H`;`E`] iso_support_min_int;
46400   THM_INTRO_TAC[`H'`;`E'`;`eps`] count_iso_translate;
46401   ASM_REWRITE_TAC[];
46402   FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
46403   ASM_MESON_TAC[];
46404   TYPE_THEN `H'' = plane_graph_image (eps_translate eps (-- &1)) H'` ABBREV_TAC ;
46405   TYPE_THEN `E'' = IMAGE2 (eps_translate eps ( -- &1)) E'`ABBREV_TAC ;
46406   UND 7 THEN DISCH_THEN (THM_INTRO_TAC[ `(H'',E'')`]);
46407   TYPE_THEN `H''` UNABBREV_TAC;
46408   TYPE_THEN `E''` UNABBREV_TAC;
46409   REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
46410   CONV_TAC (dropq_conv "H");
46411   CONV_TAC (dropq_conv "E");
46412   (* -- *)
46413   CONJ_TAC;
46414   TYPE_THEN `graph_isomorphic H' (plane_graph_image (eps_translate eps (-- &1)) H')` SUBAGOAL_TAC;
46415   IMATCH_MP_TAC  plane_graph_image_iso;
46416   REWRITE_TAC[homeomorphism_eps_translate;];
46417   USE 12 (REWRITE_RULE[iso_support_eps_pair;graph_support_eps;good_plane_graph;PAIR_SPLIT]);
46418   ASM_MESON_TAC[];
46419   THM_INTRO_TAC[`G`;`H'`;`(plane_graph_image (eps_translate eps (-- &1)) H')`] graph_isomorphic_trans;
46420   USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
46421   ASM_MESON_TAC[];
46422   (* -- *)
46423   IMATCH_MP_TAC  graph_eps_translate_image;
46424   CONJ_TAC;
46425   MESON_TAC[];
46426   ASM_REWRITE_TAC[ARITH_RULE `-- (-- x) = x`];
46427   USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
46428   ASM_MESON_TAC[];
46429   UND 7 THEN UND 13 THEN UND 11 THEN ARITH_TAC;
46430
46431   ]);;
46432   (* }}} *)
46433
46434 let graph_int_model = prove_by_refinement(
46435   `!(G:(A,B)graph_t) . (planar_graph G) /\
46436          FINITE (graph_edge G) /\
46437          FINITE (graph_vertex G) /\
46438          ~(graph_edge G = {}) /\
46439          (!v. CARD (graph_edge_around G v) <=| 4) ==>
46440   (?H E.
46441      graph_isomorphic G H /\
46442      good_plane_graph H /\
46443      FINITE E /\
46444      (!e. graph_edge H e ==> e SUBSET UNIONS E) /\
46445      (!v. graph_vertex H v
46446                   ==> E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1))) /\
46447      (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
46448      (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j))
46449     )`,
46450   (* {{{ proof *)
46451   [
46452   REP_BASIC_TAC;
46453   THM_INTRO_TAC[`G`]iso_int_model_lemma;
46454   TYPE_THEN `H` EXISTS_TAC;
46455   TYPE_THEN `E` EXISTS_TAC;
46456   THM_INTRO_TAC[`G`;`H`;`E`] iso_eps_support0;
46457   ASM_REWRITE_TAC[];
46458   FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
46459   ASM_REWRITE_TAC[];
46460   ]);;
46461   (* }}} *)
46462
46463 (* ------------------------------------------------------------------ *)
46464 (* SECTION Y *)
46465 (* ------------------------------------------------------------------ *)
46466
46467 (* if a graph has an int model then it is a rectagonal graph *)
46468 (* k33_nonplanar proved! *)
46469
46470
46471 let h_edge_ball = prove_by_refinement(
46472   `!m. h_edge m SUBSET open_ball
46473        (euclid 2,d_euclid)
46474        (pointI m + (&1/ &2)*# e1) (&1 / &2)`,
46475   (* {{{ proof *)
46476
46477   [
46478   REWRITE_TAC[h_edge;open_ball;SUBSET;euclid_point;e1;point_scale;pointI;point_add];
46479   REWRITE_TAC[euclid_point;];
46480   TYPE_THEN `v` UNABBREV_TAC;
46481   REDUCE_TAC;
46482   REWRITE_TAC[d_euclid_point];
46483   REDUCE_TAC;
46484   TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC;
46485   REWRITE_TAC[EXP_EQ_0];
46486   UND 0 THEN ARITH_TAC;
46487   REDUCE_TAC;
46488   REWRITE_TAC[POW_2_SQRT_ABS];
46489   FULL_REWRITE_TAC[int_add_th;int_of_num_th];
46490   REWRITE_TAC[GSYM REAL_ABS_BETWEEN];
46491   CONJ_TAC;
46492   REWRITE_TAC[REAL_LT_HALF1];
46493   CONJ_TAC;
46494   REWRITE_TAC[REAL_LT_SUB_RADD];
46495   REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE];
46496   UND 2 THEN REAL_ARITH_TAC;
46497   ]);;
46498
46499   (* }}} *)
46500
46501 let v_edge_ball = prove_by_refinement(
46502   `!m. v_edge m SUBSET open_ball
46503        (euclid 2,d_euclid)
46504        (pointI m + (&1/ &2)*# e2) (&1 / &2)`,
46505   (* {{{ proof *)
46506   [
46507   REWRITE_TAC[v_edge;open_ball;SUBSET;euclid_point;e2;point_scale;pointI;point_add];
46508   REWRITE_TAC[euclid_point;];
46509   TYPE_THEN `u` UNABBREV_TAC;
46510   REDUCE_TAC;
46511   REWRITE_TAC[d_euclid_point];
46512   REDUCE_TAC;
46513   TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC;
46514   REWRITE_TAC[EXP_EQ_0];
46515   UND 0 THEN ARITH_TAC;
46516   REDUCE_TAC;
46517   REWRITE_TAC[POW_2_SQRT_ABS];
46518   FULL_REWRITE_TAC[int_add_th;int_of_num_th];
46519   REWRITE_TAC[GSYM REAL_ABS_BETWEEN];
46520   CONJ_TAC;
46521   REWRITE_TAC[REAL_LT_HALF1];
46522   CONJ_TAC;
46523   REWRITE_TAC[REAL_LT_SUB_RADD];
46524   REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE];
46525   UND 2 THEN REAL_ARITH_TAC;
46526   ]);;
46527   (* }}} *)
46528
46529 let sqrt_frac = prove_by_refinement(
46530   `!n m. sqrt ((&n/ &m) pow 2) = &n/ (&m) `,
46531   (* {{{ proof *)
46532   [
46533   REP_BASIC_TAC;
46534   IMATCH_MP_TAC  POW_2_SQRT;
46535   IMATCH_MP_TAC  REAL_LE_DIV;
46536   REWRITE_TAC[REAL_POS];
46537   ]);;
46538   (* }}} *)
46539
46540 let abs_dest_int_half = prove_by_refinement(
46541   `!m. &1 / &2 <= abs  (real_of_int m - &1 / &2)`,
46542   (* {{{ proof *)
46543   [
46544   REP_BASIC_TAC;
46545   IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
46546   TYPE_THEN `&2` EXISTS_TAC;
46547   CONJ_TAC;
46548   REAL_ARITH_TAC;
46549   TYPE_THEN `&2 * (&1/ &2) = &1` SUBAGOAL_TAC;
46550   IMATCH_MP_TAC  REAL_DIV_LMUL;
46551   UND 0 THEN REAL_ARITH_TAC;
46552   TYPE_THEN `&2 = abs  (&2)` SUBAGOAL_TAC;
46553   REAL_ARITH_TAC;
46554   TYPE_THEN`!x. &2 * abs  x = abs  (&2 * x)` SUBAGOAL_TAC;
46555   UND 1 THEN REAL_ARITH_TAC;
46556   ASM_REWRITE_TAC[];
46557   REWRITE_TAC[REAL_SUB_LDISTRIB];
46558   REWRITE_TAC[GSYM int_of_num_th;GSYM int_mul_th;GSYM int_sub_th;GSYM int_abs_th;GSYM int_le];
46559   TYPE_THEN `!x. ~(&:0 = ||: x) ==> (&:1 <= ||: x)` SUBAGOAL_TAC;
46560   THM_INTRO_TAC[`x`] INT_ABS_POS;
46561   UND 3 THEN UND 4 THEN INT_ARITH_TAC;
46562   FIRST_ASSUM IMATCH_MP_TAC ;
46563   USE 4 SYM;
46564   FULL_REWRITE_TAC[INT_ABS_ZERO];
46565   THM_INTRO_TAC[`m`] INT_REP;
46566   TYPE_THEN`m` UNABBREV_TAC;
46567   FULL_REWRITE_TAC[INT_OF_NUM_MUL;INT_SUB_LDISTRIB;INT_EQ_SUB_RADD;INT_OF_NUM_ADD;INT_OF_NUM_EQ;];
46568   UND 4 THEN REDUCE_TAC ;
46569   TYPE_THEN `ODD (2 *| n)` SUBAGOAL_TAC;
46570   REWRITE_TAC[ODD_EXISTS];
46571   TYPE_THEN `m'` EXISTS_TAC;
46572   ARITH_TAC;
46573   KILL 4;
46574   TYPE_THEN `EVEN (2 *| n)` SUBAGOAL_TAC;
46575   REWRITE_TAC[EVEN_EXISTS];
46576   MESON_TAC[];
46577   ASM_MESON_TAC[EVEN_AND_ODD];
46578   ]);;
46579   (* }}} *)
46580
46581 let REAL_LT_SQUARE_ABS = prove_by_refinement(
46582   `!x y. abs  x < abs  y <=> x pow 2 < y pow 2`,
46583   (* {{{ proof *)
46584   [
46585   REP_BASIC_TAC;
46586   REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y /\ ~(y <= x))`];
46587   MESON_TAC[REAL_LE_SQUARE_ABS];
46588   ]);;
46589   (* }}} *)
46590
46591 let h_edge_closed_ball = prove_by_refinement(
46592   `!e m. edge e /\ ~(e INTER closed_ball
46593        (euclid 2,d_euclid)
46594        (pointI m + (&1/ &2)*# e1) (&1 / &2) = EMPTY) ==>
46595        (e = h_edge m)`,
46596   (* {{{ proof *)
46597   [
46598   REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
46599   (*  - *)
46600   FIRST_ASSUM DISJ_CASES_TAC;
46601   TYPE_THEN `e` UNABBREV_TAC;
46602   PROOF_BY_CONTR_TAC;
46603   USE 1 (MATCH_MP point_onto);
46604   TYPE_THEN `u` UNABBREV_TAC;
46605   KILL 5;
46606   FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;v_edge;point_inj];
46607   TYPE_THEN `p` UNABBREV_TAC;
46608   TYPE_THEN `u'` UNABBREV_TAC;
46609   USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
46610   UND 0 THEN REWRITE_TAC[];
46611   TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
46612   REWRITE_TAC[sqrt_frac];
46613   IMATCH_MP_TAC  SQRT_MONO_LT;
46614   IMATCH_MP_TAC (REAL_ARITH  `(x <= u /\ &0 < v) ==> x < u + v` );
46615   (* -- *)
46616   CONJ_TAC;
46617   REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS];
46618   TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
46619   REWRITE_TAC[REAL_ABS_DIV;ABS_N];
46620   ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG];
46621   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;
46622   REWRITE_TAC[int_sub_th];
46623   REAL_ARITH_TAC;
46624   REWRITE_TAC[abs_dest_int_half];
46625   (* -- *)
46626   IMATCH_MP_TAC  (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`);
46627   REWRITE_TAC[];
46628   USE 1 (MATCH_MP POW_ZERO);
46629   TYPE_THEN `v = real_of_int (SND m)` SUBAGOAL_TAC;
46630   UND 1 THEN REAL_ARITH_TAC;
46631   TYPE_THEN `v` UNABBREV_TAC;
46632   FULL_REWRITE_TAC[GSYM int_lt];
46633   UND 3 THEN UND 5 THEN INT_ARITH_TAC;
46634   (* - *)
46635   REWRITE_TAC[cell_clauses];
46636   TYPE_THEN `e` UNABBREV_TAC;
46637   FULL_REWRITE_TAC[h_edge];
46638   TYPE_THEN `v` UNABBREV_TAC;
46639   TYPE_THEN `u` UNABBREV_TAC;
46640   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;
46641   REWRITE_TAC[PAIR_SPLIT];
46642   PROOF_BY_CONTR_TAC;
46643   FULL_REWRITE_TAC[DE_MORGAN_THM];
46644   (* - *)
46645   USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
46646   UND 0 THEN REWRITE_TAC[];
46647   TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
46648   REWRITE_TAC[sqrt_frac];
46649   IMATCH_MP_TAC  SQRT_MONO_LT;
46650   (* - *)
46651   FIRST_ASSUM DISJ_CASES_TAC;
46652   IMATCH_MP_TAC (REAL_ARITH  `(x < u /\ &0 <= v) ==> x < u + v` );
46653   (* --B *)
46654   REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
46655   TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
46656   REWRITE_TAC[REAL_ABS_DIV;ABS_N];
46657   KILL 0;
46658   TYPE_THEN `!x y. x < abs  y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC;
46659   REAL_ARITH_TAC;
46660   TYPE_THEN `&1 / &2 < (real_of_int (FST m) + &1 / &2) - u'` ASM_CASES_TAC;
46661   DISJ1_TAC;
46662   IMATCH_MP_TAC  REAL_LE_TRANS;
46663   TYPE_THEN `&1 / &2` EXISTS_TAC;
46664   CONJ_TAC ;
46665   IMATCH_MP_TAC  REAL_LE_DIV;
46666   REAL_ARITH_TAC;
46667   UND 9 THEN REAL_ARITH_TAC;
46668   (* -- *)
46669   TYPE_THEN `real_of_int (FST m) + &1 < u'` BACK_TAC;
46670   CONJ_TAC;
46671   IMATCH_MP_TAC  REAL_LT_TRANS;
46672   TYPE_THEN `real_of_int (FST m) + &1 - u'` EXISTS_TAC;
46673   CONJ_TAC;
46674   TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC;
46675   REWRITE_TAC[REAL_LT_HALF2];
46676   UND 11 THEN REAL_ARITH_TAC;
46677   UND 10 THEN REAL_ARITH_TAC;
46678   THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE;
46679   UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t]));
46680   UND 10 THEN REAL_ARITH_TAC;
46681   (* -- *)
46682   PROOF_BY_CONTR_TAC;
46683   TYPE_THEN `u' <= real_of_int (FST m) + &1` SUBAGOAL_TAC;
46684   UND 10 THEN REAL_ARITH_TAC;
46685   TYPE_THEN `real_of_int (FST m) <= u'` SUBAGOAL_TAC;
46686   UND 9 THEN REAL_ARITH_TAC;
46687   TYPE_THEN `~(u' = real_of_int (FST m) + &1)` SUBAGOAL_TAC;
46688   TYPE_THEN `u'` UNABBREV_TAC;
46689   FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;];
46690   UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC;
46691   TYPE_THEN `u' < real_of_int (FST m) + &1` SUBAGOAL_TAC;
46692   UND 13 THEN UND 11 THEN ARITH_TAC;
46693   (* -- *)
46694   TYPE_THEN `floor u' = (FST m')` SUBAGOAL_TAC;
46695   FULL_REWRITE_TAC[int_add_th;int_of_num_th];
46696   ASM_REWRITE_TAC[floor_range];
46697   UND 6 THEN REAL_ARITH_TAC;
46698   USE 15 SYM;
46699   TYPE_THEN `floor u' = FST m` SUBAGOAL_TAC;
46700   REWRITE_TAC[floor_range];
46701   ASM_MESON_TAC[];
46702   (* -C different second coord *)
46703   IMATCH_MP_TAC  (REAL_ARITH `x < z /\ &0 <= y  ==> x < y + z`);
46704   REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
46705   REDUCE_TAC;
46706   IMATCH_MP_TAC  REAL_LTE_TRANS;
46707   TYPE_THEN `&1` EXISTS_TAC;
46708   CONJ_TAC;
46709   KILL 0;
46710   REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
46711   REWRITE_TAC[REAL_LT_HALF2];
46712   REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;];
46713   UND 7 THEN INT_ARITH_TAC;
46714   ]);;
46715   (* }}} *)
46716
46717 let v_edge_closed_ball = prove_by_refinement(
46718   `!e m. edge e /\ ~(e INTER closed_ball
46719        (euclid 2,d_euclid)
46720        (pointI m + (&1/ &2)*# e2) (&1 / &2) = EMPTY) ==>
46721        (e = v_edge m)`,
46722   (* {{{ proof *)
46723   [
46724   REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
46725   (*  - *)
46726   USE 4 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
46727   FIRST_ASSUM DISJ_CASES_TAC;
46728   TYPE_THEN `e` UNABBREV_TAC;
46729   PROOF_BY_CONTR_TAC;
46730   USE 1 (MATCH_MP point_onto);
46731   TYPE_THEN `u` UNABBREV_TAC;
46732   KILL 5;
46733   FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;h_edge;point_inj];
46734   TYPE_THEN `p` UNABBREV_TAC;
46735   TYPE_THEN `v ` UNABBREV_TAC;
46736   USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
46737   UND 0 THEN REWRITE_TAC[];
46738   TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
46739   REWRITE_TAC[sqrt_frac];
46740   IMATCH_MP_TAC  SQRT_MONO_LT;
46741   IMATCH_MP_TAC (REAL_ARITH  `(x <= v /\ &0 < u) ==> x < u + v` );
46742   (* -- *)
46743   CONJ_TAC;
46744   REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS];
46745   TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
46746   REWRITE_TAC[REAL_ABS_DIV;ABS_N];
46747   ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG];
46748   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;
46749   REWRITE_TAC[int_sub_th];
46750   REAL_ARITH_TAC;
46751   REWRITE_TAC[abs_dest_int_half];
46752   (* --// *)
46753   IMATCH_MP_TAC  (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`);
46754   REWRITE_TAC[];
46755   USE 1 (MATCH_MP POW_ZERO);
46756   TYPE_THEN `u' = real_of_int (FST  m)` SUBAGOAL_TAC;
46757   UND 1 THEN REAL_ARITH_TAC;
46758   TYPE_THEN `u'` UNABBREV_TAC;
46759   FULL_REWRITE_TAC[GSYM int_lt];
46760   UND 3 THEN UND 5 THEN INT_ARITH_TAC;
46761   (* - *)
46762   REWRITE_TAC[cell_clauses];
46763   TYPE_THEN `e` UNABBREV_TAC;
46764   FULL_REWRITE_TAC[v_edge];
46765   TYPE_THEN `u` UNABBREV_TAC;
46766   TYPE_THEN `u'` UNABBREV_TAC;
46767   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;
46768   REWRITE_TAC[PAIR_SPLIT];
46769   PROOF_BY_CONTR_TAC;
46770   FULL_REWRITE_TAC[DE_MORGAN_THM];
46771   (* - *)
46772   USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
46773   UND 0 THEN REWRITE_TAC[];
46774   TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
46775   REWRITE_TAC[sqrt_frac];
46776   IMATCH_MP_TAC  SQRT_MONO_LT;
46777   (* - *)
46778   USE 3 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
46779   FIRST_ASSUM DISJ_CASES_TAC;
46780   IMATCH_MP_TAC (REAL_ARITH  `(x < v /\ &0 <= u) ==> x < u + v` );
46781   (* --B *)
46782   REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
46783   TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
46784   REWRITE_TAC[REAL_ABS_DIV;ABS_N];
46785   KILL 0;
46786   TYPE_THEN `!x y. x < abs  y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC;
46787   REAL_ARITH_TAC;
46788   TYPE_THEN `&1 / &2 < (real_of_int (SND  m) + &1 / &2) - v` ASM_CASES_TAC;
46789   DISJ1_TAC;
46790   IMATCH_MP_TAC  REAL_LE_TRANS;
46791   TYPE_THEN `&1 / &2` EXISTS_TAC;
46792   CONJ_TAC ;
46793   IMATCH_MP_TAC  REAL_LE_DIV;
46794   REAL_ARITH_TAC;
46795   UND 9 THEN REAL_ARITH_TAC;
46796   (* -- *)
46797   TYPE_THEN `real_of_int (SND  m) + &1 < v` BACK_TAC;
46798   CONJ_TAC;
46799   IMATCH_MP_TAC  REAL_LT_TRANS;
46800   TYPE_THEN `real_of_int (SND  m) + &1 - v` EXISTS_TAC;
46801   CONJ_TAC;
46802   TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC;
46803   REWRITE_TAC[REAL_LT_HALF2];
46804   UND 11 THEN REAL_ARITH_TAC;
46805   UND 10 THEN REAL_ARITH_TAC;
46806   THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE;
46807   UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t]));
46808   UND 10 THEN REAL_ARITH_TAC;
46809   (* -- *)
46810   PROOF_BY_CONTR_TAC;
46811   TYPE_THEN `v <= real_of_int (SND  m) + &1` SUBAGOAL_TAC;
46812   UND 10 THEN REAL_ARITH_TAC;
46813   TYPE_THEN `real_of_int (SND  m) <= v` SUBAGOAL_TAC;
46814   UND 9 THEN REAL_ARITH_TAC;
46815   TYPE_THEN `~(v = real_of_int (SND  m) + &1)` SUBAGOAL_TAC;
46816   TYPE_THEN `v` UNABBREV_TAC;
46817   FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;];
46818   UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC;
46819   TYPE_THEN `v < real_of_int (SND  m) + &1` SUBAGOAL_TAC;
46820   UND 13 THEN UND 11 THEN ARITH_TAC;
46821   (* -- *)
46822   TYPE_THEN `floor v = (SND  m')` SUBAGOAL_TAC;
46823   FULL_REWRITE_TAC[int_add_th;int_of_num_th];
46824   ASM_REWRITE_TAC[floor_range];
46825   UND 6 THEN REAL_ARITH_TAC;
46826   USE 15 SYM;
46827   TYPE_THEN `floor v = SND  m` SUBAGOAL_TAC;
46828   REWRITE_TAC[floor_range];
46829   ASM_MESON_TAC[];
46830   (* -C different second coord *)
46831   IMATCH_MP_TAC  (REAL_ARITH `x < y /\ &0 <= z  ==> x < y + z`);
46832   REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
46833   REDUCE_TAC;
46834   IMATCH_MP_TAC  REAL_LTE_TRANS;
46835   TYPE_THEN `&1` EXISTS_TAC;
46836   CONJ_TAC;
46837   KILL 0;
46838   REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
46839   REWRITE_TAC[REAL_LT_HALF2];
46840   REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;];
46841   UND 7 THEN INT_ARITH_TAC;
46842   ]);;
46843   (* }}} *)
46844
46845 let connected_in_edge = prove_by_refinement(
46846   `!C. connected top2 C /\ C SUBSET (UNIONS edge) ==>
46847     (?e. edge e /\ C SUBSET e)`,
46848   (* {{{ proof *)
46849   [
46850   REP_BASIC_TAC;
46851   TYPE_THEN `C = EMPTY` ASM_CASES_TAC ;
46852   REWRITE_TAC[connected_empty];
46853   TYPE_THEN `C` UNABBREV_TAC;
46854   TYPE_THEN `h_edge (&:0,&:0)` EXISTS_TAC;
46855   REWRITE_TAC[edge_h];
46856   (* - *)
46857   TYPE_THEN `?e. edge e /\ ~(C INTER e = EMPTY)` SUBAGOAL_TAC;
46858   FULL_REWRITE_TAC[SUBSET;UNIONS;EMPTY_EXISTS];
46859   TSPEC `u` 0;
46860   REWRITE_TAC[INTER ];
46861   ASM_MESON_TAC[];
46862   (* - *)
46863   TYPE_THEN `e` EXISTS_TAC;
46864   FULL_REWRITE_TAC[connected;edge];
46865   FIRST_ASSUM DISJ_CASES_TAC;
46866   TYPE_THEN `e` UNABBREV_TAC;
46867   TYPE_THEN `A = open_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ;
46868   TYPE_THEN `B = closed_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ;
46869   TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
46870   UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`]));
46871   CONJ_TAC;
46872   TYPE_THEN `A` UNABBREV_TAC;
46873   REWRITE_TAC[top2];
46874   IMATCH_MP_TAC  open_ball_open;
46875   CONJ_TAC;
46876   TYPE_THEN `E` UNABBREV_TAC;
46877   REWRITE_TAC[top2];
46878   THM_INTRO_TAC[`top2`;`B`] closed_open ;
46879   TYPE_THEN `B` UNABBREV_TAC;
46880   REWRITE_TAC[top2];
46881   IMATCH_MP_TAC  closed_ball_closed;
46882   FULL_REWRITE_TAC[open_DEF;top2_unions;];
46883   FULL_REWRITE_TAC[top2];
46884   CONJ_TAC;
46885   TYPE_THEN `E` UNABBREV_TAC;
46886   REWRITE_TAC[EQ_EMPTY;INTER;DIFF];
46887   UND 1 THEN REWRITE_TAC[];
46888   ASM_MESON_TAC[open_ball_sub_closed;subset_imp;];
46889   USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
46890   REWRITE_TAC[SUBSET;UNION];
46891   TSPEC `x` 0;
46892   REWRITE_TAC[];
46893   TYPE_THEN `u = v_edge m` ASM_CASES_TAC;
46894   TYPE_THEN `u` UNABBREV_TAC;
46895   DISJ1_TAC;
46896   ASM_MESON_TAC[v_edge_ball;subset_imp ];
46897   DISJ2_TAC;
46898   TYPE_THEN `E` UNABBREV_TAC;
46899   REWRITE_TAC[DIFF];
46900   CONJ_TAC;
46901   FULL_REWRITE_TAC[top2_unions];
46902   ASM_MESON_TAC[subset_imp];
46903   UND 10 THEN REWRITE_TAC[];
46904   IMATCH_MP_TAC  v_edge_closed_ball;
46905   REWRITE_TAC[EMPTY_EXISTS;INTER];
46906   ASM_MESON_TAC[];
46907   FIRST_ASSUM DISJ_CASES_TAC;
46908   USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
46909   REWRITE_TAC[SUBSET];
46910   TSPEC `x` 0;
46911   REWRITE_TAC[];
46912   TYPE_THEN `u = v_edge m` BACK_TAC ;
46913   ASM_MESON_TAC[];
46914   IMATCH_MP_TAC  v_edge_closed_ball;
46915   REWRITE_TAC[INTER;EMPTY_EXISTS ];
46916   TYPE_THEN `x` EXISTS_TAC;
46917   ASM_MESON_TAC[open_ball_sub_closed;subset_imp];
46918   USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
46919   PROOF_BY_CONTR_TAC;
46920   UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET];
46921   TSPEC `u` 8;
46922   UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
46923   DISJ2_TAC;
46924   ASM_MESON_TAC[v_edge_ball;subset_imp;open_ball_sub_closed];
46925   (* -A *)
46926   TYPE_THEN `e` UNABBREV_TAC;
46927   TYPE_THEN `A = open_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ;
46928   TYPE_THEN `B = closed_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ;
46929   TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
46930   UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`]));
46931   CONJ_TAC;
46932   TYPE_THEN `A` UNABBREV_TAC;
46933   REWRITE_TAC[top2];
46934   IMATCH_MP_TAC  open_ball_open;
46935   CONJ_TAC;
46936   TYPE_THEN `E` UNABBREV_TAC;
46937   REWRITE_TAC[top2];
46938   THM_INTRO_TAC[`top2`;`B`] closed_open ;
46939   TYPE_THEN `B` UNABBREV_TAC;
46940   REWRITE_TAC[top2];
46941   IMATCH_MP_TAC  closed_ball_closed;
46942   FULL_REWRITE_TAC[open_DEF;top2_unions;];
46943   FULL_REWRITE_TAC[top2];
46944   CONJ_TAC;
46945   TYPE_THEN `E` UNABBREV_TAC;
46946   REWRITE_TAC[EQ_EMPTY;INTER;DIFF];
46947   UND 1 THEN REWRITE_TAC[];
46948   ASM_MESON_TAC[open_ball_sub_closed;subset_imp;];
46949   USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
46950   REWRITE_TAC[SUBSET;UNION];
46951   TSPEC `x` 0;
46952   REWRITE_TAC[];
46953   (* -- *)
46954   TYPE_THEN `u = h_edge m` ASM_CASES_TAC;
46955   TYPE_THEN `u` UNABBREV_TAC;
46956   DISJ1_TAC;
46957   ASM_MESON_TAC[h_edge_ball;subset_imp ];
46958   DISJ2_TAC;
46959   TYPE_THEN `E` UNABBREV_TAC;
46960   REWRITE_TAC[DIFF];
46961   CONJ_TAC;
46962   FULL_REWRITE_TAC[top2_unions];
46963   ASM_MESON_TAC[subset_imp];
46964   UND 10 THEN REWRITE_TAC[];
46965   IMATCH_MP_TAC  h_edge_closed_ball;
46966   REWRITE_TAC[EMPTY_EXISTS;INTER];
46967   ASM_MESON_TAC[];
46968   FIRST_ASSUM DISJ_CASES_TAC;
46969   USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
46970   REWRITE_TAC[SUBSET];
46971   TSPEC `x` 0;
46972   REWRITE_TAC[];
46973   TYPE_THEN `u = h_edge m` BACK_TAC ;
46974   ASM_MESON_TAC[];
46975   IMATCH_MP_TAC  h_edge_closed_ball;
46976   REWRITE_TAC[INTER;EMPTY_EXISTS ];
46977   TYPE_THEN `x` EXISTS_TAC;
46978   ASM_MESON_TAC[open_ball_sub_closed;subset_imp];
46979   USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
46980   PROOF_BY_CONTR_TAC;
46981   (* - *)
46982   UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET];
46983   TSPEC `u` 8;
46984   UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
46985   DISJ2_TAC;
46986   ASM_MESON_TAC[h_edge_ball;subset_imp;open_ball_sub_closed];
46987   (* - *)
46988   (* Mon Dec 20 15:16:18 EST 2004 *)
46989
46990   ]);;
46991   (* }}} *)
46992
46993 let int_pow2_gt1 = prove_by_refinement(
46994   `!x. ~(x = &:0) ==> &1 <= (real_of_int x) pow 2`,
46995   (* {{{ proof *)
46996   [
46997   TYPE_THEN  `&1 = &1 pow 2` SUBAGOAL_TAC ;
46998   REDUCE_TAC;
46999   UND 1 THEN DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
47000   REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS;GSYM int_le;GSYM int_abs_th ;GSYM int_of_num_th;];
47001   UND 0 THEN INT_ARITH_TAC;
47002   ]);;
47003   (* }}} *)
47004
47005 let d_euclid_pointI_pos = prove_by_refinement(
47006   `!m n. d_euclid (pointI m) (pointI n) < &1 ==> (m = n)`,
47007   (* {{{ proof *)
47008   [
47009   REWRITE_TAC[pointI;d_euclid_point;PAIR_SPLIT];
47010   PROOF_BY_CONTR_TAC;
47011   FULL_REWRITE_TAC[DE_MORGAN_THM];
47012   USE 0 (MATCH_MP (REAL_ARITH  `x < y ==> ~(y <= x)`));
47013   UND 0 THEN REWRITE_TAC[];
47014   TYPE_THEN `&1 = sqrt(&1)` SUBAGOAL_TAC;
47015   ONCE_REWRITE_TAC [EQ_SYM_EQ];
47016   IMATCH_MP_TAC  SQRT_POS_UNIQ;
47017   REDUCE_TAC;
47018   UND 0 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
47019   IMATCH_MP_TAC  SQRT_MONO_LE;
47020   REDUCE_TAC;
47021   FULL_REWRITE_TAC[GSYM int_sub_th];
47022   USE 1 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] INT_SUB_0]);
47023   FIRST_ASSUM DISJ_CASES_TAC;
47024   IMATCH_MP_TAC  (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= x + y`);
47025   IMATCH_MP_TAC  int_pow2_gt1;
47026   ASM_MESON_TAC[];
47027   IMATCH_MP_TAC  (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= y + x`);
47028   IMATCH_MP_TAC  int_pow2_gt1;
47029   ASM_MESON_TAC[];
47030   ]);;
47031   (* }}} *)
47032
47033 extend_simp_rewrites[prove_by_refinement(
47034   `&0 < &1 / &2`,
47035   (* {{{ proof *)
47036   [
47037   REWRITE_TAC[REAL_LT_HALF1];
47038   ])];;
47039   (* }}} *)
47040
47041 extend_simp_rewrites[prove_by_refinement(
47042   `&2 * &1/ &2 = &1`,
47043   (* {{{ proof *)
47044   [
47045   IMATCH_MP_TAC  REAL_DIV_LMUL;
47046   UND 0 THEN REAL_ARITH_TAC;
47047   ])];;
47048   (* }}} *)
47049
47050 let totally_bounded_pointI = prove_by_refinement(
47051   `?eps. !x m n. (&0 <eps ) /\
47052        (open_ball(euclid 2,d_euclid) x eps (pointI m) /\
47053        open_ball(euclid 2,d_euclid) x eps (pointI n) ==>
47054         (m = n))  `,
47055   (* {{{ proof *)
47056   [
47057   TYPE_THEN `&1/ &2` EXISTS_TAC;
47058   REWRITE_TAC[];
47059   IMATCH_MP_TAC  d_euclid_pointI_pos;
47060   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`x`;`&1 / &2`] BALL_DIST;
47061   TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC;
47062   ASM_MESON_TAC[];
47063   ]);;
47064   (* }}} *)
47065
47066 let simple_arc_finite_pointI = prove_by_refinement(
47067   `! e .
47068        simple_arc top2 e  ==>
47069        (?X. FINITE X /\ (!m. e (pointI m) ==> X m))`,
47070   (* {{{ proof *)
47071   [
47072   REP_BASIC_TAC;
47073   THM_INTRO_TAC[`e`] simple_arc_compact;
47074   THM_INTRO_TAC[`e`] simple_arc_euclid;
47075   THM_INTRO_TAC[`e`;`d_euclid`] compact_totally_bounded;
47076   CONJ_TAC;
47077   THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace;
47078   THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] compact_subset;
47079   FULL_REWRITE_TAC[top2];
47080   ASM_MESON_TAC[];
47081   (* - *)
47082   FULL_REWRITE_TAC[totally_bounded];
47083   THM_INTRO_TAC[] totally_bounded_pointI;
47084   TSPEC `eps` 3;
47085   RIGHT 4 "n";
47086   RIGHT 4 "m";
47087   RIGHT 4 "x";
47088   REWRITE_TAC[];
47089   TYPE_THEN `X = { m | ?b. B b /\ b (pointI m) }` ABBREV_TAC ;
47090   TYPE_THEN `X` EXISTS_TAC;
47091   (* - *)
47092   TYPE_THEN `!m. ?b. (X m) ==> (B b /\ b (pointI m))` SUBAGOAL_TAC;
47093   TYPE_THEN `X` UNABBREV_TAC;
47094   MESON_TAC[];
47095   LEFT 9 "b";
47096   CONJ_TAC;
47097   THM_INTRO_TAC[`X`;`B`;`b`] FINITE_INJ;
47098   REWRITE_TAC[INJ];
47099   REWRITE_TAC[];
47100   FIRST_ASSUM IMATCH_MP_TAC ;
47101   COPY 9;
47102   TSPEC `x` 13;
47103   TSPEC `y` 9;
47104   COPY 6;
47105   TSPEC `b x` 16;
47106   TSPEC `b y` 6;
47107   TYPE_THEN `x'` EXISTS_TAC;
47108   (* // *)
47109   TYPE_THEN `b y` UNABBREV_TAC;
47110   TYPE_THEN `b x` UNABBREV_TAC;
47111   THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace;
47112   THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`;`x'`;`eps`] open_ball_subspace;
47113   CONJ_TAC THEN ASM_MESON_TAC[subset_imp];
47114   (* - *)
47115   TYPE_THEN `X` UNABBREV_TAC;
47116   FULL_REWRITE_TAC[UNIONS];
47117   ASM_MESON_TAC[];
47118   (* Mon Dec 20 18:39:42 EST 2004 *)
47119
47120
47121   ]);;
47122   (* }}} *)
47123
47124 let simple_arc_finite_lemma1 = prove_by_refinement(
47125   `!e v v'. simple_arc_end  e v v' ==>
47126     (?X f. (X SUBSET {x | &0 <= x /\ x <= &1}) /\ FINITE X /\
47127       (f (&0) = v) /\ (f (&1) = v') /\
47128       (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
47129               continuous f (top_of_metric (UNIV,d_real)) top2 /\
47130               INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
47131         (!x.   &0 <= x /\ x <= &1 ==> ( (?m. f x = pointI m) <=> (X x))))`,
47132   (* {{{ proof *)
47133   [
47134   REP_BASIC_TAC;
47135   THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_simple;
47136   THM_INTRO_TAC[`e`] simple_arc_finite_pointI;
47137   THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end;
47138   REWR 4;
47139   TYPE_THEN `Y = {x | &0 <= x /\ x <= &1 /\ (?m. (f x = pointI m))}` ABBREV_TAC ;
47140   TYPE_THEN `Y` EXISTS_TAC;
47141   TYPE_THEN `f` EXISTS_TAC;
47142   (* - *)
47143   SUBCONJ_TAC;
47144   TYPE_THEN`Y` UNABBREV_TAC;
47145   REWRITE_TAC[SUBSET];
47146   (* - *)
47147   FULL_REWRITE_TAC[top2_unions];
47148   CONJ_TAC;
47149   THM_INTRO_TAC[`Y`;`IMAGE (pointI) X`;`f`] FINITE_INJ;
47150   CONJ_TAC;
47151   IMATCH_MP_TAC  FINITE_IMAGE;
47152   FULL_REWRITE_TAC[INJ];
47153   CONJ_TAC;
47154   REWRITE_TAC[IMAGE];
47155   TYPE_THEN `Y` UNABBREV_TAC;
47156   TYPE_THEN `m` EXISTS_TAC;
47157   FIRST_ASSUM IMATCH_MP_TAC ;
47158   USE 9 SYM;
47159   IMATCH_MP_TAC  image_imp;
47160   ASM_REWRITE_TAC[];
47161   FIRST_ASSUM IMATCH_MP_TAC ;
47162   TYPE_THEN `Y` UNABBREV_TAC;
47163   (* - *)
47164   TYPE_THEN `Y` UNABBREV_TAC;
47165   ]);;
47166   (* }}} *)
47167
47168 let simple_arc_finite_lemma2 = prove_by_refinement(
47169   `!e v v'. simple_arc_end e v v'==>
47170     (?(N:num) t f.
47171       (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\
47172       (f (&0) = v) /\ (f (&1) = v') /\
47173       (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
47174       (!i j. (i < j) /\  (i < N) /\  (j < N) ==> (t i < t j)) /\
47175               continuous f (top_of_metric (UNIV,d_real)) top2 /\
47176               INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
47177         (!x.   &0 <= x /\ x <= &1 ==>
47178         ( (?m. f x = pointI m) <=> (?k.  (k < N) /\ (x = t k)))))`,
47179   (* {{{ proof *)
47180   [
47181   REP_BASIC_TAC;
47182   THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma1;
47183   THM_INTRO_TAC[`X`] real_finite_increase;
47184   TYPE_THEN `CARD X` EXISTS_TAC;
47185   TYPE_THEN `u` EXISTS_TAC;
47186   TYPE_THEN `f` EXISTS_TAC;
47187   (* - *)
47188   SUBCONJ_TAC;
47189   FULL_REWRITE_TAC[BIJ;IMAGE;SURJ];
47190   FULL_REWRITE_TAC[SUBSET];
47191   TSPEC `x'` 11;
47192   (* - *)
47193   SUBCONJ_TAC;
47194   FIRST_ASSUM IMATCH_MP_TAC ;
47195   (* - *)
47196   TSPEC `x` 1;
47197   REWR 1;
47198   FULL_REWRITE_TAC[BIJ;SURJ];
47199   IMATCH_MP_TAC  EQ_ANTISYM;
47200   CONJ_TAC;
47201   ONCE_REWRITE_TAC[EQ_SYM_EQ];
47202   FIRST_ASSUM IMATCH_MP_TAC ;
47203   ]);;
47204   (* }}} *)
47205
47206 let connected_unions_common = prove_by_refinement(
47207   `!U (ZZ:(A->bool)->bool). (!Z. ZZ Z ==> connected U Z) /\
47208      (!Z Z'. ZZ Z /\ ZZ Z' ==> ~(Z INTER Z' = EMPTY)) ==>
47209      (connected U (UNIONS ZZ))`,
47210   (* {{{ proof *)
47211   [
47212   REWRITE_TAC[connected];
47213   SUBCONJ_TAC;
47214   TYPE_THEN `UU = UNIONS U` ABBREV_TAC ;
47215   REWRITE_TAC[UNIONS;SUBSET];
47216   TSPEC `u` 1;
47217   REWRITE_TAC[];
47218   ASM_MESON_TAC[subset_imp];
47219   (* - *)
47220   TYPE_THEN `!Z. ZZ Z ==> Z SUBSET A \/ Z SUBSET B` SUBAGOAL_TAC;
47221   TSPEC `Z` 1;
47222   REWRITE_TAC[];
47223   FIRST_ASSUM IMATCH_MP_TAC ;
47224   USE 2 (REWRITE_RULE[UNIONS;SUBSET]);
47225   REWRITE_TAC[SUBSET];
47226   FIRST_ASSUM IMATCH_MP_TAC ;
47227   ASM_MESON_TAC[];
47228   (* - *)
47229   TYPE_THEN `AA = {Z | ZZ Z /\ Z SUBSET A}` ABBREV_TAC ;
47230   TYPE_THEN `BB = {Z | ZZ Z /\ Z SUBSET B}` ABBREV_TAC ;
47231   TYPE_THEN `ZZ = AA UNION BB` SUBAGOAL_TAC;
47232   IMATCH_MP_TAC  EQ_EXT;
47233   REWRITE_TAC[UNION];
47234   TYPE_THEN `AA` UNABBREV_TAC;
47235   TYPE_THEN `BB` UNABBREV_TAC;
47236   ASM_MESON_TAC[];
47237   PROOF_BY_CONTR_TAC;
47238   USE 11 (REWRITE_RULE[DE_MORGAN_THM;UNIONS;SUBSET;UNION]);
47239   LEFT 11 "x";
47240   LEFT 12 "x";
47241   TYPE_THEN `AA` UNABBREV_TAC;
47242   TYPE_THEN `BB` UNABBREV_TAC;
47243   LEFT 11 "u";
47244   LEFT 8 "u";
47245   LEFT 12 "u";
47246   LEFT 9 "u";
47247   (* - *)
47248   TYPE_THEN `ZZ u` SUBAGOAL_TAC;
47249   ASM_MESON_TAC[];
47250   TYPE_THEN `ZZ u'` SUBAGOAL_TAC;
47251   ASM_MESON_TAC[];
47252   TYPE_THEN `u SUBSET A` SUBAGOAL_TAC;
47253   TSPEC `u` 7;
47254   FIRST_ASSUM DISJ_CASES_TAC ;
47255   USE 13(REWRITE_RULE[SUBSET]);
47256   TSPEC `x` 13;
47257   ASM_MESON_TAC[];
47258   TYPE_THEN `u' SUBSET B` SUBAGOAL_TAC;
47259   TSPEC `u'` 7;
47260   FIRST_ASSUM DISJ_CASES_TAC ;
47261   USE 14(REWRITE_RULE[SUBSET]);
47262   TSPEC `x'` 14;
47263   ASM_MESON_TAC[];
47264   (* - *)
47265   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`u`;`u'`]);
47266   USE 0 (REWRITE_RULE[EMPTY_EXISTS;INTER ]);
47267   USE 3(REWRITE_RULE[INTER;EQ_EMPTY]);
47268   TSPEC `u''` 3;
47269   ASM_MESON_TAC[subset_imp];
47270   ]);;
47271   (* }}} *)
47272
47273 let connect_real_open = prove_by_refinement(
47274   `!a b. connected
47275        (top_of_metric (UNIV,d_real)) {x | a < x /\ x < b}`,
47276   (* {{{ proof *)
47277   [
47278   REP_BASIC_TAC;
47279   TYPE_THEN `{x | a < x /\ x < b} = EMPTY` ASM_CASES_TAC;
47280   REWRITE_TAC[connected_empty];
47281   FULL_REWRITE_TAC[EMPTY_EXISTS];
47282   TYPE_THEN `ZZ = {Z | ?a' b'. a < a' /\ a' < u /\ u < b' /\ b' < b /\ (Z = {x | a' <= x /\ x <= b'})}` ABBREV_TAC ;
47283   TYPE_THEN `{x | a < x /\ x < b} = UNIONS ZZ` SUBAGOAL_TAC;
47284   TYPE_THEN `ZZ` UNABBREV_TAC;
47285   REWRITE_TAC[UNIONS];
47286   IMATCH_MP_TAC  EQ_EXT;
47287   IMATCH_MP_TAC  EQ_ANTISYM;
47288   CONJ_TAC;
47289   CONV_TAC (dropq_conv "u");
47290   CONV_TAC (dropq_conv "x'");
47291   TYPE_THEN `u < x` ASM_CASES_TAC;
47292   TYPE_THEN `(a + u)/ &2` EXISTS_TAC;
47293   TYPE_THEN `x` EXISTS_TAC;
47294   SUBCONJ_TAC;
47295   IMATCH_MP_TAC  real_middle1_lt;
47296   SUBCONJ_TAC;
47297   IMATCH_MP_TAC  real_middle2_lt;
47298   UND 6 THEN UND 4 THEN REAL_ARITH_TAC;
47299   TYPE_THEN `(a + x)/ &2` EXISTS_TAC;
47300   TYPE_THEN `(u + b)/ &2` EXISTS_TAC;
47301   SUBCONJ_TAC;
47302   IMATCH_MP_TAC  real_middle1_lt;
47303   SUBCONJ_TAC;
47304   IMATCH_MP_TAC  REAL_LTE_TRANS;
47305   TYPE_THEN `x` EXISTS_TAC;
47306   USE 4 (MATCH_MP (REAL_ARITH `~(u < x) ==> (x <= u)`));
47307   IMATCH_MP_TAC  real_middle2_lt;
47308   SUBCONJ_TAC;
47309   IMATCH_MP_TAC  real_middle1_lt;
47310   CONJ_TAC;
47311   IMATCH_MP_TAC  real_middle2_lt;
47312   CONJ_TAC;
47313   IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
47314   IMATCH_MP_TAC  real_middle2_lt;
47315   UND 4 THEN UND 7 THEN REAL_ARITH_TAC;
47316   (* -- *)
47317   TYPE_THEN `u'` UNABBREV_TAC;
47318   UND 7 THEN UND 3 THEN UND 2 THEN UND 4 THEN REAL_ARITH_TAC;
47319   (* - *)
47320   IMATCH_MP_TAC  connected_unions_common;
47321   CONJ_TAC;
47322   TYPE_THEN `ZZ` UNABBREV_TAC;
47323   REWRITE_TAC[connect_real];
47324   TYPE_THEN `ZZ` UNABBREV_TAC;
47325   TYPE_THEN `Z` UNABBREV_TAC;
47326   TYPE_THEN `Z'` UNABBREV_TAC;
47327   USE 4(REWRITE_RULE[EQ_EMPTY;INTER]);
47328   TSPEC `u` 2;
47329   KILL 3;
47330   REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC;
47331   ]);;
47332   (* }}} *)
47333
47334 let int_neg_num_th = prove_by_refinement(
47335   `!j. real_of_int (--: (&: j)) = -- (&j)`,
47336   (* {{{ proof *)
47337   [
47338   REWRITE_TAC[int_neg_th;int_of_num_th;];
47339   ]);;
47340   (* }}} *)
47341
47342 let closed_ball_subset_larger_open = prove_by_refinement(
47343   `!n a r r'.
47344      (r < r') ==> closed_ball (euclid n,d_euclid) a r SUBSET
47345           open_ball (euclid n,d_euclid) a r'`,
47346   (* {{{ proof *)
47347   [
47348   REWRITE_TAC[closed_ball;open_ball;SUBSET];
47349   UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
47350   ]);;
47351   (* }}} *)
47352
47353 let simple_arc_end_edge_closure = prove_by_refinement(
47354   `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\
47355      (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==>
47356      (closure top2 e (pointI m))`,
47357   (* {{{ proof *)
47358   [
47359   REP_BASIC_TAC;
47360   THM_INTRO_TAC[`e`] edge_euclid2;
47361   FULL_REWRITE_TAC[edge];
47362   TYPE_THEN `connected top2 C` SUBAGOAL_TAC;
47363   USE 1 (MATCH_MP simple_arc_end_simple);
47364   USE 1(MATCH_MP simple_arc_connected);
47365   PROOF_BY_CONTR_TAC;
47366   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`e`] closure_open_ball;
47367   USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
47368   TSPEC  `(pointI m)` 6;
47369   USE 5 (REWRITE_RULE[top2]);
47370   UND 6 THEN ASM_REWRITE_TAC[];
47371   PROOF_BY_CONTR_TAC;
47372   (* - *)
47373   TYPE_THEN `?r. &0 < r /\ (r < &1/ &2) /\ (e INTER closed_ball (euclid 2, d_euclid) (pointI m) r = EMPTY)` SUBAGOAL_TAC;
47374   TYPE_THEN `?s. &0 < s /\ s <= r /\ s <= &1/ &2` SUBAGOAL_TAC;
47375   TYPE_THEN `min_real r (&1 / &2)` EXISTS_TAC;
47376   REWRITE_TAC[min_real_le];
47377   REWRITE_TAC[min_real];
47378   COND_CASES_TAC;
47379   TYPE_THEN `s/ &2` EXISTS_TAC;
47380   ASM_REWRITE_TAC[REAL_LT_HALF1];
47381   CONJ_TAC;
47382   IMATCH_MP_TAC  REAL_LTE_TRANS;
47383   TYPE_THEN `s` EXISTS_TAC;
47384   REWRITE_TAC[REAL_LT_HALF2];
47385   REWRITE_TAC[EQ_EMPTY;INTER];
47386   LEFT 7 "z";
47387   TSPEC `x` 7;
47388   UND 7 THEN ASM_REWRITE_TAC[];
47389   (* -- *)
47390   TYPE_THEN `s/ &2 < r` SUBAGOAL_TAC;
47391   IMATCH_MP_TAC  REAL_LTE_TRANS;
47392   TYPE_THEN  `s` EXISTS_TAC;
47393   REWRITE_TAC[REAL_LT_HALF2];
47394   THM_INTRO_TAC[`2`;`pointI m`;`s / &2`;`r`] closed_ball_subset_larger_open;
47395   ASM_MESON_TAC[subset_imp];
47396   (*  - *)
47397   THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct;
47398   FULL_REWRITE_TAC[connected];
47399   TYPE_THEN `A = open_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ;
47400   TYPE_THEN `B = closed_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ;
47401   TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
47402   (* -A *)
47403   TYPE_THEN `top2 A /\ top2 E /\ (A INTER E = {}) /\ C SUBSET A UNION E /\ A (pointI m) /\ E (pointI n)` SUBAGOAL_TAC;
47404   CONJ_TAC;
47405   TYPE_THEN `A` UNABBREV_TAC;
47406   REWRITE_TAC[top2];
47407   IMATCH_MP_TAC  open_ball_open;
47408   CONJ_TAC;
47409   TYPE_THEN `E` UNABBREV_TAC;
47410   REWRITE_TAC[top2];
47411   THM_INTRO_TAC[`top2`;`B`] closed_open;
47412   TYPE_THEN `B` UNABBREV_TAC;
47413   REWRITE_TAC[top2];
47414   IMATCH_MP_TAC  closed_ball_closed;
47415   FULL_REWRITE_TAC[open_DEF;top2_unions ];
47416   FULL_REWRITE_TAC[top2];
47417   (* --// *)
47418   CONJ_TAC;
47419   TYPE_THEN `A` UNABBREV_TAC;
47420   TYPE_THEN `E` UNABBREV_TAC;
47421   TYPE_THEN `B` UNABBREV_TAC;
47422   REWRITE_TAC[INTER;EQ_EMPTY;DIFF];
47423   ASM_MESON_TAC[subset_imp;open_ball_sub_closed];
47424   (* -- *)
47425   TYPE_THEN `A (pointI m)` SUBAGOAL_TAC;
47426   TYPE_THEN `A` UNABBREV_TAC;
47427   IMATCH_MP_TAC  (INR open_ball_nonempty);
47428   REWRITE_TAC[pointI];
47429   (* -- *)
47430   TYPE_THEN `E (pointI n)` SUBAGOAL_TAC;
47431   TYPE_THEN `E` UNABBREV_TAC;
47432   REWRITE_TAC[DIFF];
47433   TYPE_THEN `B` UNABBREV_TAC;
47434   CONJ_TAC;
47435   REWRITE_TAC[pointI];
47436   FULL_REWRITE_TAC[pointI_inj];
47437   TYPE_THEN `open_ball (euclid 2,d_euclid) (pointI m) (&1 / &2) (pointI n)` SUBAGOAL_TAC;
47438   THM_INTRO_TAC[`2`;`pointI m`;`r'`;`&1 / &2`] closed_ball_subset_larger_open;
47439   ASM_MESON_TAC[subset_imp];
47440   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`pointI m`;`&1 / &2`] BALL_DIST;
47441   IMATCH_MP_TAC  (INR open_ball_nonempty);
47442   REWRITE_TAC[pointI];
47443   TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC;
47444   REWR 17;
47445   USE 17 (MATCH_MP d_euclid_pointI_pos);
47446   TYPE_THEN `m` UNABBREV_TAC;
47447   (* --// *)
47448   REWRITE_TAC[SUBSET;UNION];
47449   TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC;
47450   TSPEC `x` 0;
47451   ASM_MESON_TAC[];
47452   UND 19 THEN REP_CASES_TAC;
47453   DISJ2_TAC;
47454   TYPE_THEN `E` UNABBREV_TAC;
47455   REWRITE_TAC[DIFF];
47456   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
47457   ASM_MESON_TAC[subset_imp];
47458   DISJ1_TAC;
47459   DISJ2_TAC;
47460   (* - *)
47461   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`E`]);
47462   (* -B *)
47463   TYPE_THEN `C (pointI m)` SUBAGOAL_TAC;
47464   IMATCH_MP_TAC  simple_arc_end_end;
47465   UNIFY_EXISTS_TAC;
47466   TYPE_THEN `C (pointI n)` SUBAGOAL_TAC;
47467   IMATCH_MP_TAC  simple_arc_end_end2;
47468   UNIFY_EXISTS_TAC;
47469   USE 19 (REWRITE_RULE[INTER;EQ_EMPTY ]);
47470   FIRST_ASSUM DISJ_CASES_TAC;
47471   USE 24 (REWRITE_RULE[SUBSET]); (* -- *)
47472   ASM_MESON_TAC[];
47473   USE 24 (REWRITE_RULE[SUBSET]);
47474   ASM_MESON_TAC[];
47475   ]);;
47476   (* }}} *)
47477
47478 let vc_edge_pointI = prove_by_refinement(
47479   `!m n. vc_edge m (pointI n) <=> (n = m) \/ (n = up m)`,
47480   (* {{{ proof *)
47481   [
47482   REWRITE_TAC[vc_edge;cell_clauses;INR IN_SING;UNION];
47483   TYPE_THEN `pointI m + e2 = pointI (up m)` SUBAGOAL_TAC;
47484   REWRITE_TAC[up;e2;point_add ;pointI];
47485   REDUCE_TAC;
47486   REWRITE_TAC[int_of_num_th;int_add_th];
47487   REWRITE_TAC[pointI_inj];
47488   ]);;
47489   (* }}} *)
47490
47491 let hc_edge_pointI = prove_by_refinement(
47492   `!m n. hc_edge m (pointI n) <=> (n = m) \/ (n = right m)`,
47493   (* {{{ proof *)
47494   [
47495   REWRITE_TAC[hc_edge;cell_clauses;INR IN_SING;UNION];
47496   TYPE_THEN `pointI m + e1 = pointI (right m)` SUBAGOAL_TAC;
47497   REWRITE_TAC[right;e1;point_add ;pointI];
47498   REDUCE_TAC;
47499   REWRITE_TAC[int_of_num_th;int_add_th];
47500   REWRITE_TAC[pointI_inj];
47501   ]);;
47502   (* }}} *)
47503
47504 let mk_segment_v = prove_by_refinement(
47505   `!r s b x. (r <= s) ==> (mk_segment (point(b,r)) (point(b,s)) x <=>
47506       (?t. (r <= t /\ t <= s /\ (x = point(b,t)))))`,
47507   (* {{{ proof *)
47508   [
47509   REP_BASIC_TAC;
47510   REWRITE_TAC[mk_segment];
47511   REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`];
47512   IMATCH_MP_TAC  EQ_ANTISYM;
47513   CONJ_TAC;
47514   TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC;
47515   CONJ_TAC;
47516   ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`;
47517   ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`;
47518   TYPE_THEN `s = r` ASM_CASES_TAC;
47519   REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`];
47520   TYPE_THEN `&0` EXISTS_TAC;
47521   UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC;
47522   (* - *)
47523   REWRITE_TAC[point_inj;PAIR_SPLIT];
47524   TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ;
47525   TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC;
47526   TYPE_THEN `v` UNABBREV_TAC;
47527   REWRITE_TAC[GSYM real_div_assoc];
47528   REDUCE_TAC;
47529   IMATCH_MP_TAC  REAL_DIV_REFL;
47530   UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
47531   TYPE_THEN `v*(s - t)` EXISTS_TAC;
47532   TYPE_THEN `&0 < v` SUBAGOAL_TAC;
47533   TYPE_THEN `v` UNABBREV_TAC;
47534   IMATCH_MP_TAC  REAL_LT_DIV;
47535   UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
47536   (* - *)
47537   CONJ_TAC;
47538   IMATCH_MP_TAC  REAL_LE_MUL;
47539   UND 7 THEN UND 2 THEN REAL_ARITH_TAC;
47540   CONJ_TAC;
47541   IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
47542   TYPE_THEN `(s - r)` EXISTS_TAC;
47543   CONJ_TAC;
47544   UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
47545   REWRITE_TAC[REAL_MUL_ASSOC];
47546   REDUCE_TAC;
47547   UND 3 THEN REAL_ARITH_TAC;
47548   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];
47549   ASM_REWRITE_TAC[];
47550   REAL_ARITH_TAC;
47551
47552   ]);;
47553   (* }}} *)
47554
47555 let mk_segment_vc = prove_by_refinement(
47556   `!m. mk_segment (pointI m) (pointI (up m)) = vc_edge m`,
47557   (* {{{ proof *)
47558   [
47559   REWRITE_TAC[up;vc_edge;v_edge;pointI;UNION ;e2;];
47560   IMATCH_MP_TAC  EQ_EXT;
47561   THM_INTRO_TAC[`real_of_int (SND m)`;`real_of_int(SND m + &:1)`;`real_of_int (FST m)`;`x`] mk_segment_v;
47562   REWRITE_TAC[GSYM int_le];
47563   INT_ARITH_TAC;
47564   REWRITE_TAC[point_add;];
47565   REDUCE_TAC;
47566   (* - *)
47567   IMATCH_MP_TAC  EQ_ANTISYM;
47568   CONJ_TAC;
47569   REWRITE_TAC[point_inj;PAIR_SPLIT ];
47570   TYPE_THEN `t = real_of_int (SND m)` ASM_CASES_TAC;
47571  REWRITE_TAC[INR IN_SING];
47572   TYPE_THEN `t = real_of_int (SND m) + &1` ASM_CASES_TAC;
47573   REWRITE_TAC[INR IN_SING];
47574   DISJ1_TAC;
47575   CONV_TAC (dropq_conv "u");
47576 CONV_TAC (dropq_conv "v");
47577   FULL_REWRITE_TAC[int_add_th;int_of_num_th;];
47578   UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
47579   (* - *)
47580   UND 1 THEN REP_CASES_TAC ;
47581   TYPE_THEN `v` EXISTS_TAC;
47582   UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
47583   FULL_REWRITE_TAC [INR IN_SING];
47584   TYPE_THEN `real_of_int (SND m)` EXISTS_TAC;
47585   REWRITE_TAC[int_add_th;int_of_num_th];
47586   REAL_ARITH_TAC;
47587   FULL_REWRITE_TAC [INR IN_SING];
47588   TYPE_THEN `real_of_int (SND m) + &1` EXISTS_TAC;
47589   REWRITE_TAC[int_add_th;int_of_num_th];
47590   REAL_ARITH_TAC;
47591   (* Tue Dec 21 18:22:18 EST 2004 *)
47592
47593   ]);;
47594   (* }}} *)
47595
47596 let mk_segment_hc = prove_by_refinement(
47597   `!m. mk_segment (pointI m) (pointI (right m)) = hc_edge m`,
47598   (* {{{ proof *)
47599   [
47600   REWRITE_TAC[right;hc_edge;h_edge;pointI;UNION ;e1;];
47601   IMATCH_MP_TAC  EQ_EXT;
47602   THM_INTRO_TAC[`real_of_int (FST m)`;`real_of_int(FST m + &:1)`;`real_of_int (SND  m)`;`x`] mk_segment_h;
47603   REWRITE_TAC[int_add_th;int_of_num_th;];
47604   REAL_ARITH_TAC;
47605   REWRITE_TAC[point_add;];
47606   REDUCE_TAC;
47607   FULL_REWRITE_TAC[int_add_th;int_of_num_th;];
47608   (* - *)
47609   REWRITE_TAC[INR IN_SING];
47610   IMATCH_MP_TAC  EQ_ANTISYM;
47611   CONJ_TAC;
47612   REWRITE_TAC[point_inj;PAIR_SPLIT ];
47613   TYPE_THEN `t = real_of_int (FST  m)` ASM_CASES_TAC;
47614   TYPE_THEN `t = real_of_int (FST  m) + &1` ASM_CASES_TAC;
47615   CONV_TAC (dropq_conv "u");
47616 CONV_TAC (dropq_conv "v");
47617   UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
47618   (* - *)
47619   UND 1 THEN REP_CASES_TAC ;
47620   TYPE_THEN `u` EXISTS_TAC;
47621   UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
47622   TYPE_THEN `real_of_int (FST  m)` EXISTS_TAC;
47623   REAL_ARITH_TAC;
47624   TYPE_THEN `real_of_int (FST  m) + &1` EXISTS_TAC;
47625   REAL_ARITH_TAC;
47626
47627   ]);;
47628   (* }}} *)
47629
47630 let simple_arc_end_edge_full_closure = prove_by_refinement(
47631   `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\
47632     (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==>
47633     (C = closure top2 e ) `,
47634   (* {{{ proof *)
47635   [
47636   REP_BASIC_TAC;
47637   THM_INTRO_TAC[`C`;`e`;`m`;`n`] simple_arc_end_edge_closure;
47638   ASM_REWRITE_TAC[];
47639   THM_INTRO_TAC[`C`;`e`;`n`;`m`] simple_arc_end_edge_closure;
47640   CONJ_TAC;
47641   IMATCH_MP_TAC  simple_arc_end_symm;
47642   FIRST_ASSUM IMATCH_MP_TAC ;
47643   (* - *)
47644   TYPE_THEN `C SUBSET closure top2 e` SUBAGOAL_TAC;
47645   REWRITE_TAC[SUBSET];
47646   TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC;
47647   ASM_MESON_TAC[];
47648   UND 6 THEN REP_CASES_TAC;
47649   THM_INTRO_TAC[`top2`;`e`] subset_closure;
47650   REWRITE_TAC[top2_top];
47651   ASM_MESON_TAC[subset_imp];
47652   ASM_REWRITE_TAC[];
47653   ASM_REWRITE_TAC[];
47654   (* - *)
47655   TYPE_THEN `B = closure top2 e` ABBREV_TAC ;
47656   IMATCH_MP_TAC  simple_arc_end_inj;
47657   TYPE_THEN `B` EXISTS_TAC;
47658   TYPE_THEN `pointI m` EXISTS_TAC;
47659   TYPE_THEN `pointI n` EXISTS_TAC;
47660   REWRITE_TAC[SUBSET_REFL];
47661   TYPE_THEN `simple_arc_end B (pointI m) (pointI n)` BACK_TAC;
47662   IMATCH_MP_TAC  simple_arc_end_simple;
47663   ASM_MESON_TAC[];
47664   (* -A *)
47665   THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct;
47666   FULL_REWRITE_TAC[pointI_inj];
47667   (* - *)
47668   TYPE_THEN `mk_segment (pointI m) (pointI n) = B` SUBAGOAL_TAC ;
47669   FULL_REWRITE_TAC[edge];
47670   FIRST_ASSUM DISJ_CASES_TAC;
47671   TYPE_THEN `e` UNABBREV_TAC;
47672   FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;];
47673   TYPE_THEN `B` UNABBREV_TAC;
47674   TYPE_THEN `(m = m') /\ (n = up m') \/ (m = up m') /\ (n = m')` SUBAGOAL_TAC;
47675   RULE_ASSUM_TAC (REWRITE_RULE[vc_edge_pointI;]);
47676   FIRST_ASSUM DISJ_CASES_TAC;
47677   TYPE_THEN `n` UNABBREV_TAC;
47678   REWR 3;
47679   TYPE_THEN `n` UNABBREV_TAC;
47680   ASM_MESON_TAC[];
47681   (* --- *)
47682   REWRITE_TAC[GSYM mk_segment_vc];
47683   FIRST_ASSUM DISJ_CASES_TAC;
47684   MESON_TAC[mk_segment_sym];
47685   (* -- *)
47686   TYPE_THEN `e` UNABBREV_TAC;
47687   FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;];
47688   TYPE_THEN `B` UNABBREV_TAC;
47689   TYPE_THEN `(m = m') /\ (n = right m') \/ (m = right m') /\ (n = m')` SUBAGOAL_TAC;
47690   RULE_ASSUM_TAC (REWRITE_RULE[hc_edge_pointI;]);
47691   FIRST_ASSUM DISJ_CASES_TAC;
47692   TYPE_THEN `n` UNABBREV_TAC;
47693   REWR 3;
47694   TYPE_THEN `n` UNABBREV_TAC;
47695   ASM_MESON_TAC[];
47696   (* -- *)
47697   REWRITE_TAC[GSYM mk_segment_hc];
47698   FIRST_ASSUM DISJ_CASES_TAC;
47699   MESON_TAC[mk_segment_sym];
47700   KILL 6;
47701   TYPE_THEN `B` UNABBREV_TAC;
47702   IMATCH_MP_TAC  mk_segment_simple_arc_end;
47703   REWRITE_TAC[pointI_inj];
47704   REWRITE_TAC[pointI];
47705   ]);;
47706   (* }}} *)
47707
47708 let simple_arc_finite_lemma3 = prove_by_refinement(
47709   `!E e v v'. simple_arc_end e v v' /\
47710       FINITE E /\
47711       e SUBSET UNIONS E /\
47712       E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\
47713       E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\
47714       (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
47715       (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==>
47716       (?(N:num) t f.
47717       (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\
47718       (f (&0) = v) /\ (f (&1) = v') /\
47719       (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
47720       (!i j. (i < j) /\  (i < N) /\  (j < N) ==> (t i < t j)) /\
47721               continuous f (top_of_metric (UNIV,d_real)) top2 /\
47722               INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
47723         (!x.   &0 <= x /\ x <= &1 ==>
47724         ( (?m. f x = pointI m) = (?k.  (k < N) /\ (x = t k)))) /\
47725        (&0 = t 0) /\ (&1 = t (N - 1)) /\
47726       (!i. (SUC i < N) ==> (?ed. (edge ed) /\
47727            (IMAGE f { x | t i <= x /\ x <= t (SUC i) } =
47728              closure top2 ed))))
47729    `,
47730   (* {{{ proof *)
47731   [
47732   REP_BASIC_TAC;
47733   THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma2;
47734   TYPE_THEN `N` EXISTS_TAC;
47735   TYPE_THEN `t` EXISTS_TAC;
47736   TYPE_THEN `f` EXISTS_TAC;
47737   ASM_REWRITE_TAC[];
47738   (* - *)
47739   TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC;
47740   COPY 0;
47741   COPY 1;
47742   TSPEC `eps_hyper F (w 1)` 21;
47743   TSPEC `eps_hyper T (w 0)` 1;
47744   TSPEC `z` 20;
47745   TSPEC `eps` 20;
47746   TSPEC `z'` 0;
47747   TSPEC `eps'` 0;
47748   FULL_REWRITE_TAC[eps_hyper_inj];
47749   TYPE_THEN `z` UNABBREV_TAC;
47750   TYPE_THEN `z'` UNABBREV_TAC;
47751   TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC;
47752   FIRST_ASSUM IMATCH_MP_TAC ;
47753   ASM_MESON_TAC[];
47754   TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC;
47755   FIRST_ASSUM IMATCH_MP_TAC ;
47756   ASM_MESON_TAC[];
47757   REWRITE_TAC[pointI];
47758   TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC;
47759   REWRITE_TAC[int_neg;int_abstr;int_of_num_th;];
47760   TYPE_THEN `!j. (integer (-- &j))` SUBAGOAL_TAC;
47761   REWRITE_TAC[is_int];
47762   MESON_TAC[];
47763   USE 24 (REWRITE_RULE[int_rep]);
47764   USE 19 (MATCH_MP point_onto);
47765   REWRITE_TAC[point_inj];
47766   TYPE_THEN `w` UNABBREV_TAC;
47767   FULL_REWRITE_TAC[coord01;PAIR_SPLIT];
47768   (* -A *)
47769   SUBCONJ_TAC;
47770   TYPE_THEN `?m. v = pointI m` SUBAGOAL_TAC;
47771   FIRST_ASSUM IMATCH_MP_TAC ;
47772   THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end;
47773   USE 8 (MATCH_MP simple_arc_end_simple);
47774   USE 8 (MATCH_MP simple_arc_euclid);
47775   ASM_MESON_TAC[subset_imp];
47776   UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&0`]));
47777   REDUCE_TAC;
47778   TYPE_THEN `(?k. k <| N /\ (&0 = t k))` SUBAGOAL_TAC;
47779   USE 9 SYM;
47780   TYPE_THEN `m` EXISTS_TAC;
47781   ASM_REWRITE_TAC[];
47782   AP_TERM_TAC;
47783   IMATCH_MP_TAC  (ARITH_RULE `~(0 < k) ==> (k = 0)`);
47784   USE 16 (REWRITE_RULE[IMAGE;SUBSET ]);
47785   USE 16 (CONV_RULE NAME_CONFLICT_CONV);
47786   TSPEC `t 0` 16;
47787   LEFT 16 "x'" ;
47788   TSPEC `0` 16;
47789   TYPE_THEN `0 < N` SUBAGOAL_TAC;
47790   UND 21 THEN UND 20 THEN ARITH_TAC;
47791   REWR 16;
47792   USE 23 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`));
47793   UND 23 THEN REWRITE_TAC[];
47794   FIRST_ASSUM IMATCH_MP_TAC ;
47795   (* -B *)
47796   SUBCONJ_TAC;
47797   TYPE_THEN `?m. v' = pointI m` SUBAGOAL_TAC;
47798   FIRST_ASSUM IMATCH_MP_TAC ;
47799   THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end2;
47800   USE 8 (MATCH_MP simple_arc_end_simple);
47801   USE 8 (MATCH_MP simple_arc_euclid);
47802   ASM_MESON_TAC[subset_imp];
47803   UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&1`]));
47804   REDUCE_TAC;
47805   REWRITE_TAC[ARITH_RULE `1 <= 1`];
47806   USE 18 SYM;
47807   REDUCE_TAC;
47808   (* -- *)
47809   TYPE_THEN `(?k. k <| N /\ (&1 = t k))` SUBAGOAL_TAC;
47810   USE 9 SYM;
47811   TYPE_THEN `m` EXISTS_TAC;
47812   ASM_REWRITE_TAC[];
47813   AP_TERM_TAC;
47814   IMATCH_MP_TAC  (ARITH_RULE `(k < N) /\ ~(k < N - 1) ==> (k = N - 1)`);
47815   USE 16 (REWRITE_RULE[IMAGE;SUBSET ]);
47816   USE 22 (CONV_RULE NAME_CONFLICT_CONV);
47817   TSPEC `t (N-1)` 22;
47818   LEFT 22 "x'" ;
47819   TSPEC `N-1` 22;
47820   UND 22 THEN DISCH_THEN (THM_INTRO_TAC[]);
47821   UND 21 THEN ARITH_TAC;
47822   REWR 22;
47823   USE 22 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`));
47824   UND 22 THEN REWRITE_TAC[];
47825   FIRST_ASSUM IMATCH_MP_TAC ;
47826   UND 16 THEN ARITH_TAC;
47827   (* -C *)
47828   USE 20 SYM;
47829   USE 18 SYM;
47830   TYPE_THEN `&0 <= t i /\ t i <= &1` SUBAGOAL_TAC;
47831   USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
47832   FIRST_ASSUM IMATCH_MP_TAC ;
47833   TYPE_THEN `i` EXISTS_TAC;
47834   UND 19 THEN ARITH_TAC;
47835   (* - *)
47836   TYPE_THEN `&0 <= t (SUC i) /\ t (SUC i) <= &1` SUBAGOAL_TAC;
47837   USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
47838   FIRST_ASSUM IMATCH_MP_TAC ;
47839   TYPE_THEN `SUC i` EXISTS_TAC;
47840   ASM_REWRITE_TAC[];
47841   (* - *)
47842   TYPE_THEN `connected top2 (IMAGE f {x | t i < x /\ x < t (SUC i)})` SUBAGOAL_TAC;
47843   IMATCH_MP_TAC  connect_image;
47844   TYPE_THEN `top_of_metric (UNIV,d_real)` EXISTS_TAC;
47845   REWRITE_TAC[top2_unions];
47846   CONJ_TAC;
47847   REWRITE_TAC[IMAGE;SUBSET];
47848   USE 10 (REWRITE_RULE[INJ]);
47849   FIRST_ASSUM IMATCH_MP_TAC ;
47850   UND 26 THEN UND 27 THEN UND 23 THEN UND 22 THEN REAL_ARITH_TAC;
47851   (* --D *)
47852   REWRITE_TAC[connect_real_open];
47853   (* - *)
47854   TYPE_THEN `!x. &0 <= x /\ x <= &1 /\ ~(IMAGE t {j | j<| N} x) ==> (?e. edge e /\ (e (f x)))` SUBAGOAL_TAC;
47855   TYPE_THEN `e` UNABBREV_TAC;
47856   USE 6 (REWRITE_RULE[SUBSET;UNIONS;IMAGE  ]);
47857   USE 6 (CONV_RULE NAME_CONFLICT_CONV);
47858   TSPEC `f x` 6;
47859   UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
47860   TYPE_THEN `x` EXISTS_TAC;
47861   ASM_REWRITE_TAC[];
47862   TSPEC `u'` 1;
47863   REWRITE_TAC[];
47864   TYPE_THEN `u'` UNABBREV_TAC;
47865   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`z`;`eps`]);
47866   TYPE_THEN `z` UNABBREV_TAC;
47867   (* --E *)
47868   TYPE_THEN `euclid 2 (f x)` SUBAGOAL_TAC;
47869   USE 8 (MATCH_MP simple_arc_end_simple);
47870   USE 0 (MATCH_MP simple_arc_euclid);
47871   USE 0 (REWRITE_RULE[SUBSET]);
47872   FIRST_ASSUM IMATCH_MP_TAC ;
47873   IMATCH_MP_TAC  image_imp;
47874   ASM_REWRITE_TAC[];
47875   TYPE_THEN `?C. cell C /\ C (f x)` SUBAGOAL_TAC;
47876   USE 0 (MATCH_MP point_onto);
47877   THM_INTRO_TAC[`p`] cell_unions;
47878   USE 1 (REWRITE_RULE[UNIONS]);
47879   TYPE_THEN `u` EXISTS_TAC;
47880   TYPE_THEN `C` EXISTS_TAC;
47881   FULL_REWRITE_TAC[cell];
47882   UND 29 THEN REP_CASES_TAC;
47883   TYPE_THEN `C` UNABBREV_TAC;
47884   FULL_REWRITE_TAC[INR IN_SING];
47885   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
47886   TYPE_THEN `(?k. k <| N /\ (x = t k))` SUBAGOAL_TAC;
47887   USE 9 SYM;
47888   UNIFY_EXISTS_TAC;
47889   TYPE_THEN `x` UNABBREV_TAC;
47890   PROOF_BY_CONTR_TAC;
47891   UND 26 THEN REWRITE_TAC[];
47892   IMATCH_MP_TAC  image_imp;
47893   ASM_REWRITE_TAC[];
47894   REWRITE_TAC[edge_h];
47895   REWRITE_TAC[edge_v];
47896   TYPE_THEN `C` UNABBREV_TAC;
47897   USE 1 (REWRITE_RULE[squ]);
47898   TYPE_THEN `f x` UNABBREV_TAC;
47899   USE 6 (REWRITE_RULE[eps_hyper]);
47900   UND 6 THEN COND_CASES_TAC;
47901    FULL_REWRITE_TAC[e1];
47902   FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_F];
47903   FULL_REWRITE_TAC[point_inj];
47904   TYPE_THEN `p'` UNABBREV_TAC;
47905   TYPE_THEN `u` UNABBREV_TAC;
47906   (* ---F *)
47907   FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;];
47908   UND 30 THEN UND 31 THEN INT_ARITH_TAC;
47909   (* -- *)
47910    FULL_REWRITE_TAC[e2];
47911   FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_S];
47912   FULL_REWRITE_TAC[point_inj];
47913   TYPE_THEN `p'` UNABBREV_TAC;
47914   TYPE_THEN `v''` UNABBREV_TAC;
47915   FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;];
47916   UND 1 THEN UND 29 THEN INT_ARITH_TAC;
47917   (* -G *)
47918   THM_INTRO_TAC[`(IMAGE f {x | t i < x /\ x < t (SUC i)})`] connected_in_edge;
47919   REWRITE_TAC[IMAGE;SUBSET;UNIONS];
47920   FIRST_ASSUM IMATCH_MP_TAC ;
47921   CONJ_TAC;
47922   UND 29 THEN UND 22 THEN REAL_ARITH_TAC;
47923   CONJ_TAC;
47924   UND 23 THEN UND 28 THEN REAL_ARITH_TAC;
47925   USE 30 (REWRITE_RULE[IMAGE]);
47926   TYPE_THEN `x'` UNABBREV_TAC;
47927   USE 28 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`));
47928   UND 30 THEN REWRITE_TAC[];
47929   FIRST_ASSUM IMATCH_MP_TAC ;
47930   IMATCH_MP_TAC   (ARITH_RULE  `~(x = y) /\ ~(x <| y) ==> (y < x)`);
47931   CONJ_TAC;
47932   TYPE_THEN `x''` UNABBREV_TAC;
47933   USE 29 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`));
47934   UND 32 THEN REWRITE_TAC[];
47935   FIRST_ASSUM IMATCH_MP_TAC ;
47936   TYPE_THEN `i <| N` SUBAGOAL_TAC;
47937   UND 19 THEN ARITH_TAC;
47938   IMATCH_MP_TAC   (ARITH_RULE  `~(x = y) /\ ~(x <| y) ==> (y < x)`);
47939   CONJ_TAC;
47940   TYPE_THEN `x''` UNABBREV_TAC;
47941   UND 33 THEN UND 30 THEN ARITH_TAC;
47942   (* - *)
47943   TYPE_THEN `e'` EXISTS_TAC;
47944   (* -H *)
47945   TYPE_THEN `C = IMAGE f {x | t i <= x /\ x <= t (SUC i)}` ABBREV_TAC ;
47946   IMATCH_MP_TAC  simple_arc_end_edge_full_closure;
47947   KILL 5;
47948   KILL 4;
47949   KILL 2;
47950   KILL 3;
47951   KILL 0;
47952   KILL 17;
47953   TYPE_THEN `v` UNABBREV_TAC;
47954   TYPE_THEN `v'` UNABBREV_TAC;
47955   TYPE_THEN `!k. k <| N ==> (?m. f (t k) = pointI m)` SUBAGOAL_TAC;
47956   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`t k`]);
47957   USE 16 (REWRITE_RULE[IMAGE;SUBSET]);
47958   ASM_MESON_TAC[];
47959   TYPE_THEN `k` EXISTS_TAC;
47960   ASM_REWRITE_TAC[];
47961   (* - *)
47962   COPY 0;
47963   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
47964   UND 19 THEN ARITH_TAC;
47965   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
47966   TYPE_THEN `m` EXISTS_TAC;
47967   TYPE_THEN `m'` EXISTS_TAC;
47968   IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
47969   CONJ_TAC;
47970   TYPE_THEN `C` UNABBREV_TAC;
47971   USE 5 (REWRITE_RULE[IMAGE]);
47972   TYPE_THEN `x` UNABBREV_TAC;
47973   TYPE_THEN `pointI m` UNABBREV_TAC;
47974   TYPE_THEN `pointI m'` UNABBREV_TAC;
47975   USE 27 (REWRITE_RULE[IMAGE;SUBSET]);
47976   FIRST_ASSUM IMATCH_MP_TAC ;
47977   TYPE_THEN `x'` EXISTS_TAC;
47978   TYPE_THEN `~(x' = t i)` SUBAGOAL_TAC;
47979   TYPE_THEN `x'` UNABBREV_TAC;
47980   TYPE_THEN `~(x' = t (SUC i))` SUBAGOAL_TAC;
47981   TYPE_THEN `x'` UNABBREV_TAC;
47982   UND 5 THEN UND 2 THEN UND 15 THEN UND 14 THEN REAL_ARITH_TAC;
47983   (* - *)
47984   REWRITE_TAC[simple_arc_end];
47985   THM_INTRO_TAC[`&0`;`&1`;`t i`;`t (SUC i)`;`C`;`f`;`t i`;`t (SUC i)`] arc_restrict;
47986   REWRITE_TAC[REAL_ARITH `x <= x`];
47987   USE 11 (REWRITE_RULE[top2]);
47988   CONJ_TAC;
47989   FIRST_ASSUM IMATCH_MP_TAC ;
47990   UND 19 THEN ARITH_TAC;
47991   IMATCH_MP_TAC  inj_subset_domain;
47992   UNIFY_EXISTS_TAC;
47993   REWRITE_TAC[SUBSET];
47994   UND 4 THEN UND 5 THEN UND 22 THEN UND 23 THEN REAL_ARITH_TAC;
47995   TYPE_THEN `g` EXISTS_TAC;
47996   ASM_REWRITE_TAC[];
47997   REWRITE_TAC[top2];
47998   (* Tue Dec 21 19:05:25 EST 2004 *)
47999
48000   ]);;
48001   (* }}} *)
48002
48003 let order_lt_imp_psegment = prove_by_refinement(
48004   `!f n.
48005      INJ f {p | p <| n} edge /\
48006           0 <| n /\
48007           (!i j.
48008                i <| n /\ j <| n /\ (i < j)
48009                ==> (adj (f i) (f j) = (SUC i = j) ))
48010           ==> psegment (IMAGE f {p | p <| n})`,
48011   (* {{{ proof *)
48012   [
48013   REP_BASIC_TAC;
48014   IMATCH_MP_TAC  order_imp_psegment;
48015   REP_BASIC_TAC;
48016   TYPE_THEN `i <| j` ASM_CASES_TAC;
48017   TYPE_THEN `~(SUC j = i)` SUBAGOAL_TAC;
48018   UND 6 THEN UND 5 THEN ARITH_TAC;
48019   FIRST_ASSUM IMATCH_MP_TAC ;
48020   TYPE_THEN `i = j` ASM_CASES_TAC;
48021   REWRITE_TAC[adj];
48022   UND 7 THEN ARITH_TAC;
48023   TYPE_THEN `j <| i` SUBAGOAL_TAC;
48024   UND 6 THEN UND 5 THEN ARITH_TAC;
48025   TYPE_THEN `~(SUC i = j)` SUBAGOAL_TAC;
48026   UND 8 THEN UND 7 THEN ARITH_TAC;
48027   ONCE_REWRITE_TAC[adj_symm];
48028   FIRST_ASSUM IMATCH_MP_TAC ;
48029   ]);;
48030   (* }}} *)
48031
48032
48033 let simple_arc_finite_lemma4 = prove_by_refinement(
48034   `!E e v v'. simple_arc_end e v v' /\
48035       FINITE E /\
48036       e SUBSET UNIONS E /\
48037       E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\
48038       E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\
48039       (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
48040       (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==>
48041    (?S a b. segment_end S a b /\ (v = pointI a) /\ (v' = pointI b) /\
48042       (e = closure top2 (UNIONS S)))
48043    `,
48044   (* {{{ proof *)
48045   [
48046   REP_BASIC_TAC;
48047   THM_INTRO_TAC[`E`;`e`;`v`;`v'`]simple_arc_finite_lemma3;
48048   ASM_REWRITE_TAC[];
48049   (* - *)
48050   REWRITE_TAC[segment_end];
48051   LEFT 9 "ed";
48052   LEFT 9 "ed";
48053   TYPE_THEN `S = IMAGE ed {p | p <| N - 1}` ABBREV_TAC ;
48054   TYPE_THEN `S` EXISTS_TAC;
48055   TYPE_THEN `!i. i <| N ==> (?m. f (t i) = pointI m)` SUBAGOAL_TAC;
48056   USE 10 SYM;
48057   USE 11 SYM;
48058   UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`t i`]);
48059   USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
48060   FIRST_ASSUM IMATCH_MP_TAC ;
48061   UNIFY_EXISTS_TAC;
48062   ASM_REWRITE_TAC[];
48063   UNIFY_EXISTS_TAC;
48064   ASM_REWRITE_TAC[];
48065   (* - *)
48066   TYPE_THEN `0 <| N` SUBAGOAL_TAC;
48067   IMATCH_MP_TAC  (ARITH_RULE `~(N = 0) ==> (0 <| N)`);
48068   TYPE_THEN `N` UNABBREV_TAC;
48069   FULL_REWRITE_TAC[ARITH_RULE `0 -| 1 = 0`];
48070   UND 10 THEN UND 11 THEN REAL_ARITH_TAC;
48071   (* - *)
48072   TYPE_THEN `?a. f (t 0) = pointI a` SUBAGOAL_TAC;
48073   TYPE_THEN `?b. f (t (N - 1)) = pointI b` SUBAGOAL_TAC;
48074   FIRST_ASSUM IMATCH_MP_TAC ;
48075   UND 22 THEN ARITH_TAC;
48076   TYPE_THEN `a` EXISTS_TAC;
48077   TYPE_THEN `b` EXISTS_TAC;
48078   (* - *)
48079   TYPE_THEN `v = pointI a` SUBAGOAL_TAC;
48080   TYPE_THEN `v` UNABBREV_TAC;
48081   ASM_REWRITE_TAC[];
48082   (* - *)
48083   TYPE_THEN `v' = pointI b` SUBAGOAL_TAC;
48084   TYPE_THEN `v'` UNABBREV_TAC;
48085   ASM_REWRITE_TAC[];
48086   (* -A *)
48087   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;
48088   TYPE_THEN `S` UNABBREV_TAC;
48089   SUBCONJ_TAC; (* // *)
48090   REWRITE_TAC[INJ];
48091   CONJ_TAC;
48092   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
48093   UND 20 THEN ARITH_TAC;
48094   TYPE_THEN `!x y. x < y /\ y <| N - 1 ==> ~(ed x = ed y)` SUBAGOAL_TAC;
48095   TYPE_THEN `t x' < t y'` SUBAGOAL_TAC;
48096   FIRST_ASSUM IMATCH_MP_TAC ;
48097   UND 31 THEN UND 30 THEN ARITH_TAC;
48098   COPY 9;
48099   UND 33 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
48100   UND 31 THEN UND 30 THEN ARITH_TAC;
48101   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`y'`]);
48102   UND 30 THEN ARITH_TAC;
48103   TYPE_THEN `ed x'` UNABBREV_TAC;
48104   TYPE_THEN `IMAGE f {x | t x' <= x /\ x <= t (SUC x')} (f (t x'))` SUBAGOAL_TAC;
48105   USE 33 SYM;
48106   IMATCH_MP_TAC  image_imp;
48107   CONJ_TAC;
48108   REAL_ARITH_TAC;
48109   IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
48110   FIRST_ASSUM IMATCH_MP_TAC ;
48111   UND 31 THEN UND 30 THEN ARITH_TAC;
48112   TYPE_THEN `IMAGE f {x | t y' <= x /\ x <= t (SUC y')} (f (t x'))` SUBAGOAL_TAC;
48113   USE 33 SYM;
48114   ASM_REWRITE_TAC[];
48115   USE 36 (REWRITE_RULE[IMAGE]);
48116   USE 13 (REWRITE_RULE[INJ]);
48117   TYPE_THEN `t x' = x''` SUBAGOAL_TAC;
48118   FIRST_ASSUM IMATCH_MP_TAC ;
48119   USE 11 SYM;
48120   USE 10 SYM;
48121   USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
48122   CONJ_TAC;
48123   FIRST_ASSUM IMATCH_MP_TAC ;
48124   TYPE_THEN `x'` EXISTS_TAC;
48125   UND 31 THEN UND 30 THEN ARITH_TAC;
48126   TYPE_THEN `&0 <= t y' /\ t y' <= &1` SUBAGOAL_TAC;
48127   FIRST_ASSUM IMATCH_MP_TAC ;
48128   TYPE_THEN `y'` EXISTS_TAC;
48129   UND 30 THEN ARITH_TAC;
48130   CONJ_TAC;
48131   UND 41 THEN UND 38 THEN ARITH_TAC;
48132   TYPE_THEN `&0 <= t (SUC y') /\ t (SUC y') <= &1` SUBAGOAL_TAC;
48133   FIRST_ASSUM IMATCH_MP_TAC ;
48134   TYPE_THEN `SUC y'` EXISTS_TAC;
48135   UND 30 THEN ARITH_TAC;
48136   UND 42 THEN UND 37 THEN ARITH_TAC;
48137   TYPE_THEN `x''` UNABBREV_TAC;
48138   UND 38 THEN UND 32 THEN REAL_ARITH_TAC;
48139   IMATCH_MP_TAC  (ARITH_RULE  `(~(x <| y) /\ ~(y < x)) ==> (x = y)`);
48140   CONJ_TAC;
48141   UND 30 THEN UND 29 THEN UND 27 THEN UND 20 THEN MESON_TAC[];
48142   UND 30 THEN UND 29 THEN UND 28 THEN UND 20 THEN MESON_TAC[];
48143   (* -- *)
48144   SUBCONJ_TAC;
48145   IMATCH_MP_TAC  (ARITH_RULE `~(0 = N-1) ==> (0 <| N- 1)`);
48146   TYPE_THEN `N -| 1` UNABBREV_TAC;
48147   UND 10 THEN UND 11 THEN REAL_ARITH_TAC;
48148   (* --B *)
48149   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;
48150   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
48151   UND 31 THEN ARITH_TAC;
48152   USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
48153   TSPEC `u` 9;
48154   USE 9 SYM;
48155   REWRITE_TAC[IMAGE];
48156   REWRITE_TAC[CONJ_ACI];
48157   (* -- *)
48158   REWRITE_TAC[adj;EMPTY_EXISTS;INTER ];
48159   IMATCH_MP_TAC  EQ_ANTISYM;
48160   CONJ_TAC;
48161   TYPE_THEN `u` UNABBREV_TAC;
48162   TYPE_THEN `x = x'` SUBAGOAL_TAC;
48163   USE 13 (REWRITE_RULE[INJ]);
48164   USE 10 SYM;
48165   USE 11 SYM;
48166   FIRST_ASSUM IMATCH_MP_TAC ;
48167   TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
48168   USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
48169   TYPE_THEN `&0 <= t j' /\ t j' <= &1` SUBAGOAL_TAC;
48170   FIRST_ASSUM IMATCH_MP_TAC ;
48171   TYPE_THEN `j'` EXISTS_TAC;
48172   UND 41 THEN ARITH_TAC;
48173   TYPE_THEN `&0 <= t (SUC j') /\ t (SUC j') <= &1` SUBAGOAL_TAC;
48174   FIRST_ASSUM IMATCH_MP_TAC ;
48175   TYPE_THEN `SUC j'` EXISTS_TAC;
48176   UND 41 THEN ARITH_TAC;
48177   UND 44 THEN UND 39 THEN UND 43 THEN UND 40 THEN REAL_ARITH_TAC;
48178   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
48179   TYPE_THEN  `i` EXISTS_TAC;
48180   TYPE_THEN `j` EXISTS_TAC;
48181   TYPE_THEN `x'` UNABBREV_TAC;
48182   TYPE_THEN `t i < t j` SUBAGOAL_TAC;
48183   FIRST_ASSUM IMATCH_MP_TAC ;
48184   UND 28 THEN UND 29 THEN ARITH_TAC;
48185   PROOF_BY_CONTR_TAC;
48186   TYPE_THEN `t j <= t (SUC i)` SUBAGOAL_TAC;
48187   UND 35 THEN UND 33 THEN REAL_ARITH_TAC;
48188   USE 40 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`));
48189   UND 40 THEN REWRITE_TAC[];
48190   FIRST_ASSUM IMATCH_MP_TAC ;
48191   UND 39 THEN UND 27 THEN UND 28 THEN UND 29 THEN ARITH_TAC;
48192   (* -- *)
48193   TYPE_THEN `j` UNABBREV_TAC;
48194   CONJ_TAC;
48195   TYPE_THEN `i = SUC i` SUBAGOAL_TAC;
48196   USE 20 (REWRITE_RULE[INJ]);
48197   FIRST_ASSUM IMATCH_MP_TAC ;
48198   UND 33 THEN ARITH_TAC;
48199   TYPE_THEN `f (t (SUC i))` EXISTS_TAC;
48200   CONJ_TAC;
48201   TYPE_THEN `t (SUC i)` EXISTS_TAC;
48202   REWRITE_TAC[REAL_ARITH `x <= x`];
48203   IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
48204   FIRST_ASSUM IMATCH_MP_TAC ;
48205   UND 28 THEN ARITH_TAC;
48206   TYPE_THEN `t (SUC i)` EXISTS_TAC;
48207   REWRITE_TAC[REAL_ARITH `x <= x`];
48208   IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
48209   FIRST_ASSUM IMATCH_MP_TAC ;
48210   UND 28 THEN ARITH_TAC;
48211   (* - *)
48212   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;
48213   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
48214   UND 30 THEN ARITH_TAC;
48215   USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
48216   TSPEC `u` 9;
48217   USE 9 SYM;
48218   REWRITE_TAC[IMAGE];
48219   REWRITE_TAC[CONJ_ACI];
48220   (* - *)
48221   USE 11 SYM;
48222   USE 10 SYM;
48223   TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
48224   USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
48225   TYPE_THEN `&0 <= t j /\ t j <= &1` SUBAGOAL_TAC;
48226   FIRST_ASSUM IMATCH_MP_TAC ;
48227   TYPE_THEN `j` EXISTS_TAC;
48228   UND 33 THEN ARITH_TAC;
48229   TYPE_THEN `&0 <= t (SUC j) /\ t (SUC j) <= &1` SUBAGOAL_TAC;
48230   FIRST_ASSUM IMATCH_MP_TAC ;
48231   TYPE_THEN `SUC j` EXISTS_TAC;
48232   UND 33 THEN ARITH_TAC;
48233   UND 36 THEN UND 31 THEN UND 35 THEN UND 32 THEN REAL_ARITH_TAC;
48234   (* -C *)
48235   ONCE_REWRITE_TAC[CONJ_ACI];
48236   SUBCONJ_TAC;
48237   THM_INTRO_TAC[`ed`;`N-| 1`] order_lt_imp_psegment;
48238   ASM_REWRITE_TAC[];
48239   TYPE_THEN `S` UNABBREV_TAC;
48240   (* - *)
48241   TYPE_THEN `{a, b} SUBSET endpoint S` SUBAGOAL_TAC;
48242   REWRITE_TAC[SUBSET;INR in_pair];
48243   REWRITE_TAC[endpoint];
48244   THM_INTRO_TAC[`S`;`pointI x`] num_closure1;
48245   USE 32 (REWRITE_RULE[psegment;segment]);
48246   FIRST_ASSUM DISJ_CASES_TAC; (* // *)
48247   TYPE_THEN `x` UNABBREV_TAC;
48248   TYPE_THEN `ed (N -2)` EXISTS_TAC;
48249   TYPE_THEN `S` UNABBREV_TAC;
48250   REWRITE_TAC[IMAGE];
48251   IMATCH_MP_TAC  EQ_ANTISYM;
48252   CONJ_TAC;
48253   TYPE_THEN `e'` UNABBREV_TAC;
48254   PROOF_BY_CONTR_TAC;
48255   TYPE_THEN `x' < N -| 2` SUBAGOAL_TAC;
48256   IMATCH_MP_TAC  (ARITH_RULE `x' < N -| 1 /\ ~(x' = N-2) ==> x' < N -2`);
48257   PROOF_BY_CONTR_TAC;
48258   REWR 37;
48259   TYPE_THEN `x'` UNABBREV_TAC;
48260   (* ---- *)
48261   TYPE_THEN `pointI b` UNABBREV_TAC;
48262   UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[];
48263   USE 10 SYM;
48264   TYPE_THEN `t (N -1) = x''` SUBAGOAL_TAC;
48265   USE 13 (REWRITE_RULE[INJ]);
48266   FIRST_ASSUM IMATCH_MP_TAC ;
48267   USE 10 SYM;
48268   REDUCE_TAC;
48269   REWRITE_TAC[ARITH_RULE `1 <= 1`];
48270   FIRST_ASSUM IMATCH_MP_TAC ;
48271   TYPE_THEN  `x'` EXISTS_TAC;
48272   TYPE_THEN `x''` UNABBREV_TAC;
48273   USE 20 (MATCH_MP (REAL_ARITH  `x <= y ==> ~( y < x)`));
48274   UND 20 THEN REWRITE_TAC[];
48275   FIRST_ASSUM IMATCH_MP_TAC ;
48276   UND 37 THEN ARITH_TAC;
48277   TYPE_THEN `e'` UNABBREV_TAC;
48278   CONJ_TAC;
48279   TYPE_THEN `N-| 2` EXISTS_TAC;
48280   UND 28 THEN ARITH_TAC;
48281   TYPE_THEN `N -| 2 < N -| 1` SUBAGOAL_TAC;
48282   UND 28 THEN ARITH_TAC;
48283   TYPE_THEN `t (N - 1)` EXISTS_TAC;
48284   TYPE_THEN `SUC (N - 2) = N - 1` SUBAGOAL_TAC;
48285   UND 28 THEN  ARITH_TAC;
48286   USE 10 SYM;
48287   REWRITE_TAC[REAL_ARITH `x <= x`];
48288   IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
48289   FIRST_ASSUM IMATCH_MP_TAC ;
48290   UND 28 THEN ARITH_TAC;
48291   (* --D *)
48292   TYPE_THEN `x` UNABBREV_TAC;
48293   TYPE_THEN `ed (0)` EXISTS_TAC;
48294   TYPE_THEN `S` UNABBREV_TAC;
48295   REWRITE_TAC[IMAGE];
48296   IMATCH_MP_TAC  EQ_ANTISYM;
48297   CONJ_TAC;
48298   TYPE_THEN `e'` UNABBREV_TAC;
48299   PROOF_BY_CONTR_TAC;
48300   TYPE_THEN `0 < x'` SUBAGOAL_TAC;
48301   IMATCH_MP_TAC  (ARITH_RULE `~(x' = 0) ==> 0 < x'`);
48302   TYPE_THEN `x'` UNABBREV_TAC;
48303   (* --- *)
48304   TYPE_THEN `pointI a` UNABBREV_TAC;
48305   UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[];
48306   USE 11 SYM;
48307   TYPE_THEN `t (0) = x''` SUBAGOAL_TAC;
48308   USE 13 (REWRITE_RULE[INJ]);
48309   FIRST_ASSUM IMATCH_MP_TAC ;
48310   USE 11 SYM;
48311   REDUCE_TAC;
48312   FIRST_ASSUM IMATCH_MP_TAC ;
48313   TYPE_THEN  `x'` EXISTS_TAC;
48314   TYPE_THEN `x''` UNABBREV_TAC;
48315   USE 25 (MATCH_MP (REAL_ARITH  `x <= y ==> ~( y < x)`));
48316   UND 25 THEN REWRITE_TAC[];
48317   FIRST_ASSUM IMATCH_MP_TAC ;
48318   UND 38 THEN ARITH_TAC;
48319   TYPE_THEN `e'` UNABBREV_TAC;
48320   CONJ_TAC;
48321   TYPE_THEN `0` EXISTS_TAC;
48322   ASM_REWRITE_TAC[];
48323   TYPE_THEN `t (0)` EXISTS_TAC;
48324   REDUCE_TAC;
48325   USE 11 SYM;
48326   IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
48327   FIRST_ASSUM IMATCH_MP_TAC ;
48328   UND 28 THEN ARITH_TAC;
48329   (* -E *)
48330   SUBCONJ_TAC;
48331   IMATCH_MP_TAC  has_size2_pair;
48332   CONJ_TAC;
48333   IMATCH_MP_TAC  endpoint_size2;
48334   USE 33 (REWRITE_RULE[SUBSET;INR in_pair]);
48335   CONJ_TAC ;
48336   FIRST_ASSUM IMATCH_MP_TAC ;
48337   CONJ_TAC;
48338   FIRST_ASSUM IMATCH_MP_TAC ;
48339   TYPE_THEN `a` UNABBREV_TAC;
48340   TYPE_THEN `v = v'` SUBAGOAL_TAC;
48341   USE 8(MATCH_MP simple_arc_end_distinct);
48342   UND 8 THEN ASM_REWRITE_TAC[];
48343   (* -F *)
48344   IMATCH_MP_TAC  EQ_EXT ;
48345   THM_INTRO_TAC[`S`;`top2`] closure_unions;
48346   REWRITE_TAC[top2_top];
48347   FULL_REWRITE_TAC[psegment;segment];
48348   TYPE_THEN `S` UNABBREV_TAC;
48349   REWRITE_TAC[UNIONS];
48350   IMATCH_MP_TAC  EQ_ANTISYM;
48351   CONJ_TAC;
48352   USE 20 (REWRITE_RULE[IMAGE]);
48353   (* -- *)
48354   TYPE_THEN `A = {i | (i <=| N -| 1) /\ (t i <= x')}` ABBREV_TAC ;
48355   TYPE_THEN `FINITE A` SUBAGOAL_TAC;
48356   IMATCH_MP_TAC  FINITE_SUBSET;
48357   TYPE_THEN `{i | i <=| (N -| 1)}` EXISTS_TAC;
48358   TYPE_THEN `A` UNABBREV_TAC;
48359   REWRITE_TAC[SUBSET];
48360   REWRITE_TAC[FINITE_NUMSEG_LE];
48361   TYPE_THEN `A 0` SUBAGOAL_TAC;
48362   TYPE_THEN `A` UNABBREV_TAC;
48363   ASM_REWRITE_TAC[];
48364   UND 28 THEN ARITH_TAC;
48365   THM_INTRO_TAC[`A`] select_num_max;
48366   REWRITE_TAC[EMPTY_EXISTS];
48367   TYPE_THEN `0` EXISTS_TAC;
48368   TYPE_THEN `x' = &1` ASM_CASES_TAC;
48369   TYPE_THEN `closure top2 (ed (N -| 2))` EXISTS_TAC;
48370   CONJ_TAC;
48371   IMATCH_MP_TAC  image_imp;
48372   IMATCH_MP_TAC  image_imp;
48373   UND 28 THEN ARITH_TAC;
48374   USE 24 SYM;
48375   TYPE_THEN `N - 2 <| N - 1` SUBAGOAL_TAC;
48376   UND 28 THEN ARITH_TAC;
48377   TYPE_THEN `t (N -| 1)` EXISTS_TAC;
48378   TYPE_THEN `N - 1 = SUC (N - 2)` SUBAGOAL_TAC;
48379   UND 28 THEN ARITH_TAC;
48380   USE 10 SYM;
48381   ASM_REWRITE_TAC[];
48382   REWRITE_TAC[REAL_ARITH `x <= x`];
48383   IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
48384   FIRST_ASSUM IMATCH_MP_TAC ;
48385   UND 28 THEN ARITH_TAC;
48386   (* -- *)
48387   TYPE_THEN `closure top2 (ed z)` EXISTS_TAC;
48388   CONJ_TAC;
48389   IMATCH_MP_TAC  image_imp;
48390   IMATCH_MP_TAC  image_imp;
48391   TYPE_THEN `A` UNABBREV_TAC;
48392   IMATCH_MP_TAC  (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`);
48393   DISCH_TAC;
48394   TYPE_THEN `z` UNABBREV_TAC;
48395   UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC;
48396   TYPE_THEN `z <| N-1` SUBAGOAL_TAC;
48397   IMATCH_MP_TAC  (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`);
48398   TYPE_THEN `A` UNABBREV_TAC;
48399   DISCH_TAC;
48400   TYPE_THEN `z` UNABBREV_TAC;
48401   UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC;
48402   TYPE_THEN `x'` EXISTS_TAC;
48403   TYPE_THEN `A` UNABBREV_TAC;
48404   IMATCH_MP_TAC  (REAL_ARITH `~(x <= y) ==> (y <= x)`);
48405   UND 41 THEN DISCH_THEN (THM_INTRO_TAC[`SUC z`]);
48406   UND 44 THEN ARITH_TAC;
48407   UND 41 THEN ARITH_TAC;
48408   (* -G *)
48409   USE 36 (REWRITE_RULE[IMAGE]);
48410   TYPE_THEN `u` UNABBREV_TAC;
48411   TYPE_THEN `x'` UNABBREV_TAC;
48412   UND 30 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x`]);
48413   REWR 30;
48414   IMATCH_MP_TAC  image_imp;
48415   FIRST_ASSUM IMATCH_MP_TAC ;
48416   TYPE_THEN `x''` EXISTS_TAC;
48417   (* Wed Dec 22 07:47:58 EST 2004 *)
48418   ]);;
48419   (* }}} *)
48420
48421 let psegment_cls = prove_by_refinement(
48422   `!S. psegment S ==> IMAGE pointI (cls S) SUBSET closure top2 (UNIONS S)`,
48423   (* {{{ proof *)
48424   [
48425   REP_BASIC_TAC;
48426   REWRITE_TAC[cls;IMAGE;SUBSET];
48427   THM_INTRO_TAC[`S`;`top2`] closure_unions;
48428   FULL_REWRITE_TAC[top2_top;psegment;segment];
48429   REWRITE_TAC[UNIONS;IMAGE];
48430   CONV_TAC (dropq_conv "u");
48431   UNIFY_EXISTS_TAC;
48432   ]);;
48433   (* }}} *)
48434
48435 let planar_graph_rectagonal = prove_by_refinement(
48436   `!(G:(A,B)graph_t). planar_graph G /\ FINITE (graph_edge G) /\
48437          FINITE (graph_vertex G) /\
48438          ~(graph_edge G = {}) /\
48439          (!v. CARD (graph_edge_around G v) <=| 4) ==>
48440       (rectagonal_graph G)`,
48441   (* {{{ proof *)
48442   [
48443   REP_BASIC_TAC;
48444   THM_INTRO_TAC[`G`] graph_int_model;
48445   REWRITE_TAC[rectagonal_graph;rectagon_graph];
48446   TYPE_THEN `graph H` SUBAGOAL_TAC;
48447   FULL_REWRITE_TAC[good_plane_graph;plane_graph];
48448   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;
48449   FULL_REWRITE_TAC[good_plane_graph];
48450   TSPEC `e` 10;
48451   REWR 10;
48452   THM_INTRO_TAC[`H`;`e`] graph_edge_end_select;
48453   UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`v`;`v'`]);
48454   THM_INTRO_TAC[`E`;`e`;`v`;`v'`] simple_arc_finite_lemma4;
48455   ASM_REWRITE_TAC[];
48456   THM_INTRO_TAC[`H`;`e`] graph_inc_subset;
48457   TYPE_THEN `graph_vertex H v` SUBAGOAL_TAC;
48458   ASM_MESON_TAC[subset_imp];
48459   TYPE_THEN `graph_vertex H v'` SUBAGOAL_TAC;
48460   ASM_MESON_TAC[subset_imp];
48461   TYPE_THEN `S` EXISTS_TAC;
48462   TYPE_THEN `a` EXISTS_TAC;
48463   TYPE_THEN `b` EXISTS_TAC;
48464   USE 18 SYM;
48465   IMATCH_MP_TAC  has_size2_subset_ne;
48466   CONJ_TAC;
48467   IMATCH_MP_TAC  graph_edge2;
48468   REWRITE_TAC[SUBSET;INR in_pair];
48469   CONJ_TAC;
48470   FIRST_ASSUM DISJ_CASES_TAC;
48471   USE 19 SYM;
48472   ASM_REWRITE_TAC[];
48473   USE 20 SYM;
48474   ASM_REWRITE_TAC[];
48475   UND 15 THEN ASM_REWRITE_TAC[];
48476   (* -A *)
48477   LEFT 13 "S";
48478   LEFT 13 "S";
48479   (* - *)
48480   TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC;
48481   TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC;
48482   FIRST_ASSUM IMATCH_MP_TAC ;
48483   ASM_MESON_TAC[];
48484   TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC;
48485   FIRST_ASSUM IMATCH_MP_TAC ;
48486   ASM_MESON_TAC[];
48487   REWRITE_TAC[pointI];
48488   TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC;
48489   REWRITE_TAC[int_neg_num_th];
48490   USE 16 (MATCH_MP point_onto);
48491   REWRITE_TAC[point_inj];
48492   TYPE_THEN `w` UNABBREV_TAC;
48493   FULL_REWRITE_TAC[coord01;PAIR_SPLIT];
48494   (* -- *)
48495   TYPE_THEN `!v. graph_vertex H v ==> ?a. (v = pointI a)` SUBAGOAL_TAC;
48496   FIRST_ASSUM IMATCH_MP_TAC ;
48497   FULL_REWRITE_TAC[good_plane_graph;plane_graph];
48498   ASM_MESON_TAC[subset_imp];
48499   LEFT 15 "a";
48500   LEFT 15 "a";
48501   TYPE_THEN `J = mk_graph_t (IMAGE a (graph_vertex H), IMAGE S (graph_edge H),endpoint)` ABBREV_TAC ;
48502   TYPE_THEN `J` EXISTS_TAC;
48503   (* - *)
48504   TYPE_THEN `graph_isomorphic H J` SUBAGOAL_TAC;
48505   REWRITE_TAC[graph_isomorphic;graph_iso];
48506   LEFT_TAC "u";
48507   TYPE_THEN `a` EXISTS_TAC;
48508   LEFT_TAC "v";
48509   TYPE_THEN `S` EXISTS_TAC;
48510   TYPE_THEN `a,S` EXISTS_TAC;
48511   TYPE_THEN `J` UNABBREV_TAC;
48512   REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
48513   CONJ_TAC;
48514   IMATCH_MP_TAC  inj_bij;
48515   REWRITE_TAC[INJ];
48516   TYPE_THEN `x = pointI (a x)` SUBAGOAL_TAC;
48517   TYPE_THEN `y = pointI (a y)` SUBAGOAL_TAC;
48518   TYPE_THEN `a x` UNABBREV_TAC;
48519   TYPE_THEN `pointI (a y)` UNABBREV_TAC;
48520   (* -- *)
48521   CONJ_TAC;
48522   IMATCH_MP_TAC  inj_bij;
48523   REWRITE_TAC[INJ];
48524   TYPE_THEN `x = closure top2 (UNIONS (S x))` SUBAGOAL_TAC;
48525   USE 16 SYM;
48526   ASM_MESON_TAC[];
48527   TYPE_THEN `y = closure top2 (UNIONS (S y))` SUBAGOAL_TAC;
48528   ASM_MESON_TAC[];
48529   TYPE_THEN `S x` UNABBREV_TAC;
48530   ASM_MESON_TAC[];
48531   (* -- *)
48532   UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
48533   THM_INTRO_TAC[`H`;`e`] graph_inc_subset;
48534   REWR 19;
48535   USE 19 (REWRITE_RULE[SUBSET;INR in_pair]);
48536   TYPE_THEN `IMAGE a {(pointI a'), (pointI b)} = {a', b}` SUBAGOAL_TAC;
48537   REWRITE_TAC[IMAGE ;INR in_pair];
48538   IMATCH_MP_TAC  EQ_EXT ;
48539   REWRITE_TAC[INR in_pair];
48540   NAME_CONFLICT_TAC;
48541   IMATCH_MP_TAC  EQ_ANTISYM;
48542   CONJ_TAC;
48543   FIRST_ASSUM DISJ_CASES_TAC;
48544   DISJ1_TAC;
48545   ONCE_REWRITE_TAC[EQ_SYM_EQ];
48546   TSPEC `pointI b` 15;
48547   USE 15 (REWRITE_RULE[pointI_inj]);
48548   FIRST_ASSUM IMATCH_MP_TAC ;
48549   FIRST_ASSUM IMATCH_MP_TAC ;
48550   DISJ2_TAC;
48551   ONCE_REWRITE_TAC[EQ_SYM_EQ];
48552   TSPEC `pointI a'` 15;
48553   USE 15 (REWRITE_RULE[pointI_inj]);
48554   FIRST_ASSUM IMATCH_MP_TAC ;
48555   FIRST_ASSUM IMATCH_MP_TAC ;
48556   (* --- *)
48557   FIRST_ASSUM DISJ_CASES_TAC;
48558   TYPE_THEN `pointI b` EXISTS_TAC;
48559   TSPEC `pointI b` 15;
48560   USE 15 (REWRITE_RULE[pointI_inj]);
48561   FIRST_ASSUM IMATCH_MP_TAC ;
48562   FIRST_ASSUM IMATCH_MP_TAC ;
48563   TYPE_THEN `pointI a'` EXISTS_TAC;
48564   TSPEC `pointI a'` 15;
48565   USE 15 (REWRITE_RULE[pointI_inj]);
48566   FIRST_ASSUM IMATCH_MP_TAC ;
48567   FIRST_ASSUM IMATCH_MP_TAC ;
48568   FULL_REWRITE_TAC[segment_end];
48569   (* -B *)
48570   REWRITE_TAC[GSYM CONJ_ASSOC];
48571   SUBCONJ_TAC;
48572   THM_INTRO_TAC[`H`;`J`] graph_isomorphic_graph;
48573   SUBCONJ_TAC;
48574   TYPE_THEN `J` UNABBREV_TAC;
48575   REWRITE_TAC[SUBSET;graph_edge_mk_graph];
48576   USE 16 (REWRITE_RULE[IMAGE]);
48577   UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
48578   FULL_REWRITE_TAC[segment_end];
48579   (* - *)
48580   SUBCONJ_TAC;
48581   TYPE_THEN `J` UNABBREV_TAC;
48582   REWRITE_TAC[graph_inc_mk_graph];
48583   (* - *)
48584   SUBCONJ_TAC;
48585   TYPE_THEN `J` UNABBREV_TAC;
48586   FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
48587   USE 22 (REWRITE_RULE[IMAGE]);
48588   USE 23 (REWRITE_RULE[IMAGE]);
48589   COPY 13;
48590   UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
48591   UND 25 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
48592   PROOF_BY_CONTR_TAC;  (* repeat from - to here // *)
48593   USE 30 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
48594   TYPE_THEN `edge u` SUBAGOAL_TAC;
48595   FULL_REWRITE_TAC[segment_end;psegment;segment];
48596   ASM_MESON_TAC[subset_imp];
48597   TYPE_THEN `(UNIONS (S x) SUBSET closure top2 (UNIONS (S x)))` SUBAGOAL_TAC;
48598   IMATCH_MP_TAC  subset_closure;
48599   REWRITE_TAC[top2_top];
48600   TYPE_THEN `(UNIONS (S x') SUBSET closure top2 (UNIONS (S x')))` SUBAGOAL_TAC;
48601   IMATCH_MP_TAC  subset_closure;
48602   REWRITE_TAC[top2_top];
48603   TYPE_THEN `UNIONS (S x) SUBSET x` SUBAGOAL_TAC;
48604   ASM_MESON_TAC[];
48605   TYPE_THEN `UNIONS (S x') SUBSET x'` SUBAGOAL_TAC;
48606   ASM_MESON_TAC[];
48607   USE 36 (REWRITE_RULE[UNIONS;SUBSET]);
48608   USE 35 (REWRITE_RULE[UNIONS;SUBSET]);
48609   LEFT 35 "u" ;
48610   LEFT 35 "u" ;
48611   LEFT 36 "u" ;
48612   LEFT 36 "u" ;
48613   TSPEC `u` 36;
48614   TSPEC `u` 35;
48615   TYPE_THEN `u SUBSET x` SUBAGOAL_TAC;
48616   REWRITE_TAC[SUBSET];
48617   FIRST_ASSUM IMATCH_MP_TAC ;
48618   TYPE_THEN `u SUBSET x'` SUBAGOAL_TAC;
48619   REWRITE_TAC[SUBSET];
48620   FIRST_ASSUM IMATCH_MP_TAC ;
48621   FULL_REWRITE_TAC[good_plane_graph;plane_graph];
48622   UND 39 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`x'`]);
48623   DISCH_TAC;
48624   TYPE_THEN `x'` UNABBREV_TAC;
48625   TYPE_THEN `e'` UNABBREV_TAC;
48626   UND 21 THEN ASM_REWRITE_TAC[];
48627   USE 39 (REWRITE_RULE[INTER;SUBSET]);
48628   TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC;
48629   TYPE_THEN `u` UNABBREV_TAC;
48630   USE 32 (MATCH_MP edge_cell);
48631   USE 32 (MATCH_MP cell_nonempty);
48632   UND 32 THEN (REWRITE_TAC[]);
48633   USE 44 (REWRITE_RULE[EMPTY_EXISTS]);
48634   TSPEC  `u'` 39;
48635   TYPE_THEN `graph_vertex H u'` SUBAGOAL_TAC;
48636   FIRST_ASSUM IMATCH_MP_TAC ;
48637   ASM_MESON_TAC[subset_imp];
48638   UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`u'`]);
48639   UND 15 THEN UND 44 THEN UND 32 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
48640   FULL_REWRITE_TAC[edge];
48641   TYPE_THEN `c = a u'` ABBREV_TAC ;
48642   FIRST_ASSUM DISJ_CASES_TAC ;
48643   TYPE_THEN `u` UNABBREV_TAC;
48644   TYPE_THEN `u'` UNABBREV_TAC;
48645   FULL_REWRITE_TAC[cell_clauses];
48646   TYPE_THEN `u` UNABBREV_TAC;
48647   TYPE_THEN `u'` UNABBREV_TAC;
48648   FULL_REWRITE_TAC[cell_clauses];
48649   (* -C *)
48650   TYPE_THEN `graph_isomorphic J G` SUBAGOAL_TAC;
48651   THM_INTRO_TAC[`G`;`H`;`J`] graph_isomorphic_trans;
48652   IMATCH_MP_TAC  graph_isomorphic_symm;
48653   IMATCH_MP_TAC  planar_is_graph;
48654   (* - *)
48655   TYPE_THEN `J` UNABBREV_TAC;
48656   FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
48657   USE 23 (REWRITE_RULE[IMAGE]);
48658   USE 24 (REWRITE_RULE[IMAGE]);
48659   COPY 13;
48660   UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
48661   UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
48662   IMATCH_MP_TAC  SUBSET_ANTISYM;
48663   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
48664   CONJ_TAC;
48665   IMATCH_MP_TAC  subset_inter_pair;
48666   CONJ_TAC THEN (IMATCH_MP_TAC endpoint_cls);
48667   FULL_REWRITE_TAC[segment_end;psegment;segment];
48668   FULL_REWRITE_TAC[segment_end;psegment;segment];
48669   (* -D *)
48670   TYPE_THEN `IMAGE pointI (cls(S x') INTER cls(S x)) SUBSET (IMAGE pointI (endpoint (S x') INTER endpoint (S x)))` BACK_TAC;
48671   THM_INTRO_TAC[`pointI`] image_inj;
48672   FIRST_ASSUM IMATCH_MP_TAC ;
48673   TYPE_THEN `UNIV:int#int ->bool` EXISTS_TAC;
48674   REWRITE_TAC[INJ];
48675   FULL_REWRITE_TAC[pointI_inj];
48676   (* - *)
48677   TYPE_THEN `!A B. (IMAGE pointI (A INTER B) = IMAGE pointI A INTER IMAGE pointI B)` SUBAGOAL_TAC;
48678   IMATCH_MP_TAC  inj_inter;
48679   TYPE_THEN `UNIV:int#int->bool` EXISTS_TAC;
48680   TYPE_THEN `UNIV:(num->real)->bool` EXISTS_TAC;
48681   REWRITE_TAC[INJ];
48682   FULL_REWRITE_TAC[pointI_inj];
48683   (* - *)
48684   TYPE_THEN `IMAGE pointI (endpoint (S x')) = graph_inc H x'` SUBAGOAL_TAC;
48685   FULL_REWRITE_TAC[segment_end];
48686   REWRITE_TAC[IMAGE];
48687   IMATCH_MP_TAC  EQ_EXT;
48688   REWRITE_TAC[INR in_pair];
48689   MESON_TAC[];
48690   TYPE_THEN `IMAGE pointI (endpoint (S x)) = graph_inc H x` SUBAGOAL_TAC;
48691   FULL_REWRITE_TAC[segment_end];
48692   REWRITE_TAC[IMAGE];
48693   IMATCH_MP_TAC  EQ_EXT;
48694   REWRITE_TAC[INR in_pair];
48695   MESON_TAC[];
48696   USE 28 SYM;
48697   USE 30 SYM;
48698   (* -E *)
48699   TYPE_THEN `!e. graph_edge H e ==> (graph_inc H e = e INTER graph_vertex H)` SUBAGOAL_TAC;
48700   USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]);
48701   TYPE_THEN `x' INTER x SUBSET graph_vertex H` SUBAGOAL_TAC;
48702   USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]);
48703   FIRST_ASSUM IMATCH_MP_TAC ;
48704   UND 24 THEN UND 23 THEN UND 16 THEN MESON_TAC[];
48705   IMATCH_MP_TAC  SUBSET_TRANS;
48706   TYPE_THEN `x' INTER x` EXISTS_TAC;
48707   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
48708   CONJ_TAC;
48709   UND 36 THEN REWRITE_TAC[INTER;SUBSET;] THEN MESON_TAC[];
48710   (* - *)
48711   IMATCH_MP_TAC  subset_inter_pair;
48712   (* -F *)
48713   UND 31 THEN UND 13 THEN UND 29 THEN UND 27 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
48714   FULL_REWRITE_TAC[segment_end];
48715   ASM_MESON_TAC[psegment_cls];
48716   (* Wed Dec 22 11:18:27 EST 2004 *)
48717
48718   ]);;
48719   (* }}} *)
48720
48721 let cartesian_finite = prove_by_refinement(
48722   `!(A:A->bool) (B:B->bool). FINITE A /\ FINITE B ==>
48723           FINITE (cartesian A B)`,
48724   (* {{{ proof *)
48725   [
48726   REP_BASIC_TAC;
48727   TYPE_THEN `cartesian A B = {(x,y) | (x IN A) /\ (y IN B)}` SUBAGOAL_TAC;
48728   IMATCH_MP_TAC  EQ_EXT;
48729   REWRITE_TAC[cartesian];
48730   IMATCH_MP_TAC  FINITE_PRODUCT;
48731   ]);;
48732   (* }}} *)
48733
48734 let three_t_finite = prove_by_refinement(
48735   `FINITE (UNIV:three_t ->bool)`,
48736   (* {{{ proof *)
48737   [
48738   THM_INTRO_TAC[`ABS3 0`] three_delete_size;
48739   FULL_REWRITE_TAC[HAS_SIZE];
48740   FULL_REWRITE_TAC[FINITE_DELETE];
48741   ]);;
48742   (* }}} *)
48743
48744 let three_t_size3 = prove_by_refinement(
48745   `(UNIV:three_t ->bool) HAS_SIZE 3`,
48746   (* {{{ proof *)
48747   [
48748   THM_INTRO_TAC[`ABS3 0`] three_delete_size;
48749   FULL_REWRITE_TAC[HAS_SIZE];
48750   FULL_REWRITE_TAC[FINITE_DELETE];
48751   THM_INTRO_TAC[`ABS3 0`;`UNIV:three_t->bool`;] CARD_SUC_DELETE;
48752   ASM_REWRITE_TAC[];
48753   USE 2 SYM;
48754   ASM_REWRITE_TAC[];
48755   ARITH_TAC;
48756   ]);;
48757   (* }}} *)
48758
48759 let k33_nonplanar = prove_by_refinement(
48760   `~(planar_graph k33_graph)`,
48761   (* {{{ proof *)
48762   [
48763   REP_BASIC_TAC;
48764   THM_INTRO_TAC[`k33_graph`] planar_graph_rectagonal;
48765   REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex];
48766   ASSUME_TAC three_t_finite;
48767   ASSUME_TAC bool_size;
48768   FULL_REWRITE_TAC[HAS_SIZE];
48769   CONJ_TAC;
48770   IMATCH_MP_TAC  cartesian_finite;
48771   CONJ_TAC;
48772   IMATCH_MP_TAC  cartesian_finite;
48773   (* -- *)
48774   REWRITE_TAC[EMPTY_EXISTS];
48775   CONJ_TAC;
48776   TYPE_THEN `(ABS3 0,ABS3 0)` EXISTS_TAC;
48777   REWRITE_TAC[cartesian;PAIR_SPLIT];
48778   MESON_TAC[];
48779   REWRITE_TAC[graph_edge_around];
48780   REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex;cartesian_univ];
48781   TYPE_THEN `E = {e | (v = FST e,T) \/ (v = SND e,F)}` ABBREV_TAC ;
48782   TYPE_THEN `SND v ==> (E = IMAGE (\ f. (FST v, f)) UNIV)` SUBAGOAL_TAC;
48783   TYPE_THEN `E` UNABBREV_TAC;
48784   IMATCH_MP_TAC  EQ_EXT;
48785   REWRITE_TAC[IMAGE];
48786   REWRITE_TAC[PAIR_SPLIT];
48787   MESON_TAC[];
48788   TYPE_THEN `~(SND v) ==> (E = IMAGE (\ f. (f,FST v)) UNIV)` SUBAGOAL_TAC;
48789   TYPE_THEN `E` UNABBREV_TAC;
48790   IMATCH_MP_TAC  EQ_EXT;
48791   REWRITE_TAC[IMAGE];
48792   REWRITE_TAC[PAIR_SPLIT];
48793   NAME_CONFLICT_TAC;
48794   MESON_TAC[];
48795   TYPE_THEN `CARD E <=| CARD (UNIV:three_t ->bool)` SUBAGOAL_TAC;
48796   TYPE_THEN `SND v` ASM_CASES_TAC;
48797   IMATCH_MP_TAC  CARD_IMAGE_LE;
48798   IMATCH_MP_TAC  CARD_IMAGE_LE;
48799   ASSUME_TAC three_t_size3;
48800   FULL_REWRITE_TAC[HAS_SIZE];
48801   UND 8 THEN UND 7 THEN ARITH_TAC;
48802   (* - *)
48803   ASSUME_TAC rectagon_graph_k33_false;
48804   UND 2 THEN ASM_REWRITE_TAC[];
48805   (* Wed Dec 22 11:57:49 EST 2004 *)
48806
48807   ]);;
48808   (* }}} *)
48809
48810 (* ------------------------------------------------------------------ *)
48811 (* SECTION Z *)
48812 (* ------------------------------------------------------------------ *)
48813
48814 (* show the complement of a simple arc is connected *)
48815
48816
48817 let grid33 = jordan_def `grid33 m =
48818          rectangle_grid (FST m -: &:1, SND m -: &:1)
48819                     (FST m +: &:2, SND m +: &:2)`;;
48820
48821 let grid = jordan_def `grid f N =
48822    UNIONS (IMAGE
48823     ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1)))
48824     {j | j <= N})`;;
48825
48826 let grid33_conn2 = prove_by_refinement(
48827   `!m. conn2 (grid33 m)`,
48828   (* {{{ proof *)
48829
48830   [
48831   REWRITE_TAC[grid33];
48832   TYPE_THEN `SUC 2 = 3` SUBAGOAL_TAC;
48833   ARITH_TAC;
48834   TYPE_THEN `a = FST m -: &:1` ABBREV_TAC  ;
48835   TYPE_THEN `FST m +: &:2 = a +: &:(SUC 2)` SUBAGOAL_TAC;
48836   TYPE_THEN `a` UNABBREV_TAC;
48837   INT_ARITH_TAC;
48838   TYPE_THEN `b = SND m -: &:1` ABBREV_TAC ;
48839   TYPE_THEN `SND m +: &:2 = b +: &:(SUC 2)` SUBAGOAL_TAC;
48840   TYPE_THEN `b` UNABBREV_TAC;
48841   ARITH_TAC;
48842   USE 0 SYM;
48843   THM_INTRO_TAC[`2`;`2`;`(a,b)`] rectangle_grid_conn2;
48844   FULL_REWRITE_TAC[];
48845   ]);;
48846
48847   (* }}} *)
48848
48849 let grid_finite = prove_by_refinement(
48850   `!f N. FINITE (grid f N)`,
48851   (* {{{ proof *)
48852   [
48853   REWRITE_TAC[ grid];
48854   TYPE_THEN `FINITE (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N}) ` SUBAGOAL_TAC;
48855   IMATCH_MP_TAC  FINITE_IMAGE;
48856   REWRITE_TAC[FINITE_NUMSEG_LE];
48857   ASM_SIMP_TAC[FINITE_FINITE_UNIONS];
48858   USE 1 (REWRITE_RULE[IMAGE]);
48859   THM_INTRO_TAC[`floor (f (&x / &N) 0),floor (f (&x / &N) 1)`] grid33_conn2;
48860   FULL_REWRITE_TAC[conn2];
48861   ]);;
48862   (* }}} *)
48863
48864 let grid33_edge = prove_by_refinement(
48865   `!m. grid33 m SUBSET edge `,
48866   (* {{{ proof *)
48867   [
48868   REWRITE_TAC[grid33;rectangle_grid_edge];
48869   ]);;
48870   (* }}} *)
48871
48872 let grid_edge = prove_by_refinement(
48873   `!f N . grid f N SUBSET edge `,
48874   (* {{{ proof *)
48875
48876   [
48877   REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ];
48878   TYPE_THEN `u` UNABBREV_TAC;
48879   ASM_MESON_TAC[grid33_edge;subset_imp];
48880   ]);;
48881
48882   (* }}} *)
48883
48884 let floor_add_num = prove_by_refinement(
48885   `!x m. floor (x + &m) = floor x +: &:m`,
48886   (* {{{ proof *)
48887   [
48888   REWRITE_TAC [floor_range;int_add_th;int_of_num_th;];
48889   THM_INTRO_TAC[`x`;`floor x`] floor_range;
48890   REWR 0;
48891   UND 0 THEN UND 1 THEN REAL_ARITH_TAC;
48892   ]);;
48893   (* }}} *)
48894
48895 let floor_abs = prove_by_refinement(
48896   `!x y m. (abs  (x -. y) <= &m) ==> (||: (floor x -: floor y) <=: &:m)`,
48897   (* {{{ proof *)
48898   [
48899   TYPE_THEN `!x y m. (y <. x) /\ (x - y <= &m) ==> (floor x -: floor y <=: &:m)` SUBAGOAL_TAC;
48900   THM_INTRO_TAC[`x`;`y + &m`] floor_mono;
48901   UND 0 THEN REAL_ARITH_TAC;
48902   FULL_REWRITE_TAC[floor_add_num];
48903   UND 2 THEN INT_ARITH_TAC ;
48904   TYPE_THEN `y = x` ASM_CASES_TAC;
48905   TYPE_THEN `y` UNABBREV_TAC;
48906   FULL_REWRITE_TAC[REAL_ARITH `x -. x = &0`;ABS_0;INT_SUB_REFL;INT_ABS_0;int_le ; int_of_num_th];
48907   ASM_REWRITE_TAC[];
48908   TYPE_THEN `y <= x` ASM_CASES_TAC;
48909   TYPE_THEN `abs  (x - y) = (x - y)` SUBAGOAL_TAC;
48910   REWRITE_TAC[REAL_ABS_REFL];
48911   UND 3 THEN REAL_ARITH_TAC;
48912   REWR 0;
48913   TYPE_THEN `floor y  <=: floor x` SUBAGOAL_TAC;
48914   IMATCH_MP_TAC  floor_mono;
48915   TYPE_THEN `||: (floor x -: floor y) = (floor x -: floor y)` SUBAGOAL_TAC;
48916   REWRITE_TAC[INT_ABS_REFL];
48917   UND 5 THEN INT_ARITH_TAC;
48918   FIRST_ASSUM IMATCH_MP_TAC ;
48919   UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
48920   TYPE_THEN `x < y` SUBAGOAL_TAC;
48921   UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
48922   (* -A *)
48923   TYPE_THEN `abs  (x - y) = (y - x)` SUBAGOAL_TAC;
48924   UND 4 THEN REAL_ARITH_TAC;
48925   REWR 0;
48926   TYPE_THEN `floor x  <=: floor y` SUBAGOAL_TAC;
48927   IMATCH_MP_TAC  floor_mono;
48928   UND 4 THEN REAL_ARITH_TAC;
48929   TYPE_THEN `||: (floor x -: floor y) = (floor y -: floor x)` SUBAGOAL_TAC;
48930   UND 6 THEN INT_ARITH_TAC;
48931   FIRST_ASSUM IMATCH_MP_TAC ;
48932   ]);;
48933   (* }}} *)
48934
48935 let d_euclid_floor = prove_by_refinement(
48936   `!x y i n. (euclid n x) /\ (euclid n y) /\ (d_euclid x y < &1) ==>
48937      (||: (floor (x i) -: floor (y i)) <=: &:1)`,
48938   (* {{{ proof *)
48939   [
48940   REP_BASIC_TAC;
48941   IMATCH_MP_TAC  floor_abs;
48942   THM_INTRO_TAC[`n`;`x`;`y`;`i`] proj_contraction;
48943   UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
48944   ]);;
48945   (* }}} *)
48946
48947 extend_simp_rewrites[prove_by_refinement(
48948   `!x . x/ &0 = &0 `,
48949   (* {{{ proof *)
48950   [
48951   REWRITE_TAC[REAL_INV_0;real_div;REAL_MUL_RZERO];
48952   ])];;
48953   (* }}} *)
48954
48955 extend_simp_rewrites[INR in_pair ; INR IN_SING];;
48956
48957 extend_simp_rewrites[REAL_POS];;
48958
48959 let real_eq_div = prove_by_refinement(
48960   `!x y z. ~(z = &0) ==> ((x / z = y) <=> (x = y * z))`,
48961   (* {{{ proof *)
48962   [
48963   REP_BASIC_TAC;
48964   TYPE_THEN `&0 < z` ASM_CASES_TAC;
48965   ASM_SIMP_TAC[REAL_EQ_LDIV_EQ];
48966   TYPE_THEN `&0 < -- z` SUBAGOAL_TAC;
48967   UND 0 THEN UND 1 THEN REAL_ARITH_TAC;
48968   TYPE_THEN `x / z = (--x)/(--z)` SUBAGOAL_TAC;
48969   REWRITE_TAC[real_div;REAL_INV_NEG;REAL_NEG_MUL2];
48970   ASM_SIMP_TAC[REAL_EQ_LDIV_EQ];
48971   REAL_ARITH_TAC;
48972   ]);;
48973   (* }}} *)
48974
48975 let grid_conn2_induct_lemma = prove_by_refinement(
48976   `!k f N.
48977    (k <= N) /\ (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\
48978    (!i. (i < N) ==> d_euclid  (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==>
48979    conn2 (UNIONS (IMAGE
48980     ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1)))
48981     {j | j <= k}))`,
48982   (* {{{ proof *)
48983
48984   [
48985   INDUCT_TAC;
48986   TYPE_THEN `{j | j <=| 0} = {0}` SUBAGOAL_TAC;
48987   IMATCH_MP_TAC  EQ_EXT;
48988   REWRITE_TAC[INR IN_SING];
48989   ARITH_TAC;
48990   REWRITE_TAC[IMAGE;INR IN_SING ];
48991   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;
48992   IMATCH_MP_TAC  EQ_EXT;
48993   NAME_CONFLICT_TAC;
48994   REWRITE_TAC[INR IN_SING];
48995   CONV_TAC (dropq_conv "x'");
48996   REWRITE_TAC[grid33_conn2];
48997   (* - *)
48998   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`f`;`N`]);
48999   UND 2 THEN ARITH_TAC;
49000   TYPE_THEN `{j | j <=| SUC k} = {j | j <=| k} UNION {(SUC k)}` SUBAGOAL_TAC;
49001   IMATCH_MP_TAC  EQ_EXT;
49002   REWRITE_TAC[UNION;];
49003   ARITH_TAC;
49004   REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1];
49005   IMATCH_MP_TAC  conn2_union_edge;
49006   ASM_REWRITE_TAC[grid33_conn2];
49007   (* - *)
49008   CONJ_TAC;
49009     REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ];
49010   TYPE_THEN `u` UNABBREV_TAC;
49011   ASM_MESON_TAC[grid33_edge;subset_imp];
49012   REWRITE_TAC[EMPTY_EXISTS];
49013   REWRITE_TAC[grid33_edge];
49014   TYPE_THEN `{j | j <=| k} = {j | j <| k} UNION {k}` SUBAGOAL_TAC;
49015   IMATCH_MP_TAC  EQ_EXT;
49016   REWRITE_TAC[UNION;INR IN_SING];
49017   ARITH_TAC;
49018   REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1];
49019   ONCE_REWRITE_TAC[INTER_COMM];
49020   REWRITE_TAC[UNION_OVER_INTER];
49021   REWRITE_TAC[UNION];
49022   RIGHT_TAC "u";
49023   DISJ2_TAC;
49024   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
49025   UND 2 THEN ARITH_TAC;
49026   (* -A *)
49027   TYPE_THEN `a = floor (f (&k / &N) 0)` ABBREV_TAC ;
49028   TYPE_THEN `b = floor (f (&k / &N) 1)` ABBREV_TAC ;
49029   TYPE_THEN `a' = floor (f (&(SUC k) / &N) 0)` ABBREV_TAC ;
49030   TYPE_THEN `b' = floor (f (&(SUC k) / &N) 1)` ABBREV_TAC ;
49031   TYPE_THEN `h_edge (a,b)` EXISTS_TAC;
49032   REWRITE_TAC[INTER];
49033   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
49034   CONJ_TAC;
49035   REWRITE_TAC[grid33];
49036   REWRITE_TAC[rectangle_grid_h];
49037   INT_ARITH_TAC;
49038   (* - *)
49039   TYPE_THEN `!k. (k <=| N) ==> euclid 2 (f (&k / &N))` SUBAGOAL_TAC;
49040   USE 1(REWRITE_RULE[SUBSET]);
49041   FIRST_ASSUM IMATCH_MP_TAC ;
49042   IMATCH_MP_TAC  image_imp;
49043   CONJ_TAC;
49044   IMATCH_MP_TAC  REAL_LE_DIV;
49045   TYPE_THEN `&N = &0` ASM_CASES_TAC;
49046   REWRITE_TAC[];
49047   REAL_ARITH_TAC;
49048   TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
49049   UND 11 THEN REWRITE_TAC[REAL_OF_NUM_EQ;REAL_LT] THEN ARITH_TAC;
49050   ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
49051   UND 10 THEN REWRITE_TAC[REAL_LE;REAL_OF_NUM_MUL] THEN ARITH_TAC ;
49052   (* - *)
49053   TYPE_THEN `euclid 2 (f (&k/ &N))` SUBAGOAL_TAC;
49054   FIRST_ASSUM IMATCH_MP_TAC ;
49055   UND 2 THEN ARITH_TAC;
49056   TYPE_THEN `euclid 2 (f (&(SUC k)/ &N))` SUBAGOAL_TAC;
49057   (* - *)
49058   THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`0`;`2`] d_euclid_floor;
49059   THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`1`;`2`] d_euclid_floor;
49060   TYPE_THEN `||: (a - a') <=: &:1` SUBAGOAL_TAC;
49061   ASM_MESON_TAC[];
49062   TYPE_THEN `||: (b - b') <=: &:1` SUBAGOAL_TAC;
49063   ASM_MESON_TAC[];
49064   KILL 14 THEN KILL 13;
49065   KILL 5 THEN KILL  4;
49066   KILL 3 THEN KILL 1;
49067   REWRITE_TAC[grid33];
49068   REWRITE_TAC[rectangle_grid_h];
49069   UND 16 THEN UND 15 THEN INT_ARITH_TAC;
49070   (* Thu Dec 23 10:46:15 EST 2004 *)
49071
49072   ]);;
49073
49074   (* }}} *)
49075
49076 let grid_conn2 = prove_by_refinement(
49077   `!f N. (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\
49078    (!i. (i < N) ==> d_euclid  (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==>
49079    conn2 (grid f N)`,
49080   (* {{{ proof *)
49081   [
49082   REP_BASIC_TAC;
49083   THM_INTRO_TAC[`N`;`f`;`N`] grid_conn2_induct_lemma;
49084   ARITH_TAC;
49085   REWRITE_TAC[grid];
49086   ]);;
49087   (* }}} *)
49088
49089 let simple_arc_uniformly_continuous = prove_by_refinement(
49090   `!f . continuous f (top_of_metric(UNIV,d_real)) top2 /\
49091       INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
49092    uniformly_continuous f
49093         ({x | &0 <= x /\ x <= &1},d_real)
49094         (euclid 2,d_euclid)`,
49095   (* {{{ proof *)
49096   [
49097   REP_BASIC_TAC;
49098   ASSUME_TAC metric_real;
49099   IMATCH_MP_TAC  compact_uniformly_continuous;
49100   THM_INTRO_TAC[`&0`;`&1`] interval_compact;
49101   THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] compact_subset;
49102   REWRITE_TAC[metric_real];
49103   REWR 4;
49104   KILL 4;
49105   KILL 3;
49106   (* - *)
49107   TYPE_THEN  `IMAGE f {x | &0 <= x /\ x <= &1} SUBSET euclid 2` SUBAGOAL_TAC;
49108   IMATCH_MP_TAC  inj_image_subset;
49109   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
49110   (* -A *)
49111   SUBCONJ_TAC;
49112   IMATCH_MP_TAC metric_subspace;
49113   TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
49114   ASM_REWRITE_TAC[];
49115   (* -// *)
49116   THM_INTRO_TAC[`f`;`top_of_metric(UNIV,d_real)`;`top2`;`{x | &0 <= x /\ x <= &1}`] continuous_induced_domain;
49117   ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions];
49118   (* - *)
49119   THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_induced;
49120   REWRITE_TAC[metric_real];
49121   REWR 5;
49122   THM_INTRO_TAC[`f`;`{x | &0 <= x /\ x <= &1}`;`euclid 2`;`d_real`;`d_euclid`] metric_continuous_continuous;
49123   USE 7 SYM;
49124   FULL_REWRITE_TAC[top2];
49125   (* Thu Dec 23 11:29:49 EST 2004 *)
49126   ]);;
49127   (* }}} *)
49128
49129 let num_abs_of_int_mono = prove_by_refinement(
49130   `!a b. &:0 <= a /\ a <= b ==> num_abs_of_int a <= num_abs_of_int b`,
49131   (* {{{ proof *)
49132   [
49133   REWRITE_TAC[GSYM REAL_LE;num_abs_of_int_th;GSYM int_abs_th;GSYM int_le ];
49134   UND 0 THEN UND 1 THEN INT_ARITH_TAC;
49135   ]);;
49136   (* }}} *)
49137
49138 let floor_num = prove_by_refinement(
49139   `!n. floor (&n) = &:n`,
49140   (* {{{ proof *)
49141   [
49142   REWRITE_TAC[floor_range];
49143   REWRITE_TAC[int_of_num_th;];
49144   REAL_ARITH_TAC;
49145   ]);;
49146   (* }}} *)
49147
49148 let floor_neg_num = prove_by_refinement(
49149   `!n. floor (-- &n) = -- (&:n)`,
49150   (* {{{ proof *)
49151   [
49152   REWRITE_TAC[floor_range];
49153   REWRITE_TAC[int_neg_th;int_of_num_th;];
49154   REAL_ARITH_TAC;
49155   ]);;
49156   (* }}} *)
49157
49158 let delta_partition_lemma = prove_by_refinement(
49159   `!delta. (&0 < delta) ==> (?N. !x. ?i.  (0 < N) /\
49160       ((&0 <= x /\ x <= &1) ==> (i <= N) /\ abs  (&i/ &N - x) < delta))`,
49161   (* {{{ proof *)
49162   [
49163   REP_BASIC_TAC;
49164   THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE;
49165   TYPE_THEN `n` EXISTS_TAC;
49166   TYPE_THEN `num_abs_of_int (floor (&n*x))` EXISTS_TAC;
49167   TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC;
49168   TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
49169   UND 1 THEN UND 2 THEN REAL_ARITH_TAC;
49170   TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC;
49171   ASM_MESON_TAC[REAL_LE_LDIV_EQ];
49172   CONJ_TAC;
49173   FULL_REWRITE_TAC[REAL_LT];
49174   TYPE_THEN `&:0 <= floor (&n * x)` SUBAGOAL_TAC;
49175   TYPE_THEN `floor (&0) <=: floor (&n * x)` BACK_TAC;
49176   FULL_REWRITE_TAC[floor_num];
49177   IMATCH_MP_TAC  floor_mono;
49178   IMATCH_MP_TAC  REAL_LE_MUL;
49179   (* - *)
49180   CONJ_TAC;
49181   TYPE_THEN `num_abs_of_int (floor (&n * x)) <= num_abs_of_int (floor (&n))` BACK_TAC;
49182   FULL_REWRITE_TAC[floor_num;num_abs_of_int_num];
49183   IMATCH_MP_TAC  num_abs_of_int_mono;
49184   IMATCH_MP_TAC  floor_mono;
49185   TYPE_THEN `&n * x <= &n * &1` BACK_TAC;
49186   UND 8 THEN REAL_ARITH_TAC;
49187   IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
49188   (* -A *)
49189   IMATCH_MP_TAC  REAL_LT_LCANCEL_IMP;
49190   TYPE_THEN `&n` EXISTS_TAC;
49191   IMATCH_MP_TAC  REAL_LTE_TRANS;
49192   TYPE_THEN`&1` EXISTS_TAC;
49193   (* - *)
49194   REWRITE_TAC[num_abs_of_int_th;];
49195   TYPE_THEN `abs  (real_of_int (floor (&n * x))) = (real_of_int (floor (&n *x)))` SUBAGOAL_TAC;
49196   REWRITE_TAC[REAL_ABS_REFL];
49197   FULL_REWRITE_TAC [int_le; int_of_num_th;];
49198   TYPE_THEN `!u. &n * abs  (u / &n - x) = abs  (u - &n*x)` SUBAGOAL_TAC;
49199   TYPE_THEN `!t. &n * abs  t = abs  (&n *t)` SUBAGOAL_TAC;
49200   REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM];
49201   AP_TERM_TAC;
49202   REWRITE_TAC[REAL_SUB_LDISTRIB];
49203   TYPE_THEN `&n * u/ &n = u` SUBAGOAL_TAC;
49204   IMATCH_MP_TAC  REAL_DIV_LMUL;
49205   UND 10 THEN UND 3 THEN REAL_ARITH_TAC;
49206   TYPE_THEN `t = &n * x ` ABBREV_TAC ;
49207   TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC;
49208   REWRITE_TAC[floor_ineq];
49209   TYPE_THEN `abs  (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC;
49210   UND 11 THEN REAL_ARITH_TAC;
49211   THM_INTRO_TAC[`t`] floor_ineq;
49212   UND 13 THEN REAL_ARITH_TAC;
49213   ]);;
49214   (* }}} *)
49215
49216 let simple_arc_ball_cover  = prove_by_refinement(
49217   `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
49218       INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
49219     (?N. !x. ?i. (0 < N) /\ (&0 <= x /\ x <= &1 ==>
49220         (i <= N) /\
49221            open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`,
49222   (* {{{ proof *)
49223   [
49224   REP_BASIC_TAC;
49225   THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
49226   FULL_REWRITE_TAC[uniformly_continuous];
49227   TSPEC `&1` 2;
49228   UND 2 THEN DISCH_THEN (THM_INTRO_TAC[]);
49229   REWRITE_TAC[open_ball];
49230   THM_INTRO_TAC[`delta`] delta_partition_lemma;
49231   TYPE_THEN `N` EXISTS_TAC;
49232   TSPEC `x` 4;
49233   TYPE_THEN `i` EXISTS_TAC;
49234   REP_BASIC_TAC;
49235   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]);
49236   (* - *)
49237   TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC;
49238   CONJ_TAC;
49239   IMATCH_MP_TAC  REAL_LE_DIV;
49240   THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ;
49241   REWRITE_TAC[REAL_LT];
49242   REWRITE_TAC[REAL_MUL;REAL_LE];
49243   UND 8 THEN ARITH_TAC;
49244   (* - *)
49245   FULL_REWRITE_TAC[INJ];
49246   CONJ_TAC;
49247   FIRST_ASSUM IMATCH_MP_TAC ;
49248   (* - *)
49249   CONJ_TAC;
49250   FIRST_ASSUM IMATCH_MP_TAC ;
49251   (* - *)
49252   FIRST_ASSUM IMATCH_MP_TAC ;
49253   REWRITE_TAC[d_real];
49254   ]);;
49255   (* }}} *)
49256
49257 let unbounded_diff = prove_by_refinement(
49258   `!G. unbounded_set G = UNIONS(ctop G) DIFF (bounded_set G)`,
49259   (* {{{ proof *)
49260   [
49261   REWRITE_TAC[GSYM bounded_unbounded_union];
49262   IMATCH_MP_TAC  EQ_EXT;
49263   THM_INTRO_TAC[`G`] bounded_unbounded_disj;
49264   UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[];
49265   ]);;
49266   (* }}} *)
49267
49268 let bounded_diff = prove_by_refinement(
49269   `!G. bounded_set G = UNIONS(ctop G) DIFF (unbounded_set G)`,
49270   (* {{{ proof *)
49271   [
49272   REWRITE_TAC[GSYM bounded_unbounded_union];
49273   IMATCH_MP_TAC  EQ_EXT;
49274   THM_INTRO_TAC[`G`] bounded_unbounded_disj;
49275   UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[];
49276   ]);;
49277   (* }}} *)
49278
49279 let rectangle_grid_subset = prove_by_refinement(
49280   `!p q r s. (FST p <=: FST r) /\ (SND p <= SND r) /\
49281        (FST s <= FST q) /\ (SND s <= SND q) ==>
49282     rectangle_grid r s SUBSET rectangle_grid p q`,
49283   (* {{{ proof *)
49284   [
49285   REWRITE_TAC[SUBSET;rectangle_grid];
49286   FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[cell_clauses] THEN  CONV_TAC (dropq_conv "m'");
49287   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;
49288   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;
49289   ]);;
49290   (* }}} *)
49291
49292 let grid_image_bounded = prove_by_refinement(
49293   `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
49294       INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
49295    (?N. (0 < N) /\ ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER
49296          (unbounded_set (grid f N)) =  EMPTY))  `,
49297   (* {{{ proof *)
49298   [
49299   REWRITE_TAC[EQ_EMPTY;INTER;];
49300   THM_INTRO_TAC[`f`] simple_arc_ball_cover;
49301   TYPE_THEN `N` EXISTS_TAC;
49302   REWRITE_TAC[IMAGE];
49303   NAME_CONFLICT_TAC;
49304   RIGHT 2 "i";
49305   RIGHT 2 "x";
49306   TYPE_THEN `x''` UNABBREV_TAC;
49307   FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ];
49308   UND 2 THEN REWRITE_TAC[];
49309   UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
49310   REWR 2;
49311   FULL_REWRITE_TAC[open_ball];
49312   (* _ *)
49313   IMATCH_MP_TAC  bounded_avoidance_subset;
49314   TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ;
49315   TYPE_THEN `E` EXISTS_TAC;
49316   (* _ *)
49317   TYPE_THEN `conn2 E` SUBAGOAL_TAC;
49318   TYPE_THEN `E` UNABBREV_TAC;
49319   REWRITE_TAC[grid33_conn2];
49320   REWRITE_TAC[grid_edge;grid_finite];
49321   TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC;
49322   REWRITE_TAC[grid];
49323   TYPE_THEN `E` UNABBREV_TAC;
49324   TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC;
49325   IMATCH_MP_TAC  EQ_EXT;
49326   REWRITE_TAC[UNION];
49327   UND 6 THEN ARITH_TAC;
49328   REWRITE_TAC[IMAGE_UNION;UNIONS_UNION];
49329   REWRITE_TAC[SUBSET;UNION];
49330   DISJ1_TAC;
49331   REWRITE_TAC[image_sing];
49332   (* _ *)
49333   TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC;
49334   UND 3 THEN REWRITE_TAC[];
49335   THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset;
49336   USE 3 (MATCH_MP UNIONS_UNIONS);
49337   ASM_MESON_TAC[subset_imp];
49338   KILL 13;
49339   KILL 3;
49340   (* _A *)
49341   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 ;
49342   THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq;
49343   FULL_REWRITE_TAC [];
49344   REWR 13;
49345   TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
49346   TYPE_THEN `E` UNABBREV_TAC;
49347   TYPE_THEN `E'` UNABBREV_TAC;
49348   REWRITE_TAC[grid33];
49349   IMATCH_MP_TAC  rectangle_grid_subset;
49350   (* __ *)
49351   THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor;
49352   THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor;
49353   UND 3 THEN UND 11 THEN INT_ARITH_TAC;
49354   (* _ *)
49355   IMATCH_MP_TAC  bounded_avoidance_subset;
49356   TYPE_THEN `E'` EXISTS_TAC;
49357   TYPE_THEN `conn2 E'` SUBAGOAL_TAC;
49358   IMATCH_MP_TAC  conn2_rectagon;
49359   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
49360   FULL_REWRITE_TAC[conn2];
49361   (* _ *)
49362   TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
49363   TYPE_THEN `E` UNABBREV_TAC;
49364   REWRITE_TAC[grid33_edge];
49365   (* _ *)
49366   ASM_SIMP_TAC[GSYM odd_bounded];
49367   REWRITE_TAC[UNIONS];
49368   TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC;
49369   IMATCH_MP_TAC  (TAUT ` a/\ b ==> b /\ a`);
49370   (* -B *)
49371   TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC;
49372   UND 14 THEN REWRITE_TAC[];
49373   THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset;
49374   USE 14 (MATCH_MP UNIONS_UNIONS);
49375   ASM_MESON_TAC[subset_imp];
49376   (* - *)
49377   TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ;
49378   TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC;
49379   UND 19 THEN REWRITE_TAC[];
49380   REWRITE_TAC[UNIONS];
49381   TYPE_THEN `h_edge m` EXISTS_TAC;
49382   REWRITE_TAC[curve_cell_h_ver2];
49383   USE 20 (REWRITE_RULE[PAIR_SPLIT]);
49384   REWR 3;
49385   FULL_REWRITE_TAC[rectangle_grid_sq];
49386   TYPE_THEN `E'` UNABBREV_TAC;
49387   REWRITE_TAC[INSERT];
49388   (* - *)
49389   TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC;
49390   UND 19 THEN REWRITE_TAC[];
49391   REWRITE_TAC[UNIONS];
49392   TYPE_THEN `v_edge m` EXISTS_TAC;
49393   REWRITE_TAC[curve_cell_v_ver2];
49394   USE 20 (REWRITE_RULE[PAIR_SPLIT]);
49395   REWR 3;
49396   FULL_REWRITE_TAC[rectangle_grid_sq];
49397   TYPE_THEN `E'` UNABBREV_TAC;
49398   REWRITE_TAC[INSERT];
49399   (* - *)
49400   TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC;
49401   UND 19 THEN REWRITE_TAC[];
49402   REWRITE_TAC[UNIONS];
49403   TYPE_THEN `{(pointI m)}` EXISTS_TAC;
49404   ASM_SIMP_TAC[rectagon_segment;curve_cell_cls];
49405   USE 20 (REWRITE_RULE[PAIR_SPLIT]);
49406   REWR 3;
49407   FULL_REWRITE_TAC[rectangle_grid_sq];
49408   TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC;
49409   TYPE_THEN `E'` UNABBREV_TAC;
49410   REWRITE_TAC[SUBSET;INSERT];
49411   USE 24 (MATCH_MP cls_subset);
49412   USE 24 (REWRITE_RULE[SUBSET]);
49413   FIRST_ASSUM IMATCH_MP_TAC ;
49414   REWRITE_TAC[cls_h];
49415   (* -C *)
49416   USE 9 (MATCH_MP point_onto);
49417   THM_INTRO_TAC[`p`] square_domain;
49418   UND 24 THEN LET_TAC;
49419   TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC;
49420   TYPE_THEN `m` UNABBREV_TAC;
49421   REWRITE_TAC[PAIR_SPLIT];
49422   REWR 24;
49423   TYPE_THEN `point p` UNABBREV_TAC;
49424   USE 24 (REWRITE_RULE[UNION;INR IN_SING;]);
49425   REWR 9;
49426   (* -D *)
49427   ASM_SIMP_TAC[rectagon_segment;par_cell_squ];
49428   FULL_REWRITE_TAC[num_lower];
49429   USE 20 (REWRITE_RULE[PAIR_SPLIT]);
49430   REWR 3;
49431   FULL_REWRITE_TAC[rectangle_grid_sq];
49432   TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC;
49433   TYPE_THEN `E'` UNABBREV_TAC;
49434   REWRITE_TAC[INSERT;cell_clauses];
49435   REWR 24;
49436   (* - *)
49437   TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC;
49438   IMATCH_MP_TAC  EQ_EXT;
49439   REWRITE_TAC[up;PAIR_SPLIT];
49440   INT_ARITH_TAC;
49441   REWR 24;
49442   FULL_REWRITE_TAC[card_sing;EVEN2];
49443   (* Thu Dec 23 20:25:33 EST 2004 *)
49444
49445   ]);;
49446   (* }}} *)
49447
49448 let conn2_sequence_lemma1 = prove_by_refinement(
49449   `!k G N . (k <= N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
49450     (!i. (i <= N) ==> (G i SUBSET edge )) /\
49451     (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) ==>
49452    conn2 (UNIONS (IMAGE G ({i | i <=| k})))`,
49453   (* {{{ proof *)
49454   [
49455   INDUCT_TAC;
49456   TYPE_THEN `{i | i <=| 0} = {0}` SUBAGOAL_TAC;
49457   IMATCH_MP_TAC   EQ_EXT ;
49458   ARITH_TAC;
49459   REWRITE_TAC[image_sing];
49460   (* - *)
49461   UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`G`;`N`]);
49462   UND 3 THEN ARITH_TAC;
49463   TYPE_THEN `{i | i <=| SUC k} = {i | i <= k} UNION {(SUC k)}` SUBAGOAL_TAC;
49464   IMATCH_MP_TAC  EQ_EXT;
49465   REWRITE_TAC[UNION];
49466   ARITH_TAC;
49467   REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION];
49468   IMATCH_MP_TAC  conn2_union_edge;
49469   REWRITE_TAC[EMPTY_EXISTS];
49470   CONJ_TAC;
49471   REWRITE_TAC[UNIONS;IMAGE;SUBSET];
49472   FULL_REWRITE_TAC[SUBSET];
49473   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
49474   UND 8 THEN UND 3 THEN ARITH_TAC;
49475   FIRST_ASSUM IMATCH_MP_TAC ;
49476   TYPE_THEN `u` UNABBREV_TAC;
49477   REWRITE_TAC[INTER];
49478   TYPE_THEN`{i | i <=| k} = {i | i <| k} UNION {k}` SUBAGOAL_TAC;
49479   IMATCH_MP_TAC  EQ_EXT;
49480   REWRITE_TAC[UNION];
49481   ARITH_TAC;
49482   (* - *)
49483   REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION];
49484   REWRITE_TAC[UNION];
49485   FULL_REWRITE_TAC[EMPTY_EXISTS];
49486   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
49487   FULL_REWRITE_TAC[INTER];
49488   TYPE_THEN `u` EXISTS_TAC;
49489   ]);;
49490   (* }}} *)
49491
49492 let thread_finite_union = prove_by_refinement(
49493   `!(A:(A->bool)->(B->bool)) S.
49494     (FINITE S) /\ (!a b. A (a UNION b) = A a UNION A b) /\
49495       (A EMPTY = EMPTY) ==>
49496        (A (UNIONS S) = UNIONS (IMAGE A S))`,
49497   (* {{{ proof *)
49498   [
49499   REP_BASIC_TAC;
49500   TYPE_THEN `!k S. S HAS_SIZE k ==> (A (UNIONS S) = UNIONS (IMAGE A S))` SUBAGOAL_TAC THENL [INDUCT_TAC;ALL_TAC];
49501   FULL_REWRITE_TAC[HAS_SIZE_0];
49502   ASM_REWRITE_TAC[IMAGE_CLAUSES;UNIONS_0;];
49503   THM_INTRO_TAC[`S'`;`k`] HAS_SIZE_SUC;
49504   REWR 5;
49505   USE 6 (REWRITE_RULE[EMPTY_EXISTS]);
49506   TSPEC `u` 5;
49507   TSPEC `S' DELETE u` 4;
49508   TYPE_THEN `S' = (S' DELETE u) UNION {u}` SUBAGOAL_TAC;
49509   IMATCH_MP_TAC  EQ_EXT;
49510   UND 6 THEN REWRITE_TAC[DELETE;UNION;INR IN_SING ] THEN MESON_TAC[];
49511   UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
49512   ASM_REWRITE_TAC[UNIONS_UNION;IMAGE_UNION;image_sing;];
49513   (* - *)
49514   UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`CARD S`;`S`]);
49515   ASM_REWRITE_TAC[HAS_SIZE];
49516   ]);;
49517   (* }}} *)
49518
49519 let conn2_sequence_lemma2 = prove_by_refinement(
49520   `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
49521     (!i. (i <= N) ==> (G i SUBSET edge )) /\
49522     (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
49523    (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\
49524    ~(unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==>
49525    (bounded_set (UNIONS (IMAGE G {i | i <=| N})) p)`,
49526   (* {{{ proof *)
49527   [
49528   REP_BASIC_TAC;
49529   PROOF_BY_CONTR_TAC;
49530   FULL_REWRITE_TAC  [unbounded_diff;DIFF;DE_MORGAN_THM;];
49531   UND 6 THEN ASM_REWRITE_TAC[];
49532   USE 0 (ONCE_REWRITE_RULE[DISJ_SYM]);
49533   FIRST_ASSUM DISJ_CASES_TAC;
49534   KILL 0;
49535   FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM;];
49536   (* - *)
49537   COPY 1;
49538   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`]);
49539   UND 5 THEN ARITH_TAC;
49540   REWR 6;
49541   (* - *)
49542   TYPE_THEN `?j. (j <=| N) /\ UNIONS (curve_cell (G j)) p` SUBAGOAL_TAC;
49543   TYPE_THEN `!r. UNIONS (curve_cell r) = (UNIONS o curve_cell) r` SUBAGOAL_TAC;
49544   REWRITE_TAC[o_DEF];
49545   REWR 6;
49546   TYPE_THEN `A = UNIONS o curve_cell` ABBREV_TAC ;
49547   THM_INTRO_TAC[`A`;`IMAGE G {i | i <=| N}`] thread_finite_union;
49548   CONJ_TAC;
49549   IMATCH_MP_TAC  FINITE_IMAGE;
49550   REWRITE_TAC[FINITE_NUMSEG_LE];
49551   TYPE_THEN `A` UNABBREV_TAC;
49552   USE 9 GSYM;
49553   CONJ_TAC;
49554   REWRITE_TAC[curve_cell_union;UNIONS_UNION];
49555   REWRITE_TAC[curve_cell_empty;];
49556   USE 11 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
49557   TSPEC `p` 11;
49558   TYPE_THEN `A` UNABBREV_TAC;
49559   KILL 9;
49560   FULL_REWRITE_TAC[IMAGE_o];
49561   FULL_REWRITE_TAC[o_DEF];
49562   REWR 11;
49563   FULL_REWRITE_TAC[GSYM UNIONS_IMAGE_UNIONS];
49564   USE 9 (REWRITE_RULE[UNIONS]);
49565   USE 11 (REWRITE_RULE[IMAGE]);
49566   TYPE_THEN `u'` UNABBREV_TAC;
49567   TYPE_THEN `x` UNABBREV_TAC;
49568   TYPE_THEN `x'` EXISTS_TAC;
49569   REWRITE_TAC[UNIONS];
49570   TYPE_THEN `u` EXISTS_TAC;
49571   (* - *)
49572   FULL_REWRITE_TAC[curve_cell_union;UNIONS_UNION];
49573   FULL_REWRITE_TAC[UNION;DE_MORGAN_THM];
49574   TYPE_THEN `j = 0` ASM_CASES_TAC;
49575   REWR 9;
49576   (* - *)
49577   TYPE_THEN `?i. j = SUC i` SUBAGOAL_TAC ;
49578   TYPE_THEN `j - 1` EXISTS_TAC;
49579   UND 12 THEN ARITH_TAC;
49580   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
49581   REWR 10;
49582   TYPE_THEN `j` UNABBREV_TAC;
49583   UND 14 THEN ASM_REWRITE_TAC[];
49584   (* Fri Dec 24 07:02:02 EST 2004 *)
49585
49586   ]);;
49587   (* }}} *)
49588
49589 let conn2_sequence_lemma3 = prove_by_refinement(
49590   `!G N. (!i. (i <= N) ==> (G i SUBSET edge )) ==>
49591     (UNIONS (IMAGE G {i | i <=| N}) SUBSET edge)`,
49592   (* {{{ proof *)
49593   [
49594   REP_BASIC_TAC;
49595   REWRITE_TAC[UNIONS;IMAGE;SUBSET ];
49596   UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
49597   ASM_MESON_TAC[subset_imp];
49598   ]);;
49599   (* }}} *)
49600
49601 let unbounded_avoidance_subset_ver2 = prove_by_refinement(
49602   `!E E' x.
49603           unbounded_set E' x /\
49604           E SUBSET E' /\
49605           E' SUBSET edge /\
49606           FINITE E' /\
49607           conn2 E
49608              ==> unbounded_set E x`,
49609   (* {{{ proof *)
49610   [
49611   REP_BASIC_TAC;
49612   THM_INTRO_TAC[`E`;`E'`;`x`] unbounded_avoidance_subset;
49613   THM_INTRO_TAC[`E'`;`x`] unbounded_subset_unions;
49614   FULL_REWRITE_TAC[ctop_unions;DIFF];
49615   UND 6 THEN ASM_REWRITE_TAC[];
49616   ]);;
49617   (* }}} *)
49618
49619 let conn2_sequence_lemma4 = prove_by_refinement(
49620   `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
49621     (!i. (i <= N) ==> (G i SUBSET edge )) /\
49622     (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
49623    (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\
49624    (bounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==>
49625     (?C i j . rectagon C /\ bounded_set C p /\
49626        (SUC i < j) /\ (j <=| N) /\
49627        (C SUBSET (UNIONS (IMAGE G ({x | (i <=| x) /\ (x <=| j)})))) /\
49628     (!C' i' j'. rectagon C' /\ bounded_set  C' p /\
49629        (i' < j') /\ (j' <=| N) /\
49630        (C' SUBSET (UNIONS (IMAGE G ({x | (i' <=| x /\ x <=| j')})))) ==>
49631        (j - i <= j' - i') /\
49632    ((j - i = j' - i') ==>
49633       (CARD (C DIFF (G (SUC i))) <= CARD (C' DIFF (G (SUC i')))))))`,
49634   (* {{{ proof *)
49635   [
49636   REP_BASIC_TAC;
49637   THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1;
49638   ARITH_TAC;
49639   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 ;
49640   TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
49641   UND 8 THEN REWRITE_TAC[EMPTY_EXISTS];
49642   THM_INTRO_TAC[`UNIONS (IMAGE G {i | i <=| N})`] rectagon_surround_conn2;
49643   IMATCH_MP_TAC  conn2_sequence_lemma3;
49644   TYPE_THEN `(C,0,N)` EXISTS_TAC;
49645   TYPE_THEN `X` UNABBREV_TAC;
49646   REWRITE_TAC[PAIR_SPLIT];
49647   TYPE_THEN `C` EXISTS_TAC;
49648   TYPE_THEN `0` EXISTS_TAC;
49649   TYPE_THEN `N` EXISTS_TAC;
49650   REWRITE_TAC[ARITH_RULE `!x. 0 <=| x`];
49651   ARITH_TAC;
49652   (* -A *)
49653   THM_INTRO_TAC[`X`;`(\ (C,i,j). j -| i):(((((num->real)->bool)->bool)#(num#num)) -> num)`] select_image_num_min;
49654   UND 8 THEN ASM_REWRITE_TAC[];
49655   (* - *)
49656   TYPE_THEN `?D i j. z = (D,i,j)` SUBAGOAL_TAC;
49657   REWRITE_TAC[PAIR_SPLIT];
49658   MESON_TAC[];
49659   TYPE_THEN `z` UNABBREV_TAC;
49660   (* - *)
49661   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 ;
49662   TYPE_THEN `~(Y = EMPTY)` SUBAGOAL_TAC;
49663   UND 12 THEN REWRITE_TAC[EMPTY_EXISTS];
49664   TYPE_THEN `(D,i,j)` EXISTS_TAC;
49665   TYPE_THEN `Y` UNABBREV_TAC;
49666   REWRITE_TAC[PAIR_SPLIT];
49667   TYPE_THEN `D` EXISTS_TAC;
49668   TYPE_THEN `i` EXISTS_TAC;
49669   TYPE_THEN `j` EXISTS_TAC;
49670   TYPE_THEN `X` UNABBREV_TAC;
49671   USE 7 (REWRITE_RULE[PAIR_SPLIT]);
49672   ASM_REWRITE_TAC[];
49673   (* - *)
49674   THM_INTRO_TAC[`Y`;`\ (C,i',(j':num)). (CARD (C DIFF (G (SUC i'))))`] select_image_num_min;
49675   UND 12 THEN ASM_REWRITE_TAC[];
49676   TYPE_THEN `?C i' j'. z' = (C,i',j')` SUBAGOAL_TAC;
49677   REWRITE_TAC[PAIR_SPLIT];
49678   MESON_TAC[];
49679   TYPE_THEN `z'` UNABBREV_TAC;
49680   TYPE_THEN `C` EXISTS_TAC;
49681   TYPE_THEN `i'` EXISTS_TAC;
49682   TYPE_THEN `j'` EXISTS_TAC;
49683   USE 11 SYM;
49684   REWR 14;
49685   USE 11 SYM;
49686   USE 14 (REWRITE_RULE[PAIR_SPLIT]);
49687   TYPE_THEN `C'` UNABBREV_TAC;
49688   TYPE_THEN `i''` UNABBREV_TAC;
49689   TYPE_THEN `j''` UNABBREV_TAC;
49690   (* -B *)
49691   CONJ_TAC;
49692   TYPE_THEN `(SUC i' <| j') \/ (SUC i' = j')` SUBAGOAL_TAC;
49693   UND 18 THEN ARITH_TAC;
49694   FIRST_ASSUM DISJ_CASES_TAC;
49695   TYPE_THEN `j'` UNABBREV_TAC;
49696   PROOF_BY_CONTR_TAC;
49697   UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
49698   TYPE_THEN `{x | i' <=| x /\ x <=| SUC i'} = {i'} UNION {(SUC i')}` SUBAGOAL_TAC;
49699   IMATCH_MP_TAC  EQ_EXT;
49700   REWRITE_TAC[UNION];
49701   ARITH_TAC;
49702   REWR 16;
49703   USE 16 (REWRITE_RULE[UNIONS_UNION;image_sing;IMAGE_UNION]);
49704   (* -- *)
49705   THM_INTRO_TAC[`C`;`(G i' UNION G (SUC i'))`;`p`]unbounded_avoidance_subset_ver2;
49706   REWRITE_TAC[union_subset];
49707   CONJ_TAC;
49708   FIRST_ASSUM IMATCH_MP_TAC ;
49709   UND 17 THEN ARITH_TAC;
49710   CONJ_TAC;
49711   REWRITE_TAC[FINITE_UNION];
49712   TYPE_THEN `i' <=| N` SUBAGOAL_TAC;
49713   UND 17 THEN ARITH_TAC;
49714   FULL_REWRITE_TAC[conn2];
49715   IMATCH_MP_TAC  conn2_rectagon;
49716   (* -- *)
49717   THM_INTRO_TAC[`C`] bounded_unbounded_disj;
49718   USE 24 (REWRITE_RULE[INTER;EQ_EMPTY]);
49719   TSPEC `p` 24;
49720   UND 24 THEN ASM_REWRITE_TAC[];
49721   (* -C *)
49722   TYPE_THEN `X (C'',i''',j''')` SUBAGOAL_TAC;
49723   TYPE_THEN `X` UNABBREV_TAC;
49724   REWRITE_TAC[PAIR_SPLIT];
49725   TYPE_THEN `C''` EXISTS_TAC;
49726   TYPE_THEN `i'''` EXISTS_TAC;
49727   TYPE_THEN `j'''` EXISTS_TAC;
49728   ASM_REWRITE_TAC[];
49729   (* - *)
49730   CONJ_TAC;
49731   TSPEC `(C'',i''',j''')` 9;
49732   USE 9 (GBETA_RULE);
49733   (* - *)
49734   TYPE_THEN `Y (C'',i''',j''')` SUBAGOAL_TAC;
49735   TYPE_THEN `Y` UNABBREV_TAC;
49736   REWRITE_TAC[PAIR_SPLIT];
49737   TYPE_THEN `C''` EXISTS_TAC;
49738   TYPE_THEN `i'''` EXISTS_TAC;
49739   TYPE_THEN `j'''` EXISTS_TAC;
49740   ASM_REWRITE_TAC[];
49741   UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`(C'',i''',j''')`]);
49742 (*** Removed by JRH; no longer needed with paired beta in default rewrites
49743   USE 13 (GBETA_RULE);
49744  ***)
49745   (* Fri Dec 24 12:26:34 EST 2004 *)
49746   ]);;
49747   (* }}} *)
49748
49749 let endpoint_sub_rectagon = prove_by_refinement(
49750   `!C G m. rectagon G /\ C SUBSET G /\ endpoint C m ==>
49751     (?!e. G e /\ ~(C e) /\ cls {e} m)`,
49752   (* {{{ proof *)
49753   [
49754   REP_BASIC_TAC;
49755   FULL_REWRITE_TAC[endpoint];
49756   THM_INTRO_TAC[`C`;`pointI m`] num_closure1;
49757   IMATCH_MP_TAC  FINITE_SUBSET;
49758   TYPE_THEN `G` EXISTS_TAC;
49759   FULL_REWRITE_TAC[rectagon];
49760   REWR 3;
49761   FULL_REWRITE_TAC[rectagon];
49762   KILL 2;
49763   TSPEC `m` 4;
49764   USE 2 (REWRITE_RULE[INSERT]);
49765   USE 2 (ONCE_REWRITE_RULE[TAUT `a \/ b <=> b \/ a`]);
49766   FIRST_ASSUM DISJ_CASES_TAC;
49767   THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
49768   REWR 8;
49769   TSPEC `e` 8;
49770   USE 1 (REWRITE_RULE[SUBSET]);
49771   TSPEC `e` 3;
49772   ASM_MESON_TAC[];
49773   (* -A *)
49774   COPY 3;
49775   TSPEC `e` 8;
49776   USE 8 (REWRITE_RULE[]);
49777   THM_INTRO_TAC[`G`;`pointI m`] num_closure2;
49778   REWR 10;
49779   COPY 10;
49780   TSPEC `e` 10;
49781   TYPE_THEN `G e` SUBAGOAL_TAC;
49782   USE 1 (REWRITE_RULE[SUBSET]);
49783   TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
49784   ASM_MESON_TAC[];
49785   REWRITE_TAC[cls];
49786   REWRITE_TAC[EXISTS_UNIQUE_ALT];
49787   (* - *)
49788   FIRST_ASSUM DISJ_CASES_TAC;
49789   TYPE_THEN `e` UNABBREV_TAC;
49790   TYPE_THEN `b` EXISTS_TAC;
49791   IMATCH_MP_TAC  EQ_ANTISYM;
49792   CONJ_TAC;
49793   TYPE_THEN `e'` UNABBREV_TAC;
49794   TSPEC `y` 12;
49795   REWR 12;
49796   FIRST_ASSUM DISJ_CASES_TAC;
49797   TYPE_THEN `y` UNABBREV_TAC;
49798   UND 18 THEN ASM_REWRITE_TAC[];
49799   TYPE_THEN `y` UNABBREV_TAC;
49800   TSPEC  `b` 3;
49801   TSPEC `b` 12;
49802   REWR 12;
49803   REWR 3;
49804   TYPE_THEN `b` EXISTS_TAC;
49805   ASM_REWRITE_TAC[];
49806   (* - *)
49807   TYPE_THEN `e` UNABBREV_TAC;
49808   TYPE_THEN `a` EXISTS_TAC;
49809   IMATCH_MP_TAC  EQ_ANTISYM;
49810   CONJ_TAC;
49811   TYPE_THEN `e'` UNABBREV_TAC;
49812   TSPEC `y` 12;
49813   REWR 12;
49814   FIRST_ASSUM DISJ_CASES_TAC;
49815   TYPE_THEN `y` UNABBREV_TAC;
49816   UND 18 THEN ASM_REWRITE_TAC[];
49817   TYPE_THEN `y` UNABBREV_TAC;
49818   TSPEC  `a` 3;
49819   TSPEC `a` 12;
49820   REWR 12;
49821   REWR 3;
49822   TYPE_THEN `a` EXISTS_TAC;
49823   ASM_REWRITE_TAC[];
49824   (* Mon Dec 27 15:17:28 EST 2004 *)
49825   ]);;
49826   (* }}} *)
49827
49828 let cut_rectagon_unique = prove_by_refinement(
49829   `!E A B C m n. rectagon E /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\
49830     segment_end A m n /\ segment_end B m n /\ segment_end C m n /\
49831     (E = A UNION B) /\ (A INTER B = EMPTY) ==>
49832     (C = A) \/ (C = B)`,
49833   (* {{{ proof *)
49834   [
49835   REP_BASIC_TAC;
49836   TYPE_THEN `!A. A SUBSET E /\ segment_end A m n /\ ~(A INTER C = EMPTY) ==> (A SUBSET C)` SUBAGOAL_TAC;
49837   TYPE_THEN `inductive_set A' (A' INTER C)` SUBAGOAL_TAC;
49838   REWRITE_TAC[inductive_set];
49839   CONJ_TAC;
49840   REWRITE_TAC[INTER;SUBSET];
49841   FULL_REWRITE_TAC[INTER];
49842   TYPE_THEN `edge C' /\ edge C''` SUBAGOAL_TAC;
49843   FULL_REWRITE_TAC[segment_end;psegment;segment];
49844   UND 16 THEN UND 15 THEN UND 13 THEN MESON_TAC[subset_imp];
49845   THM_INTRO_TAC[`C'`;`C''`] adjv_adj;
49846   THM_INTRO_TAC[`C'`;`C''`] adjv_adj2;
49847   TYPE_THEN `q =adjv C' C''` ABBREV_TAC ;
49848   TYPE_THEN `~(C' = C'')` SUBAGOAL_TAC;
49849   FULL_REWRITE_TAC[adj];
49850   UND 22 THEN ASM_REWRITE_TAC[];
49851   (* --- *)
49852   TYPE_THEN `~(endpoint A' q)` SUBAGOAL_TAC;
49853   FULL_REWRITE_TAC[segment_end];
49854   USE 2 SYM;
49855   USE 22 (REWRITE_RULE[endpoint]);
49856   THM_INTRO_TAC[`A'`;`pointI q`] num_closure1;
49857   USE 3 (REWRITE_RULE[psegment;segment]);
49858   REWR 27;
49859   COPY 27;
49860   TSPEC `C'` 27;
49861   TSPEC `C''` 28;
49862   ASM_MESON_TAC[];
49863   (* ---A *)
49864   TYPE_THEN `~(endpoint C q)` SUBAGOAL_TAC;
49865   FULL_REWRITE_TAC[segment_end];
49866   TYPE_THEN `endpoint A'` UNABBREV_TAC;
49867   TYPE_THEN `endpoint C` UNABBREV_TAC;
49868   UND 22 THEN ASM_REWRITE_TAC[];
49869   (* --- *)
49870   PROOF_BY_CONTR_TAC;
49871   UND 23 THEN ASM_REWRITE_TAC[];
49872   IMATCH_MP_TAC  rectagon_subset_endpoint;
49873   USE 1 SYM;
49874   TYPE_THEN `E` EXISTS_TAC;
49875   CONJ_TAC THEN IMATCH_MP_TAC  num_closure_pos;
49876   CONJ_TAC;
49877   USE 2 (REWRITE_RULE[segment_end;segment;psegment]);
49878   TYPE_THEN `C'` EXISTS_TAC;
49879   (* --- *)
49880   CONJ_TAC;
49881   IMATCH_MP_TAC  FINITE_SUBSET;
49882   TYPE_THEN `E` EXISTS_TAC;
49883   REWRITE_TAC[DIFF;SUBSET];
49884   FULL_REWRITE_TAC[rectagon];
49885   TYPE_THEN `C''` EXISTS_TAC;
49886   REWRITE_TAC[DIFF];
49887   USE 11 (REWRITE_RULE[SUBSET]);
49888   (* -- *)
49889   USE 10 (REWRITE_RULE[segment_end;psegment;segment]);
49890   FULL_REWRITE_TAC[inductive_set];
49891   UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`A' INTER C`]);
49892   ASM_REWRITE_TAC[];
49893   REWRITE_TAC[SUBSET_INTER_ABSORPTION];
49894   (* -B *)
49895   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;
49896   TYPE_THEN `A' SUBSET C` SUBAGOAL_TAC;
49897   FIRST_ASSUM IMATCH_MP_TAC ;
49898   FULL_REWRITE_TAC[INTER_COMM];
49899   UND 10 THEN ASM_REWRITE_TAC[];
49900   (* -- *)
49901   TYPE_THEN `B' INTER C = EMPTY` ASM_CASES_TAC;
49902   TYPE_THEN `E` UNABBREV_TAC;
49903   TYPE_THEN `A UNION B` UNABBREV_TAC;
49904   UND 5 THEN UND 18 THEN UND 17 THEN POP_ASSUM_LIST (fun t-> ALL_TAC);
49905   FULL_REWRITE_TAC[SUBSET;INTER;EQ_EMPTY;UNION];
49906   IMATCH_MP_TAC  EQ_EXT ;
49907   TSPEC `x` 0;
49908   TSPEC `x` 1;
49909   TSPEC `x` 2;
49910   ASM_MESON_TAC[];
49911   (* -- *)
49912   TYPE_THEN `B' SUBSET C` SUBAGOAL_TAC;
49913   FIRST_ASSUM IMATCH_MP_TAC ;
49914   USE 1 SYM;
49915   TYPE_THEN `E = C` SUBAGOAL_TAC;
49916   IMATCH_MP_TAC  EQ_EXT;
49917   REWRITE_TAC[UNION];
49918   IMATCH_MP_TAC  EQ_ANTISYM;
49919   CONJ_TAC;
49920   FIRST_ASSUM DISJ_CASES_TAC;
49921   ASM_MESON_TAC[subset_imp];
49922   ASM_MESON_TAC[subset_imp];
49923   TYPE_THEN `E` UNABBREV_TAC;
49924   TYPE_THEN `A UNION B` UNABBREV_TAC;
49925   USE 5 (REWRITE_RULE[SUBSET;UNION]);
49926   TYPE_THEN `C` UNABBREV_TAC;
49927   USE 2 (REWRITE_RULE[segment_end;psegment]);
49928   UND 20 THEN ASM_REWRITE_TAC[];
49929   (* - *)
49930   TYPE_THEN `~(C INTER A = EMPTY) \/ ~( C INTER B = EMPTY)` SUBAGOAL_TAC;
49931   PROOF_BY_CONTR_TAC;
49932   USE 11 (REWRITE_RULE[DE_MORGAN_THM]);
49933   TYPE_THEN `E` UNABBREV_TAC;
49934   FULL_REWRITE_TAC[INTER;EQ_EMPTY];
49935   USE 5 (REWRITE_RULE[SUBSET;UNION]);
49936   USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
49937   FULL_REWRITE_TAC[EMPTY_EXISTS];
49938   TSPEC `u` 1;
49939   TSPEC `u` 11;
49940   TSPEC `u` 12;
49941   ASM_MESON_TAC[];
49942   FIRST_ASSUM DISJ_CASES_TAC;
49943   DISJ1_TAC;
49944   FIRST_ASSUM IMATCH_MP_TAC ;
49945   TYPE_THEN `B` EXISTS_TAC;
49946   ASM_REWRITE_TAC[SUBSET;UNION];
49947   DISJ2_TAC;
49948   FIRST_ASSUM IMATCH_MP_TAC ;
49949   TYPE_THEN `A` EXISTS_TAC;
49950   FULL_REWRITE_TAC[INTER_COMM;UNION_COMM];
49951   ASM_REWRITE_TAC[SUBSET;UNION];
49952   (* Mon Dec 27 20:34:44 EST 2004 *)
49953
49954   ]);;
49955   (* }}} *)
49956
49957 let conn2_sequence_lemma5 = prove_by_refinement(
49958   `!C E . ~(E SUBSET C) /\ psegment E /\ rectagon C /\
49959     endpoint E SUBSET cls C  ==>
49960    (?E'. E' SUBSET E /\ psegment E' /\ (E' INTER C = EMPTY ) /\
49961      (cls E' INTER cls C = endpoint E'))`,
49962   (* {{{ proof *)
49963   [
49964   REP_BASIC_TAC;
49965   TYPE_THEN `?e. E e /\ ~C e` SUBAGOAL_TAC;
49966   FULL_REWRITE_TAC[SUBSET];
49967   ASM_MESON_TAC[];
49968   (* - *)
49969   TYPE_THEN `J = segment_of (E DIFF C) e` ABBREV_TAC ;
49970   TYPE_THEN `X = { A | psegment A /\ A SUBSET E /\ (A INTER C = EMPTY) /\ (endpoint A SUBSET cls C)}` ABBREV_TAC ;
49971   TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
49972   TYPE_THEN `X` UNABBREV_TAC;
49973   TYPE_THEN `J` EXISTS_TAC;
49974   TYPE_THEN `J SUBSET (E DIFF C)` SUBAGOAL_TAC;
49975   TYPE_THEN `J` UNABBREV_TAC;
49976   THM_INTRO_TAC[`(E DIFF C)`;`e`] segment_of_G;
49977   REWRITE_TAC[DIFF];
49978   CONJ_TAC;
49979   THM_INTRO_TAC[`E`;`E DIFF C`;`e`] segment_of_segment;
49980   FULL_REWRITE_TAC[psegment];
49981   REWRITE_TAC[DIFF;SUBSET];
49982   TYPE_THEN `J` UNABBREV_TAC;
49983   REWRITE_TAC[psegment];
49984   DISCH_TAC;
49985   THM_INTRO_TAC[`segment_of (E DIFF C) e`;`E`] rectagon_subset;
49986   USE 2 (REWRITE_RULE[psegment]);
49987   IMATCH_MP_TAC  SUBSET_TRANS;
49988   TYPE_THEN `E DIFF C` EXISTS_TAC;
49989   REWRITE_TAC[DIFF;SUBSET];
49990   USE 2 (REWRITE_RULE[psegment]);
49991   ASM_MESON_TAC[];
49992   (* -- *)
49993   CONJ_TAC;
49994   UND 7 THEN REWRITE_TAC[SUBSET;DIFF];
49995   CONJ_TAC;
49996   UND 7 THEN REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY] THEN MESON_TAC[];
49997   REWRITE_TAC[SUBSET];
49998   PROOF_BY_CONTR_TAC;
49999   (* --A *)
50000   THM_INTRO_TAC[`E DIFF C`;`e`] inductive_segment;
50001   REWRITE_TAC[DIFF];
50002   FULL_REWRITE_TAC[inductive_set];
50003   USE 8 (REWRITE_RULE[endpoint]);
50004   THM_INTRO_TAC[`J`;`pointI x`] num_closure1;
50005   TYPE_THEN `J` UNABBREV_TAC;
50006   IMATCH_MP_TAC  segment_of_finite;
50007   CONJ_TAC;
50008   IMATCH_MP_TAC  FINITE_SUBSET;
50009   TYPE_THEN `E` EXISTS_TAC;
50010   REWRITE_TAC[DIFF;SUBSET];
50011   USE 2 (REWRITE_RULE[psegment;segment]);
50012   REWRITE_TAC[DIFF];
50013   REWR 13;
50014  USE 2 (REWRITE_RULE[psegment;segment]);
50015   TSPEC `x` 15;
50016   USE 15 (REWRITE_RULE[INSERT]);
50017   UND 15 THEN REP_CASES_TAC;
50018   THM_INTRO_TAC[`E`;`pointI x`] num_closure2;
50019   REWR 15;
50020   (* ---- *)
50021   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;
50022   TYPE_THEN `(e' = a) \/ (e' = b)` SUBAGOAL_TAC;
50023   TSPEC `e'` 15;
50024   USE 15 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
50025   TSPEC `e'` 13;
50026   TYPE_THEN `J` UNABBREV_TAC;
50027   THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G;
50028   REWRITE_TAC[DIFF];
50029   USE 21 (REWRITE_RULE[SUBSET]);
50030   TSPEC `e'` 21;
50031   USE 13 (REWRITE_RULE[DIFF]);
50032   FIRST_ASSUM DISJ_CASES_TAC;
50033   TYPE_THEN `e'` UNABBREV_TAC;
50034   TYPE_THEN `a` EXISTS_TAC ;
50035   TYPE_THEN `b` EXISTS_TAC;
50036   MESON_TAC[];
50037   TYPE_THEN `e'` UNABBREV_TAC;
50038   TYPE_THEN `b` EXISTS_TAC;
50039   TYPE_THEN `a` EXISTS_TAC;
50040   REWRITE_TAC [EQ_SYM_EQ ];
50041   MESON_TAC[];
50042   (* ---- *)
50043   USE 6 SYM;
50044   TYPE_THEN `segment_of (E DIFF C) e b'` SUBAGOAL_TAC;
50045   FIRST_ASSUM IMATCH_MP_TAC ;
50046   TYPE_THEN `a'` EXISTS_TAC;
50047   CONJ_TAC;
50048   TSPEC `a'` 21;
50049   TYPE_THEN `J` UNABBREV_TAC;
50050   CONJ_TAC;
50051   REWRITE_TAC[DIFF];
50052   CONJ_TAC;
50053   TSPEC `b'` 22;
50054   KILL 15;
50055   REWR 22;
50056   (* ------ *)
50057   USE 9 (REWRITE_RULE[cls]);
50058   LEFT 9 "e";
50059   TSPEC  `b'` 9;
50060   TSPEC `b'` 22;
50061   KILL 15;
50062   UND 22 THEN ASM_REWRITE_TAC[];
50063   UND 9 THEN ASM_REWRITE_TAC[];
50064   (* ----- *)
50065   REWRITE_TAC[adj];
50066   REWRITE_TAC[INTER;EMPTY_EXISTS];
50067   TYPE_THEN `pointI x` EXISTS_TAC;
50068   KILL 15;
50069   COPY 22;
50070   TSPEC  `a'` 15;
50071   TSPEC `b'` 22;
50072   REWR 22;
50073   REWR 15;
50074   (* ---- *)
50075   TSPEC `b'` 21;
50076   TYPE_THEN `J` UNABBREV_TAC;
50077   TSPEC `b'` 22;
50078   KILL 15;
50079   REWR 6;
50080   KILL 13;
50081   UND 21 THEN ASM_REWRITE_TAC[];
50082   (* --- *)
50083   USE 0 (REWRITE_RULE[SUBSET]);
50084   TSPEC `x` 0;
50085   USE 0 (REWRITE_RULE[endpoint]);
50086   UND 9 THEN ASM_REWRITE_TAC[];
50087   (* -- *)
50088   THM_INTRO_TAC[`J`;`E`;`pointI x`] num_closure_mono;
50089   TYPE_THEN `J` UNABBREV_TAC;
50090   REWRITE_TAC[SUBSET];
50091   THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G;
50092   REWRITE_TAC[DIFF];
50093   USE 19 (REWRITE_RULE[SUBSET]);
50094   TSPEC `x'` 19;
50095   USE 6 (REWRITE_RULE[DIFF]);
50096   UND 8 THEN UND 15 THEN UND 19 THEN ARITH_TAC;
50097   (* -B *)
50098   THM_INTRO_TAC[`X`] select_card_min;
50099   UND 8 THEN ASM_REWRITE_TAC[];
50100   (* - *)
50101   TYPE_THEN `z` EXISTS_TAC;
50102   TYPE_THEN `X` UNABBREV_TAC;
50103   IMATCH_MP_TAC  SUBSET_ANTISYM;
50104   IMATCH_MP_TAC  (TAUT `a /\ b==> b /\ a`);
50105   CONJ_TAC;
50106   REWRITE_TAC[SUBSET_INTER];
50107   IMATCH_MP_TAC  endpoint_cls;
50108   IMATCH_MP_TAC  FINITE_SUBSET;
50109   TYPE_THEN `E` EXISTS_TAC;
50110   USE 2 (REWRITE_RULE[psegment;segment]);
50111   REWRITE_TAC[INTER;SUBSET];
50112   PROOF_BY_CONTR_TAC;
50113   (* - cut along x *)
50114   THM_INTRO_TAC[`z`] endpoint_size2;
50115   FULL_REWRITE_TAC[has_size2];
50116   TYPE_THEN `segment_end z a b` SUBAGOAL_TAC;
50117   REWRITE_TAC[segment_end];
50118   (* - *)
50119   THM_INTRO_TAC[`z`;`a`;`b`;`x`] cut_psegment;
50120   TYPE_THEN `endpoint z` UNABBREV_TAC;
50121   USE 15 (REWRITE_RULE[INR in_pair;DE_MORGAN_THM ]);
50122   UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`A`]);
50123   CONJ_TAC;
50124   USE 20 (REWRITE_RULE[segment_end]);
50125   CONJ_TAC;
50126   IMATCH_MP_TAC  SUBSET_TRANS;
50127   TYPE_THEN `z` EXISTS_TAC;
50128   REWRITE_TAC[SUBSET;UNION];
50129   CONJ_TAC;
50130   REWRITE_TAC[EQ_EMPTY;INTER];
50131   USE 10 (REWRITE_RULE[INTER;EQ_EMPTY ]);
50132   TSPEC `x'` 10;
50133   UND 10 THEN ASM_REWRITE_TAC[];
50134   REWRITE_TAC[UNION];
50135   USE 20 (REWRITE_RULE[segment_end]);
50136   REWRITE_TAC[SUBSET;INR in_pair];
50137   FIRST_ASSUM DISJ_CASES_TAC;
50138   TYPE_THEN `x'` UNABBREV_TAC;
50139   TYPE_THEN `x'` UNABBREV_TAC;
50140   USE 7 (REWRITE_RULE[SUBSET]);
50141   FIRST_ASSUM IMATCH_MP_TAC ;
50142   REWRITE_TAC[];
50143   USE 9 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
50144   UND 9 THEN REWRITE_TAC[];
50145   IMATCH_MP_TAC  card_subset_lt;
50146   CONJ_TAC;
50147   REWRITE_TAC[SUBSET;UNION];
50148   CONJ_TAC;
50149   TYPE_THEN `B = EMPTY` SUBAGOAL_TAC;
50150   PROOF_BY_CONTR_TAC;
50151   USE 24 (REWRITE_RULE[EMPTY_EXISTS]);
50152   USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
50153   TSPEC `u` 9;
50154   USE 9 (REWRITE_RULE[UNION]);
50155   UND 22 THEN ASM_REWRITE_TAC[INTER;EMPTY_EXISTS];
50156   ASM_MESON_TAC[];
50157   TYPE_THEN `B` UNABBREV_TAC;
50158   USE 19 (REWRITE_RULE[segment_end;psegment;segment]);
50159   (* - *)
50160   TYPE_THEN `A UNION B` UNABBREV_TAC;
50161   USE 12 (REWRITE_RULE[psegment;segment;]);
50162   (* Mon Dec 27 23:01:48 EST 2004 *)
50163
50164
50165   ]);;
50166   (* }}} *)
50167
50168 let conn_splice = prove_by_refinement(
50169   `!E AE B a b a' b'. segment_end E a b /\ segment_end AE a' b' /\
50170       segment_end B a' b' /\ AE SUBSET E ==>
50171       (?B'. segment_end B' a b /\ B' SUBSET (E DIFF AE) UNION B)`,
50172   (* {{{ proof *)
50173   [
50174   REP_BASIC_TAC;
50175   TYPE_THEN `J= (E DIFF AE) UNION B` ABBREV_TAC ;
50176   TYPE_THEN `B SUBSET J` SUBAGOAL_TAC;
50177   TYPE_THEN `J` UNABBREV_TAC;
50178   REWRITE_TAC[SUBSET;UNION];
50179   (* - *)
50180   TYPE_THEN `cls B SUBSET cls J` SUBAGOAL_TAC;
50181   IMATCH_MP_TAC  cls_subset;
50182   TYPE_THEN `endpoint B SUBSET cls B` SUBAGOAL_TAC;
50183   IMATCH_MP_TAC  endpoint_cls;
50184   USE 1 (REWRITE_RULE[segment_end;segment;psegment]);
50185   (* - *)
50186   TYPE_THEN `cls B a' /\ cls B b'` SUBAGOAL_TAC;
50187   FULL_REWRITE_TAC[SUBSET];
50188   USE 1 (REWRITE_RULE[segment_end]);
50189   CONJ_TAC  THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[INR in_pair ];
50190   TYPE_THEN `cls J a' /\ cls J b'` SUBAGOAL_TAC;
50191   USE 6 (REWRITE_RULE[SUBSET]);
50192   (* -// *)
50193   TYPE_THEN `conn J` SUBAGOAL_TAC ;
50194   TYPE_THEN `!x. cls J x ==> (x = a') \/ (?P. segment_end P x a' /\ P SUBSET J)` BACK_TAC;
50195   REWRITE_TAC[conn];
50196   TYPE_THEN `a'' = a'` ASM_CASES_TAC;
50197   ONCE_REWRITE_TAC[segment_end_symm];
50198   TYPE_THEN `a''` UNABBREV_TAC;
50199   TSPEC `b''` 12;
50200   FIRST_ASSUM DISJ_CASES_TAC;
50201   TYPE_THEN `b''` UNABBREV_TAC;
50202   ASM_MESON_TAC[];
50203   TYPE_THEN `P` EXISTS_TAC;
50204   (* --- *)
50205   TYPE_THEN `b'' = a'` ASM_CASES_TAC;
50206   TYPE_THEN `b''` UNABBREV_TAC;
50207   TSPEC `a''` 12;
50208   FIRST_ASSUM DISJ_CASES_TAC;
50209   TYPE_THEN `a''` UNABBREV_TAC;
50210   ASM_MESON_TAC[];
50211   TYPE_THEN `P` EXISTS_TAC;
50212   (* --- *)
50213   COPY 12;
50214   TSPEC `a''` 18;
50215   REWR 15;
50216   TSPEC `b''` 12;
50217   REWR 12;
50218   THM_INTRO_TAC[`P`;`P'`;`a''`;`a'`;`b''`] segment_end_trans;
50219   ONCE_REWRITE_TAC[segment_end_symm];
50220   TYPE_THEN `U` EXISTS_TAC;
50221   IMATCH_MP_TAC  SUBSET_TRANS;
50222   TYPE_THEN `P UNION P'` EXISTS_TAC;
50223   REWRITE_TAC[union_subset];
50224   (* --A// *)
50225   TYPE_THEN `x = a'` ASM_CASES_TAC;
50226   TYPE_THEN `x = b'` ASM_CASES_TAC;
50227   TYPE_THEN `B` EXISTS_TAC;
50228   ONCE_REWRITE_TAC [segment_end_symm];
50229   (* -- *)
50230   TYPE_THEN `?P. segment_end P x b' /\ P SUBSET J` ASM_CASES_TAC;
50231   THM_INTRO_TAC[`P`;`B`;`x`;`b'`;`a'`] segment_end_trans;
50232   ONCE_REWRITE_TAC[segment_end_symm];
50233   TYPE_THEN `U` EXISTS_TAC;
50234   IMATCH_MP_TAC  SUBSET_TRANS;
50235   TYPE_THEN `P UNION B` EXISTS_TAC;
50236   REWRITE_TAC[union_subset];
50237   (* -- *)
50238   TYPE_THEN `cls B x` ASM_CASES_TAC;
50239   THM_INTRO_TAC[`B`;`a'`;`b'`;`x`] cut_psegment;
50240   TYPE_THEN `A` EXISTS_TAC;
50241   ONCE_REWRITE_TAC[segment_end_symm];
50242   TYPE_THEN `J` UNABBREV_TAC;
50243   REWRITE_TAC[SUBSET;UNION];
50244   (* --// *)
50245   TYPE_THEN `cls E x` SUBAGOAL_TAC;
50246   TYPE_THEN `(E DIFF AE) SUBSET E` SUBAGOAL_TAC;
50247   REWRITE_TAC[DIFF;SUBSET];
50248   USE 17 (MATCH_MP cls_subset);
50249   USE 17 (REWRITE_RULE[SUBSET]);
50250   FIRST_ASSUM IMATCH_MP_TAC ;
50251   TYPE_THEN `J` UNABBREV_TAC;
50252   FULL_REWRITE_TAC[cls_union];
50253   USE 12 (REWRITE_RULE[UNION]);
50254   REWR 4;
50255   (* -- *)
50256   TYPE_THEN `cls (E DIFF AE) x` SUBAGOAL_TAC ;
50257   TYPE_THEN `J` UNABBREV_TAC;
50258   USE 12 (REWRITE_RULE[cls_union]);
50259   USE 4 (REWRITE_RULE[UNION]);
50260   REWR 4;
50261   (* -- *)
50262   PROOF_BY_CONTR_TAC;
50263   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 ;
50264   TYPE_THEN `inductive_set E S` SUBAGOAL_TAC;
50265   REWRITE_TAC[inductive_set];
50266   SUBCONJ_TAC;
50267   TYPE_THEN `S` UNABBREV_TAC;
50268   REWRITE_TAC[SUBSET];
50269   SUBCONJ_TAC;
50270   USE 18 (REWRITE_RULE[cls]);
50271   UND 22 THEN REWRITE_TAC[EMPTY_EXISTS];
50272   TYPE_THEN `e` EXISTS_TAC;
50273   TYPE_THEN `S` UNABBREV_TAC;
50274   USE 23 (REWRITE_RULE[DIFF]);
50275   TYPE_THEN `x` EXISTS_TAC;
50276   (* --- *)
50277   TYPE_THEN `S` UNABBREV_TAC;
50278   CONJ_TAC;
50279   THM_INTRO_TAC[`E`;`AE`;`adjv C C'`] psegment_subset_endpoint;
50280   SUBCONJ_TAC;
50281   USE 3 (REWRITE_RULE[segment_end]);
50282   CONJ_TAC;
50283   IMATCH_MP_TAC  num_closure_pos;
50284   CONJ_TAC;
50285   USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
50286   TYPE_THEN `C'` EXISTS_TAC;
50287   IMATCH_MP_TAC  adjv_adj2;
50288   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50289   USE 34 (REWRITE_RULE[SUBSET]);
50290   IMATCH_MP_TAC  num_closure_pos;
50291   CONJ_TAC;
50292   IMATCH_MP_TAC  FINITE_SUBSET;
50293   TYPE_THEN `E` EXISTS_TAC;
50294   REWRITE_TAC[DIFF;SUBSET];
50295   USE 3 (REWRITE_RULE[segment_end;psegment;segment]);
50296   TYPE_THEN `C` EXISTS_TAC;
50297   ASM_REWRITE_TAC [DIFF];
50298   IMATCH_MP_TAC  adjv_adj;
50299   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50300   USE 34 (REWRITE_RULE[SUBSET]);
50301   USE 2 (REWRITE_RULE[segment_end]);
50302   TYPE_THEN `endpoint AE` UNABBREV_TAC;
50303   USE 30 (REWRITE_RULE[INR in_pair]);
50304   (* ----B *)
50305   TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC;
50306   TYPE_THEN `adjv C C'` UNABBREV_TAC;
50307   FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN (TYPE_THEN`x'` UNABBREV_TAC);
50308   UND 24 THEN REWRITE_TAC[];
50309   TYPE_THEN `B` EXISTS_TAC;
50310   ONCE_REWRITE_TAC [segment_end_symm];
50311   UND 20 THEN REWRITE_TAC[];
50312   TYPE_THEN `B` EXISTS_TAC;
50313   (* ----//B1 *)
50314   THM_INTRO_TAC[`C`;`C'`] adjv_adj;
50315   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50316   USE 35 (REWRITE_RULE[SUBSET]);
50317   (* ---- *)
50318   TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC;
50319   TYPE_THEN `J` UNABBREV_TAC;
50320   REWRITE_TAC[SUBSET;INR IN_SING;DIFF;UNION];
50321   (* ---- *)
50322   TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC;
50323   IMATCH_MP_TAC  segment_end_sing;
50324   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50325   USE 37 (REWRITE_RULE[SUBSET]);
50326   FIRST_ASSUM DISJ_CASES_TAC;
50327   TYPE_THEN `b'` UNABBREV_TAC;
50328   UND 20 THEN REWRITE_TAC[];
50329   TYPE_THEN `{C}` EXISTS_TAC;
50330   TYPE_THEN `a'` UNABBREV_TAC;
50331   UND 24 THEN REWRITE_TAC[];
50332   TYPE_THEN `{C}` EXISTS_TAC;
50333   (* --- *)
50334   TYPE_THEN `adjv C C'` EXISTS_TAC;
50335   TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC;
50336    USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50337   USE 32 (REWRITE_RULE[SUBSET]);
50338   CONJ_TAC;
50339   IMATCH_MP_TAC  adjv_adj2;
50340   (* --- *)
50341   TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC;
50342   TYPE_THEN `adjv C C'` UNABBREV_TAC;
50343   (* ---C//  *)
50344   TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC;
50345   IMATCH_MP_TAC  segment_end_sing;
50346   IMATCH_MP_TAC  adjv_adj;
50347   TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC;
50348   TYPE_THEN `J` UNABBREV_TAC;
50349   REWRITE_TAC[SUBSET;DIFF;UNION;INR IN_SING ];
50350   (* --- *)
50351   TYPE_THEN `adjv C C' = a'` ASM_CASES_TAC;
50352   TYPE_THEN `adjv C C'` UNABBREV_TAC;
50353   PROOF_BY_CONTR_TAC;
50354   UND 24 THEN ASM_REWRITE_TAC[];
50355   TYPE_THEN `{C}` EXISTS_TAC;
50356   TYPE_THEN `adjv C C' = b'` ASM_CASES_TAC;
50357   TYPE_THEN `adjv C C'` UNABBREV_TAC;
50358   PROOF_BY_CONTR_TAC;
50359   UND 20 THEN ASM_REWRITE_TAC[];
50360   TYPE_THEN `{C}` EXISTS_TAC;
50361   (* --- repeat from here *)
50362   TYPE_THEN `x' = a'` ASM_CASES_TAC;
50363   TYPE_THEN `x'` UNABBREV_TAC;
50364   PROOF_BY_CONTR_TAC;
50365   UND 20 THEN REWRITE_TAC[];
50366   TYPE_THEN `B` EXISTS_TAC;
50367   TYPE_THEN `x' = b'` ASM_CASES_TAC;
50368   TYPE_THEN `x'` UNABBREV_TAC;
50369   PROOF_BY_CONTR_TAC;
50370   UND 24 THEN REWRITE_TAC[];
50371   TYPE_THEN `B` EXISTS_TAC;
50372   ONCE_REWRITE_TAC[segment_end_symm];
50373   (* --- *)
50374   CONJ_TAC;
50375   UND 24 THEN REWRITE_TAC[];
50376   THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`a'`] segment_end_trans;
50377   TYPE_THEN `U` EXISTS_TAC;
50378   IMATCH_MP_TAC  SUBSET_TRANS;
50379   TYPE_THEN `{C} UNION P` EXISTS_TAC;
50380   REWRITE_TAC[union_subset];
50381   (* ---// *)
50382   UND 20 THEN REWRITE_TAC[];
50383   THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`b'`] segment_end_trans;
50384   TYPE_THEN `U` EXISTS_TAC;
50385   IMATCH_MP_TAC  SUBSET_TRANS;
50386   TYPE_THEN `{C} UNION P` EXISTS_TAC;
50387   REWRITE_TAC[union_subset];
50388   (* -- *)
50389   TYPE_THEN `S = E` SUBAGOAL_TAC;
50390   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50391   FIRST_ASSUM IMATCH_MP_TAC ;
50392   FULL_REWRITE_TAC[inductive_set];
50393   ASM_REWRITE_TAC[];
50394   (* -- *)
50395   TYPE_THEN `S` UNABBREV_TAC;
50396   USE 22 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
50397   TYPE_THEN `~(AE = EMPTY)` SUBAGOAL_TAC;
50398   USE 2 (REWRITE_RULE[segment_end;segment;psegment]);
50399   UND 27 THEN ASM_REWRITE_TAC[];
50400   USE 22 (REWRITE_RULE[EMPTY_EXISTS]);
50401   TSPEC `u` 20;
50402   UND 20 THEN ASM_REWRITE_TAC[];
50403   USE 0 (REWRITE_RULE[SUBSET]);
50404   (* -D//  *)
50405   FULL_REWRITE_TAC[conn];
50406   TYPE_THEN `~(a = b)` SUBAGOAL_TAC;
50407   USE 3 (MATCH_MP segment_end_disj);
50408  UND 3 THEN ASM_REWRITE_TAC[];
50409   ONCE_REWRITE_TAC[TAUT `a /\ b <=> b /\ a`];
50410   FIRST_ASSUM IMATCH_MP_TAC ;
50411   (* - *)
50412   TYPE_THEN `!c. endpoint E c /\ cls AE c ==> endpoint AE c` SUBAGOAL_TAC;
50413   REWRITE_TAC[endpoint];
50414   THM_INTRO_TAC[`AE`;`E`;`pointI c`] num_closure_mono;
50415   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50416   USE 15 (REWRITE_RULE[endpoint]);
50417   REWR 16;
50418   USE 16 (MATCH_MP (ARITH_RULE `x <=| 1 ==> (x = 1) \/ (x = 0)`));
50419   FIRST_ASSUM DISJ_CASES_TAC;
50420   PROOF_BY_CONTR_TAC;
50421   USE 14 (REWRITE_RULE[cls]);
50422   THM_INTRO_TAC[`AE`;`pointI c`] num_closure0;
50423   USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
50424   REWR 20;
50425   TSPEC `e` 20;
50426   UND 19 THEN ASM_REWRITE_TAC[];
50427   (* -E *)
50428   TYPE_THEN `!c. endpoint E c ==> cls J c` SUBAGOAL_TAC;
50429   TYPE_THEN `J` UNABBREV_TAC;
50430   REWRITE_TAC[cls_union];
50431   REWRITE_TAC[UNION];
50432   TYPE_THEN `cls AE c` ASM_CASES_TAC;
50433   TSPEC `c` 14;
50434   TYPE_THEN `endpoint AE c` SUBAGOAL_TAC;
50435   FIRST_ASSUM IMATCH_MP_TAC ;
50436   TYPE_THEN `endpoint B c` SUBAGOAL_TAC;
50437   FULL_REWRITE_TAC[segment_end];
50438   TYPE_THEN `{a',b'}` UNABBREV_TAC;
50439   THM_INTRO_TAC[`B`] endpoint_cls;
50440   USE 1 (REWRITE_RULE[segment_end;psegment;segment]);
50441   DISJ2_TAC;
50442   ASM_MESON_TAC[subset_imp];
50443   DISJ1_TAC;
50444   TYPE_THEN `E = (E DIFF AE) UNION AE` SUBAGOAL_TAC;
50445   IMATCH_MP_TAC  EQ_EXT;
50446   UND 0 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
50447   TYPE_THEN `cls E c` SUBAGOAL_TAC;
50448   THM_INTRO_TAC[`E`] endpoint_cls;
50449   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
50450   ASM_MESON_TAC[subset_imp];
50451   UND 16 THEN DISCH_THEN (fun t -> USE 17 (ONCE_REWRITE_RULE[t]));
50452   FULL_REWRITE_TAC[cls_union];
50453   USE 16 (REWRITE_RULE[UNION ]);
50454   REWR 16;
50455   (* - *)
50456   USE 3 (REWRITE_RULE[segment_end]);
50457   TYPE_THEN `endpoint E` UNABBREV_TAC;
50458   USE 15 (REWRITE_RULE[INR in_pair]);
50459   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
50460   (* Tue Dec 28 12:02:34 EST 2004 *)
50461
50462   ]);;
50463   (* }}} *)
50464
50465 let conn2_sequence = prove_by_refinement(
50466   `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
50467     (!i. (i <= N) ==> (G i SUBSET edge )) /\
50468     (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
50469     (!i j. (i < j) /\ (j <=| N) /\ ~(SUC i = j) ==>
50470          (curve_cell (G i) INTER (curve_cell (G j)) = EMPTY)) /\
50471     (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) ==>
50472     (unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p)
50473    `,
50474   (* {{{ proof *)
50475   [
50476   REP_BASIC_TAC;
50477   PROOF_BY_CONTR_TAC;
50478   THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1;
50479   ARITH_TAC;
50480   THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma2;
50481   THM_INTRO_TAC[`G`;`N`] conn2_sequence_lemma3;
50482   THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma4;
50483   (* - *)
50484   TYPE_THEN `?ei. C ei /\ G i ei /\ (!k. i < k /\ k <=|j ==> ~G k ei)` SUBAGOAL_TAC;
50485   PROOF_BY_CONTR_TAC;
50486   UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`SUC i`;`j`]);
50487   TYPE_THEN `{x | i <=| x /\ x <=| j} = {i} UNION {x | SUC i <= x /\ x <= j}` SUBAGOAL_TAC;
50488   IMATCH_MP_TAC  EQ_EXT;
50489   REWRITE_TAC[UNION];
50490   UNDH 3810 THEN ARITH_TAC;
50491   REWRH 1849;
50492   USEH 4802 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]);
50493   USEH 5681 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]);
50494   REWRITE_TAC[SUBSET;UNIONS;IMAGE];
50495   CONV_TAC (dropq_conv "u");
50496   NAME_CONFLICT_TAC;
50497   TSPECH `x` 7945;
50498   LEFTH 1695 "ei";
50499   TSPECH `x` 5608;
50500   LEFTH 1699 "u";
50501   USEH 7623 (CONV_RULE NAME_CONFLICT_CONV);
50502   REWRH 2787;
50503   TYPE_THEN `G i x` ASM_CASES_TAC;
50504   REWRH 2360;
50505   LEFTH 4513 "k" ;
50506   TYPE_THEN `k` EXISTS_TAC;
50507   UNDH 2414 THEN MESON_TAC[ARITH_RULE `a <| b ==> SUC a <=| b`];
50508   REWRH 7623;
50509   ASM_MESON_TAC[];
50510   UNDH 5817 THEN UNDH 3810 THEN ARITH_TAC;
50511   (* -A *)
50512   TYPE_THEN `?ej. C ej /\ G j ej /\ (!k. i <= k /\ k <| j ==> ~G k ej)` SUBAGOAL_TAC;
50513   PROOF_BY_CONTR_TAC;
50514   UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`i`;`j -1`]);
50515   TYPE_THEN `{x | i <=| x /\ x <=| j} = {j} UNION {x | i <= x /\ x <= j- 1}` SUBAGOAL_TAC;
50516   IMATCH_MP_TAC  EQ_EXT;
50517   REWRITE_TAC[UNION];
50518   UNDH 3810 THEN ARITH_TAC;
50519   REWRH 1849;
50520   USEH 6712 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]);
50521   USEH 7737 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]);
50522   REWRITE_TAC[SUBSET;UNIONS;IMAGE];
50523   CONJ_TAC ;
50524   UNDH 3810 THEN ARITH_TAC;
50525   CONJ_TAC;
50526   UNDH 5153 THEN ARITH_TAC;
50527   CONV_TAC (dropq_conv "u");
50528   NAME_CONFLICT_TAC;
50529   TSPECH `x` 5663;
50530   LEFTH 6587 "ej";
50531   TSPECH `x` 613;
50532   LEFTH 8601 "u";
50533   USEH 2468 (CONV_RULE NAME_CONFLICT_CONV);
50534   REWRH 3770;
50535   TYPE_THEN `G j x` ASM_CASES_TAC;
50536   REWRH 7772;
50537   LEFTH 3203 "k" ;
50538   TYPE_THEN `k` EXISTS_TAC;
50539   UNDH 9304 THEN MESON_TAC[ARITH_RULE `a <| b ==> a <=| b - 1`];
50540   REWRH 2468;
50541   ASM_MESON_TAC[];
50542   UNDH 7805 THEN UNDH 3810 THEN ARITH_TAC;
50543   (* -B< *)
50544   TYPE_THEN `Ci = {e | C e /\ G i e /\ (!k. i <| k /\ k <=| j ==> ~G k e)}` ABBREV_TAC ;
50545   TYPE_THEN `Ci ei` SUBAGOAL_TAC;
50546   TYPE_THEN `Ci` UNABBREV_TAC;
50547   ASM_REWRITE_TAC[];
50548   (* - *)
50549   TYPE_THEN `CiS = segment_of Ci ei` ABBREV_TAC ;
50550   TYPE_THEN `segment CiS` SUBAGOAL_TAC;
50551   TYPE_THEN `CiS` UNABBREV_TAC;
50552   IMATCH_MP_TAC  segment_of_segment;
50553   TYPE_THEN `C` EXISTS_TAC;
50554   CONJ_TAC;
50555   IMATCH_MP_TAC  rectagon_segment;
50556   TYPE_THEN `Ci` UNABBREV_TAC;
50557   REWRITE_TAC[SUBSET];
50558   (* - *)
50559   TYPE_THEN `~Ci ej` SUBAGOAL_TAC THENL [TYPE_THEN `Ci` UNABBREV_TAC;ALL_TAC];
50560   TSPECH `j` 9673;
50561   UNDH 375 THEN ASM_REWRITE_TAC[];
50562   UNDH 3810  THEN ARITH_TAC;
50563   (* - *)
50564   TYPE_THEN `CiS SUBSET Ci` SUBAGOAL_TAC;
50565   TYPE_THEN `CiS` UNABBREV_TAC;
50566   IMATCH_MP_TAC  segment_of_G;
50567   (* - *)
50568   TYPE_THEN `psegment CiS` SUBAGOAL_TAC;
50569   PROOF_BY_CONTR_TAC;
50570   THM_INTRO_TAC[`CiS`;`C`] rectagon_subset;
50571   USEH 5119 (REWRITE_RULE[psegment]);
50572   REWRH 2394;
50573   CONJ_TAC;
50574   IMATCH_MP_TAC  rectagon_segment;
50575   IMATCH_MP_TAC  SUBSET_TRANS;
50576   TYPE_THEN `Ci` EXISTS_TAC;
50577   TYPE_THEN `Ci` UNABBREV_TAC;
50578   REWRITE_TAC[SUBSET];
50579   TYPE_THEN `C` UNABBREV_TAC;
50580   USEH 2712 (REWRITE_RULE[SUBSET]);
50581   UNDH 7665 THEN REWRITE_TAC[];
50582   (* - *)
50583   THM_INTRO_TAC[`CiS`] endpoint_size2;
50584   FULL_REWRITE_TAC[has_size2];
50585   USEH 1801 SYM;
50586   (* -C< *)
50587   TYPE_THEN `Ci SUBSET C` SUBAGOAL_TAC;
50588   TYPE_THEN `Ci` UNABBREV_TAC;
50589   REWRITE_TAC[SUBSET];
50590   TYPE_THEN `CiS SUBSET C` SUBAGOAL_TAC;
50591   IMATCH_MP_TAC  SUBSET_TRANS;
50592   TYPE_THEN `Ci` EXISTS_TAC;
50593   (* - *)
50594   TYPE_THEN `!m. endpoint CiS m ==> cls (G (SUC i)) m` SUBAGOAL_TAC;
50595   THM_INTRO_TAC[`CiS`;`C`;`m`] endpoint_sub_rectagon;
50596   USEH 5941 (REWRITE_RULE[EXISTS_UNIQUE_ALT]);
50597   REWRITE_TAC[cls];
50598   TYPE_THEN `e` EXISTS_TAC;
50599   TSPECH `e` 8431;
50600   USEH 3634 (REWRITE_RULE[cls_edge]);
50601   (* -- *)
50602   KILLH 3313 THEN KILLH 5237 THEN KILLH 2072  THEN KILLH 4795 THEN KILLH 3667 THEN KILLH 8912;
50603   REWRH 142;
50604   TYPE_THEN `~Ci e` SUBAGOAL_TAC;
50605   KILLH 5989 THEN KILLH 9803 THEN KILLH 1909 THEN KILLH 8416 THEN KILLH 320 THEN KILLH 846;
50606   THM_INTRO_TAC[`Ci`;`ei`] inductive_segment;
50607   FULL_REWRITE_TAC[inductive_set];
50608   USEH 7070 (REWRITE_RULE[endpoint]);
50609   THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1;
50610   FULL_REWRITE_TAC[segment];
50611   REWRH 4780;
50612   UNDH 8549 THEN DISCH_THEN (THM_INTRO_TAC[`e'`;`e`]);
50613   REWRITE_TAC[adj;INTER;EMPTY_EXISTS];
50614   TSPECH `e'` 5120;
50615   REWRH 6063;
50616   CONJ_TAC;
50617   TYPE_THEN `e'` UNABBREV_TAC;
50618   UNDH 9580 THEN ASM_REWRITE_TAC[];
50619   TYPE_THEN `pointI m` EXISTS_TAC;
50620   TYPE_THEN `CiS` UNABBREV_TAC;
50621   UNDH 1420 THEN ASM_REWRITE_TAC[];
50622   (* -- *)
50623   TYPE_THEN `UNIONS (IMAGE G {x | i <=| x /\ x <=| j}) e` SUBAGOAL_TAC;
50624   USEH 1849 (REWRITE_RULE[SUBSET]);
50625   USEH 9077 (REWRITE_RULE[UNIONS;IMAGE]);
50626   TYPE_THEN `u` UNABBREV_TAC;
50627   (* --// *)
50628   TYPE_THEN `!y. (SUC i < y) /\ (y <=| N) ==> ~(G y e)` SUBAGOAL_TAC;
50629   UNDH 4928 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`y`]);
50630   UNDH 8692 THEN ARITH_TAC;
50631   USEH 6879 (REWRITE_RULE[INTER;EQ_EMPTY]);
50632   TSPECH `{(pointI m)}` 6278;
50633   TYPE_THEN `!r. (r <=| N) ==> (G r SUBSET UNIONS (IMAGE G {i | i <=| N}))` SUBAGOAL_TAC;
50634   REWRITE_TAC[UNIONS;IMAGE;SUBSET];
50635   CONV_TAC (dropq_conv "u");
50636   TYPE_THEN `r` EXISTS_TAC;
50637   (* --- *)
50638   TYPE_THEN `!r. (r <=| N) ==> (curve_cell (G r) {(pointI m)} <=> (?e. G r e /\ closure top2 e (pointI m)))` SUBAGOAL_TAC;
50639   IMATCH_MP_TAC  curve_cell_point;
50640   USEH 2858 (REWRITE_RULE[conn2;]);
50641   IMATCH_MP_TAC  FINITE_SUBSET;
50642   UNIFY_EXISTS_TAC;
50643   (* --- *)
50644   TYPE_THEN `i <=| N` SUBAGOAL_TAC;
50645   UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
50646   UNDH 4794 THEN ASM_REWRITE_TAC[];
50647   CONJ_TAC;
50648   USEH 7070 (REWRITE_RULE[endpoint]);
50649   THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1;
50650   IMATCH_MP_TAC  FINITE_SUBSET;
50651   TYPE_THEN `C` EXISTS_TAC;
50652   FULL_REWRITE_TAC[rectagon];
50653   REWRH 4780;
50654   TYPE_THEN `e'` EXISTS_TAC;
50655   TSPECH `e'` 5120;
50656   REWRH 6063;
50657   TYPE_THEN `Ci` UNABBREV_TAC;
50658   USEH 2281 (REWRITE_RULE[SUBSET]);
50659   (* --- *)
50660   TYPE_THEN `e` EXISTS_TAC;
50661   (* --D< *)
50662   PROOF_BY_CONTR_TAC;
50663   USEH 1849 (REWRITE_RULE[UNIONS;IMAGE;SUBSET]);
50664   TSPECH `e` 5988;
50665   FULL_REWRITE_TAC[];
50666   TYPE_THEN `u'` UNABBREV_TAC;
50667   TYPE_THEN `x' = i` ASM_CASES_TAC;
50668   TYPE_THEN `x'` UNABBREV_TAC;
50669   TYPE_THEN `Ci` UNABBREV_TAC;
50670   UNDH 8814 THEN ASM_REWRITE_TAC[];
50671   TSPECH  `k` 8651;
50672   TYPE_THEN `k = SUC i` ASM_CASES_TAC;
50673   UNDH 9079 THEN ASM_REWRITE_TAC[];
50674   TYPE_THEN `k` UNABBREV_TAC;
50675   UNDH 5461 THEN ASM_REWRITE_TAC[];
50676   UNDH 9872 THEN UNDH 5198 THEN  UNDH 2528 THEN UNDH 5153 THEN ARITH_TAC;
50677   (* -- *)
50678   TYPE_THEN `x' = SUC i` ASM_CASES_TAC;
50679   TYPE_THEN `x'` UNABBREV_TAC;
50680   UNDH 9079 THEN ASM_REWRITE_TAC[];
50681   TSPECH `x'` 8651;
50682   UNDH 7878 THEN ASM_REWRITE_TAC[];
50683   UNDH 9481 THEN UNDH 5258 THEN UNDH 5565 THEN UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC;
50684   (* - *)
50685   COPYH 9674;
50686   UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`b`]);
50687   USEH 8662 SYM;
50688   REWRITE_TAC[];
50689   UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`a`]);
50690   USEH 8662 SYM;
50691   REWRITE_TAC[];
50692   (* -E *)
50693   TYPE_THEN `X = { E | E SUBSET (C UNION (G (SUC i))) /\ ~(E ei) /\ ~(E ej) /\ segment_end E a b }` ABBREV_TAC ;
50694   TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
50695   TYPE_THEN `X` UNABBREV_TAC;
50696   UNDH 8912 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
50697   UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
50698   THM_INTRO_TAC[`G (SUC i)`] conn2_imp_conn;
50699   FIRST_ASSUM IMATCH_MP_TAC ;
50700    UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
50701   FULL_REWRITE_TAC[conn];
50702   UNDH 6247 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
50703   TYPE_THEN  `S` EXISTS_TAC;
50704   CONJ_TAC;
50705   IMATCH_MP_TAC  SUBSET_TRANS;
50706   TYPE_THEN `G (SUC i)` EXISTS_TAC;
50707   REWRITE_TAC[SUBSET;UNION ];
50708   TSPECH `SUC i` 320;
50709   TSPECH `SUC i` 9803;
50710   UNDH 8789 THEN DISCH_THEN (THM_INTRO_TAC[]);
50711   UNDH 3810 THEN ARITH_TAC;
50712   UNDH 5005 THEN DISCH_THEN (THM_INTRO_TAC[]);
50713   ARITH_TAC;
50714   PROOF_BY_CONTR_TAC;
50715   FULL_REWRITE_TAC[DE_MORGAN_THM];
50716   USEH 1620 (REWRITE_RULE[SUBSET]);
50717   FIRST_ASSUM DISJ_CASES_TAC;
50718   UNDH 4837 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ;
50719   UNDH 683 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ;
50720   TYPE_THEN `f = (\ E . CARD (E DIFF C))` ABBREV_TAC ;
50721   THM_INTRO_TAC[`X`;`f`] select_image_num_min;
50722   UNDH 6007 THEN ASM_REWRITE_TAC[];
50723   TYPE_THEN `E = z` ABBREV_TAC ;
50724   TYPE_THEN `z` UNABBREV_TAC;
50725   (* -F< *)
50726   TYPE_THEN `cls C a /\ cls C b` SUBAGOAL_TAC;
50727   TYPE_THEN `cls CiS SUBSET cls C` SUBAGOAL_TAC;
50728   IMATCH_MP_TAC  cls_subset;
50729   USEH 2127 (REWRITE_RULE[SUBSET]);
50730   THM_INTRO_TAC[`CiS`] endpoint_cls;
50731   USEH 214 (REWRITE_RULE[psegment;segment]);
50732   USEH 477 (REWRITE_RULE[SUBSET]);
50733   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];
50734   (* -// *)
50735   THM_INTRO_TAC[`C`;`a`;`b`] cut_rectagon_cls;
50736   TYPE_THEN `segment_end CiS a b` SUBAGOAL_TAC;
50737   REWRITE_TAC[segment_end];
50738   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;
50739   THM_INTRO_TAC[`C`;`A`;`B`;`CiS`;`a`;`b`] cut_rectagon_unique;
50740   REWRITE_TAC[SUBSET;UNION];
50741   FIRST_ASSUM DISJ_CASES_TAC ;
50742   TYPE_THEN `A` UNABBREV_TAC;
50743   TYPE_THEN `B` EXISTS_TAC;
50744   ASM_REWRITE_TAC[];
50745   FULL_REWRITE_TAC[INTER_COMM];
50746   ASM_REWRITE_TAC[];
50747   TYPE_THEN `B` UNABBREV_TAC;
50748   TYPE_THEN `A` EXISTS_TAC;
50749   ASM_REWRITE_TAC[];
50750   FULL_REWRITE_TAC[INTER_COMM;UNION_COMM;];
50751   KILLH 7539 THEN KILLH 8335 THEN KILLH 2130 THEN KILLH 6524 THEN KILLH 3863;
50752   (* -G< *)
50753   TYPE_THEN `CjS ej` SUBAGOAL_TAC;
50754   TYPE_THEN `C` UNABBREV_TAC;
50755   USEH 2238 (REWRITE_RULE[UNION ]);
50756   UNDH 3048 THEN UNDH 2712 THEN UNDH 7665 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC ));
50757   USEH 2712 (REWRITE_RULE[SUBSET]);
50758   ASM_MESON_TAC[];
50759   (* -// *)
50760   TYPE_THEN `CiS ei` SUBAGOAL_TAC;
50761   TYPE_THEN `CiS` UNABBREV_TAC;
50762   REWRITE_TAC[segment_of_in];
50763   TYPE_THEN `~CjS ei` SUBAGOAL_TAC;
50764   UNDH 947 THEN UNDH 1398  THEN UNDH 3558 THEN REWRITE_TAC[INTER;EQ_EMPTY] THEN MESON_TAC[];
50765   (* -// *)
50766   TYPE_THEN `~(E SUBSET C)` SUBAGOAL_TAC;
50767   TYPE_THEN `X` UNABBREV_TAC;
50768   THM_INTRO_TAC[`C`;`CiS`;`CjS`;`E`;`a`;`b`] cut_rectagon_unique;
50769   REWRITE_TAC[SUBSET;UNION];
50770   FIRST_ASSUM DISJ_CASES_TAC;
50771   TYPE_THEN `E` UNABBREV_TAC;
50772   UNDH 5338 THEN ASM_REWRITE_TAC[];
50773   TYPE_THEN `E` UNABBREV_TAC;
50774   UNDH 442 THEN ASM_REWRITE_TAC[];
50775   (* -H< *)
50776   THM_INTRO_TAC[`C`;`E`] conn2_sequence_lemma5;
50777   USEH 4704 SYM;
50778   CONJ_TAC;
50779   TYPE_THEN `X` UNABBREV_TAC;
50780   USEH 7614 (REWRITE_RULE[segment_end]);
50781   TYPE_THEN `X` UNABBREV_TAC;
50782   USEH 7614 (REWRITE_RULE[segment_end]);
50783   REWRITE_TAC[SUBSET;INR in_pair];
50784   FIRST_ASSUM (DISJ_CASES_TAC ) THEN (TYPE_THEN `x` UNABBREV_TAC);
50785   (* -// *)
50786   THM_INTRO_TAC[`E'`] endpoint_size2;
50787   FULL_REWRITE_TAC[has_size2];
50788   (* -// *)
50789   TYPE_THEN `?E''. E'' SUBSET C /\ ~E'' ei /\ ~E'' ej /\ segment_end E'' a' b'` ASM_CASES_TAC;
50790   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));
50791   (* -- *)
50792   TYPE_THEN `X` UNABBREV_TAC;
50793   TYPE_THEN `f` UNABBREV_TAC;
50794   (* --I< *)
50795   THM_INTRO_TAC[`E`;`E'`;`E''`;`a`;`b`;`a'`;`b'`] conn_splice;
50796   REWRITE_TAC[segment_end];
50797   TSPECH `B'` 8320;
50798   UNDH 8902 THEN  DISCH_THEN (THM_INTRO_TAC[]);
50799   CONJ_TAC;
50800   IMATCH_MP_TAC  SUBSET_TRANS;
50801   TYPE_THEN `E UNION E''` EXISTS_TAC ;
50802   CONJ_TAC;
50803   UNDH 280 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
50804   REWRITE_TAC[union_subset];
50805   UNDH 6943 THEN REWRITE_TAC[SUBSET;UNION];
50806   TYPE_THEN `B' SUBSET E UNION E''` SUBAGOAL_TAC;
50807   UNDH 280 THEN REWRITE_TAC[DIFF;SUBSET;UNION] THEN MESON_TAC[];
50808   USEH 9489 (REWRITE_RULE[SUBSET;UNION]);
50809   CONJ_TAC;
50810   ASM_MESON_TAC[];
50811   ASM_MESON_TAC[];
50812   (* -- *)
50813   TYPE_THEN `B' DIFF C SUBSET (E DIFF E') DIFF C` SUBAGOAL_TAC;
50814   UNDH 280 THEN UND 3 THEN REWRITE_TAC[SUBSET;DIFF;UNION;] THEN MESON_TAC[];
50815   USEH 8272 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
50816   UNDH 200 THEN ASM_REWRITE_TAC[];
50817   IMATCH_MP_TAC  card_subset_lt;
50818   CONJ_TAC;
50819   UNDH 8308 THEN (REWRITE_TAC[DIFF;SUBSET]) THEN MESON_TAC[];
50820   CONJ_TAC;
50821   USEH 7143 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
50822   TYPE_THEN `~(E' = EMPTY)` SUBAGOAL_TAC ;
50823   USEH 4430 (REWRITE_RULE[psegment;segment]);
50824   UNDH 5706 THEN ASM_REWRITE_TAC[];
50825   USEH 5706 (REWRITE_RULE[EMPTY_EXISTS]);
50826   TSPECH `u` 5085;
50827   USEH 9707 (REWRITE_RULE[DIFF]);
50828   USEH 7802 (REWRITE_RULE[INTER;EQ_EMPTY]);
50829   TSPECH `u` 6967;
50830   UNDH 366 THEN ASM_REWRITE_TAC[];
50831   PROOF_BY_CONTR_TAC;
50832   REWRH 2690;
50833   USEH 8308 (REWRITE_RULE[SUBSET;DIFF;]);
50834   TSPECH `u` 5436;
50835   USEH 5435 (REWRITE_RULE[SUBSET]);
50836   TSPECH `u` 5036;
50837   ASM_MESON_TAC[];
50838   (* -- *)
50839   IMATCH_MP_TAC  FINITE_SUBSET;
50840   TYPE_THEN `E` EXISTS_TAC;
50841   REWRITE_TAC[DIFF;SUBSET];
50842   USEH 7614 (REWRITE_RULE[segment_end;segment;psegment]);
50843   (* -J< // (57 HYP here ) *)
50844   (* KILLH 846  THEN KILLH 1909  THEN KILLH 5989; ?? *)
50845   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;
50846   KILLH 4596 THEN KILLH 947 THEN KILLH 5282;
50847   (* - *)
50848   TYPE_THEN `E' SUBSET C UNION (G (SUC i))` SUBAGOAL_TAC;
50849   IMATCH_MP_TAC  SUBSET_TRANS;
50850   TYPE_THEN `E` EXISTS_TAC;
50851   TYPE_THEN `X` UNABBREV_TAC;
50852   (* - *)
50853   TYPE_THEN `E' SUBSET (G (SUC i))` SUBAGOAL_TAC;
50854   UNDH 7718 THEN UNDH 7802 THEN REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;UNION] THEN MESON_TAC[];
50855   KILLH 7718;
50856   KILLH 7292 THEN KILLH 4330 THEN KILLH 4248 THEN KILLH 2712 THEN KILLH 7665 THEN KILLH 5425 THEN KILLH 5357 THEN KILLH 1285;
50857   KILLH 145 THEN KILLH 7070 THEN KILLH 2483 THEN KILLH 9777;
50858   KILLH 7420;
50859   KILLH 5435;
50860   (* -K< *)
50861   TYPE_THEN `cls C a' /\ cls C b'` SUBAGOAL_TAC;
50862   TYPE_THEN ` endpoint E' SUBSET cls C` SUBAGOAL_TAC;
50863   USEH 2907 SYM;
50864  KILLH  8660;
50865   TYPE_THEN `endpoint E'` UNABBREV_TAC;
50866   REWRITE_TAC[SUBSET;INTER];
50867   REWRH 5756;
50868   USEH 6207 (REWRITE_RULE[SUBSET;INR in_pair]);
50869   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
50870   (* -// *)
50871   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;
50872   THM_INTRO_TAC[`C`;`a'`;`b'`] cut_rectagon_cls;
50873   TYPE_THEN `A ei` ASM_CASES_TAC;
50874   TYPE_THEN `A` EXISTS_TAC;
50875   TYPE_THEN `B` EXISTS_TAC;
50876   FULL_REWRITE_TAC[INTER_COMM];
50877   LEFTH 4284 "E''";
50878   TSPECH `B` 567;
50879   UNDH 469 THEN ASM_REWRITE_TAC[];
50880   FULL_REWRITE_TAC[DE_MORGAN_THM];
50881   UNDH 7424 THEN REP_CASES_TAC;
50882   PROOF_BY_CONTR_TAC;
50883   UNDH 3642 THEN REWRITE_TAC[SUBSET;UNION];
50884   USEH 8335 (REWRITE_RULE[INTER;EQ_EMPTY]);
50885   TSPECH `ei` 554;
50886   UNDH 8511 THEN ASM_REWRITE_TAC[];
50887   (* --// *)
50888   TYPE_THEN `B` EXISTS_TAC;
50889   TYPE_THEN `A` EXISTS_TAC;
50890   FULL_REWRITE_TAC[INTER_COMM;UNION_COMM];
50891   CONJ_TAC;
50892   UNDH 4532 THEN (TYPE_THEN `C` UNABBREV_TAC) THEN ASM_REWRITE_TAC[UNION];
50893   LEFTH 4284 "E''";
50894   TSPECH `A` 567;
50895   PROOF_BY_CONTR_TAC;
50896   UNDH 937 THEN ASM_REWRITE_TAC[];
50897   REWRITE_TAC[SUBSET;UNION];
50898   (* -L< *)
50899
50900   TYPE_THEN `~(G (SUC i) ei)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
50901   UNDH 3810 THEN ARITH_TAC;
50902   TYPE_THEN `~(G (SUC i) ej)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
50903   ARITH_TAC;
50904   (* -// *)
50905   TYPE_THEN `psegment_triple A B E'` SUBAGOAL_TAC;
50906   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));
50907   FULL_REWRITE_TAC[psegment_triple;segment_end];
50908   CONJ_TAC;
50909   TYPE_THEN `C` UNABBREV_TAC;
50910   TYPE_THEN `(A INTER E' = EMPTY) /\ (B INTER E' = EMPTY)` SUBAGOAL_TAC;
50911   TYPE_THEN `C` UNABBREV_TAC;
50912   UNDH 7714 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION] THEN MESON_TAC[];
50913   (* --// *)
50914   TYPE_THEN `(cls A INTER cls E' = {a',b'}) /\ (cls B INTER cls E' = {a',b'})` SUBAGOAL_TAC;
50915   TYPE_THEN `C` UNABBREV_TAC;
50916   USEH 9349 (REWRITE_RULE[cls_union]);
50917   CONJ_TAC THEN (IMATCH_MP_TAC  SUBSET_ANTISYM);
50918   CONJ_TAC;
50919   TYPE_THEN `endpoint E'` UNABBREV_TAC;
50920   TYPE_THEN `{a',b'}` UNABBREV_TAC;
50921   REWRITE_TAC[INTER;SUBSET;UNION];
50922   REWRITE_TAC[SUBSET_INTER];
50923   CONJ_TAC;
50924   KILLH 2907;
50925   TYPE_THEN `{a',b'}` UNABBREV_TAC;
50926   REWRITE_TAC[INTER;SUBSET];
50927   TYPE_THEN `{a',b'}` UNABBREV_TAC;
50928   IMATCH_MP_TAC  endpoint_cls;
50929   FULL_REWRITE_TAC[psegment;segment];
50930   CONJ_TAC;
50931   TYPE_THEN `{a',b'}` UNABBREV_TAC;
50932   TYPE_THEN `endpoint E'` UNABBREV_TAC;
50933   REWRITE_TAC[INTER;SUBSET;UNION];
50934   REWRITE_TAC[SUBSET_INTER];
50935   CONJ_TAC;
50936   USEH 5640 SYM;
50937   IMATCH_MP_TAC  endpoint_cls;
50938   USEH 4134 (REWRITE_RULE[psegment;segment]);
50939   USEH 2907 SYM;
50940   IMATCH_MP_TAC  endpoint_cls;
50941   USEH 4430 (REWRITE_RULE[psegment;segment]);
50942   CONJ_TAC THEN IMATCH_MP_TAC  segment_end_union_rectagon;
50943   FULL_REWRITE_TAC[segment_end];
50944   MESON_TAC[];
50945   FULL_REWRITE_TAC[segment_end];
50946   MESON_TAC[];
50947   (* -M< // *)
50948   USEH 2518 (MATCH_MP psegment_triple3);
50949   COPYH 7680;
50950   USEH 7680 (MATCH_MP bounded_triple_inner_union);
50951   USEH 3265 (REWRITE_RULE [SUBSET]);
50952   (* TSPEC p deferred ///// *)
50953   (* -// *)
50954   TYPE_THEN `~(bounded_set (B UNION E') p)` SUBAGOAL_TAC;
50955   UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`B UNION E'`;`i`;`j`]);
50956   CONJ_TAC;
50957   FULL_REWRITE_TAC[psegment_triple];
50958   CONJ_TAC;
50959   UNDH 3810 THEN ARITH_TAC;
50960   IMATCH_MP_TAC  SUBSET_TRANS;
50961   TYPE_THEN `C UNION E'` EXISTS_TAC ;
50962   CONJ_TAC;
50963   REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
50964   TYPE_THEN `A UNION B` UNABBREV_TAC;
50965   REWRITE_TAC[union_subset];
50966   REWRITE_TAC[SUBSET;UNIONS;IMAGE];
50967   CONV_TAC (dropq_conv "u");
50968   TYPE_THEN `SUC i` EXISTS_TAC;
50969   USEH 343 (REWRITE_RULE[SUBSET]);
50970   UNDH 3810 THEN ARITH_TAC;
50971   REWRH 9345;
50972   USEH 1598 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
50973   UNDH 5101 THEN REWRITE_TAC[];
50974   IMATCH_MP_TAC  card_subset_lt;
50975   CONJ_TAC;
50976   UNDH 343 THEN  REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
50977   CONJ_TAC;
50978   USEH 7390 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
50979   TSPECH `ei` 9338;
50980   USEH 4016 (REWRITE_RULE[UNION;DIFF]);
50981   UNDH 1090 THEN ASM_REWRITE_TAC[];
50982   FIRST_ASSUM DISJ_CASES_TAC;
50983   UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
50984   TYPE_THEN `ei` EXISTS_TAC;
50985   UNDH 4837 THEN ASM_REWRITE_TAC[];
50986   ASM_MESON_TAC[subset_imp];
50987   IMATCH_MP_TAC  FINITE_SUBSET;
50988   TYPE_THEN `A UNION B` EXISTS_TAC;
50989   CONJ_TAC;
50990   USEH 2130 SYM;
50991   USEH 5107 (REWRITE_RULE[rectagon]);
50992   REWRITE_TAC[SUBSET;DIFF];
50993   (* -// *)
50994   TYPE_THEN `~(bounded_set (E' UNION A) p)` SUBAGOAL_TAC;
50995   UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`E' UNION A`;`i`;`j`]);
50996   CONJ_TAC;
50997   FULL_REWRITE_TAC[psegment_triple];
50998   CONJ_TAC;
50999   UNDH 3810 THEN ARITH_TAC;
51000   IMATCH_MP_TAC  SUBSET_TRANS;
51001   TYPE_THEN `E' UNION C` EXISTS_TAC ;
51002   CONJ_TAC;
51003   REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
51004   TYPE_THEN `A UNION B` UNABBREV_TAC;
51005   REWRITE_TAC[union_subset];
51006   REWRITE_TAC[SUBSET;UNIONS;IMAGE];
51007   CONV_TAC (dropq_conv "u");
51008   TYPE_THEN `SUC i` EXISTS_TAC;
51009   USEH 343 (REWRITE_RULE[SUBSET]);
51010   UNDH 3810 THEN ARITH_TAC;
51011   REWRH 9505;
51012   USEH 4752 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
51013   UNDH 2448 THEN REWRITE_TAC[];
51014   IMATCH_MP_TAC  card_subset_lt;
51015   CONJ_TAC;
51016   UNDH 343 THEN  REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
51017   CONJ_TAC;
51018   USEH 758 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
51019   TSPECH `ej` 1425;
51020   USEH 5076 (REWRITE_RULE[UNION;DIFF]);
51021   UNDH 5580 THEN ASM_REWRITE_TAC[];
51022   USEH 3977 (MATCH_MP (TAUT `a \/ b ==> b\/ a`));
51023   FIRST_ASSUM DISJ_CASES_TAC;
51024   UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
51025   TYPE_THEN `ej` EXISTS_TAC;
51026   UNDH 683 THEN ASM_REWRITE_TAC[];
51027   ASM_MESON_TAC[subset_imp];
51028   IMATCH_MP_TAC  FINITE_SUBSET;
51029   TYPE_THEN `A UNION B` EXISTS_TAC;
51030   CONJ_TAC;
51031   USEH 2130 SYM;
51032   USEH 5107 (REWRITE_RULE[rectagon]);
51033   REWRITE_TAC[SUBSET;DIFF];
51034   (* -N< // *)
51035   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;
51036   KILLH 683 THEN KILLH 4837 THEN KILLH 3627 THEN KILLH 2590 THEN KILLH 830 THEN KILLH 8335 THEN KILLH 4401 THEN KILLH 3688;
51037   POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t));
51038   (* - *)
51039   TYPE_THEN `bounded_set (B UNION E' UNION A) p` SUBAGOAL_TAC;
51040   IMATCH_MP_TAC  bounded_avoidance_subset;
51041   TYPE_THEN `C` EXISTS_TAC;
51042   CONJ_TAC;
51043   REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
51044   CONJ_TAC;
51045   REWRITE_TAC[union_subset];
51046   USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]);
51047   CONJ_TAC;
51048   REWRITE_TAC[FINITE_UNION];
51049   USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]);
51050   CONJ_TAC;
51051   TYPE_THEN `A UNION B` UNABBREV_TAC;
51052   IMATCH_MP_TAC  conn2_rectagon;
51053   (* --// *)
51054   UNDH 8721 THEN REWRITE_TAC[] THEN (IMATCH_MP_TAC  bounded_set_curve_cell_empty);
51055   TYPE_THEN `UNIONS (IMAGE G {i | i <=| N})` EXISTS_TAC;
51056   TYPE_THEN `B UNION E' UNION A = E' UNION C` SUBAGOAL_TAC;
51057   REWRITE_TAC[UNION_ACI ];
51058   REWRITE_TAC[union_subset];
51059   CONJ_TAC;
51060   REWRITE_TAC[SUBSET;UNIONS;IMAGE];
51061   CONV_TAC (dropq_conv "u");
51062   TYPE_THEN `(SUC i)` EXISTS_TAC;
51063   USEH 343 (REWRITE_RULE[SUBSET]);
51064   UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
51065   TYPE_THEN `A UNION B` UNABBREV_TAC;
51066   IMATCH_MP_TAC  SUBSET_TRANS;
51067   UNIFY_EXISTS_TAC;
51068   IMATCH_MP_TAC  UNIONS_UNIONS;
51069   REWRITE_TAC[IMAGE;SUBSET];
51070   TYPE_THEN `x` UNABBREV_TAC;
51071   TYPE_THEN `x'` EXISTS_TAC;
51072   UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC;
51073   TSPECH `p` 2110;
51074   USEH 1588 (ONCE_REWRITE_RULE[UNION]);
51075   USEH 6893 (REWRITE_RULE[]);
51076   ASM_MESON_TAC[];
51077   (* Tue Dec 28 15:56:13 EST 2004 *)
51078   ]);;
51079   (* }}} *)
51080
51081 (* ------------------------------------------------------------------ *)
51082 (* SECTION AA *)
51083 (* ------------------------------------------------------------------ *)
51084
51085
51086 (* finish proof of the connectedness of the complement of an arc *)
51087
51088 let real_div_denom = prove_by_refinement(
51089   `!z x y . (&0 < z) ==> ((x/ z <= y/ z) <=> (x <= y))`,
51090   (* {{{ proof *)
51091   [
51092   REP_BASIC_TAC;
51093   ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
51094   ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
51095   REWRITE_TAC[GSYM real_div_assoc];
51096   ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
51097   FULL_REWRITE_TAC[REAL_MUL_AC];
51098   IMATCH_MP_TAC  REAL_LE_RMUL_EQ;
51099   ]);;
51100   (* }}} *)
51101
51102 let real_div_denom_lt = prove_by_refinement(
51103   `!z x y . (&0 < z) ==> ((x/ z < y/ z) <=> (x < y))`,
51104   (* {{{ proof *)
51105   [
51106   REP_BASIC_TAC;
51107   ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
51108   ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
51109   REWRITE_TAC[GSYM real_div_assoc];
51110   ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
51111   FULL_REWRITE_TAC[REAL_MUL_AC];
51112   IMATCH_MP_TAC  REAL_LT_RMUL_EQ;
51113   ]);;
51114   (* }}} *)
51115
51116 let simple_arc_constants = prove_by_refinement(
51117   `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\
51118                            euclid 2 p /\ euclid 2 q ==>
51119   (?d N B a d'. (&0 <. d) /\ (&0 <. d') /\ (0 < N) /\
51120     (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\
51121     (C = UNIONS (IMAGE B {i | i <| N})) /\
51122     (!x. C x ==>
51123         (&8 * d <= d_euclid x p) /\ (&8 * d <= d_euclid x q)) /\
51124     (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==>
51125         (&16 * d' < d_euclid x y)) /\
51126     (!i. (i <| N) ==>
51127         (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d))))
51128     `,
51129   (* {{{ proof *)
51130   [
51131   REP_BASIC_TAC;
51132   THM_INTRO_TAC[`C`]simple_arc_compact;
51133   THM_INTRO_TAC[`2`] metric_euclid;
51134   THM_INTRO_TAC[`C`] simple_arc_nonempty;
51135   THM_INTRO_TAC[`top2`] compact_point;
51136   FULL_REWRITE_TAC[top2_unions];
51137   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{p}`] compact_distance;
51138   FULL_REWRITE_TAC[top2];
51139   REWRITE_TAC[EMPTY_EXISTS];
51140   MESON_TAC[];
51141   FULL_REWRITE_TAC[INR IN_SING];
51142   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{q}`] compact_distance;
51143   FULL_REWRITE_TAC[top2];
51144   REWRITE_TAC[EMPTY_EXISTS];
51145   MESON_TAC[];
51146   FULL_REWRITE_TAC[INR IN_SING];
51147   (* - *)
51148   TYPE_THEN `p''''` UNABBREV_TAC;
51149   TYPE_THEN `p''` UNABBREV_TAC;
51150   TYPE_THEN `d = (min_real (d_euclid p''' q) (d_euclid p' p))/(&8)` ABBREV_TAC ;
51151   TYPE_THEN `d` EXISTS_TAC;
51152   TYPE_THEN `&0 < d` SUBAGOAL_TAC;
51153   TYPE_THEN `d` UNABBREV_TAC;
51154   IMATCH_MP_TAC  REAL_LT_DIV;
51155   ASSUME_TAC (REAL_ARITH `&0 < &8`);
51156   REWRITE_TAC[min_real] ;
51157   THM_INTRO_TAC[`C`] simple_arc_euclid;
51158   COND_CASES_TAC;
51159   IMATCH_MP_TAC  d_euclid_pos2;
51160   TYPE_THEN `2` EXISTS_TAC;
51161   ASM_MESON_TAC[subset_imp];
51162   IMATCH_MP_TAC  d_euclid_pos2;
51163   TYPE_THEN `2` EXISTS_TAC;
51164   ASM_MESON_TAC[subset_imp];
51165   (* -A// *)
51166   TYPE_THEN `(!x. C x ==> &8 * d <= d_euclid x p /\ &8 * d <= d_euclid x q)` SUBAGOAL_TAC;
51167   TYPE_THEN `&8 * d = min_real (d_euclid p''' q) (d_euclid p' p)` SUBAGOAL_TAC;
51168   TYPE_THEN `d` UNABBREV_TAC;
51169   IMATCH_MP_TAC  REAL_DIV_LMUL;
51170   UND 10 THEN REAL_ARITH_TAC ;
51171   UNDH 6289 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`q`]);
51172   ASM_REWRITE_TAC[];
51173   UNDH 4386 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`p`]);
51174   ASM_REWRITE_TAC[];
51175   THM_INTRO_TAC[`(d_euclid p''' q)`;`d_euclid p' p  `] min_real_le;
51176   UNDH 4228 THEN UNDH 5042 THEN UNDH 8570 THEN UNDH 8336 THEN REAL_ARITH_TAC;
51177   KILLH 8745 THEN KILLH 6021 THEN KILLH 6289 THEN KILLH 371;
51178   KILLH 4386 THEN KILLH 6186;
51179   (* -B// *)
51180   COPYH 3550;
51181   USEH 3550 (REWRITE_RULE[simple_arc]);
51182   FULL_REWRITE_TAC[top2_unions];
51183   THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
51184   FULL_REWRITE_TAC[uniformly_continuous];
51185   TSPECH `d` 814;
51186   FULL_REWRITE_TAC[];
51187   (* - *)
51188   TYPE_THEN `?N. &1/delta <= &N` SUBAGOAL_TAC;
51189   REWRITE_TAC[REAL_ARCH_SIMPLE];
51190   TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
51191   IMATCH_MP_TAC  REAL_LTE_TRANS;
51192   UNIFY_EXISTS_TAC;
51193   TYPE_THEN `&1/ &N <= delta` SUBAGOAL_TAC;
51194   UNDH 338 THEN   ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
51195   FULL_REWRITE_TAC[REAL_MUL_AC];
51196   TYPE_THEN `N' = 2*N` ABBREV_TAC ;
51197   TYPE_THEN `&0 < &N'` SUBAGOAL_TAC;
51198   TYPE_THEN `N'` UNABBREV_TAC;
51199   FULL_REWRITE_TAC[REAL_OF_NUM_LT];
51200   UNDH 7562 THEN ARITH_TAC;
51201   (* - *)
51202   TYPE_THEN `!r. (r <= &1/ (&N')) ==> (r < delta)` SUBAGOAL_TAC;
51203   TYPE_THEN `&1/ &N' < &1/ &N` SUBAGOAL_TAC;
51204   ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
51205   ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
51206   REWRITE_TAC[GSYM real_div_assoc];
51207   ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
51208   TYPE_THEN `N'` UNABBREV_TAC;
51209   REDUCE_TAC;
51210   UNDH 5547 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC;
51211   UNDH 5945 THEN UNDH 3160 THEN UNDH 532 THEN REAL_ARITH_TAC;
51212   (* -C// *)
51213   KILLH 1557 THEN KILLH 5945 THEN KILLH 5547 THEN KILLH 338;
51214   TYPE_THEN `N'` EXISTS_TAC;
51215   TYPE_THEN `B = (\ i. IMAGE f {x | (&i / &N') <= x /\ (x <= &(SUC i)/(&N'))} )` ABBREV_TAC ;
51216   TYPE_THEN `B` EXISTS_TAC;
51217   TYPE_THEN `a = (\ i. f(&i / &N'))` ABBREV_TAC  ;
51218   TYPE_THEN `a` EXISTS_TAC;
51219   (* - *)
51220   THM_INTRO_TAC[`&N'`] real_div_denom;
51221   REWRH 9377;
51222   (* - *)
51223   TYPE_THEN `!x. (&0 <= x/ &N') <=> (&0 <= x)` SUBAGOAL_TAC;
51224   UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`x`]);
51225   FULL_REWRITE_TAC[REAL_DIV_LZERO];
51226   (* - *)
51227   TYPE_THEN `!x. (x/ &N' <= &1) <=> (x <= &N')` SUBAGOAL_TAC;
51228   UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`&N'`]);
51229   THM_INTRO_TAC[`&N'`] REAL_DIV_REFL;
51230   TYPE_THEN `&N'` UNABBREV_TAC;
51231   UNDH 869 THEN REAL_ARITH_TAC;
51232   REWRH 4881;
51233   (* - *)
51234   TYPE_THEN `!i x. (i <| N') /\ (&i / &N' <= x) /\ (x <= &(SUC i) / &N') ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
51235   TYPE_THEN `&0 <= &i / &N' /\ &(SUC i) / (&N') <= &1` BACK_TAC;
51236   UNDH 601 THEN UNDH 1707 THEN UNDH 167 THEN UNDH 1199 THEN REAL_ARITH_TAC;
51237   REWRITE_TAC[REAL_OF_NUM_LE];
51238   UNDH 9580 THEN ARITH_TAC;
51239   (* -D// *)
51240   TYPE_THEN `(!i. i <| N' ==> (?x. B i x /\ B i SUBSET open_ball (euclid 2,d_euclid) x d))` SUBAGOAL_TAC;
51241   TYPE_THEN `a i` EXISTS_TAC;
51242   TYPE_THEN `a` UNABBREV_TAC;
51243   SUBCONJ_TAC;
51244   TYPE_THEN `B` UNABBREV_TAC;
51245   IMATCH_MP_TAC  image_imp;
51246   ASM_REWRITE_TAC[REAL_OF_NUM_LE ];
51247   ARITH_TAC;
51248   (* -- *)
51249   TYPE_THEN `B` UNABBREV_TAC;
51250   REWRITE_TAC[open_ball;IMAGE;SUBSET;];
51251   TYPE_THEN `x` UNABBREV_TAC;
51252   USEH 3550 (MATCH_MP simple_arc_euclid);
51253   TYPE_THEN `C` UNABBREV_TAC;
51254   USEH 3429 (REWRITE_RULE[SUBSET]);
51255   CONJ_TAC;
51256   FIRST_ASSUM IMATCH_MP_TAC ;
51257   IMATCH_MP_TAC  image_imp;
51258   ASM_REWRITE_TAC[REAL_OF_NUM_LE ];
51259   UNDH 9580 THEN ARITH_TAC;
51260   (* -- *)
51261   CONJ_TAC;
51262   FIRST_ASSUM IMATCH_MP_TAC ;
51263   IMATCH_MP_TAC  image_imp;
51264   FIRST_ASSUM  IMATCH_MP_TAC ;
51265   TYPE_THEN  `i` EXISTS_TAC;
51266   FIRST_ASSUM IMATCH_MP_TAC ;
51267   ASM_REWRITE_TAC[REAL_OF_NUM_LE];
51268   CONJ_TAC;
51269   UNDH 9580 THEN ARITH_TAC;
51270   CONJ_TAC;
51271   FIRST_ASSUM IMATCH_MP_TAC ;
51272   TYPE_THEN `i` EXISTS_TAC;
51273   REWRITE_TAC[d_real];
51274   TYPE_THEN `x' <= &i/ &N' + &1/ &N'` SUBAGOAL_TAC;
51275   UNDH 3570 THEN REWRITE_TAC[REAL];
51276   REWRITE_TAC[real_div;GSYM REAL_ADD_RDISTRIB];
51277   REWRITE_TAC[GSYM real_div];
51278   FIRST_ASSUM IMATCH_MP_TAC ;
51279   UNDH 4551 THEN UNDH 1464 THEN  REAL_ARITH_TAC;
51280   KILLH 8623 THEN KILLH 2193;
51281   KILLH 626 THEN KILLH 4538;
51282   (* -E// *)
51283   TYPE_THEN `!i. &i / &N' < &(SUC i)/ &N'` SUBAGOAL_TAC;
51284   ASM_SIMP_TAC[real_div_denom_lt];
51285   REWRITE_TAC[REAL_OF_NUM_LT];
51286   ARITH_TAC;
51287   (* - *)
51288   TYPE_THEN `(!i. i <| N' ==> simple_arc_end (B i) (a i) (a (SUC i)))` SUBAGOAL_TAC;
51289   TYPE_THEN `a` UNABBREV_TAC;
51290   TYPE_THEN `B` UNABBREV_TAC;
51291   REWRITE_TAC[simple_arc_end];
51292   THM_INTRO_TAC[`f`;`&0`;`&1`;`&i/ &N'`;`&(SUC i)/ &N'`] arc_reparameter_gen;
51293   IMATCH_MP_TAC  inj_subset_domain;
51294   UNIFY_EXISTS_TAC;
51295   REWRITE_TAC[SUBSET];
51296   FIRST_ASSUM IMATCH_MP_TAC ;
51297   TYPE_THEN `i` EXISTS_TAC;
51298   TYPE_THEN `g` EXISTS_TAC;
51299   ASM_REWRITE_TAC[];
51300   (* -F// *)
51301   TYPE_THEN `(IMAGE f {x | &0 <= x /\ x <= &1} = UNIONS (IMAGE B {i | i <| N'}))` SUBAGOAL_TAC;
51302   IMATCH_MP_TAC  EQ_EXT;
51303   REWRITE_TAC[UNIONS;IMAGE];
51304   TYPE_THEN `B` UNABBREV_TAC;
51305   REWRITE_TAC[IMAGE];
51306   IMATCH_MP_TAC  EQ_ANTISYM;
51307   CONJ_TAC;
51308   CONV_TAC (dropq_conv "u");
51309   NAME_CONFLICT_TAC;
51310   LEFT_TAC "x''";
51311   LEFT_TAC "x''";
51312   TYPE_THEN `x'` EXISTS_TAC;
51313   (* --- *)
51314   TYPE_THEN `x' = &1` ASM_CASES_TAC;
51315   TYPE_THEN `N' -| 1` EXISTS_TAC;
51316   FULL_REWRITE_TAC[REAL_LT;REAL_LE];
51317   TYPE_THEN `N' -| 1 <| N'` SUBAGOAL_TAC;
51318   UNDH 8859 THEN ARITH_TAC;
51319   CONJ_TAC;
51320   UNDH 9064 THEN ARITH_TAC;
51321   FULL_REWRITE_TAC[GSYM REAL_LT];
51322   ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
51323   REDUCE_TAC;
51324   FULL_REWRITE_TAC[REAL_LT];
51325   UND 25 THEN ARITH_TAC;
51326   (* --- *)
51327   TYPE_THEN `num_abs_of_int (floor (&N' * x'))` EXISTS_TAC;
51328   TYPE_THEN `t = &N' * x'` ABBREV_TAC ;
51329   TYPE_THEN `x' = t/(&N')` SUBAGOAL_TAC;
51330   TYPE_THEN `t` UNABBREV_TAC;
51331   REWRITE_TAC[real_div_assoc];
51332   ONCE_REWRITE_TAC[EQ_SYM_EQ ];
51333   IMATCH_MP_TAC  REAL_DIV_LMUL;
51334   UNDH 3200 THEN UNDH 7688 THEN REAL_ARITH_TAC;
51335   TYPE_THEN `&0 <= t` SUBAGOAL_TAC;
51336   TYPE_THEN `t` UNABBREV_TAC;
51337   IMATCH_MP_TAC  REAL_LE_MUL;
51338   TYPE_THEN `&:0 <=: (floor t)` SUBAGOAL_TAC;
51339   REWRITE_TAC[int_of_num_th;GSYM floor_le];
51340   REWRITE_TAC[GSYM REAL_OF_NUM_LT];
51341   ASM_REWRITE_TAC[REAL;num_abs_of_int_th;GSYM int_abs_th;];
51342   TYPE_THEN `(||: (floor t) = (floor t))` SUBAGOAL_TAC;
51343   REWRITE_TAC[INT_ABS_REFL;];
51344   THM_INTRO_TAC[`t`] floor_ineq;
51345   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
51346   TYPE_THEN `t < &N' * &1` SUBAGOAL_TAC;
51347   TYPE_THEN `t` UNABBREV_TAC;
51348   ASM_SIMP_TAC[REAL_LT_LMUL_EQ];
51349   UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
51350   CONJ_TAC;
51351   UNDH 5082 THEN REAL_ARITH_TAC;
51352   TYPE_THEN `real_of_int (floor (&N' )) = &N'` SUBAGOAL_TAC;
51353   REWRITE_TAC[floor_num;int_of_num_th;];
51354   UNDH 6307 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
51355   REWRITE_TAC[GSYM   int_lt ];
51356   IMATCH_MP_TAC  (INT_ARITH  `~(x = y) /\ (x <= y) ==> (x <: y)`);
51357   CONJ_TAC;
51358   FULL_REWRITE_TAC[floor_range];
51359   FULL_REWRITE_TAC[int_of_num_th;floor_num];
51360   UNDH 1048 THEN UNDH 6689 THEN REAL_ARITH_TAC;
51361   IMATCH_MP_TAC  floor_mono;
51362   UNDH 1048 THEN REAL_ARITH_TAC;
51363   TYPE_THEN `u` UNABBREV_TAC;
51364   TYPE_THEN `x` UNABBREV_TAC;
51365   TYPE_THEN `x''` EXISTS_TAC;
51366   FIRST_ASSUM IMATCH_MP_TAC ;
51367   TYPE_THEN `x'` EXISTS_TAC;
51368   (* -G// *)
51369   TYPE_THEN `!i. (i <| N') ==> compact top2 (B i)` SUBAGOAL_TAC;
51370   UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
51371   USEH 9744 (MATCH_MP simple_arc_end_simple);
51372   USEH 3463 (MATCH_MP simple_arc_compact);
51373   (* - *)
51374   TYPE_THEN `!i. (i <| N') ==> ~(B i = EMPTY)` SUBAGOAL_TAC;
51375   UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
51376   USEH 9744 (MATCH_MP simple_arc_end_simple);
51377   USEH 3463 (MATCH_MP simple_arc_nonempty);
51378   UNDH 8481 THEN ASM_REWRITE_TAC[];
51379   (* - *)
51380   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;
51381   REWRITE_TAC[PAIR_SPLIT];
51382   CONV_TAC (dropq_conv "i");
51383   CONV_TAC (dropq_conv "j");
51384   TYPE_THEN `i = FST k` ABBREV_TAC ;
51385   TYPE_THEN `j = SND k` ABBREV_TAC ;
51386   RIGHT_TAC "y";
51387   RIGHT_TAC "x";
51388   RIGHT_TAC "dij";
51389   THM_INTRO_TAC[`(euclid 2)`;`d_euclid`;`(B i)`;`(B j)`] compact_distance;
51390   CONJ_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
51391   UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
51392   FULL_REWRITE_TAC[top2];
51393   FIRST_ASSUM IMATCH_MP_TAC ;
51394   UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
51395   TYPE_THEN `d_euclid p' p''` EXISTS_TAC;
51396   (* -- *)
51397   CONJ_TAC;
51398   IMATCH_MP_TAC  d_euclid_pos2;
51399   TYPE_THEN `2` EXISTS_TAC;
51400   CONJ_TAC;
51401   TYPE_THEN `p''` UNABBREV_TAC;
51402   TYPE_THEN `B` UNABBREV_TAC;
51403   USEH 7066 (REWRITE_RULE[IMAGE]);
51404   USEH 6258 (REWRITE_RULE[IMAGE]);
51405   TYPE_THEN `p'` UNABBREV_TAC;
51406   TYPE_THEN `x = x'` SUBAGOAL_TAC;
51407   FULL_REWRITE_TAC[INJ];
51408   FIRST_ASSUM IMATCH_MP_TAC ;
51409   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
51410   UNIFY_EXISTS_TAC;
51411   UNIFY_EXISTS_TAC;
51412   UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
51413   TYPE_THEN `x'` UNABBREV_TAC;
51414   TYPE_THEN `&j/ &N' <= &(SUC i) / (&N')` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  REAL_LE_TRANS;ALL_TAC];
51415   UNIFY_EXISTS_TAC;
51416   UNDH 5902 THEN ASM_REWRITE_TAC[];
51417   UNDH 4223 THEN UNDH 3810 THEN REWRITE_TAC[REAL_LE] THEN ARITH_TAC;
51418   (* --- *)
51419   TYPE_THEN `(i <| N')` SUBAGOAL_TAC;
51420   UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
51421   TYPE_THEN `!i x. (i <| N') /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC;
51422   TSPECH `i'` 8913;
51423   USEH 9316 (MATCH_MP simple_arc_end_simple);
51424   USEH 5604 (MATCH_MP simple_arc_euclid);
51425   ASM_MESON_TAC[subset_imp];
51426   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
51427   UNIFY_EXISTS_TAC;
51428   UNIFY_EXISTS_TAC;
51429   (* -- *)
51430   FIRST_ASSUM IMATCH_MP_TAC ;
51431   (* -H// *)
51432   LEFTH 8852 "dij";
51433   TYPE_THEN `?d''. (&0 < d'') /\  (!i j. (SUC i < j /\ j <| N') ==> (d'' <= dij (i,j)))` SUBAGOAL_TAC;
51434   TYPE_THEN `X = { r  | (?i j. SUC i < j /\ j <| N' /\ (r = dij (i,j))) }` ABBREV_TAC ;
51435   TYPE_THEN `d'' = inf X` ABBREV_TAC ;
51436   TYPE_THEN `X = IMAGE dij {(i,j) | (SUC i < j /\ j < N')}` SUBAGOAL_TAC;
51437   TYPE_THEN `X` UNABBREV_TAC;
51438   IMATCH_MP_TAC  EQ_EXT;
51439   REWRITE_TAC[IMAGE;];
51440   NAME_CONFLICT_TAC;
51441   POP_ASSUM_LIST (fun t->ALL_TAC);
51442   IMATCH_MP_TAC  EQ_ANTISYM;
51443   CONJ_TAC;
51444   CONV_TAC (dropq_conv "x'");
51445   ASM_MESON_TAC[];
51446   TYPE_THEN `x'` UNABBREV_TAC;
51447   ASM_MESON_TAC[];
51448   (* -- *)
51449   TYPE_THEN `FINITE X` SUBAGOAL_TAC;
51450   IMATCH_MP_TAC  FINITE_IMAGE;
51451   IMATCH_MP_TAC  FINITE_SUBSET;
51452   TYPE_THEN `A = {i | (i <| N')}` ABBREV_TAC ;
51453   TYPE_THEN `{(i,j) | A i /\ A j}` EXISTS_TAC;
51454   CONJ_TAC;
51455   THM_INTRO_TAC[`A`;`A`] FINITE_PRODUCT;
51456   TYPE_THEN `A` UNABBREV_TAC;
51457   REWRITE_TAC[FINITE_NUMSEG_LT];
51458   REWRITE_TAC[SUBSET;];
51459   TYPE_THEN `A` UNABBREV_TAC;
51460   TYPE_THEN`i` EXISTS_TAC;
51461   TYPE_THEN `j` EXISTS_TAC;
51462   UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
51463   (* --// *)
51464   TYPE_THEN `X = EMPTY` ASM_CASES_TAC;
51465   TYPE_THEN `&1` EXISTS_TAC;
51466   REWRH 9106;
51467   USEH 3802 SYM;
51468   USEH 7502 (REWRITE_RULE[image_empty]);
51469   USEH 1549 (REWRITE_RULE[EQ_EMPTY]);
51470   TSPECH  `(i,j)` 7313 ;
51471   LEFTH 4977 "i'";
51472   TSPECH `i` 9356;
51473   LEFTH 6976 "j'";
51474   TSPECH `j` 1468;
51475   UNDH 5891 THEN ASM_REWRITE_TAC[];
51476   (* --H2// *)
51477   THM_INTRO_TAC[`X`] finite_inf_min;
51478   THM_INTRO_TAC[`X`] finite_inf;
51479   TYPE_THEN `d''` EXISTS_TAC;
51480   USEH 9106 SYM;
51481   (* TYPE_THEN `d''` UNABBREV_TAC; *)
51482   (* -- *)
51483   CONJ_TAC;
51484   TYPE_THEN `?i j. SUC i <| j /\ j <| N' /\ (d'' = dij (i,j))` SUBAGOAL_TAC;
51485   UNDH 7611 THEN ASM_REWRITE_TAC[] THEN UNDH 3235 THEN DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
51486   UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]);
51487   ASM_REWRITE_TAC[];
51488   REP_BASIC_TAC;
51489   UNDH 6732 THEN DISCH_THEN (THM_INTRO_TAC[`dij (i,j)`]);
51490   UNDH 3235 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
51491   ASM_MESON_TAC[];
51492   USEH 7679 SYM;
51493   ASM_REWRITE_TAC[];
51494   (* -I *)
51495   TYPE_THEN `d' = d''/ &32` ABBREV_TAC  ;
51496   TYPE_THEN `&0 < &32` SUBAGOAL_TAC;
51497   REAL_ARITH_TAC;
51498   TYPE_THEN `d'` EXISTS_TAC;
51499   SUBCONJ_TAC;
51500   TYPE_THEN `d'` UNABBREV_TAC;
51501   ASM_SIMP_TAC[REAL_LT_RDIV_0];
51502   SUBCONJ_TAC;
51503   FULL_REWRITE_TAC[REAL_LT];
51504   (* - *)
51505   IMATCH_MP_TAC  REAL_LTE_TRANS;
51506   TYPE_THEN `d''` EXISTS_TAC;
51507   CONJ_TAC;
51508   TYPE_THEN `d'` UNABBREV_TAC;
51509   REWRITE_TAC[GSYM real_div_assoc];
51510   ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
51511   REWRITE_TAC[REAL_MUL_AC];
51512   IMATCH_MP_TAC  REAL_LT_LMUL;
51513   REAL_ARITH_TAC;
51514   (* -/// *)
51515   UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]);
51516   ASM_REWRITE_TAC[];
51517   IMATCH_MP_TAC  REAL_LE_TRANS;
51518   TYPE_THEN `dij (i,j)` EXISTS_TAC;
51519   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
51520   (* Wed Dec 29 17:40:18 EST 2004 *)
51521
51522   ]);;
51523   (* }}} *)
51524
51525 let euclid_scale_rinv = prove_by_refinement(
51526   `!x r. (&0 < r) ==> ((r * &1/ r) *# x = x)`,
51527   (* {{{ proof *)
51528   [
51529   REP_BASIC_TAC;
51530   USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
51531   ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
51532   ]);;
51533   (* }}} *)
51534
51535 let euclid_scale_bij = prove_by_refinement(
51536   `!r . (&0 < r) ==> BIJ (euclid_scale r) (euclid 2) (euclid 2)`,
51537   (* {{{ proof *)
51538   [
51539   REP_BASIC_TAC;
51540   REWRITE_TAC[BIJ;INJ;];
51541   TYPE_THEN `!x. (r * &1 / r) *# x = x` SUBAGOAL_TAC;
51542   USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
51543   ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
51544   SUBCONJ_TAC;
51545   CONJ_TAC;
51546   IMATCH_MP_TAC  euclid_scale_closure;
51547   TYPE_THEN `euclid_scale (&1/ r)` (fun t -> USEH 9290 (AP_TERM t));
51548   FULL_REWRITE_TAC[euclid_scale_act];
51549   USEH 7114 (ONCE_REWRITE_RULE[REAL_ARITH `x * y = y *x`]);
51550   REWRH 5498;
51551   REWRITE_TAC[SURJ];
51552   REP_BASIC_TAC;
51553   TYPE_THEN`(&1/ r) *# x` EXISTS_TAC;
51554   CONJ_TAC;
51555   IMATCH_MP_TAC  euclid_scale_closure;
51556   REWRITE_TAC[euclid_scale_act];
51557   ]);;
51558   (* }}} *)
51559
51560 let euclid_scale_cont = prove_by_refinement(
51561   `!r. (&0 < r) ==> (continuous (euclid_scale r) top2 top2)`,
51562   (* {{{ proof *)
51563   [
51564   REP_BASIC_TAC;
51565   THM_INTRO_TAC[`( *# ) r`] metric_continuous_continuous_top2;
51566   REWRITE_TAC[IMAGE;SUBSET];
51567   IMATCH_MP_TAC euclid_scale_closure;
51568   REWRITE_TAC[metric_continuous;metric_continuous_pt];
51569   TYPE_THEN `epsilon/r` EXISTS_TAC;
51570   SUBCONJ_TAC;
51571   IMATCH_MP_TAC  REAL_LT_DIV;
51572   THM_INTRO_TAC[`2`;`r`;`x`;`y`] norm_scale_vec;
51573   TYPE_THEN `abs  r = r` SUBAGOAL_TAC;
51574   REWRITE_TAC[REAL_ABS_REFL];
51575   UNDH 6412 THEN REAL_ARITH_TAC;
51576   UNDH 3108 THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
51577   FULL_REWRITE_TAC[REAL_MUL_AC];
51578   ]);;
51579   (* }}} *)
51580
51581 let euclid_scale_inv = prove_by_refinement(
51582   `!r x. (&0 < r) /\ (euclid 2 x) ==>
51583      (INV (( *# ) r) (euclid 2) (euclid 2) x = (( *# ) (&1 / r)) x)`,
51584   (* {{{ proof *)
51585   [
51586   REP_BASIC_TAC;
51587   THM_INTRO_TAC[`( *# ) r`;`(euclid 2)`;`(euclid 2)`;`&1 / r *# x`;`x`] INVERSE_XY;
51588   ASM_SIMP_TAC[euclid_scale_bij];
51589   IMATCH_MP_TAC  euclid_scale_closure;
51590   USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
51591   REWRITE_TAC[euclid_scale_act];
51592   ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
51593   ]);;
51594   (* }}} *)
51595
51596 let euclid_scale_homeo = prove_by_refinement(
51597   `!r. (&0 < r) ==> homeomorphism (euclid_scale r) top2 top2`,
51598   (* {{{ proof *)
51599   [
51600   REP_BASIC_TAC;
51601   IMATCH_MP_TAC  bicont_homeomorphism;
51602   REWRITE_TAC[top2_unions];
51603   ASM_SIMP_TAC [euclid_scale_bij];
51604   ASM_SIMP_TAC[euclid_scale_cont];
51605   IMATCH_MP_TAC  cont_domain;
51606   TYPE_THEN `( *# ) (&1 / r)` EXISTS_TAC;
51607   TYPE_THEN `&0 < &1 /r` SUBAGOAL_TAC;
51608   ASM_SIMP_TAC[euclid_scale_cont];
51609   FULL_REWRITE_TAC[top2_unions];
51610   ASM_SIMP_TAC[euclid_scale_inv];
51611   (* Wed Dec 29 18:45:44 EST 2004 *)
51612   ]);;
51613   (* }}} *)
51614
51615 let simple_arc_end_homeo = prove_by_refinement(
51616   `!f C a b. simple_arc_end C a b /\ homeomorphism f top2 top2 ==>
51617   simple_arc_end (IMAGE f C) (f a) (f b)`,
51618   (* {{{ proof *)
51619   [
51620   REWRITE_TAC[simple_arc_end_cont];
51621   TYPE_THEN `f o f'` EXISTS_TAC;
51622   REWRITE_TAC[IMAGE_o];
51623   TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBAGOAL_TAC;
51624   IMATCH_MP_TAC  metric_subspace;
51625   TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
51626   REWRITE_TAC[metric_real];
51627   (* - *)
51628   TYPE_THEN `UNIONS (top_of_metric (({x | &0 <= x /\ x <= &1},d_real))) = {x | &0 <= x /\ x <= &1}` SUBAGOAL_TAC;
51629   IMATCH_MP_TAC  (GSYM top_of_metric_unions);
51630   (* - *)
51631   CONJ_TAC;
51632   IMATCH_MP_TAC  continuous_comp;
51633   TYPE_THEN `top2` EXISTS_TAC;
51634   REWRITE_TAC[top2_unions];
51635   FULL_REWRITE_TAC[homeomorphism];
51636   (* -- *)
51637   IMATCH_MP_TAC  inj_image_subset;
51638   (* - *)
51639   CONJ_TAC;
51640   REWRITE_TAC[comp_comp];
51641   IMATCH_MP_TAC  COMP_INJ;
51642   TYPE_THEN `(euclid 2)` EXISTS_TAC;
51643   FULL_REWRITE_TAC[homeomorphism];
51644   FULL_REWRITE_TAC[top2_unions;BIJ];
51645   REWRITE_TAC[o_DEF];
51646   ]);;
51647   (* }}} *)
51648
51649 let simple_arc_homeo = prove_by_refinement(
51650   `!f C. simple_arc top2 C /\ homeomorphism f top2 top2 ==>
51651    simple_arc top2 (IMAGE f C)`,
51652   (* {{{ proof *)
51653   [
51654   REP_BASIC_TAC;
51655   RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]);
51656   TYPE_THEN `simple_arc_end C (f' (&0)) (f' (&1))` SUBAGOAL_TAC;
51657   REWRITE_TAC[simple_arc_end];
51658   TYPE_THEN `f'` EXISTS_TAC;
51659   FULL_REWRITE_TAC[top2_unions];
51660   THM_INTRO_TAC[`f`;`C`;`f' (&0)`;`f' (&1)`] simple_arc_end_homeo;
51661   USEH 6603 (MATCH_MP simple_arc_end_simple);
51662   TYPE_THEN `C` UNABBREV_TAC;
51663   ]);;
51664   (* }}} *)
51665
51666 let euclid_scale_simple_arc_ver2 = prove_by_refinement(
51667   `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ (euclid 2 p) /\
51668     (euclid 2 q) /\ ~(p = q) /\
51669     (!A. simple_arc_end A p q ==> ~(C INTER A = EMPTY)) ==>
51670     (?C' p' q' d N B a d'.
51671            simple_arc top2 C' /\ ~C' p' /\ ~C' q' /\ (euclid 2 p') /\
51672         (euclid 2 q') /\ ~(p' = q') /\
51673       (!A. simple_arc_end A p' q' ==> ~(C' INTER A = EMPTY)) /\
51674       (&1 <=. d) /\ (&1 <=. d') /\ (0 < N) /\
51675     (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\
51676     (C' = UNIONS (IMAGE B {i | i <| N})) /\
51677     (!x. C' x ==>
51678         (&8 * d <= d_euclid x p') /\ (&8 * d <= d_euclid x q')) /\
51679     (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==>
51680         (&16 * d' < d_euclid x y)) /\
51681     (!i. (i <| N) ==>
51682         (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d))))
51683     `,
51684   (* {{{ proof *)
51685
51686   [
51687   REP_BASIC_TAC;
51688   THM_INTRO_TAC[`C`;`p`;`q`] simple_arc_constants;
51689   TYPE_THEN `r = min_real d d'` ABBREV_TAC ;
51690   TYPE_THEN `f = ( *# ) (&1 /r)` ABBREV_TAC ;
51691   TYPE_THEN `C' = IMAGE f C` ABBREV_TAC ;
51692   TYPE_THEN `B' = (IMAGE f) o B` ABBREV_TAC ;
51693   TYPE_THEN `p' = f p` ABBREV_TAC ;
51694   TYPE_THEN `q' = f q` ABBREV_TAC ;
51695   TYPE_THEN `dr = d/r` ABBREV_TAC ;
51696   TYPE_THEN `dr' = d'/r` ABBREV_TAC ;
51697   TYPE_THEN `a' = f o a` ABBREV_TAC ;
51698   TYPE_THEN `C'` EXISTS_TAC;
51699   TYPE_THEN `p'` EXISTS_TAC;
51700   TYPE_THEN `q'` EXISTS_TAC;
51701   TYPE_THEN `dr` EXISTS_TAC;
51702   TYPE_THEN `N` EXISTS_TAC;
51703   TYPE_THEN `B'` EXISTS_TAC;
51704   TYPE_THEN `a'` EXISTS_TAC;
51705   TYPE_THEN `dr'` EXISTS_TAC;
51706   (* -A *)
51707   TYPE_THEN `&0 < r` SUBAGOAL_TAC;
51708   TYPE_THEN `r` UNABBREV_TAC;
51709   REWRITE_TAC[min_real];
51710   COND_CASES_TAC;
51711   TYPE_THEN `&0 < &1/ r` SUBAGOAL_TAC;
51712   (* - *)
51713   TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC;
51714   TYPE_THEN `f` UNABBREV_TAC;
51715   IMATCH_MP_TAC  euclid_scale_homeo;
51716   USEH 5104 SYM;
51717   SUBCONJ_TAC;
51718   TYPE_THEN `C'` UNABBREV_TAC;
51719   IMATCH_MP_TAC  simple_arc_homeo;
51720   (* - *)
51721   TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC;
51722   USEH 3550 (MATCH_MP simple_arc_euclid);
51723   IMATCH_MP_TAC  subset_imp;
51724   UNIFY_EXISTS_TAC;
51725   (* - *)
51726   SUBCONJ_TAC;
51727   TYPE_THEN `C'` UNABBREV_TAC;
51728   TYPE_THEN `p'` UNABBREV_TAC;
51729   UNDH 9726 THEN ASM_REWRITE_TAC[];
51730   USEH 7428 (REWRITE_RULE[IMAGE]);
51731   FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
51732   TYPE_THEN `(x = p)` SUBAGOAL_TAC;
51733   FIRST_ASSUM IMATCH_MP_TAC ;
51734   FULL_REWRITE_TAC[top2_unions];
51735   TYPE_THEN `p` UNABBREV_TAC;
51736   (* - *)
51737   SUBCONJ_TAC;
51738   TYPE_THEN `C'` UNABBREV_TAC;
51739   TYPE_THEN `q'` UNABBREV_TAC;
51740   UNDH 6497 THEN ASM_REWRITE_TAC[];
51741   USEH 4199 (REWRITE_RULE[IMAGE]);
51742   FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
51743   TYPE_THEN `(q = x)` SUBAGOAL_TAC;
51744   FIRST_ASSUM IMATCH_MP_TAC ;
51745   FULL_REWRITE_TAC[top2_unions];
51746   TYPE_THEN `q` UNABBREV_TAC;
51747   (* -B *)
51748   TYPE_THEN `euclid 2 p' /\ euclid 2 q'` SUBAGOAL_TAC;
51749   TYPE_THEN `p'` UNABBREV_TAC;
51750   TYPE_THEN `q'` UNABBREV_TAC;
51751   FULL_REWRITE_TAC[homeomorphism;BIJ;SURJ;top2_unions];
51752   (* -// *)
51753   CONJ_TAC;
51754   TYPE_THEN `p'` UNABBREV_TAC;
51755   TYPE_THEN `q'` UNABBREV_TAC;
51756   FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
51757   UNDH 11 THEN REWRITE_TAC[];
51758   FIRST_ASSUM IMATCH_MP_TAC ;
51759   REWRITE_TAC[top2_unions];
51760   (* - *)
51761   CONJ_TAC;
51762   TYPE_THEN `g = ( *# ) r` ABBREV_TAC ;
51763   TYPE_THEN `A' = IMAGE g A` ABBREV_TAC ;
51764   TYPE_THEN`homeomorphism g top2 top2` SUBAGOAL_TAC;
51765   TYPE_THEN `g` UNABBREV_TAC;
51766   ASM_SIMP_TAC[euclid_scale_homeo];
51767   TSPECH `A'` 8219;
51768   TYPE_THEN `!x.  (g (f x) = x)` SUBAGOAL_TAC;
51769   TYPE_THEN `g` UNABBREV_TAC;
51770   TYPE_THEN `f` UNABBREV_TAC;
51771   REWRITE_TAC[euclid_scale_act];
51772   ASM_SIMP_TAC [euclid_scale_rinv];
51773   (* -- *)
51774   UNDH 5082 THEN DISCH_THEN (THM_INTRO_TAC[]);
51775   TYPE_THEN `A'` UNABBREV_TAC;
51776   TYPE_THEN `(p = g p') /\ (q = g q')` SUBAGOAL_TAC;
51777   TYPE_THEN `p'` UNABBREV_TAC;
51778   TYPE_THEN `q'` UNABBREV_TAC;
51779   IMATCH_MP_TAC  simple_arc_end_homeo;
51780   USEH 7123  (REWRITE_RULE[INTER;EMPTY_EXISTS]);
51781   USEH 8329  (REWRITE_RULE[EQ_EMPTY;INTER]);
51782   TSPECH `f u` 5681;
51783   UNDH 1812 THEN REWRITE_TAC[];
51784   TYPE_THEN `C'` UNABBREV_TAC;
51785   CONJ_TAC;
51786   IMATCH_MP_TAC  image_imp;
51787   TYPE_THEN `A'` UNABBREV_TAC;
51788   USEH 1648 (REWRITE_RULE[IMAGE]);
51789   TYPE_THEN `f` UNABBREV_TAC;
51790   TYPE_THEN `g` UNABBREV_TAC;
51791   REWRITE_TAC[euclid_scale_act];
51792   ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`];
51793   ASM_SIMP_TAC[euclid_scale_rinv];
51794   (* -C *)
51795   CONJ_TAC;
51796   TYPE_THEN `dr` UNABBREV_TAC;
51797   TYPE_THEN `r` UNABBREV_TAC;
51798   ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
51799   REDUCE_TAC;
51800   REWRITE_TAC[min_real_le];
51801   CONJ_TAC;
51802   TYPE_THEN `dr'` UNABBREV_TAC;
51803   TYPE_THEN `r` UNABBREV_TAC;
51804   ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
51805   REDUCE_TAC;
51806   REWRITE_TAC[min_real_le];
51807   (* - *)
51808   CONJ_TAC;
51809   TYPE_THEN `B'` UNABBREV_TAC;
51810   TYPE_THEN `a'` UNABBREV_TAC;
51811   REWRITE_TAC[o_DEF];
51812   IMATCH_MP_TAC  simple_arc_end_homeo;
51813   (* - *)
51814   CONJ_TAC;
51815   TYPE_THEN `C'` UNABBREV_TAC;
51816   TYPE_THEN `B'` UNABBREV_TAC;
51817   REWRITE_TAC[IMAGE_o];
51818   REWRITE_TAC[GSYM image_unions];
51819   (* - *)
51820   TYPE_THEN `!x y. (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid (f x) (f y) = (d_euclid x y)/r)` SUBAGOAL_TAC;
51821   TYPE_THEN `f` UNABBREV_TAC;
51822   THM_INTRO_TAC[`2`;`&1 / r`;`x`;`y`] norm_scale_vec;
51823   TYPE_THEN `abs  (&1/r) = &1/r` SUBAGOAL_TAC;
51824   REWRITE_TAC[ABS_REFL];
51825   UNDH 4597 THEN REAL_ARITH_TAC;
51826   ONCE_REWRITE_TAC[REAL_ARITH `x * y = y* x`];
51827   REWRITE_TAC[GSYM real_div_assoc];
51828   REDUCE_TAC;
51829   (* -D *)
51830   CONJ_TAC;
51831   TYPE_THEN `C'` UNABBREV_TAC;
51832   USEH 3184 (REWRITE_RULE[IMAGE]);
51833   TYPE_THEN `p'` UNABBREV_TAC;
51834   TYPE_THEN `q'` UNABBREV_TAC;
51835   ASM_SIMP_TAC[];
51836   TYPE_THEN `dr` UNABBREV_TAC;
51837   REWRITE_TAC[GSYM real_div_assoc];
51838   ASM_SIMP_TAC[real_div_denom];
51839   (* - *)
51840   TYPE_THEN `!i x. (i <| N) /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC;
51841   UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
51842   USEH 9744 (MATCH_MP simple_arc_end_simple);
51843   USEH 3463 (MATCH_MP simple_arc_euclid);
51844   USEH 4246 (REWRITE_RULE[SUBSET]);
51845   (* - *)
51846   CONJ_TAC;
51847   TYPE_THEN `B'` UNABBREV_TAC;
51848   FULL_REWRITE_TAC[o_DEF];
51849   USEH 407 (REWRITE_RULE[IMAGE]);
51850   USEH 3121 (REWRITE_RULE[IMAGE]);
51851   TYPE_THEN `i <| N` SUBAGOAL_TAC;
51852   UNDH 3810 THEN UNDH 1688 THEN ARITH_TAC;
51853   UNDH 2436 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x'`]);
51854   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_MESON_TAC[];
51855   TYPE_THEN `dr'` UNABBREV_TAC;
51856   REWRITE_TAC[GSYM real_div_assoc];
51857   ASM_SIMP_TAC[real_div_denom_lt];
51858   FIRST_ASSUM IMATCH_MP_TAC ;
51859   ASM_MESON_TAC[];
51860   (* -E *)
51861   TSPECH `i` 4673;
51862   REWRITE_TAC[];
51863   TYPE_THEN `f x` EXISTS_TAC;
51864   TYPE_THEN `B'` UNABBREV_TAC;
51865   REWRITE_TAC[o_DEF];
51866   SUBCONJ_TAC;
51867   IMATCH_MP_TAC  image_imp;
51868   FULL_REWRITE_TAC[SUBSET;open_ball];
51869   USEH 4418 (REWRITE_RULE[IMAGE]);
51870   TSPECH `x''` 7148;
51871   (* - *)
51872   CONJ_TAC;
51873   TYPE_THEN `f` UNABBREV_TAC;
51874   IMATCH_MP_TAC  euclid_scale_closure;
51875   CONJ_TAC;
51876   TYPE_THEN `f` UNABBREV_TAC;
51877   IMATCH_MP_TAC  euclid_scale_closure;
51878   ASM_SIMP_TAC[];
51879   TYPE_THEN `dr` UNABBREV_TAC;
51880   ASM_SIMP_TAC[real_div_denom_lt];
51881   (* Thu Dec 30 10:14:03 EST 2004 *)
51882
51883   ]);;
51884
51885   (* }}} *)
51886
51887 let delta_pos_arch = prove_by_refinement(
51888   `!d. (&0 < d) ==> (?n. (0 <| n) /\ (&1/(&n) < d))`,
51889   (* {{{ proof *)
51890   [
51891   REP_BASIC_TAC;
51892   THM_INTRO_TAC[`&1/d`] REAL_ARCH_SIMPLE;
51893   TYPE_THEN `2 * n` EXISTS_TAC;
51894   SUBCONJ_TAC;
51895   REWRITE_TAC[LT_MULT];
51896   CONJ_TAC;
51897   ARITH_TAC;
51898   REWRITE_TAC[GSYM REAL_LT];
51899   IMATCH_MP_TAC  REAL_LTE_TRANS;
51900   TYPE_THEN `&1 / d` EXISTS_TAC;
51901   (* - *)
51902   IMATCH_MP_TAC  REAL_LTE_TRANS;
51903   TYPE_THEN `&1/ &n` EXISTS_TAC;
51904   (* - *)
51905   TYPE_THEN `&0 < &(2 *| n)` SUBAGOAL_TAC;
51906   REWRITE_TAC[REAL_LT];
51907   TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
51908   FULL_REWRITE_TAC[REAL_LT];
51909   FULL_REWRITE_TAC[LT_MULT];
51910   CONJ_TAC;
51911   ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
51912   ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`];
51913   REWRITE_TAC[GSYM real_div_assoc];
51914   ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
51915   REDUCE_TAC;
51916   FULL_REWRITE_TAC[REAL_LT];
51917   UNDH 3476 THEN ARITH_TAC;
51918   UNDH 27 THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
51919   FULL_REWRITE_TAC[REAL_MUL_AC];
51920   ]);;
51921   (* }}} *)
51922
51923 let suc_div = prove_by_refinement(
51924   `!i a. &(SUC i) / a = &i/ a + &1/a`,
51925   (* {{{ proof *)
51926   [
51927   REWRITE_TAC[REAL];
51928   REWRITE_TAC[real_div];
51929   REAL_ARITH_TAC;
51930   ]);;
51931   (* }}} *)
51932
51933 let delta_partition_lemma_ver2 = prove_by_refinement(
51934   `!delta. (&0 < delta) ==> (?M. !N. !x. ?i.  (0 < M) /\
51935       ((M <= N) /\ (&0 <= x /\ x <= &1) ==>
51936       (i <= N) /\ abs  (&i/ &N - x) < delta))`,
51937   (* {{{ proof *)
51938   [
51939   REP_BASIC_TAC;
51940   THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE;
51941   TYPE_THEN `n` EXISTS_TAC;
51942   TYPE_THEN `num_abs_of_int (floor (&N*x))` EXISTS_TAC;
51943   TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC;
51944   TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
51945   UND 1 THEN UND 2 THEN REAL_ARITH_TAC;
51946   TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC;
51947   ASM_MESON_TAC[REAL_LE_LDIV_EQ];
51948   CONJ_TAC;
51949   FULL_REWRITE_TAC[REAL_LT];
51950   TYPE_THEN `&:0 <= floor (&N * x)` SUBAGOAL_TAC;
51951   TYPE_THEN `floor (&0) <=: floor (&N * x)` BACK_TAC;
51952   FULL_REWRITE_TAC[floor_num];
51953   IMATCH_MP_TAC  floor_mono;
51954   IMATCH_MP_TAC  REAL_LE_MUL;
51955   (* - *)
51956   CONJ_TAC;
51957   TYPE_THEN `num_abs_of_int (floor (&N * x)) <= num_abs_of_int (floor (&N))` BACK_TAC;
51958   FULL_REWRITE_TAC[floor_num;num_abs_of_int_num];
51959   IMATCH_MP_TAC  num_abs_of_int_mono;
51960   IMATCH_MP_TAC  floor_mono;
51961   TYPE_THEN `&N * x <= &N * &1` BACK_TAC;
51962   UND 9 THEN REAL_ARITH_TAC;
51963   IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
51964   (* -A *)
51965   IMATCH_MP_TAC  REAL_LT_LCANCEL_IMP;
51966   TYPE_THEN `&N` EXISTS_TAC;
51967   (* - *)
51968   TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
51969   FULL_REWRITE_TAC[REAL_LT];
51970   UNDH 3476 THEN UNDH 9390 THEN ARITH_TAC;
51971   IMATCH_MP_TAC  REAL_LTE_TRANS;
51972   TYPE_THEN`&1` EXISTS_TAC;
51973   (* - *)
51974   REWRITE_TAC[num_abs_of_int_th;];
51975   TYPE_THEN `abs  (real_of_int (floor (&N * x))) = (real_of_int (floor (&N *x)))` SUBAGOAL_TAC;
51976   REWRITE_TAC[REAL_ABS_REFL];
51977   FULL_REWRITE_TAC [int_le; int_of_num_th;];
51978   TYPE_THEN `!u. &N * abs  (u / &N - x) = abs  (u - &N*x)` SUBAGOAL_TAC;
51979   TYPE_THEN `!t. &N * abs  t = abs  (&N *t)` SUBAGOAL_TAC;
51980   REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM];
51981   AP_TERM_TAC;
51982   REWRITE_TAC[REAL_SUB_LDISTRIB];
51983   TYPE_THEN `&N * u/ &N = u` SUBAGOAL_TAC;
51984   IMATCH_MP_TAC  REAL_DIV_LMUL;
51985   UND 12 THEN UND 9 THEN REAL_ARITH_TAC;
51986   TYPE_THEN `t = &N * x ` ABBREV_TAC ;
51987   TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC;
51988   REWRITE_TAC[floor_ineq];
51989   TYPE_THEN `abs  (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC;
51990   UND 13 THEN REAL_ARITH_TAC;
51991   THM_INTRO_TAC[`t`] floor_ineq;
51992   CONJ_TAC;
51993   UND 15 THEN REAL_ARITH_TAC;
51994   (* - *)
51995   IMATCH_MP_TAC  REAL_LE_TRANS;
51996   TYPE_THEN `&n * delta` EXISTS_TAC;
51997   ASM_SIMP_TAC[REAL_LE_RMUL_EQ];
51998   FULL_REWRITE_TAC[REAL_LE];
51999   ]);;
52000   (* }}} *)
52001
52002 let simple_arc_ball_cover_ver2  = prove_by_refinement(
52003   `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
52004       INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
52005     (?M. !N. !x. ?i. (0 < M) /\ (( M <= N) /\ (&0 <= x /\ x <= &1) ==>
52006         (i <= N) /\
52007            open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`,
52008   (* {{{ proof *)
52009   [
52010   REP_BASIC_TAC;
52011   THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
52012   FULL_REWRITE_TAC[uniformly_continuous];
52013   TSPECH `&1` 814;
52014   UNDH 4636 THEN DISCH_THEN (THM_INTRO_TAC[]);
52015   REWRITE_TAC[open_ball];
52016   THM_INTRO_TAC[`delta`] delta_partition_lemma_ver2;
52017   TYPE_THEN `M` EXISTS_TAC;
52018   TSPECH `N` 6807;
52019   TSPECH `x` 8373;
52020   TYPE_THEN `i` EXISTS_TAC;
52021   REP_BASIC_TAC;
52022   UNDH 5594 THEN DISCH_THEN (THM_INTRO_TAC[]);
52023   (* - *)
52024   TYPE_THEN `0 <| N` SUBAGOAL_TAC;
52025   UNDH 6734 THEN UNDH 4600 THEN ARITH_TAC;
52026   (* - *)
52027   TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC;
52028   CONJ_TAC;
52029   IMATCH_MP_TAC  REAL_LE_DIV;
52030   THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ;
52031   REWRITE_TAC[REAL_LT];
52032   REWRITE_TAC[REAL_MUL;REAL_LE];
52033   UNDH 8395 THEN ARITH_TAC;
52034   (* - *)
52035   FULL_REWRITE_TAC[INJ];
52036   CONJ_TAC;
52037   FIRST_ASSUM IMATCH_MP_TAC ;
52038   (* - *)
52039   CONJ_TAC;
52040   FIRST_ASSUM IMATCH_MP_TAC ;
52041   (* - *)
52042   FIRST_ASSUM IMATCH_MP_TAC ;
52043   REWRITE_TAC[d_real];
52044   ]);;
52045   (* }}} *)
52046
52047 let grid_image_bounded_ver2 = prove_by_refinement(
52048   `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
52049       INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
52050    (?M. !N. (0 < M) /\ ((M <= N) ==>
52051     ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER
52052          (unbounded_set (grid f N)) =  EMPTY))  )`,
52053   (* {{{ proof *)
52054
52055   [
52056   REWRITE_TAC[EQ_EMPTY;INTER;];
52057   THM_INTRO_TAC[`f`] simple_arc_ball_cover_ver2;
52058   TYPE_THEN `M` EXISTS_TAC;
52059   REWRITE_TAC[IMAGE];
52060   NAME_CONFLICT_TAC;
52061   TSPECH `N` 8189;
52062   RIGHTH 2874 "i";
52063   RIGHTH 3911 "x";
52064   TYPE_THEN `x''` UNABBREV_TAC;
52065   TYPE_THEN `0 <| N` SUBAGOAL_TAC;
52066   UNDH 4600 THEN UNDH 6734 THEN ARITH_TAC;
52067   FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ];
52068   UNDH 5619 THEN REWRITE_TAC[]; (* ~bounded *)
52069   UNDH 1431 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
52070   REWRH 3036;
52071   FULL_REWRITE_TAC[open_ball];
52072   (* _ *)
52073   IMATCH_MP_TAC  bounded_avoidance_subset;
52074   TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ;
52075   TYPE_THEN `E` EXISTS_TAC;
52076   (* _ *)
52077   TYPE_THEN `conn2 E` SUBAGOAL_TAC;
52078   TYPE_THEN `E` UNABBREV_TAC;
52079   REWRITE_TAC[grid33_conn2];
52080   REWRITE_TAC[grid_edge;grid_finite];
52081   TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC;
52082   REWRITE_TAC[grid];
52083   TYPE_THEN `E` UNABBREV_TAC;
52084   TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC;
52085   IMATCH_MP_TAC  EQ_EXT;
52086   REWRITE_TAC[UNION];
52087   UNDH 8395 THEN ARITH_TAC; (* i <=| N *)
52088   (* -- *)
52089   REWRITE_TAC[IMAGE_UNION;UNIONS_UNION];
52090   REWRITE_TAC[SUBSET;UNION];
52091   DISJ1_TAC;
52092   REWRITE_TAC[image_sing];
52093   (* - *)
52094   TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC;
52095   UNDH 4893 THEN REWRITE_TAC[];
52096   THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset;
52097   USEH 2367 (MATCH_MP UNIONS_UNIONS); (* CURVE_CELL SUBSET curve-cell *)
52098   ASM_MESON_TAC[subset_imp];
52099   KILLH 3474; (* E SUBSET grid f N *)
52100   KILLH 4893; (* ~UNIONS (. grid f N) *)
52101   (* -A// *)
52102   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 ;
52103   THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq;
52104   FULL_REWRITE_TAC [];
52105   REWRH 2390;
52106   TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
52107   TYPE_THEN `E` UNABBREV_TAC;
52108   TYPE_THEN `E'` UNABBREV_TAC;
52109   REWRITE_TAC[grid33];
52110   IMATCH_MP_TAC  rectangle_grid_subset;
52111   (* __ *)
52112   THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor;
52113   THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor;
52114   UNDH 7979 THEN UNDH 4359 THEN INT_ARITH_TAC;
52115   (* -// *)
52116   IMATCH_MP_TAC  bounded_avoidance_subset;
52117   TYPE_THEN `E'` EXISTS_TAC;
52118   TYPE_THEN `conn2 E'` SUBAGOAL_TAC;
52119   IMATCH_MP_TAC  conn2_rectagon;
52120   TYPE_THEN `FINITE E` SUBAGOAL_TAC;
52121   FULL_REWRITE_TAC[conn2];
52122   (* -// *)
52123   TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
52124   TYPE_THEN `E` UNABBREV_TAC;
52125   REWRITE_TAC[grid33_edge];
52126   (* -// *)
52127   ASM_SIMP_TAC[GSYM odd_bounded];
52128   REWRITE_TAC[UNIONS];
52129   TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC;
52130   IMATCH_MP_TAC  (TAUT ` a/\ b ==> b /\ a`);
52131   (* -B// *)
52132   TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC;
52133   UNDH 1109 THEN REWRITE_TAC[]; (* ~  E *)
52134   THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset;
52135   USEH 2664 (MATCH_MP UNIONS_UNIONS);  (* curve-cell SUBSET *)
52136   ASM_MESON_TAC[subset_imp];
52137   (* -// *)
52138   TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ;
52139   TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC;
52140   UNDH 8466 THEN REWRITE_TAC[]; (* ~ *)
52141   REWRITE_TAC[UNIONS];
52142   TYPE_THEN `h_edge m` EXISTS_TAC;
52143   REWRITE_TAC[curve_cell_h_ver2];
52144   USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); (* floor,floor = m *)
52145   REWRH 1242; (* rg flor,flor *)
52146   FULL_REWRITE_TAC[rectangle_grid_sq];
52147   TYPE_THEN `E'` UNABBREV_TAC;
52148   REWRITE_TAC[INSERT];
52149   (* -// *)
52150   TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC;
52151   UNDH 8466 THEN REWRITE_TAC[]; (* ~UNIONS .. E' *)
52152   REWRITE_TAC[UNIONS];
52153   TYPE_THEN `v_edge m` EXISTS_TAC;
52154   REWRITE_TAC[curve_cell_v_ver2];
52155   USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
52156   REWRH 1242;
52157   FULL_REWRITE_TAC[rectangle_grid_sq];
52158   TYPE_THEN `E'` UNABBREV_TAC;
52159   REWRITE_TAC[INSERT];
52160   (* -// *)
52161   TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC;
52162   UNDH 8466 THEN REWRITE_TAC[];
52163   REWRITE_TAC[UNIONS];
52164   TYPE_THEN `{(pointI m)}` EXISTS_TAC;
52165   ASM_SIMP_TAC[rectagon_segment;curve_cell_cls];
52166   USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
52167   REWRH 1242;
52168   FULL_REWRITE_TAC[rectangle_grid_sq];
52169   TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC;
52170   TYPE_THEN `E'` UNABBREV_TAC;
52171   REWRITE_TAC[SUBSET;INSERT];
52172   USEH 9677 (MATCH_MP cls_subset); (* { hedge } SUBSET E' *)
52173   USEH 1949 (REWRITE_RULE[SUBSET]);
52174   FIRST_ASSUM IMATCH_MP_TAC ;
52175   REWRITE_TAC[cls_h];
52176   (* -C// *)
52177   USEH 2851 (MATCH_MP point_onto); (* euclid 2 (f x') *)
52178   THM_INTRO_TAC[`p`] square_domain;
52179   UNDH 4082 THEN LET_TAC;
52180   TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC;
52181   TYPE_THEN `m` UNABBREV_TAC;
52182   REWRITE_TAC[PAIR_SPLIT];
52183   REWRH 2288; (* big ONE *)
52184   TYPE_THEN `point p` UNABBREV_TAC;
52185   USEH 459 (REWRITE_RULE[UNION;INR IN_SING;]); (* long *)
52186   REWRH 4739; (* \/ *)
52187   (* -D// *)
52188   ASM_SIMP_TAC[rectagon_segment;par_cell_squ];
52189   FULL_REWRITE_TAC[num_lower];
52190   USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
52191   REWRH 1242;  (* rect-grid *)
52192   FULL_REWRITE_TAC[rectangle_grid_sq];
52193   TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC;
52194   TYPE_THEN `E'` UNABBREV_TAC;
52195   REWRITE_TAC[INSERT;cell_clauses];
52196   REWRH 5179; (* EVEN *)
52197   (* - *)
52198   TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC;
52199   IMATCH_MP_TAC  EQ_EXT;
52200   REWRITE_TAC[up;PAIR_SPLIT];
52201   INT_ARITH_TAC;
52202   REWRH 3452; (* EVEN *)
52203   FULL_REWRITE_TAC[card_sing;EVEN2];
52204   ]);;
52205
52206   (* }}} *)
52207
52208 let grid33_h = prove_by_refinement(
52209   `!m. grid33 m (h_edge m)`,
52210   (* {{{ proof *)
52211   [
52212   REWRITE_TAC[grid33];
52213   REWRITE_TAC[rectangle_grid];
52214   DISJ1_TAC;
52215   TYPE_THEN `m` EXISTS_TAC;
52216   INT_ARITH_TAC;
52217   ]);;
52218   (* }}} *)
52219
52220 let curve_cell_grid_unions = prove_by_refinement(
52221   `!f N. curve_cell (grid f N) =
52222        UNIONS (IMAGE curve_cell
52223        ((IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1)))
52224          {j | j <=| N})))`,
52225   (* {{{ proof *)
52226
52227   [
52228   REP_BASIC_TAC;
52229   REWRITE_TAC[grid];
52230   TYPE_THEN `S = (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1)))  {j | j <=| N})` ABBREV_TAC ;
52231   IMATCH_MP_TAC  thread_finite_union;
52232   REWRITE_TAC[curve_cell_union;curve_cell_empty];
52233   TYPE_THEN `S` UNABBREV_TAC;
52234   IMATCH_MP_TAC  FINITE_IMAGE;
52235   REWRITE_TAC[FINITE_NUMSEG_LE];
52236   ]);;
52237
52238   (* }}} *)
52239
52240 let curve_cell_finite_union = prove_by_refinement(
52241   `!E. FINITE E ==>
52242      ( curve_cell (UNIONS E) = UNIONS (IMAGE curve_cell E))`,
52243   (* {{{ proof *)
52244   [
52245   REP_BASIC_TAC;
52246   IMATCH_MP_TAC  thread_finite_union;
52247   REWRITE_TAC[curve_cell_empty;curve_cell_union];
52248   ]);;
52249   (* }}} *)
52250
52251 let grid33_unions = prove_by_refinement(
52252   `!p.  grid33 p =
52253     (IMAGE h_edge
52254        { m | (FST p -: &:1 <=: FST m) /\ FST m <=: FST p +: &:1 /\
52255               SND p -: &:1 <=: SND m /\ (SND m <=: SND p +: &:2) })
52256    UNION
52257     (IMAGE v_edge
52258        { m | FST p -: &:1 <=: FST m /\ FST m <= FST p +: &:2 /\
52259              SND p -: &:1 <=: SND m /\ SND m <= SND p +: &:1}) `,
52260   (* {{{ proof *)
52261
52262   [
52263   REWRITE_TAC[grid33;IMAGE;rectangle_grid];
52264   IMATCH_MP_TAC  EQ_EXT;
52265   REWRITE_TAC[UNION];
52266   IMATCH_MP_TAC  EQ_ANTISYM ;
52267   CONJ_TAC;
52268   FIRST_ASSUM DISJ_CASES_TAC;
52269   TYPE_THEN `x` UNABBREV_TAC;
52270   FULL_REWRITE_TAC[cell_clauses];
52271   CONV_TAC (dropq_conv "x");
52272   TYPE_THEN `m'` UNABBREV_TAC;
52273   UNDH 3867 THEN INT_ARITH_TAC;
52274   (* -- *)
52275   TYPE_THEN `x` UNABBREV_TAC;
52276   FULL_REWRITE_TAC[cell_clauses];
52277   CONV_TAC (dropq_conv "x");
52278   TYPE_THEN `m'` UNABBREV_TAC;
52279   UNDH 2244 THEN INT_ARITH_TAC;
52280   (* - *)
52281   FIRST_ASSUM DISJ_CASES_TAC;
52282   TYPE_THEN `x` UNABBREV_TAC;
52283   FULL_REWRITE_TAC[cell_clauses];
52284   CONV_TAC (dropq_conv "m");
52285   TYPE_THEN `x'` UNABBREV_TAC;
52286   UNDH 6786 THEN INT_ARITH_TAC;
52287   (* - *)
52288   TYPE_THEN `x` UNABBREV_TAC;
52289   FULL_REWRITE_TAC[cell_clauses];
52290   CONV_TAC (dropq_conv "m");
52291   TYPE_THEN `x'` UNABBREV_TAC;
52292   UNDH 2096 THEN INT_ARITH_TAC;
52293   ]);;
52294
52295   (* }}} *)
52296
52297 let int_range_finite = prove_by_refinement(
52298   `!a b. FINITE {t | a <=: t /\ t <=: b}`,
52299   (* {{{ proof *)
52300   [
52301   REP_BASIC_TAC;
52302   TYPE_THEN `b <: a` ASM_CASES_TAC;
52303   TYPE_THEN `{ t | a <=: t /\ t <=: b} = EMPTY ` BACK_TAC;
52304   REWRITE_TAC[FINITE_RULES];
52305   IMATCH_MP_TAC  EQ_EXT;
52306   UNDH 5826 THEN INT_ARITH_TAC;
52307   (* - *)
52308   THM_INTRO_TAC[`a`] INT_REP;
52309   THM_INTRO_TAC[`b`] INT_REP;
52310   TYPE_THEN `a` UNABBREV_TAC;
52311   TYPE_THEN `b` UNABBREV_TAC;
52312   (* - *)
52313   THM_INTRO_TAC[`{ i | i <=| (n' + m) - (n + m') }`;`{t | (&:n -: &:m)  <=: t /\ t <=: &:n' -: &:m'}`;`(\ i. (&:i) + &:n -: &:m)`] SURJ_FINITE;
52314   REWRITE_TAC[FINITE_NUMSEG_LE];
52315   REWRITE_TAC[SURJ];
52316   CONJ_TAC;
52317   TYPE_THEN `(n +| m') <= (n' + m)` SUBAGOAL_TAC;
52318   REWRITE_TAC[GSYM INT_OF_NUM_LE];
52319   REWRITE_TAC[GSYM INT_OF_NUM_ADD];
52320   UNDH 6818 THEN INT_ARITH_TAC;
52321   USEH 2499 (MATCH_MP INT_OF_NUM_SUB);
52322   USEH 6968 SYM;
52323   FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE];
52324   REWRH 3919;
52325   FULL_REWRITE_TAC[INT_OF_NUM_ADD];
52326   CONJ_TAC;
52327   TYPE_THEN `&:0 <=: &:x` SUBAGOAL_TAC;
52328   REWRITE_TAC[INT_OF_NUM_LE];
52329   ARITH_TAC;
52330   UNDH 163 THEN ARITH_TAC;
52331   UNDH 1710 THEN ARITH_TAC;
52332   (* -A *)
52333   THM_INTRO_TAC[`x`] INT_REP;
52334   TYPE_THEN `x` UNABBREV_TAC;
52335   TYPE_THEN `(n'' + m) -| (m'' + n)` EXISTS_TAC;
52336   TYPE_THEN `&:n'' + &:m' <=: &:n' + &:m''` SUBAGOAL_TAC;
52337   UNDH 4837 THEN INT_ARITH_TAC;
52338   KILLH 4837;
52339   TYPE_THEN `&:m'' + &:n <=: &:n'' + &:m` SUBAGOAL_TAC;
52340   UNDH 9532 THEN INT_ARITH_TAC;
52341   KILLH 9532;
52342   KILLH 6818;
52343   (* - *)
52344   CONJ_TAC;
52345   FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE];
52346   UNDH 8565 THEN UNDH 9575 THEN ARITH_TAC;
52347   (* - *)
52348   FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE];
52349   ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB];
52350   FULL_REWRITE_TAC[GSYM INT_OF_NUM_ADD];
52351   FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE;GSYM INT_OF_NUM_ADD ];
52352   UNDH 4630 THEN UNDH 1357 THEN INT_ARITH_TAC;
52353   ]);;
52354   (* }}} *)
52355
52356 let subs_lemma = prove_by_refinement(
52357   `!y (f:A->bool). (f y) ==> (!x. (x = y) ==> f x)`,
52358   (* {{{ proof *)
52359   [
52360   REP_BASIC_TAC;
52361   TYPE_THEN `x` UNABBREV_TAC;
52362   ]);;
52363   (* }}} *)
52364
52365 (*** JRH changed the labels here because somehow
52366      some beta-redexes get contracted that did not before,
52367      (new IN_ELIM_THM?) and this changes the set comprehensions
52368
52369 let int2_range_finite = prove_by_refinement(
52370   `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\
52371                           c <=: SND m /\ SND m <=: d}`,
52372   (* {{{ proof *)
52373   [
52374   REP_BASIC_TAC;
52375   THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT;
52376   REWRITE_TAC[int_range_finite];
52377   USEH 3506 (MATCH_MP subs_lemma);
52378   FIRST_ASSUM IMATCH_MP_TAC ;
52379   IMATCH_MP_TAC  EQ_EXT;
52380   KILLH 8899;
52381   IMATCH_MP_TAC  EQ_ANTISYM;
52382   CONJ_TAC;
52383   NAME_CONFLICT_TAC;
52384   CONV_TAC (dropq_conv "t'");
52385   CONV_TAC (dropq_conv "u'");
52386   REWRITE_TAC[PAIR_SPLIT];
52387   ASM_MESON_TAC[];
52388   ASM_REWRITE_TAC[];
52389   ]);;
52390   (* }}} *)
52391
52392  ****)
52393
52394 let int2_range_finite = prove_by_refinement(
52395   `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\
52396                           c <=: SND m /\ SND m <=: d}`,
52397   (* {{{ proof *)
52398   [
52399   REP_BASIC_TAC;
52400   THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT;
52401   REWRITE_TAC[int_range_finite];
52402   USEH 4853 (MATCH_MP subs_lemma);
52403   FIRST_ASSUM IMATCH_MP_TAC ;
52404   IMATCH_MP_TAC  EQ_EXT;
52405   KILLH 4636;
52406   IMATCH_MP_TAC  EQ_ANTISYM;
52407   CONJ_TAC;
52408   NAME_CONFLICT_TAC;
52409   CONV_TAC (dropq_conv "t'");
52410   CONV_TAC (dropq_conv "u'");
52411   REWRITE_TAC[PAIR_SPLIT];
52412   ASM_MESON_TAC[];
52413   ASM_REWRITE_TAC[];
52414   ]);;
52415   (* }}} *)
52416
52417
52418 let grid33_finite = prove_by_refinement(
52419   `!p. FINITE (grid33 p)`,
52420   (* {{{ proof *)
52421   [
52422   REWRITE_TAC[grid33_unions];
52423   REWRITE_TAC[FINITE_UNION];
52424   CONJ_TAC THEN (IMATCH_MP_TAC  FINITE_IMAGE) THEN (REWRITE_TAC[int2_range_finite]);
52425   ]);;
52426   (* }}} *)
52427
52428 let d_euclid_bound2 = prove_by_refinement(
52429   `!x y eps. euclid 2 x /\ euclid 2 y /\ (abs  (x 0 - y 0) <= eps) /\
52430     (abs  (x 1 - y 1) <= eps) ==> (d_euclid x y <= sqrt(&2) * eps)`,
52431   (* {{{ proof *)
52432   [
52433   REP_BASIC_TAC;
52434   IMATCH_MP_TAC  D_EUCLID_BOUND;
52435   REP_BASIC_TAC;
52436   TYPE_THEN `(i=0) \/ (i = 1) \/ (2 <= i)` SUBAGOAL_TAC;
52437   ARITH_TAC;
52438   UNDH 2744 THEN REP_CASES_TAC;
52439   TYPE_THEN `i` UNABBREV_TAC;
52440   TYPE_THEN `i` UNABBREV_TAC;
52441   FULL_REWRITE_TAC[euclid];
52442   UND 0 THEN REAL_ARITH_TAC;
52443   ]);;
52444   (* }}} *)
52445
52446 let grid33_radius = prove_by_refinement(
52447   `!x y. (euclid 2 x) /\
52448   (UNIONS (curve_cell (grid33 (floor (x 0),floor (x 1)))) y) ==>
52449         (d_euclid x y < &4 )`,
52450   (* {{{ proof *)
52451   [
52452   REP_BASIC_TAC;
52453   TYPE_THEN `m = (floor (x 0),floor (x 1))` ABBREV_TAC  ;
52454   THM_INTRO_TAC[`grid33 m`] (GSYM curve_closure_ver2);
52455   REWRITE_TAC[grid33_edge;grid33_finite];
52456   REWRH 2056;
52457   KILLH 7690;
52458   TYPE_THEN `(UNIONS (grid33 m)) SUBSET  closed_ball (euclid 2,d_euclid) x (&3) ` BACK_TAC;
52459   THM_INTRO_TAC[`top2`;`UNIONS(grid33 m)`;`closed_ball (euclid 2,d_euclid) x (&3)`;] closure_subset;
52460   REWRITE_TAC [top2_top;];
52461   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`&3 `]closed_ball_closed;
52462   FULL_REWRITE_TAC[GSYM top2];
52463   KILLH 1468;
52464   FULL_REWRITE_TAC[SUBSET;closed_ball];
52465   TSPECH `y` 8043;
52466   FULL_REWRITE_TAC[];
52467   UNDH 9621 THEN REAL_ARITH_TAC;
52468   (* -A *)
52469   KILLH 920;
52470   FULL_REWRITE_TAC [grid33_unions];
52471   REWRITE_TAC[UNIONS_UNION;union_subset];
52472   (* - *)
52473   TYPE_THEN `sqrt (&2) * (&2) <= (&3)` SUBAGOAL_TAC;
52474   IMATCH_MP_TAC  REAL_POW_2_LE;
52475   REWRITE_TAC[REAL_POW_MUL];
52476   CONJ_TAC;
52477   IMATCH_MP_TAC  REAL_LE_MUL;
52478   IMATCH_MP_TAC  SQRT_POS_LE;
52479   TYPE_THEN `sqrt(&2) pow 2 = &2` SUBAGOAL_TAC;
52480   IMATCH_MP_TAC  SQRT_POW_2;
52481   REWRITE_TAC[REAL_POW_2];
52482   REAL_ARITH_TAC;
52483   (* - *)
52484   CONJ_TAC;
52485   FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball];
52486   TYPE_THEN `u` UNABBREV_TAC;
52487   SUBCONJ_TAC;
52488   ASM_MESON_TAC[h_edge_euclid;subset_imp];
52489   IMATCH_MP_TAC  REAL_LE_TRANS;
52490   TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC;
52491   IMATCH_MP_TAC d_euclid_bound2;
52492   FULL_REWRITE_TAC[h_edge];
52493   REWRITE_TAC[coord01];
52494   TYPE_THEN `v` UNABBREV_TAC;
52495   TYPE_THEN `x'` UNABBREV_TAC;
52496   TYPE_THEN `m` UNABBREV_TAC;
52497   THM_INTRO_TAC[`x 0`] floor_ineq;
52498   THM_INTRO_TAC[`x 1`] floor_ineq;
52499   FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le];
52500   POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC;
52501   (* - *)
52502   FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball];
52503   TYPE_THEN `u` UNABBREV_TAC;
52504   SUBCONJ_TAC;
52505   ASM_MESON_TAC[v_edge_euclid;subset_imp];
52506   IMATCH_MP_TAC  REAL_LE_TRANS;
52507   TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC;
52508   IMATCH_MP_TAC d_euclid_bound2;
52509   FULL_REWRITE_TAC[v_edge];
52510   REWRITE_TAC[coord01];
52511   TYPE_THEN `u` UNABBREV_TAC;
52512   TYPE_THEN `x'` UNABBREV_TAC;
52513   TYPE_THEN `m` UNABBREV_TAC;
52514   THM_INTRO_TAC[`x 0`] floor_ineq;
52515   THM_INTRO_TAC[`x 1`] floor_ineq;
52516   FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le];
52517   POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC;
52518   (* Thu Dec 30 21:22:53 EST 2004 *)
52519
52520   ]);;
52521   (* }}} *)
52522
52523 let simple_arc_grid_properties = prove_by_refinement(
52524   `!C a b. simple_arc_end C a b ==> (?E.
52525       E SUBSET edge /\
52526       (C INTER (unbounded_set E) = EMPTY) /\
52527       conn2 E /\
52528       E (h_edge (floor (a 0),floor (a 1))) /\
52529       E (h_edge (floor (b 0),floor (b 1))) /\
52530      (!y. UNIONS (curve_cell E) y ==> (?x. C x /\ d_euclid x y < &4)))`,
52531   (* {{{ proof *)
52532
52533   [
52534   REP_BASIC_TAC;
52535   COPYH 2895;
52536   USEH 2895 (REWRITE_RULE [simple_arc_end]);
52537   THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
52538   FULL_REWRITE_TAC[uniformly_continuous];
52539   (* - *)
52540   TYPE_THEN `!N' x. (&0 < &N') ==> ((&0 <= x/ &N') <=> (&0 <= x))` SUBAGOAL_TAC;
52541   THM_INTRO_TAC[`&N'`;`&0`;`x`] real_div_denom;
52542   FULL_REWRITE_TAC[REAL_DIV_LZERO];
52543   (* - *)
52544   TYPE_THEN `!N' x. (&0 < &N') ==> ((x/ &N' <= &1) <=> (x <= &N'))` SUBAGOAL_TAC;
52545   ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
52546   REDUCE_TAC;
52547   (* - *)
52548   TYPE_THEN `?N. (!i N'. (N <= N') /\ (i <| N') ==> d_euclid (f (&i / &N')) (f (&(SUC i) / &N')) < &1)` SUBAGOAL_TAC;
52549   TSPECH `&1` 814;
52550   FULL_REWRITE_TAC[REAL_ARITH `&0 < &1`];
52551   THM_INTRO_TAC[`delta`] delta_pos_arch;
52552   TYPE_THEN `n` EXISTS_TAC;
52553   FIRST_ASSUM IMATCH_MP_TAC ;
52554   FULL_REWRITE_TAC[GSYM REAL_LT];
52555   FULL_REWRITE_TAC[REAL_LE;REAL_LT;d_real];
52556   (* -- *)
52557   TYPE_THEN `0 <| N'` SUBAGOAL_TAC;
52558   UNDH 800 THEN UNDH 3476 THEN ARITH_TAC;
52559   (* -- *)
52560   FULL_REWRITE_TAC[REAL_LE;REAL_LT;];
52561   CONJ_TAC;
52562   UNDH 9580 THEN ARITH_TAC;
52563   CONJ_TAC;
52564   UNDH 9580 THEN ARITH_TAC;
52565   REWRITE_TAC[suc_div];
52566   REWRITE_TAC[REAL_ARITH `abs  (x - (x + y)) = abs  y`];
52567   REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
52568   IMATCH_MP_TAC  REAL_LET_TRANS;
52569   TYPE_THEN `&1/ &n`EXISTS_TAC;
52570   FULL_REWRITE_TAC[GSYM REAL_LT];
52571   ASM_SIMP_TAC[RAT_LEMMA4];
52572   REDUCE_TAC;
52573   (* -A *)
52574   THM_INTRO_TAC[`f`] grid_image_bounded_ver2;
52575   TYPE_THEN `n = N +| M` ABBREV_TAC  ;
52576   TYPE_THEN`E = grid f n` ABBREV_TAC ;
52577   TYPE_THEN `E` EXISTS_TAC;
52578   TYPE_THEN `0 <| n /\ M <= n /\ N <= n` SUBAGOAL_TAC;
52579   RIGHTH 8917 "N";
52580   UNDH 8208 THEN UNDH 4600 THEN ARITH_TAC;
52581   (* - *)
52582   SUBCONJ_TAC;
52583   TYPE_THEN `E` UNABBREV_TAC;
52584   REWRITE_TAC [  grid_edge];
52585   (* - *)
52586   SUBCONJ_TAC;
52587   TSPECH `n` 8917;
52588   TYPE_THEN `E` UNABBREV_TAC;
52589   (* - *)
52590   SUBCONJ_TAC;
52591   TYPE_THEN `E` UNABBREV_TAC;
52592   IMATCH_MP_TAC  grid_conn2;
52593   CONJ_TAC;
52594   IMATCH_MP_TAC  inj_image_subset;
52595   (* -- *)
52596   FIRST_ASSUM IMATCH_MP_TAC ;
52597   (* -B *)
52598   CONJ_TAC;
52599   TYPE_THEN `E` UNABBREV_TAC;
52600   REWRITE_TAC[grid];
52601   TYPE_THEN `a` UNABBREV_TAC;
52602   REWRITE_TAC[IMAGE;UNIONS];
52603   CONV_TAC (dropq_conv "u");
52604   TYPE_THEN `0` EXISTS_TAC;
52605   CONJ_TAC;
52606   UNDH 3476 THEN ARITH_TAC;
52607   REWRITE_TAC[REAL_DIV_LZERO;grid33_h];
52608   (* - *)
52609   CONJ_TAC;
52610   TYPE_THEN `E` UNABBREV_TAC;
52611   REWRITE_TAC[grid];
52612   TYPE_THEN `b` UNABBREV_TAC;
52613   REWRITE_TAC[IMAGE;UNIONS];
52614   CONV_TAC (dropq_conv "u");
52615   TYPE_THEN `n` EXISTS_TAC;
52616   CONJ_TAC;
52617   ARITH_TAC;
52618   USEH 3476 (REWRITE_RULE [GSYM REAL_LT]);
52619   USEH 1089 (MATCH_MP (REAL_ARITH `&0 < y ==> ~(y = &0)`));
52620   ASM_SIMP_TAC[REAL_DIV_REFL];
52621   REWRITE_TAC[grid33_h];
52622   (* -C *)
52623   TYPE_THEN `E` UNABBREV_TAC;
52624   USEH 2127 (REWRITE_RULE[curve_cell_grid_unions]);
52625   USEH 957 (REWRITE_RULE[IMAGE;UNIONS]);
52626   TYPE_THEN `x` UNABBREV_TAC;
52627   TYPE_THEN `u'` UNABBREV_TAC;
52628   TYPE_THEN `f ( &x' / &n )` EXISTS_TAC;
52629   SUBCONJ_TAC;
52630   IMATCH_MP_TAC image_imp ;
52631   FULL_REWRITE_TAC[GSYM REAL_LT];
52632   FULL_REWRITE_TAC[REAL_LE;REAL_LT ];
52633   ARITH_TAC;
52634   (* - *)
52635   IMATCH_MP_TAC  grid33_radius;
52636   CONJ_TAC;
52637   USEH 2083 (REWRITE_RULE[IMAGE]);
52638   USEH 7215 (REWRITE_RULE[INJ]);
52639   FIRST_ASSUM IMATCH_MP_TAC ;
52640   (* - *)
52641   REWRITE_TAC[UNIONS];
52642   UNIFY_EXISTS_TAC;
52643   (* Thu Dec 30 21:27:32 EST 2004 *)
52644   ]);;
52645
52646   (* }}} *)
52647
52648 let unbounded_set_lemma = prove_by_refinement(
52649   `!E p. (FINITE E /\ E SUBSET edge) ==>
52650      (unbounded_set E p <=> (?r. !s. (r <= s) ==>
52651           (?C. simple_arc_end C p (point(s,&0)) /\
52652               (C INTER UNIONS (curve_cell E) = EMPTY))))`,
52653   (* {{{ proof *)
52654   [
52655   REP_BASIC_TAC;
52656   IMATCH_MP_TAC  EQ_ANTISYM;
52657   CONJ_TAC;
52658   THM_INTRO_TAC[`E`;`p`] unbounded_euclid;
52659   USEH 7802 (MATCH_MP point_onto);
52660   TYPE_THEN `p` UNABBREV_TAC;
52661   (* -- *)
52662   FULL_REWRITE_TAC[unbounded_set;unbounded];
52663   TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ;
52664   TYPE_THEN `r'` EXISTS_TAC;
52665   THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc;
52666   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
52667   THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
52668   TYPE_THEN `s` UNABBREV_TAC;
52669   TYPE_THEN `r'` UNABBREV_TAC;
52670   UNDH 5363 THEN UNDH 4629 THEN REAL_ARITH_TAC;
52671   USEH 3140 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
52672   FIRST_ASSUM IMATCH_MP_TAC ;
52673     THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
52674   UNDH 1263 THEN UNDH 5669 THEN UNDH 6232 THEN REAL_ARITH_TAC;
52675   (* - *)
52676   REWRITE_TAC[unbounded_set;unbounded];
52677   TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
52678   TSPECH `r` 3171;
52679   FULL_REWRITE_TAC[REAL_ARITH `r <= r`];
52680   COPYH 3604;
52681   USEH 3604 (MATCH_MP simple_arc_end_end);
52682   USEH 3604 (MATCH_MP simple_arc_end_simple);
52683   USEH 3550 (MATCH_MP simple_arc_euclid);
52684   ASM_MESON_TAC[subset_imp];
52685   USEH 7802 (MATCH_MP point_onto);
52686   TYPE_THEN `p` UNABBREV_TAC;
52687   (* - *)
52688   TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ;
52689   TYPE_THEN `r'` EXISTS_TAC;
52690   THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc;
52691   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
52692   THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
52693   UNDH 5363 THEN UNDH 6232 THEN UNDH 5669 THEN UNDH 9420 THEN REAL_ARITH_TAC;
52694   FIRST_ASSUM IMATCH_MP_TAC ;
52695   TYPE_THEN `r'` UNABBREV_TAC;
52696   THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
52697   UNDH 1263 THEN UNDH 540 THEN REAL_ARITH_TAC;
52698   (* Fri Dec 31 07:35:03 EST 2004 *)
52699
52700   ]);;
52701   (* }}} *)
52702
52703 let simple_arc_end_subset_trans_lemma = prove_by_refinement(
52704   `!C a b c. simple_arc_end C a b /\ C c /\ ~(c = a) ==>
52705     (?C'. C' SUBSET C /\ simple_arc_end C' a c)`,
52706   (* {{{ proof *)
52707   [
52708   REP_BASIC_TAC;
52709   TYPE_THEN `b = c` ASM_CASES_TAC;
52710   TYPE_THEN `b` UNABBREV_TAC;
52711   TYPE_THEN `C` EXISTS_TAC;
52712   REWRITE_TAC[SUBSET_REFL];
52713   THM_INTRO_TAC[`C`;`a`;`b`;`c`] simple_arc_end_cut;
52714   TYPE_THEN `C'` EXISTS_TAC;
52715   TYPE_THEN `C` UNABBREV_TAC;
52716   REWRITE_TAC[SUBSET;UNION];
52717   ]);;
52718   (* }}} *)
52719
52720 let simple_arc_end_subset_trans = prove_by_refinement(
52721   `!C C' a b c. simple_arc_end C a b /\ simple_arc_end C' b c /\
52722     ~(a = c) ==>
52723     (?U. simple_arc_end U a c /\ U SUBSET (C UNION C'))`,
52724   (* {{{ proof *)
52725   [
52726   REP_BASIC_TAC;
52727   TYPE_THEN `C' a` ASM_CASES_TAC;
52728   THM_INTRO_TAC[`C'`;`c`;`b`;`a`] simple_arc_end_subset_trans_lemma;
52729   IMATCH_MP_TAC  simple_arc_end_symm;
52730   TYPE_THEN `C''` EXISTS_TAC;
52731   CONJ_TAC;
52732   IMATCH_MP_TAC  simple_arc_end_symm;
52733   IMATCH_MP_TAC  SUBSET_TRANS;
52734   UNIFY_EXISTS_TAC;
52735   REWRITE_TAC[SUBSET;UNION];
52736   (* - *)
52737   THM_INTRO_TAC[`C`;`{a}`;`C'`] simple_arc_end_restriction;
52738   CONJ_TAC;
52739   USEH 2895 (MATCH_MP simple_arc_end_simple);
52740   CONJ_TAC;
52741   USEH 2895 (MATCH_MP simple_arc_end_end_closed);
52742   CONJ_TAC;
52743   USEH 3594 (MATCH_MP simple_arc_end_closed);
52744   CONJ_TAC;
52745   PROOF_BY_CONTR_TAC;
52746   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ];
52747   TYPE_THEN `u` UNABBREV_TAC;
52748   ASM_MESON_TAC[];
52749   CONJ_TAC THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
52750   TYPE_THEN `a` EXISTS_TAC;
52751   USEH 2895 (MATCH_MP simple_arc_end_end);
52752   TYPE_THEN `b` EXISTS_TAC;
52753   USEH 2895 (MATCH_MP simple_arc_end_end2);
52754   USEH 3594 (MATCH_MP simple_arc_end_end);
52755   (* - *)
52756   TYPE_THEN `v = a` SUBAGOAL_TAC;
52757   USEH 6975 (REWRITE_RULE[eq_sing]);
52758   USEH 8361 (REWRITE_RULE[INTER;INR IN_SING]);
52759   TYPE_THEN `v` UNABBREV_TAC;
52760   (* - *)
52761   TYPE_THEN `v' = c` ASM_CASES_TAC;
52762   TYPE_THEN `v'` UNABBREV_TAC;
52763   TYPE_THEN `C''` EXISTS_TAC;
52764   FULL_REWRITE_TAC[SUBSET;UNION];
52765   (* - *)
52766   THM_INTRO_TAC[`C'`;`c`;`b`;`v'`] simple_arc_end_subset_trans_lemma;
52767   CONJ_TAC;
52768   IMATCH_MP_TAC  simple_arc_end_symm;
52769   USEH 9287 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
52770   USEH 6723 (MATCH_MP simple_arc_end_symm);
52771   THM_INTRO_TAC[`C''`;`C'''`;`a`;`v'`;`c`] simple_arc_end_trans;
52772   IMATCH_MP_TAC  EQ_EXT;
52773   REWRITE_TAC[INTER];
52774   IMATCH_MP_TAC  EQ_ANTISYM;
52775   CONJ_TAC;
52776   FULL_REWRITE_TAC[INTER;eq_sing;INR IN_SING;SUBSET];
52777   ASM_MESON_TAC[];
52778   (* -- *)
52779   CONJ_TAC;
52780   USEH 3266 (MATCH_MP simple_arc_end_end2);
52781   USEH 2088 (MATCH_MP simple_arc_end_end);
52782   TYPE_THEN `C'' UNION C'''` EXISTS_TAC;
52783   FULL_REWRITE_TAC[SUBSET;UNION];
52784   FIRST_ASSUM DISJ_CASES_TAC;
52785   (* Fri Dec 31 08:49:20 EST 2004 *)
52786
52787   ]);;
52788   (* }}} *)
52789
52790 let unbounded_set_trans_lemma = prove_by_refinement(
52791   `!E p q x r. FINITE E /\ E SUBSET edge /\
52792      (unbounded_set E p) /\
52793      (UNIONS E SUBSET (closed_ball(euclid 2,d_euclid) x r)) /\
52794      (?C. simple_arc_end C p q /\
52795          (C INTER closed_ball(euclid 2,d_euclid) x r = EMPTY)) ==>
52796    (unbounded_set E q)`,
52797   (* {{{ proof *)
52798   [
52799   REP_BASIC_TAC;
52800   TYPE_THEN `closure top2 (UNIONS E) SUBSET (closed_ball (euclid 2,d_euclid) x r)` SUBAGOAL_TAC;
52801   IMATCH_MP_TAC  closure_subset;
52802   REWRITE_TAC[top2_top];
52803   REWRITE_TAC[top2];
52804   IMATCH_MP_TAC  closed_ball_closed;
52805   (* - *)
52806   THM_INTRO_TAC[`E`] curve_closure_ver2;
52807   REWRH 5238;
52808   KILLH 3085;
52809   KILLH 5161;
52810   (* - *)
52811   TYPE_THEN `C INTER UNIONS (curve_cell E) = EMPTY` SUBAGOAL_TAC;
52812   PROOF_BY_CONTR_TAC;
52813   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
52814   FULL_REWRITE_TAC[EQ_EMPTY ];
52815   TSPECH `u` 5342;
52816   FULL_REWRITE_TAC[SUBSET];
52817   ASM_MESON_TAC[];
52818   (* - *)
52819   UNDH 2166 THEN ASM_SIMP_TAC [unbounded_set_lemma];
52820   TYPE_THEN `euclid 2 q` SUBAGOAL_TAC;
52821   COPYH 5276;
52822   USEH 5276 (MATCH_MP simple_arc_end_simple);
52823   USEH 5276 (MATCH_MP simple_arc_end_end2);
52824   USEH 3550 (MATCH_MP simple_arc_euclid);
52825   ASM_MESON_TAC[subset_imp];
52826   USEH 877 (MATCH_MP point_onto);
52827   TYPE_THEN `q` UNABBREV_TAC;
52828   (* - *)
52829   TYPE_THEN `r'' = max_real r' (FST p' + &1)` ABBREV_TAC ;
52830   TYPE_THEN `r''` EXISTS_TAC;
52831   TSPECH `s` 5976;
52832   (* - *)
52833   TYPE_THEN `r' <= s` SUBAGOAL_TAC;
52834   TYPE_THEN `r''` UNABBREV_TAC;
52835   THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le;
52836   UNDH 6140 THEN UNDH 3019 THEN REAL_ARITH_TAC;
52837   REP_BASIC_TAC;
52838   USEH 9110 (MATCH_MP simple_arc_end_symm);
52839   (* - *)
52840   TYPE_THEN `~(point p' = point (s,&0))` SUBAGOAL_TAC;
52841   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
52842   TYPE_THEN `s` UNABBREV_TAC;
52843   TYPE_THEN `r''` UNABBREV_TAC;
52844   THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le;
52845   UNDH 9809 THEN UNDH 7108 THEN REAL_ARITH_TAC;
52846   THM_INTRO_TAC[`C`;`C'`;`point p'`;`p`;`(point(s,&0))`] simple_arc_end_subset_trans;
52847   TYPE_THEN `U` EXISTS_TAC;
52848   PROOF_BY_CONTR_TAC;
52849   FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
52850   FULL_REWRITE_TAC[SUBSET;UNION;EQ_EMPTY];
52851   ASM_MESON_TAC[];
52852   (* Fri Dec 31 09:05:35 EST 2004 *)
52853
52854   ]);;
52855   (* }}} *)
52856
52857 let unbounded_set_empty = prove_by_refinement(
52858   `(unbounded_set EMPTY = euclid 2)`,
52859   (* {{{ proof *)
52860   [
52861   THM_INTRO_TAC[`EMPTY:((num->real)->bool)->bool`] unbound_set_x_axis;
52862   REWRITE_TAC[FINITE_RULES];
52863   TSPECH `r` 9109;
52864   FULL_REWRITE_TAC[REAL_ARITH `r <= r`];
52865   IMATCH_MP_TAC  EQ_EXT;
52866   IMATCH_MP_TAC  EQ_ANTISYM;
52867   CONJ_TAC;
52868   IMATCH_MP_TAC  unbounded_euclid;
52869   UNIFY_EXISTS_TAC;
52870   (* - *)
52871   TYPE_THEN `x = (point(r,&0))` ASM_CASES_TAC;
52872   ASM_REWRITE_TAC[];
52873   (* - *)
52874   IMATCH_MP_TAC  unbounded_set_trans_lemma;
52875   REWRITE_TAC[FINITE_RULES];
52876   TYPE_THEN `point(r,&0)` EXISTS_TAC;
52877   TYPE_THEN `point(&0,&0)` EXISTS_TAC;
52878   TYPE_THEN `-- &1` EXISTS_TAC;
52879   (* - *)
52880   THM_INTRO_TAC[`2`;`point(&0,&0)`;`-- &1`] closed_ball_empty;
52881   REAL_ARITH_TAC;
52882   TYPE_THEN `mk_segment (point (r,&0)) x` EXISTS_TAC;
52883   CONJ_TAC;
52884   IMATCH_MP_TAC  mk_segment_simple_arc_end;
52885   REWRITE_TAC[INTER_EMPTY];
52886   (* Fri Dec 31 09:37:30 EST 2004 *)
52887
52888   ]);;
52889   (* }}} *)
52890
52891 let continuous_real_const = prove_by_refinement(
52892   `!r. continuous (\t. r) (top_of_metric (UNIV,d_real))
52893  (top_of_metric (UNIV,d_real))`,
52894   (* {{{ proof *)
52895   [
52896   REWRITE_TAC[continuous;preimage];
52897   TYPE_THEN `v r` ASM_CASES_TAC;
52898   TYPE_THEN `{x | UNIONS (top_of_metric (UNIV,d_real)) x} = UNIONS (top_of_metric(UNIV,d_real))` SUBAGOAL_TAC;
52899   IMATCH_MP_TAC  EQ_EXT;
52900   IMATCH_MP_TAC  top_univ;
52901   IMATCH_MP_TAC  top_of_metric_top;
52902   REWRITE_TAC[metric_real];
52903 (**** Modified by JRH to avoid GSPEC
52904   REWRITE_TAC[GSYM EMPTY;GSPEC;top_of_metric_empty ];
52905  ****)
52906   (let lemma = prove(`{x | F} = {}`,
52907                      REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]) in
52908    REWRITE_TAC[lemma; top_of_metric_empty])
52909   (* Fri Dec 31 10:30:48 EST 2004 *)
52910
52911   ]);;
52912   (* }}} *)
52913
52914 let continuous_real_mul = prove_by_refinement(
52915   `!r. (&0 < r) ==> continuous (( *. ) r)
52916   (top_of_metric (UNIV,d_real))
52917  (top_of_metric (UNIV,d_real)) `,
52918   (* {{{ proof *)
52919   [
52920   REP_BASIC_TAC;
52921   THM_INTRO_TAC[`( *. ) r`;`UNIV:real->bool`;`UNIV:real->bool`;`d_real`;`d_real`;] metric_continuous_continuous;
52922   REWRITE_TAC[metric_real];
52923   REWRITE_TAC[metric_continuous;metric_continuous_pt];
52924   FULL_REWRITE_TAC[d_real];
52925   TYPE_THEN `epsilon/r` EXISTS_TAC;
52926   SUBCONJ_TAC;
52927   IMATCH_MP_TAC  REAL_LT_DIV;
52928   UNDH 5576 THEN (ASM_SIMP_TAC[REAL_LT_RDIV_EQ]);
52929   ASM_SIMP_TAC[REAL_ARITH `r * x - r *y = r*. (x - y)`;ABS_MUL ];
52930   UNDH 7175 THEN UNDH 6412 THEN REAL_ARITH_TAC;
52931   ]);;
52932   (* }}} *)
52933
52934 let polar_curve_lemma = prove_by_refinement(
52935   `!x theta r. euclid 2 x /\ &0 < theta /\ theta < &2 * pi /\ &0 < r ==>
52936    (?C.
52937     simple_arc_end C (x + point(r,&0)) (x + r *# (cis theta)) /\
52938     !y. C y ==> (d_euclid x y = r))`,
52939   (* {{{ proof *)
52940   [
52941   REP_BASIC_TAC;
52942   TYPE_THEN `f = (\ (t:real) . r) ` ABBREV_TAC  ;
52943   TYPE_THEN `g = ( *. ) theta` ABBREV_TAC ;
52944   THM_INTRO_TAC[`x`;`f`;`g`] polar_cont;
52945   TYPE_THEN `f` UNABBREV_TAC;
52946   TYPE_THEN `g` UNABBREV_TAC;
52947   ASM_SIMP_TAC [continuous_real_const;continuous_real_mul];
52948   TYPE_THEN `G = (\t. euclid_plus x (f t *# cis (g t))) ` ABBREV_TAC ;
52949   TYPE_THEN `C = IMAGE G {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
52950   TYPE_THEN `C` EXISTS_TAC;
52951   REWRITE_TAC[simple_arc_end];
52952   SUBCONJ_TAC;
52953   TYPE_THEN `G` EXISTS_TAC;
52954   (* -- *)
52955   TYPE_THEN `G (&0) = euclid_plus x (point (r,&0)) ` SUBAGOAL_TAC;
52956   TYPE_THEN `G` UNABBREV_TAC;
52957   AP_TERM_TAC;
52958   TYPE_THEN `f` UNABBREV_TAC;
52959   TYPE_THEN `g` UNABBREV_TAC;
52960   REDUCE_TAC;
52961   REWRITE_TAC[cis];
52962   REWRITE_TAC[point_scale;COS_0;SIN_0];
52963   REDUCE_TAC;
52964   (* -- *)
52965   TYPE_THEN `G (&1) = euclid_plus x (r *# cis theta)` SUBAGOAL_TAC;
52966   TYPE_THEN `G` UNABBREV_TAC;
52967   AP_TERM_TAC;
52968   TYPE_THEN `f` UNABBREV_TAC;
52969   TYPE_THEN `g` UNABBREV_TAC;
52970   REDUCE_TAC;
52971   (* -- *)
52972   TYPE_THEN `G` UNABBREV_TAC;
52973   REWRITE_TAC[INJ];
52974   CONJ_TAC;
52975   IMATCH_MP_TAC  euclid_add_closure;
52976   REWRITE_TAC[polar_euclid];
52977   (* -- *)
52978   FULL_REWRITE_TAC[euclid_add_cancel];
52979   TYPE_THEN `f` UNABBREV_TAC;
52980   THM_INTRO_TAC[`g x'`;`g y`;`r`;`r`] polar_inj;
52981   TYPE_THEN `g` UNABBREV_TAC;
52982   ASSUME_TAC (REAL_ARITH `&0 < r ==> &0 <= r`);
52983   TYPE_THEN `!x. &0 <= x ==> &0 <= theta* x` SUBAGOAL_TAC;
52984   IMATCH_MP_TAC  REAL_LE_MUL;
52985   UNDH 2540 THEN REAL_ARITH_TAC;
52986   TYPE_THEN `!x. (x <= &1) ==> (theta* x < &2 * pi)` SUBAGOAL_TAC;
52987   IMATCH_MP_TAC  REAL_LET_TRANS;
52988   TYPE_THEN `theta* &1` EXISTS_TAC;
52989   CONJ_TAC;
52990   IMATCH_MP_TAC  REAL_LE_LMUL;
52991   UNDH 2540 THEN REAL_ARITH_TAC;
52992   REDUCE_TAC;
52993   FIRST_ASSUM DISJ_CASES_TAC;
52994   TYPE_THEN `r` UNABBREV_TAC;
52995   UNDH 869 THEN REAL_ARITH_TAC;
52996   TYPE_THEN `g` UNABBREV_TAC;
52997   FULL_REWRITE_TAC[REAL_EQ_MUL_LCANCEL];
52998   FIRST_ASSUM DISJ_CASES_TAC;
52999   TYPE_THEN `theta` UNABBREV_TAC;
53000   UNDH 869 THEN REAL_ARITH_TAC;
53001   (* -A *)
53002   TYPE_THEN `C` UNABBREV_TAC;
53003   TYPE_THEN `G` UNABBREV_TAC;
53004   USEH 1547 (REWRITE_RULE[IMAGE]);
53005   TYPE_THEN `f` UNABBREV_TAC;
53006   TYPE_THEN `g` UNABBREV_TAC;
53007   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;
53008   AP_THM_TAC;
53009   AP_TERM_TAC;
53010   REWRITE_TAC[euclid_scale0;euclid_rzero];
53011   THM_INTRO_TAC[`2`;`(&0 *# cis (theta * x'))`;`(r *# cis (theta * x'))`;`x`]  metric_translate_LEFT;
53012   REWRITE_TAC[polar_euclid];
53013   REWRITE_TAC[d_euclid_eq_arg];
53014   UNDH 6412 THEN REAL_ARITH_TAC;
53015   (* Fri Dec 31 11:25:13 EST 2004 *)
53016
53017   ]);;
53018   (* }}} *)
53019
53020 let unbounded_set_ball = prove_by_refinement(
53021   `!E x r p.  (&0 < r) /\
53022         FINITE E /\ E SUBSET edge /\ (euclid 2 p) /\
53023         UNIONS E SUBSET (closed_ball (euclid 2,d_euclid) x r) /\
53024         ~(closed_ball (euclid 2,d_euclid) x r p) ==>
53025       unbounded_set E p`,
53026   (* {{{ proof *)
53027
53028   [
53029   REP_BASIC_TAC;
53030   THM_INTRO_TAC[`E`] unbound_set_x_axis;
53031   (* - *)
53032   TYPE_THEN `E = EMPTY` ASM_CASES_TAC;
53033   FULL_REWRITE_TAC[unbounded_set_empty];
53034   TYPE_THEN `UNIONS E = EMPTY` ASM_CASES_TAC;
53035   FULL_REWRITE_TAC[UNIONS_EQ_EMPTY];
53036   REWRH 7639;
53037   TYPE_THEN `E` UNABBREV_TAC;
53038   USEH 8908(REWRITE_RULE[SUBSET;INR IN_SING ]);
53039   TYPE_THEN `edge EMPTY` SUBAGOAL_TAC;
53040   USEH 1936 (MATCH_MP edge_cell);
53041   USEH 5731 (MATCH_MP cell_nonempty);
53042   ASM_MESON_TAC[];
53043   FULL_REWRITE_TAC[EMPTY_EXISTS];
53044   (* - *)
53045   TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
53046   FULL_REWRITE_TAC[SUBSET;closed_ball];
53047   TSPECH `u` 9087;
53048   USEH 1837 (MATCH_MP point_onto);
53049   TYPE_THEN `x` UNABBREV_TAC;
53050   (* -A *)
53051   TYPE_THEN `!x. (FST p' + r <  x) ==> unbounded_set E (point(x,&0))` SUBAGOAL_TAC;
53052   TYPE_THEN `r' <= x'` ASM_CASES_TAC;
53053   IMATCH_MP_TAC  unbounded_set_trans_lemma;
53054   TYPE_THEN `point(r',&0)` EXISTS_TAC;
53055   TYPE_THEN `point p'` EXISTS_TAC;
53056   TYPE_THEN `r` EXISTS_TAC;
53057   CONJ_TAC;
53058   FIRST_ASSUM IMATCH_MP_TAC ;
53059   REAL_ARITH_TAC;
53060   TYPE_THEN `mk_segment (point (r',&0)) (point(x',&0))` EXISTS_TAC;
53061   CONJ_TAC;
53062   IMATCH_MP_TAC  mk_segment_simple_arc_end;
53063   REWRITE_TAC[point_inj;PAIR_SPLIT];
53064   TYPE_THEN `x'` UNABBREV_TAC;
53065   UNDH 7236 THEN REAL_ARITH_TAC;
53066   ONCE_REWRITE_TAC[mk_segment_sym];
53067   PROOF_BY_CONTR_TAC;
53068   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
53069   THM_INTRO_TAC[`x'`;`r'`;`&0`;`u''`]mk_segment_h;
53070   UNDH 7636 THEN REAL_ARITH_TAC;
53071   REWRH 9446;
53072   TYPE_THEN `u''` UNABBREV_TAC;
53073   USEH 7067 (REWRITE_RULE[closed_ball]);
53074   THM_INTRO_TAC[`2`;`point p'`;`point(t,&0)`;`0`]proj_contraction;
53075   FULL_REWRITE_TAC[coord01];
53076   UNDH 9207 THEN UNDH 6790 THEN UNDH 9670 THEN UNDH 2823 THEN REAL_ARITH_TAC;
53077   (* -B *)
53078   KILLH 3473;
53079   KILLH 5938;
53080   KILLH 7857;
53081   (* - *)
53082   TYPE_THEN `?R theta. r < R /\ &0 <= theta /\ theta < &2 * pi /\ (p = (point p') + (R *# cis theta))` SUBAGOAL_TAC;
53083   FULL_REWRITE_TAC[closed_ball];
53084   TYPE_THEN `?q. (euclid 2 q) /\ (p = point p' + q) ` SUBAGOAL_TAC;
53085   TYPE_THEN `euclid_minus p (point p')` EXISTS_TAC;
53086   CONJ_TAC;
53087   IMATCH_MP_TAC  euclid_sub_closure;
53088   IMATCH_MP_TAC  EQ_EXT;
53089   REWRITE_TAC[euclid_plus;euclid_minus];
53090   REAL_ARITH_TAC;
53091   TYPE_THEN `p` UNABBREV_TAC;
53092   (* -- *)
53093   USEH 877 (MATCH_MP polar_exist);
53094   TYPE_THEN `q` UNABBREV_TAC;
53095   TYPE_THEN `r'` EXISTS_TAC ;
53096   TYPE_THEN `t` EXISTS_TAC;
53097   ASM_REWRITE_TAC[];
53098   PROOF_BY_CONTR_TAC;
53099   UNDH 1925 THEN ASM_REWRITE_TAC[];
53100   (* -- *)
53101   THM_INTRO_TAC[`2`;`&0 *# cis t`;`r' *# cis t`;`point p'`] metric_translate_LEFT;
53102   REWRITE_TAC[polar_euclid];
53103   TYPE_THEN `point p' + &0 *# cis t = point p'` SUBAGOAL_TAC;
53104   REWRITE_TAC[euclid_scale0;euclid_rzero];
53105   REWRH 5125;
53106   REWRITE_TAC[d_euclid_eq_arg];
53107   UNDH 3665 THEN UNDH 1444 THEN REAL_ARITH_TAC;
53108   (* -C *)
53109   TYPE_THEN `unbounded_set E (point (FST p' + R,SND p'))` SUBAGOAL_TAC;
53110   TYPE_THEN `SND p' = &0` ASM_CASES_TAC;
53111   FIRST_ASSUM IMATCH_MP_TAC ;
53112   UNDH 8204 THEN REAL_ARITH_TAC;
53113   IMATCH_MP_TAC  unbounded_set_trans_lemma;
53114   TYPE_THEN `point (FST p' +R, &0)` EXISTS_TAC;
53115   TYPE_THEN `point p'` EXISTS_TAC;
53116   TYPE_THEN `r` EXISTS_TAC;
53117   CONJ_TAC;
53118   FIRST_ASSUM IMATCH_MP_TAC ;
53119   UNDH 8204 THEN REAL_ARITH_TAC;
53120   TYPE_THEN `mk_segment (point (FST p' + R,&0)) (point(FST p' + R,SND p'))` EXISTS_TAC;
53121   CONJ_TAC;
53122   IMATCH_MP_TAC  mk_segment_simple_arc_end;
53123   REWRITE_TAC[point_inj;PAIR_SPLIT];
53124   UNDH 5038 THEN ASM_REWRITE_TAC[];
53125   (* -- *)
53126   TYPE_THEN `&0 <= SND p'` ASM_CASES_TAC;
53127   PROOF_BY_CONTR_TAC;
53128   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
53129   THM_INTRO_TAC[`&0`;`SND p'`;`FST p' + R`;`u`]mk_segment_v;
53130   REWRH 1093;
53131   TYPE_THEN `u` UNABBREV_TAC;
53132   FULL_REWRITE_TAC[closed_ball];
53133   THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction;
53134   FULL_REWRITE_TAC[coord01];
53135   UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC;
53136   (* -- *)
53137   ONCE_REWRITE_TAC[mk_segment_sym];
53138   PROOF_BY_CONTR_TAC;
53139   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
53140   THM_INTRO_TAC[`SND p'`;`&0`;`FST p' + R`;`u`]mk_segment_v;
53141   UNDH 2479 THEN REAL_ARITH_TAC;
53142   REWRH 2966;
53143   TYPE_THEN `u` UNABBREV_TAC;
53144   FULL_REWRITE_TAC[closed_ball];
53145   THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction;
53146   FULL_REWRITE_TAC[coord01];
53147   UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC;
53148   (* -D *)
53149   TYPE_THEN `theta= &0` ASM_CASES_TAC ;
53150   REWRITE_TAC[cis;COS_0;SIN_0;point_scale];
53151   TYPE_THEN `point p' + point (R * &1, R* &0) = point (FST p' + R , SND p')` SUBAGOAL_TAC;
53152   IMATCH_MP_TAC  EQ_SYM;
53153   ONCE_REWRITE_TAC[euclid_add_comm];
53154   REWRITE_TAC[euclid_cancel1];
53155   REWRITE_TAC[euclid_minus_scale;point_scale;point_add;point_inj;PAIR_SPLIT];
53156   REAL_ARITH_TAC;
53157   ASM_REWRITE_TAC[];
53158   (* - *)
53159   IMATCH_MP_TAC  unbounded_set_trans_lemma;
53160   TYPE_THEN `point (FST p' + R,SND p')` EXISTS_TAC;
53161   TYPE_THEN `point p'` EXISTS_TAC;
53162   TYPE_THEN `r` EXISTS_TAC;
53163   THM_INTRO_TAC[`point p'`;`theta`;`R`] polar_curve_lemma;
53164   UNDH 6412 THEN UNDH 8204 THEN UNDH 6162 THEN UNDH 4026 THEN REAL_ARITH_TAC;
53165   TYPE_THEN `C` EXISTS_TAC;
53166   (* - *)
53167   CONJ_TAC;
53168   TYPE_THEN `?u v. (p' = (u,v))` SUBAGOAL_TAC ;
53169   REWRITE_TAC[PAIR_SPLIT];
53170   MESON_TAC[];
53171   TYPE_THEN `p'` UNABBREV_TAC;
53172   FULL_REWRITE_TAC[point_add;REAL_ARITH `x + &0 = x`];
53173   (* - *)
53174   PROOF_BY_CONTR_TAC;
53175   FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
53176   USEH 3064 (REWRITE_RULE[closed_ball]);
53177   TSPECH `u` 5780;
53178   TYPE_THEN `R` UNABBREV_TAC;
53179   UNDH 8265 THEN UNDH 4705 THEN REAL_ARITH_TAC;
53180   (* Fri Dec 31 12:28:22 EST 2004 *)
53181
53182   ]);;
53183
53184   (* }}} *)
53185
53186 let unbounded_connect = prove_by_refinement(
53187   `!E p q. FINITE E /\ E SUBSET edge /\ ~(p = q) /\
53188     unbounded_set E p /\ unbounded_set E q ==>
53189     (?C. C SUBSET unbounded_set E /\ simple_arc_end C p q)`,
53190   (* {{{ proof *)
53191   [
53192   REP_BASIC_TAC;
53193   TYPE_THEN `(?r. !s. r <= s  ==> (?C. simple_arc_end C p (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC;
53194   ASM_MESON_TAC[unbounded_set_lemma];
53195   TYPE_THEN `(?r. !s. r <= s  ==> (?C. simple_arc_end C q (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC;
53196   ASM_MESON_TAC[unbounded_set_lemma];
53197   TYPE_THEN `r'' = max_real r r'` ABBREV_TAC ;
53198   TSPECH `r''` 4812;
53199   TSPECH `r''` 3171;
53200   THM_INTRO_TAC[`r`;`r'`] max_real_le;
53201   UNDH 4459 THEN DISCH_THEN (THM_INTRO_TAC[]);
53202   UNDH 6887 THEN UNDH 2 THEN REAL_ARITH_TAC;
53203   UNDH 5611 THEN DISCH_THEN (THM_INTRO_TAC[]);
53204   UNDH 7318 THEN UNDH 2 THEN REAL_ARITH_TAC;
53205   THM_INTRO_TAC[`C`;`C'`;`p`;`point(r'',&0)`;`q`] simple_arc_end_subset_trans;
53206   IMATCH_MP_TAC  simple_arc_end_symm;
53207   TYPE_THEN `U` EXISTS_TAC;
53208   (* - *)
53209   THM_INTRO_TAC[`E`] unbounded_set_comp;
53210   THM_INTRO_TAC[`E`;`x`] unbounded_set_comp_elt;
53211   THM_INTRO_TAC[`E`;`x`;`p`] unbounded_comp_unique;
53212   REWRITE_TAC[GSYM unbounded_set];
53213   IMATCH_MP_TAC  rectagon_curve;
53214   TYPE_THEN `q` EXISTS_TAC;
53215   (* - *)
53216   PROOF_BY_CONTR_TAC;
53217   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
53218   FULL_REWRITE_TAC[SUBSET;UNION];
53219   FULL_REWRITE_TAC[EQ_EMPTY];
53220   ASM_MESON_TAC[];
53221   (* Fri Dec 31 16:38:36 EST 2004 *)
53222
53223   ]);;
53224   (* }}} *)
53225
53226 let simple_arc_conn_complement = prove_by_refinement(
53227   `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\
53228        (euclid 2 p) /\ ~(p = q) /\
53229    (euclid 2 q) ==> (?A. simple_arc_end A p q /\ (C INTER A = EMPTY))`,
53230   (* {{{ proof *)
53231   [
53232   REP_BASIC_TAC;
53233   PROOF_BY_CONTR_TAC;
53234   THM_INTRO_TAC[`C`;`p`;`q`] euclid_scale_simple_arc_ver2;
53235   REP_BASIC_TAC;
53236   ASM_MESON_TAC[];
53237   (* - *)
53238   KILLH 907 THEN KILLH 877 THEN KILLH 7802 THEN KILLH 6497 THEN KILLH 9726 THEN KILLH 3550 THEN KILLH 11;
53239   (* - simple-arc-grid-properties *)
53240   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;
53241   RIGHT_TAC "E";
53242   TSPECH `i` 4963;
53243   USEH 9744 (MATCH_MP simple_arc_grid_properties);
53244   TYPE_THEN `E` EXISTS_TAC;
53245   LEFTH 3651 "E";
53246   (* - conn2-sequence *)
53247   THM_INTRO_TAC[`E`;`N-1`] conn2_sequence;
53248   (* -A *)
53249   TYPE_THEN `!i. (i <=| N- 1) ==> (i <| N)` SUBAGOAL_TAC;
53250   UNDH 7562 THEN UNDH 6077 THEN ARITH_TAC;
53251   TYPE_THEN `(!i. i <=| N- 1 ==> conn2 (E i))` SUBAGOAL_TAC;
53252   TSPECH `i` 2188;
53253   UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
53254   REWRH 1437;
53255   (* - *)
53256   TYPE_THEN `!i. (i <= N-| 1) ==> (E i SUBSET edge)` SUBAGOAL_TAC;
53257   TSPECH `i` 2188;
53258   UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
53259   REWRH 456;
53260   (* - *)
53261   TYPE_THEN `(!i. (SUC i <= N -| 1) ==> ~(E i INTER E (SUC i) = {}))` SUBAGOAL_TAC;
53262   UNDH 6943 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
53263   TYPE_THEN `h_edge (floor (a (SUC i) 0), floor (a (SUC i) 1))` EXISTS_TAC;
53264   CONJ_TAC;
53265   TSPECH `i` 2188;
53266   UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
53267   UNDH 1989 THEN UNDH 7562 THEN ARITH_TAC;
53268   TSPECH `SUC i` 2188;
53269   UNDH 395 THEN DISCH_THEN (THM_INTRO_TAC[]);
53270   REWRH  7915 ;
53271   (* -B *)
53272   TYPE_THEN `(!i j.  i <| j /\ j <=| N -| 1 /\ ~(SUC i = j) ==> (curve_cell (E i) INTER curve_cell (E j) = {}))` SUBAGOAL_TAC;
53273   PROOF_BY_CONTR_TAC;
53274   USEH 2591 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
53275   TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  cell_nonempty ; ALL_TAC];
53276   THM_INTRO_TAC[`E i`] curve_cell_cell;
53277   FIRST_ASSUM IMATCH_MP_TAC ;
53278   UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
53279   ASM_MESON_TAC[subset_imp];
53280   USEH 1008 (REWRITE_RULE[EMPTY_EXISTS]);
53281   (* -- *)
53282   TYPE_THEN `euclid 2 u'` SUBAGOAL_TAC;
53283   IMATCH_MP_TAC  subset_imp;
53284   TYPE_THEN `u` EXISTS_TAC;
53285   IMATCH_MP_TAC  cell_euclid;
53286   IMATCH_MP_TAC  subset_imp;
53287   TYPE_THEN `curve_cell (E j)` EXISTS_TAC;
53288   IMATCH_MP_TAC  curve_cell_cell;
53289   (* -- *)
53290   TYPE_THEN `(?x. B i x /\ d_euclid x u' < &4)` SUBAGOAL_TAC;
53291   TSPECH `i` 2188;
53292   UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
53293   UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
53294   FIRST_ASSUM IMATCH_MP_TAC ;
53295   REWRITE_TAC[UNIONS];
53296   UNIFY_EXISTS_TAC;
53297   (* -- *)
53298   TYPE_THEN `(?y. B j y /\ d_euclid y u' < &4)` SUBAGOAL_TAC;
53299   TSPECH `j` 2188;
53300   UNDH 7711 THEN DISCH_THEN (THM_INTRO_TAC[]);
53301   FIRST_ASSUM IMATCH_MP_TAC ;
53302   REWRITE_TAC[UNIONS];
53303   UNIFY_EXISTS_TAC;
53304   (* -- *)
53305   UNDH 1512 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`x`;`y`]);
53306   UNDH 5462 THEN UNDH 2236 THEN ARITH_TAC;
53307   (* -- *)
53308   TYPE_THEN `!k x. B k x /\ (k <| N) ==> euclid 2 x` SUBAGOAL_TAC;
53309   UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
53310   USEH 120 (MATCH_MP   simple_arc_end_simple);
53311   USEH 6892 (MATCH_MP simple_arc_euclid);
53312   IMATCH_MP_TAC  subset_imp;
53313   UNIFY_EXISTS_TAC;
53314   TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBAGOAL_TAC;
53315   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
53316   TYPE_THEN `i` EXISTS_TAC;
53317   UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
53318   TYPE_THEN `j` EXISTS_TAC;
53319   (* -- *)
53320   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`u'`;`y`] metric_space_triangle;
53321   TYPE_THEN `d_euclid x y <= &8` SUBAGOAL_TAC;
53322   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`y`;`u'`] metric_space_symm;
53323   UNDH 8326 THEN UNDH 204 THEN UNDH 2611 THEN UNDH 2778 THEN REAL_ARITH_TAC;
53324   UNDH 6749 THEN UNDH 4559 THEN UNDH 6444 THEN REAL_ARITH_TAC;
53325   REWRH 6286;
53326   (* -C *)
53327   TYPE_THEN `E' = UNIONS (IMAGE E {i | i <=| N -| 1})` ABBREV_TAC ;
53328   TYPE_THEN `E' SUBSET edge` SUBAGOAL_TAC;
53329   TYPE_THEN `E'` UNABBREV_TAC;
53330   REWRITE_TAC[IMAGE;UNIONS;SUBSET];
53331   TYPE_THEN `u` UNABBREV_TAC;
53332   TSPECH `x'` 2188;
53333   UNDH 1746 THEN DISCH_THEN (THM_INTRO_TAC[]);
53334   IMATCH_MP_TAC  subset_imp;
53335   UNIFY_EXISTS_TAC;
53336   (* - *)
53337   TYPE_THEN `FINITE E'` SUBAGOAL_TAC;
53338   TYPE_THEN `E'` UNABBREV_TAC;
53339   THM_INTRO_TAC[`IMAGE E {i | i <=| N -| 1}`] FINITE_FINITE_UNIONS;
53340   IMATCH_MP_TAC  FINITE_IMAGE;
53341   REWRITE_TAC[FINITE_NUMSEG_LE];
53342   USEH 3282 (REWRITE_RULE[IMAGE]);
53343   UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
53344   FULL_REWRITE_TAC[conn2];
53345   (* - *)
53346   TYPE_THEN `C' INTER unbounded_set E' = EMPTY` SUBAGOAL_TAC;
53347   PROOF_BY_CONTR_TAC;
53348   USEH 8327 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
53349   USEH 3168 (REWRITE_RULE [UNIONS;IMAGE]);
53350   TYPE_THEN `u'` UNABBREV_TAC;
53351   TSPECH `x` 2188;
53352   REP_BASIC_TAC;
53353   USEH 2251 (REWRITE_RULE[INTER;EQ_EMPTY]);
53354   TSPECH `u` 5859;
53355   UNDH 5490 THEN ASM_REWRITE_TAC[];
53356   IMATCH_MP_TAC  unbounded_avoidance_subset_ver2;
53357   TYPE_THEN `E'` EXISTS_TAC;
53358   TYPE_THEN `E'` UNABBREV_TAC;
53359   REWRITE_TAC[SUBSET;UNIONS;IMAGE];
53360   CONV_TAC (dropq_conv "u");
53361   TYPE_THEN `x` EXISTS_TAC;
53362   UNDH 5971 THEN ARITH_TAC;
53363   (* -D *)
53364   TYPE_THEN `unbounded_set E' p' /\ unbounded_set E' q'` ASM_CASES_TAC;
53365   THM_INTRO_TAC[`E'`;`p'`;`q'`] unbounded_connect;
53366   TSPECH `C` 7694;
53367   USEH 8696 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
53368   USEH 5828 (REWRITE_RULE[SUBSET]);
53369   USEH 6174 (REWRITE_RULE[INTER;EQ_EMPTY]);
53370   TSPECH `u` 5341;
53371   TSPECH `u` 7291;
53372   UNDH 362 THEN ASM_REWRITE_TAC[];
53373   (* -E *)
53374   TYPE_THEN `N = 1` ASM_CASES_TAC;
53375   TYPE_THEN `N` UNABBREV_TAC;
53376   FULL_REWRITE_TAC[ARITH_RULE `i <| 1 <=> (i = 0)`];
53377   FULL_REWRITE_TAC[ARITH_RULE `i <= 1 -| 1 <=> (i = 0)`];
53378   TSPECH `0` 6703;
53379   TYPE_THEN `0 = 0` SUBAGOAL_TAC;
53380   TYPE_THEN `{i | i = 0} = {0}` SUBAGOAL_TAC;
53381   IMATCH_MP_TAC  EQ_EXT;
53382   REWRH 327;
53383   REWRH 627;
53384   FULL_REWRITE_TAC[image_sing];
53385   TYPE_THEN `E'` UNABBREV_TAC;
53386   TYPE_THEN `C'` UNABBREV_TAC;
53387   TSPECH `0` 4218;
53388   UNDH 9174 THEN DISCH_THEN (THM_INTRO_TAC[]);
53389   (* -- *)
53390   UNDH 5439 THEN REWRITE_TAC[];
53391   TYPE_THEN `!p. (!x. B 0 x ==> &8 *d <= d_euclid x p) /\ (euclid 2 p) ==> unbounded_set (E 0) p` SUBAGOAL_TAC;
53392   IMATCH_MP_TAC  unbounded_set_ball;
53393   TYPE_THEN `x` EXISTS_TAC;
53394   TYPE_THEN `&7* d` EXISTS_TAC;
53395   CONJ_TAC;
53396   IMATCH_MP_TAC  REAL_LT_MUL;
53397   UNDH 5147 THEN REAL_ARITH_TAC;
53398   (* --- *)
53399   CONJ_TAC;
53400   REWRITE_TAC[SUBSET;closed_ball];
53401   SUBCONJ_TAC;
53402   TSPECH `0` 6993;
53403   UNDH 9405 THEN DISCH_THEN (THM_INTRO_TAC[]);
53404   USEH 4758 (MATCH_MP simple_arc_end_simple);
53405   USEH 6872 (MATCH_MP simple_arc_euclid);
53406   IMATCH_MP_TAC  subset_imp;
53407   TYPE_THEN `B 0` EXISTS_TAC;
53408   SUBCONJ_TAC;
53409   USEH 6028 (REWRITE_RULE[UNIONS]);
53410   IMATCH_MP_TAC  subset_imp;
53411   TYPE_THEN `u` EXISTS_TAC;
53412   IMATCH_MP_TAC  cell_euclid;
53413   IMATCH_MP_TAC  edge_cell;
53414   IMATCH_MP_TAC  subset_imp;
53415   TYPE_THEN `E 0` EXISTS_TAC;
53416   (* ---- *)
53417   UNDH 7489 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
53418   IMATCH_MP_TAC  subset_imp;
53419   TYPE_THEN `UNIONS (E 0)` EXISTS_TAC;
53420   IMATCH_MP_TAC UNIONS_UNIONS;
53421   REWRITE_TAC[SUBSET];
53422   USEH 361 (REWRITE_RULE[SUBSET]);
53423   ASM_SIMP_TAC[curve_cell_edge];
53424   USEH 5290 (REWRITE_RULE[SUBSET;open_ball]);
53425   TSPECH `x''` 19;
53426   REP_BASIC_TAC;
53427   (* ---- *)
53428   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`x''`;`x'`] metric_space_triangle;
53429   TYPE_THEN `d_euclid x x' <= d + &4` SUBAGOAL_TAC;
53430   UNDH 8092 THEN UNDH 8809 THEN UNDH 9378 THEN REAL_ARITH_TAC;
53431   IMATCH_MP_TAC  REAL_LE_TRANS;
53432   TYPE_THEN `d + &4` EXISTS_TAC;
53433   UNDH 5147 THEN REAL_ARITH_TAC;
53434   (* --- *)
53435   USEH 129 (REWRITE_RULE[closed_ball]);
53436   TSPECH `x` 7711;
53437   UNDH 6465 THEN UNDH 5617 THEN UNDH 5147 THEN REAL_ARITH_TAC;
53438   (* -- *)
53439   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
53440   (* -F *)
53441   TYPE_THEN `0 <| N -| 1` SUBAGOAL_TAC;
53442   UNDH 426 THEN UNDH 7562 THEN ARITH_TAC;
53443   REWRH 532;
53444   UNDH 7535 THEN REWRITE_TAC[];
53445   (* - *)
53446   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;
53447   TYPE_THEN `!i. (SUC i <= (N-1)) ==> C' (a (SUC i))` SUBAGOAL_TAC;
53448   REWRITE_TAC[UNIONS;IMAGE];
53449   CONV_TAC (dropq_conv ("u"));
53450   TYPE_THEN `i` EXISTS_TAC;
53451   CONJ_TAC;
53452   UNDH 1989 THEN ARITH_TAC;
53453   TSPECH `i` 4963;
53454   TYPE_THEN `i <| N` SUBAGOAL_TAC;
53455   UNDH 1989 THEN ARITH_TAC;
53456   USEH 9744 (MATCH_MP simple_arc_end_end2);
53457   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN REP_BASIC_TAC THEN ASM_MESON_TAC[];
53458   (* - *)
53459   FIRST_ASSUM IMATCH_MP_TAC ;
53460   UNDH 8137 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
53461   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;
53462   COPYH 2188;
53463   UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
53464   UNDH 1989 THEN ARITH_TAC;
53465   UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
53466   KILLH 5053 THEN KILLH 8136 THEN KILLH 5388 THEN KILLH 6737;
53467   (* -G *)
53468   IMATCH_MP_TAC  unbounded_set_ball;
53469   TYPE_THEN `a(SUC i)` EXISTS_TAC;
53470   TYPE_THEN `&7 *d` EXISTS_TAC;
53471   (* - *)
53472   CONJ_TAC;
53473   IMATCH_MP_TAC  REAL_LT_MUL;
53474   UNDH 5147 THEN REAL_ARITH_TAC;
53475   (* - *)
53476   CONJ_TAC;
53477   REWRITE_TAC[  FINITE_UNION];
53478   FULL_REWRITE_TAC[conn2];
53479   REWRITE_TAC[union_subset];
53480   REWRITE_TAC[UNIONS_UNION;union_subset];
53481   (* - *)
53482   IMATCH_MP_TAC  (TAUT `a/\ b ==> b/\ a`);
53483   CONJ_TAC;
53484   USEH 9183 (REWRITE_RULE[closed_ball]);
53485   UNDH 6641 THEN UNDH 3603 THEN UNDH 5147 THEN REAL_ARITH_TAC;
53486   (* - *)
53487   TYPE_THEN `!i x. (i <| N) /\  (B i x) ==> euclid 2 x` SUBAGOAL_TAC;
53488   UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
53489   USEH 9316 (MATCH_MP simple_arc_end_simple);
53490   USEH 5604 (MATCH_MP simple_arc_euclid);
53491   USEH 2996 (REWRITE_RULE[SUBSET]);
53492   COPYH 3219;
53493   TSPECH `i` 3219;
53494   TSPECH `SUC i` 3219;
53495   (* - *)
53496   TYPE_THEN `(i <| N) /\ (SUC i <| N)` SUBAGOAL_TAC;
53497   UNDH 1989 THEN ARITH_TAC;
53498   REWRH 6689;
53499   REWRH 5459;
53500   (* - *)
53501   TYPE_THEN `B i (a(SUC i))` SUBAGOAL_TAC;
53502   TSPECH `i` 4963;
53503   USEH 9744 (MATCH_MP simple_arc_end_end2);
53504   (* - *)
53505   TYPE_THEN `B (SUC i) (a (SUC i))` SUBAGOAL_TAC;
53506   TSPECH `SUC i` 4963;
53507   USEH 9147 (MATCH_MP simple_arc_end_end);
53508   (* - *)
53509   REWRITE_TAC[SUBSET;closed_ball];
53510   TYPE_THEN `euclid 2 (a(SUC i))` SUBAGOAL_TAC;
53511   (* - *)
53512   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;
53513   IMATCH_MP_TAC  BALL_DIST;
53514   TYPE_THEN `euclid 2` EXISTS_TAC;
53515   UNDH 4673 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
53516   TYPE_THEN `x'` EXISTS_TAC;
53517   CONJ_TAC;
53518   IMATCH_MP_TAC  subset_imp;
53519   TYPE_THEN `B i'` EXISTS_TAC;
53520   IMATCH_MP_TAC  subset_imp;
53521   TYPE_THEN `B i'` EXISTS_TAC;
53522   (* - *)
53523   KILLH 3302 THEN KILLH 6317 THEN KILLH 4963 THEN KILLH 4847;
53524   KILLH 4673 THEN KILLH 3226 THEN KILLH 9755 THEN KILLH 8762 THEN KILLH 6174;
53525   KILLH 7802 THEN KILLH 3603 THEN KILLH 5957;
53526   (* - *)
53527   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;
53528   THM_INTRO_TAC[`euclid 2`;`d_euclid`;`a(SUC i)`;`y`;`x`] metric_space_triangle;
53529   UNDH 8917 THEN UNDH 3588 THEN UNDH 1391 THEN UNDH 5147 THEN REAL_ARITH_TAC;
53530   (* - *)
53531   TYPE_THEN `!G x. G SUBSET edge /\ UNIONS G x ==> (euclid 2 x /\ UNIONS (curve_cell G) x)` SUBAGOAL_TAC;
53532   USEH 6599 (REWRITE_RULE[UNIONS]);
53533   TYPE_THEN `edge u` SUBAGOAL_TAC;
53534   IMATCH_MP_TAC  subset_imp;
53535   TYPE_THEN `G` EXISTS_TAC;
53536   CONJ_TAC;
53537   USEH 9350 (MATCH_MP edge_euclid2);
53538   IMATCH_MP_TAC  subset_imp;
53539   TYPE_THEN `u` EXISTS_TAC;
53540   REWRITE_TAC[UNIONS];
53541   TYPE_THEN `u` EXISTS_TAC;
53542   ASM_SIMP_TAC[curve_cell_edge];
53543   (* -H *)
53544   CONJ_TAC;
53545   UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E i`;`x`]);
53546   UNDH 404 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
53547   FIRST_ASSUM IMATCH_MP_TAC ;
53548   TYPE_THEN `x'` EXISTS_TAC;
53549   FIRST_ASSUM IMATCH_MP_TAC ;
53550   TYPE_THEN `i` EXISTS_TAC;
53551   (* - *)
53552   UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E (SUC i)`;`x`]);
53553   UNDH 9352 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
53554   FIRST_ASSUM IMATCH_MP_TAC ;
53555   TYPE_THEN `x'` EXISTS_TAC;
53556   FIRST_ASSUM IMATCH_MP_TAC ;
53557   TYPE_THEN `SUC i` EXISTS_TAC;
53558   (* Sat Jan  1 19:23:34 EST 2005 *)
53559
53560   ]);;
53561   (* }}} *)
53562
53563 let cut_arc =
53564   jordan_def `cut_arc C v w = @B. simple_arc_end B v w /\ B SUBSET C`;;
53565
53566 let cut_arc_symm = prove_by_refinement(
53567   `!C v w. cut_arc C v w = cut_arc C w v`,
53568   (* {{{ proof *)
53569   [
53570   REWRITE_TAC[cut_arc];
53571   TYPE_THEN `!B. simple_arc_end B v w = simple_arc_end B w v` SUBAGOAL_TAC;
53572   MESON_TAC[simple_arc_end_symm];
53573   ]);;
53574   (* }}} *)
53575
53576 let cut_arc_simple = prove_by_refinement(
53577   `!C v w. simple_arc top2 C /\  C v /\ C w /\ ~(v = w) ==>
53578         simple_arc_end (cut_arc C v w) v w`,
53579   (* {{{ proof *)
53580   [
53581   REWRITE_TAC[cut_arc];
53582   SELECT_TAC;
53583   ASM_MESON_TAC[simple_arc_end_select];
53584   ]);;
53585   (* }}} *)
53586
53587 let cut_arc_subset = prove_by_refinement(
53588   `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==>
53589         cut_arc C v w SUBSET C`,
53590   (* {{{ proof *)
53591   [
53592   REWRITE_TAC[cut_arc];
53593   SELECT_TAC;
53594   ASM_MESON_TAC[simple_arc_end_select];
53595   ]);;
53596   (* }}} *)
53597
53598 let cut_arc_unique = prove_by_refinement(
53599   `!C v w B. simple_arc top2 C /\ (B SUBSET C) /\ simple_arc_end B v w
53600         ==> (cut_arc C v w = B)`,
53601   (* {{{ proof *)
53602   [
53603   REP_BASIC_TAC;
53604   IMATCH_MP_TAC  simple_arc_end_inj;
53605   TYPE_THEN `C` EXISTS_TAC;
53606   TYPE_THEN `v` EXISTS_TAC;
53607   TYPE_THEN `w` EXISTS_TAC;
53608   TYPE_THEN `~(v = w)` SUBAGOAL_TAC THENL[ (IMATCH_MP_TAC  simple_arc_end_distinct);ALL_TAC];
53609   TYPE_THEN `B` EXISTS_TAC;
53610   TYPE_THEN `C v` SUBAGOAL_TAC;
53611   IMATCH_MP_TAC  subset_imp;
53612   TYPE_THEN `B` EXISTS_TAC;
53613   IMATCH_MP_TAC  simple_arc_end_end;
53614   TYPE_THEN `w` EXISTS_TAC;
53615   TYPE_THEN `C w` SUBAGOAL_TAC ;
53616   IMATCH_MP_TAC  subset_imp;
53617   TYPE_THEN `B` EXISTS_TAC;
53618   IMATCH_MP_TAC  simple_arc_end_end2;
53619   UNIFY_EXISTS_TAC;
53620   ASM_MESON_TAC [cut_arc_subset;cut_arc_simple];
53621   ]);;
53622   (* }}} *)
53623
53624 let cut_arc_inter = prove_by_refinement(
53625   `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==>
53626      (cut_arc C v u INTER cut_arc C u w = {u}) /\
53627      (cut_arc C v u UNION cut_arc C u w = C)`,
53628   (* {{{ proof *)
53629   [
53630   REP_BASIC_TAC;
53631   THM_INTRO_TAC[`C`;`v`;`w`;`u`] simple_arc_end_cut;
53632   TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
53633   USEH 8829 (MATCH_MP simple_arc_end_simple);
53634   TYPE_THEN `cut_arc C v u = C'` SUBAGOAL_TAC;
53635   IMATCH_MP_TAC  cut_arc_unique;
53636   TYPE_THEN `C` UNABBREV_TAC;
53637   REWRITE_TAC[SUBSET;UNION];
53638   TYPE_THEN `cut_arc C u w = C''` SUBAGOAL_TAC;
53639   IMATCH_MP_TAC  cut_arc_unique;
53640   TYPE_THEN `C` UNABBREV_TAC;
53641    REWRITE_TAC[SUBSET;UNION];
53642   ASM_REWRITE_TAC[];
53643   (* Sat Jan  1 19:57:51 EST 2005 *)
53644
53645   ]);;
53646   (* }}} *)
53647
53648 let simple_closed_curve_euclid = prove_by_refinement(
53649   `!C . simple_closed_curve top2 C ==> (C SUBSET euclid 2) `,
53650   (* {{{ proof *)
53651   [
53652   REWRITE_TAC[simple_closed_curve];
53653   REWRITE_TAC[IMAGE;SUBSET];
53654   TYPE_THEN `!u. &0 <= u /\ u < &1 ==> euclid 2 (f u)` SUBAGOAL_TAC;
53655   FULL_REWRITE_TAC[INJ;top2_unions];
53656   FIRST_ASSUM  IMATCH_MP_TAC ;
53657   USEH 5825 SYM ;
53658   TYPE_THEN `x' = &1` ASM_CASES_TAC;
53659   ASM_REWRITE_TAC[];
53660   FIRST_ASSUM IMATCH_MP_TAC ;
53661   FIRST_ASSUM IMATCH_MP_TAC ;
53662  UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
53663   ]);;
53664   (* }}} *)
53665
53666 let open_real_interval = prove_by_refinement(
53667   `!a b. top_of_metric (UNIV,d_real) {x | a < x /\ x < b}`,
53668   (* {{{ proof *)
53669   [
53670   REP_BASIC_TAC;
53671   THM_INTRO_TAC[`b`] half_open;
53672   THM_INTRO_TAC[`a`] half_open_above;
53673   TYPE_THEN `{x | a < x /\ x < b} = {x | a < x} INTER {x | x < b}` SUBAGOAL_TAC;
53674   IMATCH_MP_TAC  EQ_EXT;
53675   REWRITE_TAC[INTER];
53676   IMATCH_MP_TAC  top_inter;
53677   IMATCH_MP_TAC  top_of_metric_top;
53678   REWRITE_TAC[metric_real];
53679   ]);;
53680   (* }}} *)
53681
53682 let simple_closed_curve_cut_unique = prove_by_refinement(
53683   `!A A' A'' C v w. simple_closed_curve top2 C /\
53684       simple_arc_end A v w /\
53685       simple_arc_end A' v w /\
53686       simple_arc_end A'' v w /\
53687       ~(A' = A'') /\
53688     (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==>
53689       (A = A') \/ (A = A'')`,
53690   (* {{{ proof *)
53691   [
53692   REP_BASIC_TAC;
53693   TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC;
53694   CONJ_TAC;
53695   IMATCH_MP_TAC  subset_imp;
53696   TYPE_THEN `A'` EXISTS_TAC;
53697   IMATCH_MP_TAC  simple_arc_end_end;
53698   TYPE_THEN`w` EXISTS_TAC;
53699   CONJ_TAC;
53700   IMATCH_MP_TAC  subset_imp;
53701   TYPE_THEN `A'` EXISTS_TAC;
53702   REWRITE_TAC[SUBSET_UNION];
53703   IMATCH_MP_TAC  simple_arc_end_end2;
53704   TYPE_THEN `v` EXISTS_TAC;
53705   USEH 4051  (MATCH_MP simple_arc_end_distinct);
53706   UNDH 1472 THEN ASM_REWRITE_TAC[];
53707   (* - *)
53708   THM_INTRO_TAC[`C`;`v`] simple_closed_curve_pt;
53709   TYPE_THEN `?t. (&0 < t /\ t < &1 /\ (f t = w))` SUBAGOAL_TAC ;
53710   (*   KILLH 9405; *)
53711   TYPE_THEN `C` UNABBREV_TAC ;
53712   FULL_REWRITE_TAC[IMAGE];
53713   TYPE_THEN `x` EXISTS_TAC;
53714   TYPE_THEN `x = &0` ASM_CASES_TAC;
53715   TYPE_THEN `x` UNABBREV_TAC;
53716   ASM_MESON_TAC[];
53717   TYPE_THEN `x = &1` ASM_CASES_TAC;
53718   ASM_MESON_TAC[];
53719   UNDH 3483 THEN UNDH 9557 THEN UNDH 953 THEN UNDH 8032 THEN REAL_ARITH_TAC;
53720   TYPE_THEN `w` UNABBREV_TAC;
53721   TYPE_THEN `v` UNABBREV_TAC;
53722   (* -A *)
53723   (*   USEH 9405 SYM; // *)
53724   FULL_REWRITE_TAC[top2_unions];
53725   TYPE_THEN `simple_arc_end (IMAGE f {x | &0 <= x /\ x <= t}) (f (&0)) (f t)` SUBAGOAL_TAC;
53726   USEH 5825 SYM;
53727   IMATCH_MP_TAC  simple_arc_segment;
53728   UNDH 6523 THEN REAL_ARITH_TAC;
53729   (* - *)
53730   TYPE_THEN `simple_arc_end (IMAGE f {x | t <= x /\ x <= &1}) (f t) (f (&1))` SUBAGOAL_TAC;
53731   IMATCH_MP_TAC  simple_arc_segment;
53732   UNDH 2449 THEN REAL_ARITH_TAC;
53733   USEH 5825 SYM;
53734   REWRH 3167;
53735   (* - *)
53736   TYPE_THEN `!q. {x | q <= x /\ x <= q} = {q}` SUBAGOAL_TAC;
53737   IMATCH_MP_TAC  EQ_EXT;
53738   REAL_ARITH_TAC;
53739   (* - *)
53740   TYPE_THEN `!x. &0 <= x /\ x <= &1 ==> euclid 2 (f x)` SUBAGOAL_TAC;
53741   IMATCH_MP_TAC  subset_imp;
53742   TYPE_THEN `C` EXISTS_TAC;
53743   CONJ_TAC;
53744   IMATCH_MP_TAC  image_imp;
53745   ASM_REWRITE_TAC[];
53746   USEH 5674 SYM;
53747   IMATCH_MP_TAC  simple_closed_curve_euclid;
53748   (* - *)
53749   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;
53750   TYPE_THEN `closed_ top2 (IMAGE f {x | &0 <= x /\ x <= r})` SUBAGOAL_TAC;
53751   TYPE_THEN `r = &0` ASM_CASES_TAC ;
53752   ASM_REWRITE_TAC[];
53753   REWRITE_TAC[image_sing];
53754   IMATCH_MP_TAC  closed_point;
53755   FIRST_ASSUM IMATCH_MP_TAC ;
53756   IMATCH_MP_TAC  simple_arc_end_closed;
53757   TYPE_THEN  `f( &0)` EXISTS_TAC;
53758   TYPE_THEN `f (r)` EXISTS_TAC;
53759   IMATCH_MP_TAC  simple_arc_segment;
53760   UNDH 5145 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC;
53761   TYPE_THEN `closed_ top2 (IMAGE f {x | s <= x /\ x <= &1})` SUBAGOAL_TAC;
53762   TYPE_THEN `s = &1` ASM_CASES_TAC ;
53763   ASM_REWRITE_TAC[];
53764   REWRITE_TAC[image_sing];
53765   IMATCH_MP_TAC  closed_point;
53766   FIRST_ASSUM IMATCH_MP_TAC ;
53767   IMATCH_MP_TAC  simple_arc_end_closed;
53768   TYPE_THEN  `f(s)` EXISTS_TAC;
53769   USEH 1826 SYM;
53770   TYPE_THEN `f (&1)` EXISTS_TAC;
53771   IMATCH_MP_TAC  simple_arc_segment;
53772   UNDH 2144 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC;
53773   TYPE_THEN `closed_ top2 ((IMAGE f {x | &0 <= x /\ x <= r}) UNION (IMAGE f {x | s <= x /\ x <= &1}))` SUBAGOAL_TAC;
53774   IMATCH_MP_TAC  closed_union;
53775   REWRITE_TAC[top2_top];
53776   USEH 9076 (MATCH_MP closed_open);
53777   FULL_REWRITE_TAC[open_DEF;top2_unions ];
53778   TYPE_THEN `(euclid 2 DIFF   (IMAGE f {x | &0 <= x /\ x <= r} UNION  IMAGE f {x | s <= x /\ x <= &1}))` EXISTS_TAC;
53779   IMATCH_MP_TAC  EQ_EXT;
53780   REWRITE_TAC[IMAGE;DIFF;UNION;INTER];
53781   NAME_CONFLICT_TAC;
53782   IMATCH_MP_TAC  EQ_ANTISYM;
53783   CONJ_TAC;
53784   TYPE_THEN `x` UNABBREV_TAC;
53785   REWRITE_TAC[DE_MORGAN_THM;CONJ_ACI];
53786   TYPE_THEN `&0 <= x' /\ x' <= &1` SUBAGOAL_TAC;
53787   UNDH 507 THEN UNDH 3413 THEN UNDH 1908 THEN UNDH 147 THEN REAL_ARITH_TAC;
53788   CONJ_TAC;
53789   TYPE_THEN `x'` EXISTS_TAC;
53790   ASM_REWRITE_TAC[];
53791   CONJ_TAC;
53792   FIRST_ASSUM IMATCH_MP_TAC ;
53793   CONJ_TAC;
53794   USEH 2422 (REWRITE_RULE[INJ]);
53795   TYPE_THEN `x'' = &1` ASM_CASES_TAC;
53796   TYPE_THEN `x' = &0` SUBAGOAL_TAC;
53797   FIRST_ASSUM IMATCH_MP_TAC ;
53798   ASM_REWRITE_TAC[];
53799   UNDH 507 THEN UNDH 1908 THEN REAL_ARITH_TAC;
53800   TYPE_THEN `x'` UNABBREV_TAC;
53801   UNDH 8462 THEN UNDH 147 THEN REAL_ARITH_TAC;
53802   TYPE_THEN `x' = x''` SUBAGOAL_TAC;
53803   FIRST_ASSUM IMATCH_MP_TAC ;
53804   UNDH 5595 THEN UNDH 8732 THEN UNDH 9674 THEN UNDH 507 THEN UNDH 9329 THEN UNDH 1908 THEN REAL_ARITH_TAC ;
53805   TYPE_THEN `x''` UNABBREV_TAC;
53806   UNDH 507 THEN UNDH 1162 THEN REAL_ARITH_TAC;
53807   (* --- *)
53808   TYPE_THEN `x' = x''` SUBAGOAL_TAC;
53809   USEH 2422 (REWRITE_RULE[INJ]);
53810   FIRST_ASSUM IMATCH_MP_TAC ;
53811   UNDH 8691 THEN UNDH 7080 THEN UNDH 1908 THEN UNDH 507 THEN REAL_ARITH_TAC;
53812   TYPE_THEN `x''` UNABBREV_TAC;
53813   UNDH 3283 THEN UNDH 3413 THEN REAL_ARITH_TAC;
53814   (* -- *)
53815   FULL_REWRITE_TAC[DE_MORGAN_THM];
53816   TYPE_THEN `x'` EXISTS_TAC;
53817   LEFTH  7656 "x'";
53818   TSPECH `x'` 4068;
53819   TYPE_THEN `x` UNABBREV_TAC;
53820   LEFTH 5373 "x''";
53821   TSPECH `x'` 1785;
53822   UNDH 1589 THEN UNDH 4223 THEN REWRITE_TAC[] THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC;
53823   (* -B *)
53824   COPYH 7922;
53825   UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`t`]);
53826   UNDH 6523 THEN REAL_ARITH_TAC;
53827   UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`t`;`&1`]);
53828   UNDH 2449 THEN REAL_ARITH_TAC;
53829   (* - *)
53830   USEH 5674 SYM;
53831   TYPE_THEN `U INTER U' INTER C = EMPTY` SUBAGOAL_TAC;
53832   TYPE_THEN `U INTER U' INTER C = (U INTER C) INTER (U' INTER C)` SUBAGOAL_TAC;
53833   IMATCH_MP_TAC  EQ_EXT;
53834   REWRITE_TAC[INTER] THEN MESON_TAC[];
53835   TYPE_THEN `U INTER C` UNABBREV_TAC;
53836   TYPE_THEN `U' INTER C` UNABBREV_TAC;
53837   PROOF_BY_CONTR_TAC;
53838   USEH 6182 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]);
53839   TYPE_THEN `u` UNABBREV_TAC;
53840   TYPE_THEN `x = x'` SUBAGOAL_TAC;
53841   USEH 2422 (REWRITE_RULE[INJ]);
53842   FIRST_ASSUM IMATCH_MP_TAC ;
53843   UNDH 4410 THEN UNDH 8119 THEN UNDH 6523 THEN UNDH 5777 THEN UNDH 2449 THEN REAL_ARITH_TAC;
53844   TYPE_THEN `x'` UNABBREV_TAC;
53845   UNDH 4480 THEN UNDH 8119 THEN REAL_ARITH_TAC;
53846   (* -C *)
53847   TYPE_THEN `UNIONS (top_of_metric (UNIV,d_real)) = UNIV` SUBAGOAL_TAC;
53848   IMATCH_MP_TAC  (GSYM top_of_metric_unions);
53849   REWRITE_TAC[metric_real];
53850   THM_INTRO_TAC[`&0`;`&1`] connect_real_open;
53851   THM_INTRO_TAC[`&0`;`&1`] open_real_interval;
53852   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;
53853   COPYH 3089;
53854     USEH 3089 (REWRITE_RULE[simple_arc_end]);
53855   USEH 3272 (REWRITE_RULE[continuous;preimage]);
53856   REWRH 1293;
53857   TYPE_THEN `!v. top2 v ==> top_of_metric(UNIV,d_real) {x | &0 < x /\ x < &1 /\ v (f' x)}` SUBAGOAL_TAC;
53858   TYPE_THEN `{x | &0 < x /\ x < &1 /\ v' (f' x)} = {x | &0 < x /\ x < &1 } INTER {x | v' (f' x)}` SUBAGOAL_TAC;
53859   IMATCH_MP_TAC  EQ_EXT;
53860   REWRITE_TAC[INTER];
53861   MESON_TAC[];
53862   IMATCH_MP_TAC top_inter;
53863   IMATCH_MP_TAC  top_of_metric_top;
53864   REWRITE_TAC[metric_real];
53865   COPYH 7847;
53866   TSPECH `U` 7847;
53867   TSPECH `U'`7847;
53868   FULL_REWRITE_TAC[connected];
53869   UNDH 868 THEN DISCH_THEN (THM_INTRO_TAC[`{x | &0 < x /\ x < &1 /\ U (f' x)}`;`{x | &0 < x /\ x < &1 /\ U' (f' x)}`]);
53870   CONJ_TAC;
53871   PROOF_BY_CONTR_TAC;
53872   USEH 228 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
53873   TYPE_THEN `C (f' u)` SUBAGOAL_TAC;
53874   IMATCH_MP_TAC  subset_imp;
53875   TYPE_THEN `B` EXISTS_TAC;
53876   IMATCH_MP_TAC  image_imp;
53877   UNDH 5411 THEN UNDH 7814 THEN REAL_ARITH_TAC;
53878   USEH 161 (REWRITE_RULE[INTER;EQ_EMPTY]);
53879   TSPECH `f' u` 3418;
53880   UNDH 1284 THEN ASM_REWRITE_TAC[];
53881   REWRITE_TAC[SUBSET;UNION];
53882   TYPE_THEN `C (f' x)` SUBAGOAL_TAC;
53883   IMATCH_MP_TAC  subset_imp;
53884   TYPE_THEN `B` EXISTS_TAC;
53885   IMATCH_MP_TAC  image_imp;
53886   UNDH 4410 THEN UNDH 2236 THEN REAL_ARITH_TAC ;
53887   USEH 3773 SYM;
53888   REWRH 5090;
53889   USEH 8548 (REWRITE_RULE[IMAGE]);
53890   TYPE_THEN `~(x' = &0)` SUBAGOAL_TAC;
53891   TYPE_THEN `x'` UNABBREV_TAC;
53892   TYPE_THEN `f(&0)` UNABBREV_TAC;
53893   TYPE_THEN `f(&1)` UNABBREV_TAC;
53894   TYPE_THEN `x = &0` SUBAGOAL_TAC;
53895   USEH 5798 (REWRITE_RULE[INJ]);
53896   FIRST_ASSUM IMATCH_MP_TAC ;
53897   UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
53898   TYPE_THEN `x` UNABBREV_TAC;
53899   UNDH 869 THEN REAL_ARITH_TAC;
53900   TYPE_THEN `~(x' = &1)` SUBAGOAL_TAC;
53901   TYPE_THEN `x'` UNABBREV_TAC;
53902   TYPE_THEN `f(&0)` UNABBREV_TAC;
53903   TYPE_THEN `f(&1)` UNABBREV_TAC;
53904   TYPE_THEN `x = &0` SUBAGOAL_TAC;
53905   USEH 5798 (REWRITE_RULE[INJ]);
53906   FIRST_ASSUM IMATCH_MP_TAC ;
53907   UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
53908   TYPE_THEN `x` UNABBREV_TAC;
53909   UNDH 869 THEN REAL_ARITH_TAC;
53910   TYPE_THEN `~(x' = t)` SUBAGOAL_TAC;
53911   TYPE_THEN `x'` UNABBREV_TAC;
53912   TYPE_THEN `f(&0)` UNABBREV_TAC;
53913   TYPE_THEN `f(&1)` UNABBREV_TAC;
53914   TYPE_THEN `f t` UNABBREV_TAC;
53915   TYPE_THEN `x = &1` SUBAGOAL_TAC;
53916   USEH 5798 (REWRITE_RULE[INJ]);
53917   FIRST_ASSUM IMATCH_MP_TAC ;
53918   UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
53919   TYPE_THEN `x` UNABBREV_TAC;
53920   UNDH 6586 THEN REAL_ARITH_TAC;
53921   (* --- *)
53922   TYPE_THEN `x' < t` ASM_CASES_TAC;
53923   DISJ1_TAC;
53924   USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
53925   TSPECH `f x'` 4001;
53926   USEH 4175 (REWRITE_RULE[INTER]);
53927   USEH 4860 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`));
53928   FIRST_ASSUM IMATCH_MP_TAC ;
53929   IMATCH_MP_TAC  image_imp;
53930   ASM_REWRITE_TAC[];
53931   UNDH 2455 THEN UNDH 9329 THEN REAL_ARITH_TAC;
53932   DISJ2_TAC;
53933   USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
53934   TSPECH `f x'` 7907;
53935   USEH 1343 (REWRITE_RULE[INTER]);
53936   USEH 5291 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`));
53937   FIRST_ASSUM IMATCH_MP_TAC ;
53938   IMATCH_MP_TAC  image_imp;
53939   ASM_REWRITE_TAC[];
53940   UNDH 9585 THEN UNDH 7068 THEN UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
53941   (* --D *)
53942   FIRST_ASSUM DISJ_CASES_TAC;
53943   DISJ1_TAC;
53944   IMATCH_MP_TAC  simple_arc_end_inj;
53945   TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC;
53946   TYPE_THEN `f (&0)` EXISTS_TAC;
53947   TYPE_THEN `f (t)` EXISTS_TAC;
53948   CONJ_TAC;
53949   TYPE_THEN `B` UNABBREV_TAC;
53950   CONJ_TAC;
53951   USEH 4679 (MATCH_MP simple_arc_end_simple);
53952   REWRITE_TAC[SUBSET_REFL];
53953   REWRITE_TAC[SUBSET;IMAGE];
53954   (* --- *)
53955   TYPE_THEN `x' = &0` ASM_CASES_TAC ;
53956   ASM_REWRITE_TAC[];
53957   TYPE_THEN `&0` EXISTS_TAC;
53958   UNDH 2449 THEN REAL_ARITH_TAC;
53959   TYPE_THEN `x' = &1` ASM_CASES_TAC;
53960   ASM_REWRITE_TAC[];
53961   TYPE_THEN `t` EXISTS_TAC;
53962   UNDH 2449 THEN REAL_ARITH_TAC;
53963   USEH 8833 (REWRITE_RULE[SUBSET]);
53964   UNDH 5386 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
53965   UNDH 6268 THEN UNDH 2455 THEN UNDH 9329 THEN UNDH 3324 THEN REAL_ARITH_TAC;
53966   TYPE_THEN `C (f' x')` SUBAGOAL_TAC;
53967   IMATCH_MP_TAC  subset_imp;
53968   TYPE_THEN `B` EXISTS_TAC;
53969   IMATCH_MP_TAC  image_imp;
53970 (*** Removed by JRH --- not quite sure why this changed
53971   UNDH 7473 THEN UNDH 5707 THEN UNDH 6268 THEN  UNDH 2455 THEN REAL_ARITH_TAC;
53972  ***)
53973   USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
53974   TSPECH `(f' x')` 4001;
53975   USEH 3320 (REWRITE_RULE[INTER;IMAGE]);
53976   REWRH 7476;
53977   TYPE_THEN `x''` EXISTS_TAC;
53978   UNDH 4332 THEN UNDH 4962 THEN REAL_ARITH_TAC;
53979   (* --E *)
53980   DISJ2_TAC;
53981   IMATCH_MP_TAC  simple_arc_end_inj;
53982   TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC;
53983   TYPE_THEN `f t` EXISTS_TAC;
53984   TYPE_THEN `f (&1)` EXISTS_TAC;
53985   USEH 1826 SYM;
53986   CONJ_TAC;
53987   TYPE_THEN `B` UNABBREV_TAC;
53988   IMATCH_MP_TAC  simple_arc_end_symm;
53989   ASM_MESON_TAC[];
53990   CONJ_TAC;
53991   USEH 9241 (MATCH_MP simple_arc_end_simple);
53992   REWRITE_TAC[SUBSET_REFL];
53993   REWRITE_TAC[SUBSET;IMAGE];
53994   (* --- *)
53995   TYPE_THEN `x' = &0` ASM_CASES_TAC ;
53996   ASM_REWRITE_TAC[];
53997   TYPE_THEN `&1` EXISTS_TAC;
53998   UNDH 6523 THEN REAL_ARITH_TAC;
53999   TYPE_THEN `x' = &1` ASM_CASES_TAC;
54000   ASM_REWRITE_TAC[];
54001   TYPE_THEN `t` EXISTS_TAC;
54002   UNDH 6523 THEN REAL_ARITH_TAC;
54003   TYPE_THEN `&0 < x' /\ x' < &1` SUBAGOAL_TAC;
54004   UNDH 9329 THEN UNDH 2455 THEN UNDH 3324 THEN UNDH 6268 THEN REAL_ARITH_TAC;
54005   USEH 1419 (REWRITE_RULE[SUBSET]);
54006   UNDH 7111 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
54007   TYPE_THEN `C (f' x')` SUBAGOAL_TAC;
54008   IMATCH_MP_TAC  subset_imp;
54009   TYPE_THEN `B` EXISTS_TAC;
54010   IMATCH_MP_TAC  image_imp;
54011   ASM_REWRITE_TAC[];
54012   USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
54013   TSPECH `(f' x')` 7907;
54014   USEH 1445 (REWRITE_RULE[INTER;IMAGE]);
54015   REWRH 6223;
54016   TYPE_THEN `x''` EXISTS_TAC;
54017   UNDH 4402 THEN UNDH 8966 THEN REAL_ARITH_TAC;
54018   (* -F *)
54019   TYPE_THEN `X = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ;
54020   TYPE_THEN `Y = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ;
54021   TYPE_THEN `a = f(&0)` ABBREV_TAC ;
54022   TYPE_THEN `b = f t` ABBREV_TAC ;
54023   TYPE_THEN `f t` UNABBREV_TAC;
54024   TYPE_THEN `f (&0)` UNABBREV_TAC;
54025   TYPE_THEN `f (&1)` UNABBREV_TAC;
54026   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);
54027   TYPE_THEN `(A = X) \/ (A = Y)` SUBAGOAL_TAC;
54028   FIRST_ASSUM IMATCH_MP_TAC ;
54029   TYPE_THEN `(A' = X) \/ (A' = Y)` SUBAGOAL_TAC;
54030   FIRST_ASSUM IMATCH_MP_TAC ;
54031   TYPE_THEN `(A'' = X) \/ (A'' = Y)` SUBAGOAL_TAC;
54032   FIRST_ASSUM IMATCH_MP_TAC ;
54033   FIRST_ASSUM DISJ_CASES_TAC THEN FIRST_ASSUM DISJ_CASES_TAC THEN ASM_MESON_TAC[];
54034   (* Sun Jan  2 11:55:31 EST 2005 *)
54035
54036   ]);;
54037   (* }}} *)
54038
54039 let infinite_closed_interval = prove_by_refinement(
54040   `!a b. a < b ==> INFINITE {x | a <= x /\ x <= b}`,
54041   (* {{{ proof *)
54042   [
54043   REP_BASIC_TAC;
54044   TYPE_THEN `?r s. a < r /\ r < s /\ s < b` SUBAGOAL_TAC;
54045   TYPE_THEN `(&2*a + b)/ &3` EXISTS_TAC;
54046   TYPE_THEN `(a + &2*b)/ &3` EXISTS_TAC;
54047   ASSUME_TAC (REAL_ARITH `&0 < &3 /\ ~(&3 = &0)`);
54048   ASM_SIMP_TAC[REAL_LT_RDIV_EQ;REAL_LT_LDIV_EQ;REAL_DIV_RMUL];
54049   UNDH 4394 THEN REAL_ARITH_TAC;
54050   IMATCH_MP_TAC  infinite_subset;
54051   TYPE_THEN `{x | r < x /\ x < s}` EXISTS_TAC ;
54052   CONJ_TAC;
54053   ASM_SIMP_TAC[infinite_interval];
54054   REWRITE_TAC[SUBSET];
54055   UNDH 2351 THEN UNDH 2116 THEN UNDH 5157 THEN UNDH 4011 THEN REAL_ARITH_TAC;
54056   (* Sun Jan  2 12:21:29 EST 2005 *)
54057
54058   ]);;
54059   (* }}} *)
54060
54061 let infinite_image = prove_by_refinement(
54062   `!(f:A->B) X. INFINITE X /\ INJ f X UNIV ==> INFINITE (IMAGE f X)`,
54063   (* {{{ proof *)
54064   [
54065   REWRITE_TAC[INJ;INFINITE];
54066   THM_INTRO_TAC[`f`;`IMAGE f X`;`X`] FINITE_IMAGE_INJ_GENERAL;
54067   ASM_REWRITE_TAC[];
54068   UNDH 3229 THEN REWRITE_TAC[];
54069   TYPE_THEN `{x | x IN X /\ f x IN IMAGE f X} = X` SUBAGOAL_TAC;
54070   IMATCH_MP_TAC  EQ_EXT;
54071   ASM_MESON_TAC[image_imp];
54072   REWRH 2588;
54073   ]);;
54074   (* }}} *)
54075
54076 let simple_arc_infinite = prove_by_refinement(
54077   `!C. simple_arc top2 C ==> INFINITE C`,
54078   (* {{{ proof *)
54079   [
54080   REWRITE_TAC[simple_arc];
54081   IMATCH_MP_TAC  infinite_image;
54082   CONJ_TAC;
54083   IMATCH_MP_TAC  infinite_closed_interval;
54084   FULL_REWRITE_TAC[INJ];
54085   FIRST_ASSUM IMATCH_MP_TAC ;
54086   ]);;
54087   (* }}} *)
54088
54089 let simple_closed_curve_cut_unique_inter = prove_by_refinement(
54090   `!A A' A'' C v w. simple_closed_curve top2 C /\
54091       simple_arc_end A v w /\
54092       simple_arc_end A' v w /\
54093       simple_arc_end A'' v w /\
54094       (A' INTER A'' = {v,w})  /\
54095     (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==>
54096       (A = A') \/ (A = A'')`,
54097   (* {{{ proof *)
54098   [
54099   REP_BASIC_TAC;
54100   IMATCH_MP_TAC  simple_closed_curve_cut_unique;
54101   TYPE_THEN `C` EXISTS_TAC;
54102   TYPE_THEN `v` EXISTS_TAC;
54103   TYPE_THEN `w` EXISTS_TAC;
54104   DISCH_TAC;
54105   TYPE_THEN `A''` UNABBREV_TAC;
54106   FULL_REWRITE_TAC [INTER_ACI];
54107   TYPE_THEN `A'` UNABBREV_TAC;
54108   USEH 2648 (MATCH_MP simple_arc_end_simple);
54109   USEH 9214 (MATCH_MP simple_arc_infinite);
54110   FULL_REWRITE_TAC[INFINITE];
54111   UNDH 8436 THEN ASM_REWRITE_TAC[];
54112   REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
54113   (* Sun Jan  2 12:47:35 EST 2005 *)
54114   ]);;
54115   (* }}} *)
54116
54117 let jordan_curve_access = prove_by_refinement(
54118   `!A C v w x p. simple_closed_curve top2 C /\
54119       simple_arc_end A v w /\
54120       A SUBSET C /\
54121       A x /\ ~(x = v) /\ ~(x = w) /\
54122       (euclid 2 p) /\
54123       ~C p /\
54124       (?q. ~( p = q) /\ ~(C q) /\ (euclid 2 q) /\
54125          (!B. simple_arc_end B p q ==> ~(B INTER C = EMPTY)))   ==>
54126     (?E.
54127         simple_arc_end E p x /\
54128         E INTER C SUBSET A /\
54129       (!e. E e /\ ~C e /\ ~(p = e) ==> (cut_arc E p e INTER C = EMPTY)))`,
54130   (* {{{ proof *)
54131   [
54132   REP_BASIC_TAC;
54133   TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC;
54134   CONJ_TAC;
54135   IMATCH_MP_TAC  subset_imp;
54136   TYPE_THEN `A` EXISTS_TAC;
54137   IMATCH_MP_TAC  simple_arc_end_end;
54138   TYPE_THEN`w` EXISTS_TAC;
54139   CONJ_TAC;
54140   IMATCH_MP_TAC  subset_imp;
54141   TYPE_THEN `A` EXISTS_TAC;
54142   IMATCH_MP_TAC  simple_arc_end_end2;
54143   TYPE_THEN `v` EXISTS_TAC;
54144   USEH 9236  (MATCH_MP simple_arc_end_distinct);
54145   UNDH 1472 THEN ASM_REWRITE_TAC[];
54146   (* - *)
54147   THM_INTRO_TAC[`C`;`v`;`w`] simple_closed_cut;
54148   (* - *)
54149   TYPE_THEN `?B. (A UNION B = C) /\ (A INTER B = {v,w}) /\ (simple_arc_end B v w)` SUBAGOAL_TAC;
54150   THM_INTRO_TAC[`A`;`C'`;`C''`;`C`;`v`;`w`] simple_closed_curve_cut_unique_inter;
54151   TYPE_THEN `C` UNABBREV_TAC;
54152   REWRITE_TAC[SUBSET;UNION];
54153   (* -- *)
54154   FIRST_ASSUM DISJ_CASES_TAC ;
54155   TYPE_THEN `C'` UNABBREV_TAC;
54156   TYPE_THEN `C''` EXISTS_TAC;
54157   TYPE_THEN `C''` UNABBREV_TAC;
54158   TYPE_THEN `C'` EXISTS_TAC;
54159   FULL_REWRITE_TAC[INTER_ACI;UNION_ACI];
54160   KILLH 6724 THEN KILLH 906 THEN KILLH 4244 THEN KILLH 3747;
54161   (* -A *)
54162   THM_INTRO_TAC[`B`;`p`;`q`] simple_arc_conn_complement;
54163   USEH 2164 (MATCH_MP simple_arc_end_simple);
54164   TYPE_THEN `B SUBSET C` SUBAGOAL_TAC;
54165   TYPE_THEN `C` UNABBREV_TAC;
54166   REWRITE_TAC[SUBSET;UNION];
54167   ASM_MESON_TAC[subset_imp];
54168   (* - *)
54169   THM_INTRO_TAC[`A'`;`{p}`;`A`] simple_arc_end_restriction;
54170   CONJ_TAC;
54171   USEH 384 (MATCH_MP   simple_arc_end_simple);
54172   CONJ_TAC;
54173   USEH 384 (MATCH_MP simple_arc_end_end_closed);
54174   CONJ_TAC;
54175   USEH 9236 (MATCH_MP simple_arc_end_closed);
54176   CONJ_TAC;
54177   REWRITE_TAC[EQ_EMPTY];
54178   FULL_REWRITE_TAC[INTER;INR IN_SING];
54179   TYPE_THEN `x'` UNABBREV_TAC;
54180   ASM_MESON_TAC[subset_imp];
54181   REWRITE_TAC[EMPTY_EXISTS;INTER];
54182   CONJ_TAC;
54183   CONV_TAC (dropq_conv "u");
54184   USEH 384 (MATCH_MP simple_arc_end_end);
54185   TSPECH `A'` 1640;
54186   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
54187   TYPE_THEN `u` EXISTS_TAC;
54188   TYPE_THEN `C` UNABBREV_TAC;
54189   FULL_REWRITE_TAC[UNION];
54190   FIRST_ASSUM DISJ_CASES_TAC;
54191   FULL_REWRITE_TAC[EQ_EMPTY];
54192   ASM_MESON_TAC[];
54193   (* - *)
54194   TYPE_THEN `v' = p` SUBAGOAL_TAC;
54195   USEH 6335 (REWRITE_RULE[INR eq_sing;INTER;INR IN_SING ]);
54196   TYPE_THEN `v'` UNABBREV_TAC;
54197   (* -B *)
54198   TYPE_THEN `x = v''` ASM_CASES_TAC ;
54199   TYPE_THEN `v''` UNABBREV_TAC;
54200   TYPE_THEN `C'` EXISTS_TAC;
54201   SUBCONJ_TAC;
54202   TYPE_THEN `C` UNABBREV_TAC;
54203   REWRITE_TAC[INTER;UNION;SUBSET];
54204   FIRST_ASSUM DISJ_CASES_TAC;
54205   FULL_REWRITE_TAC[INTER;EQ_EMPTY;SUBSET ];
54206   ASM_MESON_TAC[];
54207   (* -- *)
54208   TYPE_THEN `~(e = x)` SUBAGOAL_TAC;
54209   TYPE_THEN `e` UNABBREV_TAC;
54210   UNDH 3668 THEN REWRITE_TAC[] ;
54211   IMATCH_MP_TAC  subset_imp;
54212   TYPE_THEN `A` EXISTS_TAC;
54213   THM_INTRO_TAC[`C'`;`e`;`p`;`x`] cut_arc_inter;
54214   (* -- *)
54215   PROOF_BY_CONTR_TAC;
54216   THM_INTRO_TAC[`C'`;`p`;`e`] cut_arc_subset;
54217   CONJ_TAC;
54218   USEH 8530 (MATCH_MP simple_arc_end_simple);
54219   USEH 8530 (MATCH_MP simple_arc_end_end);
54220   FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
54221   FULL_REWRITE_TAC[SUBSET;INR eq_sing ;INR IN_SING;];
54222   THM_INTRO_TAC[`C'`;`e`;`x`] cut_arc_simple;
54223   USEH 8530 (MATCH_MP simple_arc_end_simple);
54224   USEH 5502 (MATCH_MP simple_arc_end_end2);
54225   ASM_MESON_TAC[];
54226   (* -C *)
54227   TYPE_THEN `cutvx = cut_arc A v'' x` ABBREV_TAC ;
54228   TYPE_THEN `E = C' UNION cutvx` ABBREV_TAC ;
54229   TYPE_THEN `E` EXISTS_TAC;
54230   (* - *)
54231   TYPE_THEN `simple_arc top2 A` SUBAGOAL_TAC;
54232   IMATCH_MP_TAC  simple_arc_end_simple;
54233   ASM_MESON_TAC[];
54234   (* - *)
54235   TYPE_THEN `A v'' ` SUBAGOAL_TAC;
54236   FULL_REWRITE_TAC[INTER;INR eq_sing; INR IN_SING];
54237   THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_simple;
54238   (* - *)
54239   SUBCONJ_TAC;
54240   TYPE_THEN `E` UNABBREV_TAC ;
54241   IMATCH_MP_TAC  simple_arc_end_trans;
54242   TYPE_THEN `v''` EXISTS_TAC;
54243   TYPE_THEN `cutvx` UNABBREV_TAC;
54244   IMATCH_MP_TAC  SUBSET_ANTISYM;
54245   CONJ_TAC;
54246   USEH 6508 SYM;
54247   REWRITE_TAC[INTER;SUBSET];
54248   THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset;
54249   IMATCH_MP_TAC  subset_imp;
54250   UNIFY_EXISTS_TAC;
54251   REWRITE_TAC[SUBSET;INTER;INR IN_SING];
54252   FULL_REWRITE_TAC[INTER;INR IN_SING;INR eq_sing];
54253   USEH 4778 (MATCH_MP simple_arc_end_end);
54254   (* -D *)
54255   SUBCONJ_TAC;
54256   TYPE_THEN `E` UNABBREV_TAC;
54257   TYPE_THEN `cutvx` UNABBREV_TAC;
54258   TYPE_THEN `C` UNABBREV_TAC;
54259   REWRITE_TAC[SUBSET;INTER;UNION];
54260   FIRST_ASSUM DISJ_CASES_TAC;
54261   KILLH 4866;
54262   FIRST_ASSUM DISJ_CASES_TAC;
54263   FULL_REWRITE_TAC[SUBSET;EQ_EMPTY;INTER;];
54264   ASM_MESON_TAC[];
54265   THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset;
54266   IMATCH_MP_TAC  subset_imp;
54267   UNIFY_EXISTS_TAC;
54268   (* -E *)
54269   TYPE_THEN `simple_arc top2 E` SUBAGOAL_TAC;
54270   USEH 9538 (MATCH_MP simple_arc_end_simple);
54271   TYPE_THEN `C' p /\ C' e`  SUBAGOAL_TAC;
54272   CONJ_TAC;
54273   FULL_REWRITE_TAC[INTER;INR eq_sing;INR IN_SING];
54274   TYPE_THEN `E` UNABBREV_TAC;
54275   USEH 3684 (REWRITE_RULE[UNION]);
54276   FIRST_ASSUM DISJ_CASES_TAC;
54277   TYPE_THEN `cutvx SUBSET C` SUBAGOAL_TAC;
54278   IMATCH_MP_TAC  SUBSET_TRANS;
54279   TYPE_THEN `A` EXISTS_TAC;
54280   TYPE_THEN `cutvx` UNABBREV_TAC;
54281   IMATCH_MP_TAC  cut_arc_subset;
54282   ASM_MESON_TAC[subset_imp];
54283   (* - *)
54284   TYPE_THEN `cut_arc E p e = cut_arc C' p e` SUBAGOAL_TAC;
54285   IMATCH_MP_TAC  cut_arc_unique;
54286   TYPE_THEN `E` UNABBREV_TAC;
54287   CONJ_TAC;
54288   TYPE_THEN `cut_arc C' p e SUBSET C'` BACK_TAC;
54289   UNDH 7958 THEN REWRITE_TAC[SUBSET;UNION];
54290   IMATCH_MP_TAC  cut_arc_subset;
54291   USEH 2528 (MATCH_MP simple_arc_end_simple);
54292   IMATCH_MP_TAC  cut_arc_simple;
54293   USEH 2528 (MATCH_MP simple_arc_end_simple);
54294   (* - *)
54295   TYPE_THEN `~(e = v'')` SUBAGOAL_TAC;
54296   UNDH 5697 THEN ASM_REWRITE_TAC[];
54297   TYPE_THEN `C` UNABBREV_TAC;
54298   REWRITE_TAC[UNION];
54299   THM_INTRO_TAC[`C'`;`e`;`p`;`v''`] cut_arc_inter;
54300   (* - *)
54301   TYPE_THEN `C' INTER C = {v''}` SUBAGOAL_TAC;
54302   TYPE_THEN `C` UNABBREV_TAC;
54303   REWRITE_TAC[eq_sing;INR IN_SING ;INTER;UNION;];
54304   USEH 2528 (MATCH_MP simple_arc_end_end2);
54305   REP_BASIC_TAC;
54306   FIRST_ASSUM DISJ_CASES_TAC ;
54307   USEH 6508 (REWRITE_RULE[INTER;INR eq_sing;INR IN_SING]);
54308   FIRST_ASSUM IMATCH_MP_TAC ;
54309   USEH 7813 (REWRITE_RULE[SUBSET]);
54310   USEH 4523 (REWRITE_RULE[EQ_EMPTY;INTER;]);
54311   ASM_MESON_TAC[];
54312   (* -F *)
54313   TYPE_THEN `C' v''` SUBAGOAL_TAC;
54314   USEH 2528 (MATCH_MP simple_arc_end_end2);
54315   TYPE_THEN `~cut_arc C' p e v''` SUBAGOAL_TAC;
54316   USEH 8060 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
54317   UNDH 2267 THEN DISCH_THEN (THM_INTRO_TAC[`v''`]);
54318   THM_INTRO_TAC[`C'`;`e`;`v''`] cut_arc_simple;
54319   USEH 2528 (MATCH_MP   simple_arc_end_simple);
54320   USEH 1175 (MATCH_MP simple_arc_end_end2);
54321   UNDH 1069 THEN ASM_REWRITE_TAC[];
54322   PROOF_BY_CONTR_TAC;
54323   USEH 7182 (REWRITE_RULE [EMPTY_EXISTS;INTER]);
54324   USEH 3774 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
54325   TYPE_THEN `u = v''` SUBAGOAL_TAC;
54326   FIRST_ASSUM IMATCH_MP_TAC ;
54327   TYPE_THEN `cut_arc C' p e SUBSET C'` SUBAGOAL_TAC;
54328   IMATCH_MP_TAC  cut_arc_subset;
54329   USEH 2528 (MATCH_MP simple_arc_end_simple);
54330   IMATCH_MP_TAC  subset_imp;
54331   UNIFY_EXISTS_TAC;
54332   TYPE_THEN `u` UNABBREV_TAC;
54333   UNDH 9484 THEN ASM_REWRITE_TAC[];
54334   (* Sun Jan  2 14:55:11 EST 2005 *)
54335
54336   ]);;
54337   (* }}} *)
54338
54339 (* ------------------------------------------------------------------ *)
54340 (* SECTION BB *)
54341 (* ------------------------------------------------------------------ *)
54342
54343
54344 (* show that a Jordan curve has no more than 2 components *)
54345
54346 let jordan_curve_seg3 = prove_by_refinement(
54347   `!C. simple_closed_curve top2 C ==>
54348      (?s.  (!(i:three_t). (s i SUBSET C) /\ (simple_arc top2 (s i))) /\
54349           (!i j. ~(s i INTER s j = EMPTY) ==> (i = j)))`,
54350   (* {{{ proof *)
54351   [
54352   REWRITE_TAC[simple_closed_curve];
54353   TYPE_THEN `s = (\ i. IMAGE f {x | ((&2 * &(REP3 i) + &1)/ &8) <= x /\ x <= ((&2 * &(REP3 i) + &2)/ &8) } )` ABBREV_TAC ;
54354   TYPE_THEN `s` EXISTS_TAC;
54355   (* - *)
54356   TYPE_THEN `&0 < &8 /\ ~(&8 = &0)` SUBAGOAL_TAC;
54357   REAL_ARITH_TAC;
54358   TYPE_THEN `!i. &0 <= (&2 * &(REP3 i) + &1) / &8` SUBAGOAL_TAC;
54359   IMATCH_MP_TAC  REAL_LE_DIV;
54360   REDUCE_TAC;
54361   TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / &8 <= &1` SUBAGOAL_TAC;
54362   ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
54363   REDUCE_TAC;
54364   THM_INTRO_TAC[`i`] rep3_lt;
54365   UNDH 1618 THEN ARITH_TAC;
54366   (* - *)
54367   CONJ_TAC;
54368   CONJ_TAC;
54369   TYPE_THEN `s` UNABBREV_TAC;
54370   REWRITE_TAC[SUBSET;IMAGE];
54371   TYPE_THEN `x'` EXISTS_TAC;
54372   CONJ_TAC;
54373   IMATCH_MP_TAC  REAL_LE_TRANS;
54374   UNIFY_EXISTS_TAC;
54375   IMATCH_MP_TAC  REAL_LE_TRANS;
54376   UNIFY_EXISTS_TAC;
54377   (* -- *)
54378   TYPE_THEN `s` UNABBREV_TAC ;
54379   THM_INTRO_TAC[`f`;`(&2 * &(REP3 i) + &1) / &8 `;`(&2 * &(REP3 i) + &2) / &8`] simple_arc_segment;
54380   FULL_REWRITE_TAC[top2_unions];
54381   CONJ_TAC;
54382  ASM_SIMP_TAC[real_div_denom_lt];
54383   REDUCE_TAC;
54384   ARITH_TAC;
54385   DISJ1_TAC;
54386   IMATCH_MP_TAC  REAL_LT_DIV;
54387   REDUCE_TAC;
54388   ARITH_TAC;
54389   USEH 6148 (MATCH_MP simple_arc_end_simple);
54390   (* -A *)
54391   TYPE_THEN `!i j. (REP3 i < REP3 j) ==> (s i INTER s j = EMPTY)` BACK_TAC ;
54392   TYPE_THEN `(REP3 i = REP3 j) \/ (REP3 j <| REP3 i) \/ (REP3 i < REP3 j)` SUBAGOAL_TAC;
54393   ARITH_TAC;
54394   UNDH 2249 THEN REP_CASES_TAC;
54395   REWRITE_TAC[three_t_eq];
54396   UNDH 6857 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
54397   FULL_REWRITE_TAC[INTER_COMM];
54398   ASM_MESON_TAC[];
54399   ASM_MESON_TAC[];
54400   (* - *)
54401   PROOF_BY_CONTR_TAC;
54402   KILLH 1348;
54403   FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
54404   TYPE_THEN `s` UNABBREV_TAC;
54405   USEH 4729 (REWRITE_RULE[IMAGE]);
54406   USEH 9244 (REWRITE_RULE[IMAGE]);
54407   TYPE_THEN `u` UNABBREV_TAC;
54408   (* - *)
54409   TYPE_THEN `x = x'` SUBAGOAL_TAC;
54410   FULL_REWRITE_TAC[INJ];
54411   FIRST_ASSUM IMATCH_MP_TAC ;
54412   TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / (&8) < &1`SUBAGOAL_TAC;
54413   UNDH 7394 THEN SIMP_TAC[REAL_LT_LDIV_EQ];
54414   REDUCE_TAC;
54415   THM_INTRO_TAC[`i`] rep3_lt;
54416   UNDH 1618 THEN ARITH_TAC;
54417   TYPE_THEN `&0 <= x /\ &0 <= x'` SUBAGOAL_TAC;
54418   ASM_MESON_TAC[REAL_LE_TRANS];
54419   CONJ_TAC THEN IMATCH_MP_TAC  REAL_LET_TRANS THEN UNIFY_EXISTS_TAC;
54420   (* - *)
54421   TYPE_THEN `x'` UNABBREV_TAC;
54422   TYPE_THEN `(&2 * &(REP3 j') + &1) / &8 <= (&2 * &(REP3 i') + &2)/ &8` SUBAGOAL_TAC;
54423   IMATCH_MP_TAC  REAL_LE_TRANS THEN UNIFY_EXISTS_TAC;
54424   (* - *)
54425   USEH 8118 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`));
54426   UNDH 4580 THEN REWRITE_TAC[];
54427   ASM_SIMP_TAC[REAL_LT_RDIV];
54428   REDUCE_TAC;
54429   UNDH 4372 THEN ARITH_TAC;
54430   (* Sun Jan  2 20:07:58 EST 2005 *)
54431
54432   ]);;
54433   (* }}} *)
54434
54435 let abs3_distinct = prove_by_refinement(
54436   `~(ABS3 0 = ABS3 1) /\ ~(ABS3 0 = ABS3 2) /\ ~(ABS3 1 = ABS3 2)`,
54437   (* {{{ proof *)
54438   [
54439   TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3(ABS3 j))==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC;
54440   TYPE_THEN `ABS3 i` UNABBREV_TAC;
54441   REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC  THEN ASM_REWRITE_TAC[ABS3_012] THEN ARITH_TAC;
54442   ]);;
54443   (* }}} *)
54444
54445 let three_t_enum = prove_by_refinement(
54446   `!(a:A) b c. ?(f:three_t ->A). (f(ABS3 0) = a) /\
54447          (f(ABS3 1) = b) /\ (f(ABS3 2) = c)`,
54448   (* {{{ proof *)
54449   [
54450   REP_BASIC_TAC;
54451   TYPE_THEN `f = (\ i. (if (i = ABS3 0) then a else (if (i = ABS3 1) then b else c)))` ABBREV_TAC ;
54452   TYPE_THEN `f` EXISTS_TAC;
54453   TYPE_THEN `f` UNABBREV_TAC;
54454   REWRITE_TAC[abs3_distinct];
54455   ]);;
54456   (* }}} *)
54457
54458 let three_t_univ = prove_by_refinement(
54459   `!P. P (ABS3 0) /\ P(ABS3 1) /\ P(ABS3 2) ==> (!i. P i)`,
54460   (* {{{ proof *)
54461   [
54462   REP_BASIC_TAC;
54463   THM_INTRO_TAC[`i`] ABS3_onto;
54464   TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2)` SUBAGOAL_TAC;
54465   UNDH 4616 THEN ARITH_TAC;
54466  UNDH 2783 THEN REP_CASES_TAC  THEN (TYPE_THEN `j` UNABBREV_TAC);
54467   ]);;
54468   (* }}} *)
54469
54470 let simple_arc_sep_three_t = prove_by_refinement(
54471   `!C x p.
54472       (!(i:three_t). simple_arc_end (C i) x (p i)) /\
54473       (!i j. (C i) (p j) ==> (i = j)) ==>
54474    (?C' x.
54475       (!i. simple_arc_end (C' i) x (p i)) /\
54476       (!i j. ~(i = j) ==> (C' i INTER C' j = {x})) /\
54477       (!A. (!i. (C i) SUBSET A) ==> (!i. (C' i) SUBSET A)))  `,
54478   (* {{{ proof *)
54479   [
54480   REP_BASIC_TAC;
54481   TYPE_THEN `A = C(ABS3 0) UNION C(ABS3 1) UNION C(ABS3 2)` ABBREV_TAC ;
54482   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;
54483   REWRITE_TAC[SUBSET_REFL];
54484   TYPE_THEN `!i j. ~(i = j) ==> ~(C i (p j))` SUBAGOAL_TAC;
54485   ASM_MESON_TAC[];
54486   TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3 (ABS3 j))  ==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC;
54487   TYPE_THEN `ABS3 i` UNABBREV_TAC;
54488   REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[ABS3_012] THEN ARITH_TAC ;
54489   THM_INTRO_TAC[`C1'`;`C2'`;`C3'`] three_t_enum;
54490   TYPE_THEN `f` EXISTS_TAC;
54491   TYPE_THEN `x'` EXISTS_TAC;
54492   TYPE_THEN `C1'` UNABBREV_TAC;
54493   TYPE_THEN `C2'` UNABBREV_TAC;
54494   TYPE_THEN `C3'` UNABBREV_TAC;
54495   (* - *)
54496   CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ;ALL_TAC];
54497   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];
54498   IMATCH_MP_TAC  SUBSET_TRANS;
54499   TYPE_THEN `A` EXISTS_TAC;
54500   FULL_REWRITE_TAC[union_subset];
54501   TYPE_THEN `!i. (f i SUBSET A)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  three_t_univ;ALL_TAC];
54502   (* - *)
54503   UNDH 2066 THEN UNDH 915 THEN POP_ASSUM_LIST (fun t->ALL_TAC);
54504   TYPE_THEN `A` UNABBREV_TAC;
54505   REWRITE_TAC[union_subset];
54506   (* Sun Jan  2 21:17:07 EST 2005 *)
54507
54508   ]);;
54509   (* }}} *)
54510
54511 let old_every_step_tac = !EVERY_STEP_TAC;;
54512 EVERY_STEP_TAC :=
54513       REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN
54514       (REWRITE_TAC[]) ;;
54515
54516 let transpose = jordan_def `transpose (Q:A->B->C) i j = Q j i`;;
54517
54518 let transpose2 = prove_by_refinement(
54519   `!Q . (transpose (transpose Q))  = (Q:A->B->C) `,
54520   (* {{{ proof *)
54521   [
54522   REP_BASIC_TAC;
54523   IMATCH_MP_TAC  EQ_EXT;
54524   IMATCH_MP_TAC  EQ_EXT;
54525   REWRITE_TAC[transpose];
54526   ]);;
54527   (* }}} *)
54528
54529 let k33_planar_graph_data_expand = prove_by_refinement(
54530   `(!q A CA B CB.
54531       (!(i:three_t) (j:three_t) i' j'.
54532           (q i j = q i' j') ==> (i = i') /\ (j = j')) /\
54533       (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\
54534       (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\
54535       (!i j i' j' u. (CB i j u /\ CA i' j' u) ==>
54536            (i = i') /\ (j = j') /\ (u = q i j)) /\
54537       (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\
54538       (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j'))
54539     ==> (?A' CA' B' CB'.
54540       (!i j. simple_arc_end (CA' i j) (A' i) (q i j)) /\
54541       (!i j. simple_arc_end (CB' i j) (B' j) (q i j)) /\
54542       (!i j i' j' u. (CB' i j u /\ CA' i' j' u) ==>
54543            (i = i') /\ (j = j') /\ (u = q i j)) /\
54544       (!i j i' j'. ~(CA' i j INTER CA' i' j' = EMPTY) ==> (i = i')) /\
54545       (!i j i' j'. ~(CB' i j INTER CB' i' j' = EMPTY) ==> (j = j')) /\
54546       (!i j k. ~(j = k) ==> (CA' i j INTER CA' i k = {(A' i)})) /\
54547       (!i j k. ~(j = k) ==> (CB' j i INTER CB' k i = {(B' i)}))
54548       ))
54549         `,
54550   (* {{{ proof *)
54551   [
54552   REP_BASIC_TAC;
54553   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;
54554   IMATCH_MP_TAC  simple_arc_sep_three_t;
54555   TYPE_THEN `A i` EXISTS_TAC;
54556   ASM_REWRITE_TAC[];
54557   UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`q i j'`]);
54558   ASM_REWRITE_TAC[];
54559   UNDH 190 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`]);
54560   USEH 6066 (MATCH_MP simple_arc_end_end2);
54561   ASM_REWRITE_TAC[];
54562   ASM_REWRITE_TAC[];
54563   RIGHTH 7847 "i";
54564   RIGHTH 705 "i";
54565   TYPE_THEN `A'` EXISTS_TAC;
54566   TYPE_THEN `CA'` EXISTS_TAC;
54567   TYPE_THEN `(!i j. simple_arc_end (CA' i j) (A' i) (q i j))` SUBAGOAL_TAC;
54568   ASM_REWRITE_TAC[];
54569   ASM_REWRITE_TAC[];
54570   (* -A *)
54571   TYPE_THEN `!i j u. CA' i j u ==> (?j'. CA i j' u)` SUBAGOAL_TAC;
54572   TSPECH `i` 6858;
54573   TSPECH `UNIONS (IMAGE (CA i) (UNIV))` 1295;
54574   UNDH 3086 THEN DISCH_THEN (THM_INTRO_TAC[]);
54575   REWRITE_TAC[SUBSET;UNIONS;IMAGE ];
54576   CONV_TAC (dropq_conv ("u"));
54577   UNIFY_EXISTS_TAC;
54578  ASM_REWRITE_TAC[];
54579   TSPECH `j` 7352;
54580   USEH 4766  (REWRITE_RULE[SUBSET;UNIONS;IMAGE]);
54581   TSPECH `u` 9646;
54582   REP_BASIC_TAC;
54583   TYPE_THEN `u'` UNABBREV_TAC;
54584   UNIFY_EXISTS_TAC;
54585   ASM_REWRITE_TAC[];
54586   (* - *)
54587   TYPE_THEN `(!i j i' j'. ~(CA' i j INTER CA' i' j' = {}) ==> (i = i'))` SUBAGOAL_TAC;
54588   USEH 3155 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
54589   COPYH 6882;
54590   UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
54591   ASM_REWRITE_TAC[];
54592   UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
54593   ASM_REWRITE_TAC[];
54594   KILLH 33;
54595   FIRST_ASSUM IMATCH_MP_TAC ;
54596   REWRITE_TAC[EMPTY_EXISTS;INTER];
54597   TYPE_THEN `j'''` EXISTS_TAC;
54598   TYPE_THEN `j''` EXISTS_TAC;
54599   UNIFY_EXISTS_TAC;
54600   ASM_REWRITE_TAC[];
54601   ASM_REWRITE_TAC[];
54602   (* -B *)
54603   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;
54604   IMATCH_MP_TAC  simple_arc_sep_three_t;
54605   TYPE_THEN `B i` EXISTS_TAC;
54606   REWRITE_TAC[transpose];
54607   ASM_REWRITE_TAC[];
54608   UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`;`j'`;`i`;`q j' i`]);
54609   ASM_REWRITE_TAC[];
54610   UNDH 8461 THEN DISCH_THEN (THM_INTRO_TAC[`j'`;`i`]);
54611   USEH 6944 (MATCH_MP simple_arc_end_end2);
54612   ASM_REWRITE_TAC[];
54613   ASM_REWRITE_TAC[];
54614   RIGHTH 2590 "i";
54615   RIGHTH 5199 "i";
54616   TYPE_THEN `B'` EXISTS_TAC;
54617   TYPE_THEN `CB' = transpose CBt'` ABBREV_TAC ;
54618   TYPE_THEN `CBt' = transpose CB'` SUBAGOAL_TAC;
54619   TYPE_THEN `CB'` UNABBREV_TAC;
54620   REWRITE_TAC[transpose2];
54621   TYPE_THEN `CBt'` UNABBREV_TAC;
54622   FULL_REWRITE_TAC[transpose];
54623   KILLH 87;
54624   TYPE_THEN `CB'` EXISTS_TAC;
54625   ASM_REWRITE_TAC[];
54626   (* -C *)
54627   TYPE_THEN `!i j u. CB' i j u ==> (?i'. CB i' j u)` SUBAGOAL_TAC;
54628   TSPECH `j` 4587;
54629   TSPECH `UNIONS (IMAGE (transpose CB j) (UNIV))` 6357;
54630   UNDH 3701 THEN DISCH_THEN (THM_INTRO_TAC[]);
54631   REWRITE_TAC[SUBSET;UNIONS;IMAGE;transpose ];
54632   CONV_TAC (dropq_conv ("u"));
54633   UNIFY_EXISTS_TAC;
54634  ASM_REWRITE_TAC[];
54635   TSPECH `i` 8438;
54636   USEH 4864  (REWRITE_RULE[SUBSET;UNIONS;IMAGE]);
54637   TSPECH `u` 7999;
54638   FULL_REWRITE_TAC[transpose];
54639   TYPE_THEN `u'` UNABBREV_TAC;
54640   UNIFY_EXISTS_TAC;
54641   ASM_REWRITE_TAC[];
54642   (* - *)
54643   TYPE_THEN `(!i j i' j'. ~(CB' i j INTER CB' i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC;
54644   USEH 541 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
54645   COPYH 5811;
54646   UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
54647   ASM_REWRITE_TAC[];
54648   UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
54649   ASM_REWRITE_TAC[];
54650   KILLH 3657;
54651   KILLH 6409;
54652   FIRST_ASSUM IMATCH_MP_TAC ;
54653   REWRITE_TAC[EMPTY_EXISTS;INTER];
54654   TYPE_THEN `i'''` EXISTS_TAC;
54655   TYPE_THEN `i''` EXISTS_TAC;
54656   UNIFY_EXISTS_TAC;
54657   ASM_REWRITE_TAC[];
54658   ASM_REWRITE_TAC[];
54659   (* -D *)
54660   UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
54661   ASM_REWRITE_TAC[];
54662   UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
54663   ASM_REWRITE_TAC[];
54664   UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i''`;`j`;`i'`;`j''`;`u`]);
54665   ASM_REWRITE_TAC[];
54666   TYPE_THEN `j''` UNABBREV_TAC;
54667   TYPE_THEN `i''` UNABBREV_TAC;
54668   TYPE_THEN `u` UNABBREV_TAC;
54669   TSPECH `i'` 6858;
54670   (* -- *)
54671   TYPE_THEN `~(j = j')` ASM_CASES_TAC;
54672   UNDH 1784 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`j'`]);
54673   UNDH 2577 THEN ASM_REWRITE_TAC[];
54674   USEH 6310 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
54675   TSPECH `q i' j` 3488;
54676   REWRH 4791;
54677   TSPECH `j` 1529;
54678   COPYH 3976;
54679   USEH 3976 (MATCH_MP simple_arc_end_distinct);
54680   UNDH 587 THEN ASM_REWRITE_TAC[];
54681   ONCE_REWRITE_TAC[EQ_SYM_EQ];
54682   FIRST_ASSUM IMATCH_MP_TAC ;
54683   USEH 3976 (MATCH_MP  simple_arc_end_end2);
54684   ASM_REWRITE_TAC[];
54685   FULL_REWRITE_TAC[];
54686   TYPE_THEN `j'` UNABBREV_TAC;
54687   (* -E *)
54688   TYPE_THEN `(i = i')` BACK_TAC;
54689   TYPE_THEN `i'` UNABBREV_TAC;
54690   PROOF_BY_CONTR_TAC;
54691   TSPECH `j` 4587;
54692   UNDH 5789 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`]);
54693   UNDH 3113 THEN ASM_REWRITE_TAC[];
54694   USEH 3441 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
54695   TSPECH `q i' j` 7938;
54696   REWRH 5749;
54697   TSPECH `i'` 7762;
54698   COPYH 8730;
54699   USEH 8730 (MATCH_MP simple_arc_end_distinct);
54700   UNDH 586 THEN ASM_REWRITE_TAC[];
54701   ONCE_REWRITE_TAC[EQ_SYM_EQ];
54702   FIRST_ASSUM IMATCH_MP_TAC ;
54703   USEH 8730 (MATCH_MP  simple_arc_end_end2);
54704   ASM_REWRITE_TAC[];
54705   (* Tue Jan  4 10:50:14 EST 2005 *)
54706
54707   ]);;
54708   (* }}} *)
54709
54710 let three_t_size3 = prove_by_refinement(
54711   `(UNIV:three_t->bool) HAS_SIZE 3`,
54712   (* {{{ proof *)
54713   [
54714   ASSUME_TAC (ARITH_RULE `3 = SUC 2`);
54715   ASM_REWRITE_TAC[];
54716   REWRITE_TAC[HAS_SIZE_SUC];
54717   REWRITE_TAC[three_delete_size];
54718   ]);;
54719   (* }}} *)
54720
54721 let no_k33_planar_graph_data = prove_by_refinement(
54722   `(!q A CA B CB.
54723       (!(i:three_t) (j:three_t) i' j'.
54724           (q i j = q i' j') ==> (i = i') /\ (j = j')) /\
54725       (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\
54726       (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\
54727       (!i j i' j' u. (CB i j u /\ CA i' j' u) ==>
54728            (i = i') /\ (j = j') /\ (u = q i j)) /\
54729       (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\
54730       (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j')) ==>
54731      F)`,
54732   (* {{{ proof *)
54733   [
54734   REP_BASIC_TAC;
54735   THM_INTRO_TAC[`q`;`A`;`CA`;`B`;`CB`] k33_planar_graph_data_expand;
54736   ASM_REWRITE_TAC[];
54737   KILLH 33 THEN KILLH 3657 THEN KILLH 8763 THEN KILLH 190 THEN KILLH 8461;
54738   TYPE_THEN `CE = ( \i j. CA' i j UNION CB' i j)` ABBREV_TAC ;
54739   TYPE_THEN `!i j. CE i j = CA' i j UNION CB' i j` SUBAGOAL_TAC;
54740   TYPE_THEN `CE` UNABBREV_TAC;
54741   TYPE_THEN `!i j. simple_arc_end (CE i j) (A' i) (B' j)` SUBAGOAL_TAC;
54742   TYPE_THEN `CE` UNABBREV_TAC;
54743   IMATCH_MP_TAC  simple_arc_end_trans;
54744   TYPE_THEN `q i j` EXISTS_TAC;
54745   ASM_REWRITE_TAC[];
54746   CONJ_TAC;
54747   IMATCH_MP_TAC  simple_arc_end_symm;
54748   ASM_REWRITE_TAC[];
54749   IMATCH_MP_TAC  SUBSET_ANTISYM;
54750   CONJ_TAC;
54751   REWRITE_TAC[INTER;SUBSET;INR IN_SING];
54752   ASM_MESON_TAC[];
54753   REWRITE_TAC[SUBSET;INR IN_SING;INTER];
54754   TYPE_THEN `x` UNABBREV_TAC;
54755   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
54756   (* - *)
54757   TYPE_THEN `A = IMAGE A' UNIV` ABBREV_TAC ;
54758   TYPE_THEN `B = IMAGE B' UNIV` ABBREV_TAC ;
54759   TYPE_THEN `E = IMAGE (\ (i,j).  (CE i j)) (cartesian UNIV UNIV)` ABBREV_TAC ;
54760   (* - *)
54761   TYPE_THEN `!i j. CA' i j (q i j)` SUBAGOAL_TAC;
54762   ASM_MESON_TAC[simple_arc_end_end2];
54763   TYPE_THEN `!i j. CB' i j (q i j)` SUBAGOAL_TAC;
54764   ASM_MESON_TAC[simple_arc_end_end2];
54765   TYPE_THEN `!i j. CA' i j (A' i)` SUBAGOAL_TAC;
54766   ASM_MESON_TAC[simple_arc_end_end];
54767   TYPE_THEN `!i j. CB' i j (B' j)` SUBAGOAL_TAC;
54768   ASM_MESON_TAC[simple_arc_end_end];
54769   (* - *)
54770   TYPE_THEN `!i i' j. CA' i j (A' i') ==> (i = i')` SUBAGOAL_TAC;
54771   KILLH 5790;
54772   FIRST_ASSUM IMATCH_MP_TAC ;
54773   TYPE_THEN `j` EXISTS_TAC;
54774   REWRITE_TAC[INTER;EMPTY_EXISTS];
54775   TYPE_THEN `j` EXISTS_TAC;
54776   TYPE_THEN `(A' i')` EXISTS_TAC;
54777   ASM_REWRITE_TAC[];
54778   (* - *)
54779   TYPE_THEN `!i j j'. CB' i j (B' j') ==> (j = j')` SUBAGOAL_TAC;
54780   KILLH 6409;
54781   KILLH 1344;
54782   FIRST_ASSUM IMATCH_MP_TAC ;
54783   TYPE_THEN `i` EXISTS_TAC;
54784   REWRITE_TAC[INTER;EMPTY_EXISTS];
54785   TYPE_THEN `i` EXISTS_TAC;
54786   TYPE_THEN `(B' j')` EXISTS_TAC;
54787   ASM_REWRITE_TAC[];
54788   (* - *)
54789   TYPE_THEN `!i i' j. ~CB' i j (A' i') ` SUBAGOAL_TAC;
54790   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`A' i'`]);
54791   ASM_REWRITE_TAC[];
54792   USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
54793   UNDH 6711 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`]);
54794   TYPE_THEN `A' i'` EXISTS_TAC;
54795   ASM_REWRITE_TAC[];
54796   TYPE_THEN `i'` UNABBREV_TAC;
54797   ASM_MESON_TAC[simple_arc_end_distinct];
54798   (* - *)
54799   TYPE_THEN `!i  j j'. ~CA' i j (B' j') ` SUBAGOAL_TAC;
54800   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`B' j'`]);
54801   ASM_REWRITE_TAC[];
54802   TYPE_THEN `j'` UNABBREV_TAC;
54803   ASM_MESON_TAC[simple_arc_end_distinct];
54804   (* - *)
54805   TYPE_THEN `!i j. CE i j INTER A = {(A' i)}` SUBAGOAL_TAC;
54806   REWRITE_TAC[eq_sing;INR IN_SING;INTER];
54807   TYPE_THEN `A` UNABBREV_TAC;
54808   REWRITE_TAC[IMAGE];
54809   TYPE_THEN `CE` UNABBREV_TAC;
54810   REWRITE_TAC[UNION];
54811   ASM_REWRITE_TAC[];
54812   NAME_CONFLICT_TAC;
54813   CONJ_TAC;
54814   MESON_TAC[];
54815   TYPE_THEN `u'` UNABBREV_TAC ;
54816   TYPE_THEN `x' = i` SUBAGOAL_TAC;
54817   ASM_MESON_TAC[];
54818   ASM_REWRITE_TAC[];
54819   (* - *)
54820   TYPE_THEN `!i j. CE i j INTER B = {(B' j)}` SUBAGOAL_TAC;
54821   REWRITE_TAC[eq_sing;INR IN_SING;INTER];
54822   TYPE_THEN `B` UNABBREV_TAC;
54823   REWRITE_TAC[IMAGE];
54824   TYPE_THEN `CE` UNABBREV_TAC;
54825   REWRITE_TAC[UNION];
54826   ASM_REWRITE_TAC[];
54827   NAME_CONFLICT_TAC;
54828   CONJ_TAC;
54829   MESON_TAC[];
54830   TYPE_THEN `u'` UNABBREV_TAC ;
54831   TYPE_THEN `x' = j` SUBAGOAL_TAC;
54832   ASM_MESON_TAC[];
54833   ASM_REWRITE_TAC[];
54834   (* -A *)
54835   TYPE_THEN `!i i'. (A' i = A' i') ==> (i = i')` SUBAGOAL_TAC;
54836   UNDH 1344 THEN DISCH_THEN IMATCH_MP_TAC ;
54837   ASM_MESON_TAC[];
54838   (* - *)
54839   TYPE_THEN `!j j'. (B' j = B' j') ==> (j = j')` SUBAGOAL_TAC;
54840   UNDH 6780 THEN DISCH_THEN IMATCH_MP_TAC ;
54841   ASM_MESON_TAC[];
54842   (* - *)
54843   TYPE_THEN `!i j i' j'. ~(CE i j INTER CE i' j' = EMPTY) ==> (i = i') \/ (j = j')` SUBAGOAL_TAC;
54844   PROOF_BY_CONTR_TAC;
54845   FULL_REWRITE_TAC[DE_MORGAN_THM];
54846   TYPE_THEN `CE` UNABBREV_TAC;
54847   USEH 672 (REWRITE_RULE[EMPTY_EXISTS;INTER;UNION]);
54848   USEH 5790  (REWRITE_RULE[EMPTY_EXISTS;INTER]);
54849   USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
54850   FIRST_ASSUM DISJ_CASES_TAC THEN KILLH 7160 THEN (FIRST_ASSUM DISJ_CASES_TAC) ;
54851   UNDH 3113 THEN REWRITE_TAC[] THEN UNDH 6711 THEN DISCH_THEN IMATCH_MP_TAC ;
54852   UNIFY_EXISTS_TAC;
54853   ASM_REWRITE_TAC[];
54854   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`u`]);
54855   ASM_REWRITE_TAC[];
54856   ASM_MESON_TAC[];
54857   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`i`;`j`;`u`]);
54858   ASM_REWRITE_TAC[];
54859   ASM_MESON_TAC[];
54860   UNDH 2577 THEN REWRITE_TAC[] THEN UNDH 6981 THEN DISCH_THEN IMATCH_MP_TAC ;
54861   UNIFY_EXISTS_TAC;
54862   ASM_REWRITE_TAC[];
54863   (* -B *)
54864   TYPE_THEN `!i j. ~(A' i = B' j)` SUBAGOAL_TAC;
54865   ASM_MESON_TAC[];
54866   (* - *)
54867   TYPE_THEN `!i j j'. ~(j = j') ==>  (CE i j INTER CE i j' = {(A' i)})` SUBAGOAL_TAC;
54868   IMATCH_MP_TAC  SUBSET_ANTISYM;
54869   CONJ_TAC;
54870   TYPE_THEN `CE` UNABBREV_TAC;
54871   REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING];
54872   FIRST_ASSUM DISJ_CASES_TAC   THEN (KILLH 2709) THEN (FIRST_ASSUM DISJ_CASES_TAC  );
54873   USEH 6932  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[];
54874   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`j'`;`x`]);
54875   ASM_REWRITE_TAC[];
54876   ASM_MESON_TAC[];
54877   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`x`]);
54878   ASM_REWRITE_TAC[];
54879   ASM_MESON_TAC[];
54880   USEH 5790 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
54881   ASM_MESON_TAC[];
54882   REWRITE_TAC[INR IN_SING;SUBSET;INTER];
54883   TYPE_THEN `x` UNABBREV_TAC;
54884   USEH 9014 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
54885   ASM_MESON_TAC[];
54886   (* - *)
54887   TYPE_THEN `!i i' j. ~(i = i') ==>  (CE i j INTER CE i' j = {(B' j)})` SUBAGOAL_TAC;
54888   IMATCH_MP_TAC  SUBSET_ANTISYM;
54889   CONJ_TAC;
54890   TYPE_THEN `CE` UNABBREV_TAC;
54891   REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING];
54892   FIRST_ASSUM DISJ_CASES_TAC   THEN (KILLH 3625) THEN (FIRST_ASSUM DISJ_CASES_TAC  );
54893   USEH 6409  (REWRITE_RULE[EMPTY_EXISTS;INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[];
54894   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`x`]);
54895   ASM_REWRITE_TAC[];
54896   ASM_MESON_TAC[];
54897   UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`i`;`j`;`x`]);
54898   ASM_REWRITE_TAC[];
54899   ASM_MESON_TAC[];
54900   USEH 3599 (REWRITE_RULE[INTER;eq_sing;INR IN_SING;]);
54901   ASM_MESON_TAC[];
54902   REWRITE_TAC[INR IN_SING;SUBSET;INTER];
54903   TYPE_THEN `x` UNABBREV_TAC;
54904   USEH 4144 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
54905   ASM_MESON_TAC[];
54906   (* -C *)
54907   TYPE_THEN `g = (\ (i,j). CE i j)` ABBREV_TAC ;
54908   TYPE_THEN `BIJ g (cartesian UNIV UNIV) E` SUBAGOAL_TAC;
54909   TYPE_THEN `E` UNABBREV_TAC;
54910   IMATCH_MP_TAC  inj_bij;
54911   REWRITE_TAC[INJ];
54912   TYPE_THEN `g` UNABBREV_TAC;
54913   TYPE_THEN `?i j. x = (i,j)` SUBAGOAL_TAC;
54914   REWRITE_TAC[PAIR_SPLIT];
54915   MESON_TAC[];
54916   TYPE_THEN `x` UNABBREV_TAC;
54917   TYPE_THEN `?i j. y = (i,j)` SUBAGOAL_TAC;
54918   REWRITE_TAC[PAIR_SPLIT];
54919   MESON_TAC[];
54920   TYPE_THEN `y` UNABBREV_TAC;
54921 (*** Removed by JRH; this happens automatically now
54922   USEH 8053 (GBETA_RULE);
54923  ***)
54924   REWRITE_TAC[PAIR_SPLIT];
54925   (* -- *)
54926   TYPE_THEN `!i j. INFINITE (CE i j)` SUBAGOAL_TAC;
54927   IMATCH_MP_TAC  simple_arc_infinite;
54928   IMATCH_MP_TAC  simple_arc_end_simple;
54929   ASM_MESON_TAC[];
54930   (* -- *)
54931   TYPE_THEN `(i = i') \/ (j = j')` SUBAGOAL_TAC;
54932   FIRST_ASSUM IMATCH_MP_TAC ;
54933   TYPE_THEN `CE i' j'` UNABBREV_TAC;
54934   FULL_REWRITE_TAC[INTER_IDEMPOT];
54935   TSPECH `i` 6411;
54936   TSPECH `j` 2286;
54937   FULL_REWRITE_TAC[INFINITE];
54938   TYPE_THEN `CE i j` UNABBREV_TAC;
54939   FULL_REWRITE_TAC[FINITE_RULES];
54940   ASM_REWRITE_TAC[];
54941   FIRST_ASSUM DISJ_CASES_TAC;
54942   ASM_REWRITE_TAC[];
54943   PROOF_BY_CONTR_TAC;
54944   UNDH 2315 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]);
54945   ASM_MESON_TAC[];
54946   TYPE_THEN `i'` UNABBREV_TAC;
54947   TYPE_THEN `CE i j'` UNABBREV_TAC;
54948   FULL_REWRITE_TAC[INTER_IDEMPOT];
54949   FULL_REWRITE_TAC[INFINITE];
54950   UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[];
54951   TYPE_THEN `CE i j` UNABBREV_TAC;
54952   FULL_REWRITE_TAC[FINITE_SING];
54953   ASM_REWRITE_TAC[];
54954   TYPE_THEN `j'` UNABBREV_TAC;
54955   PROOF_BY_CONTR_TAC;
54956   UNDH 3532 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]);
54957   ASM_MESON_TAC[];
54958   TYPE_THEN `CE i' j` UNABBREV_TAC;
54959   FULL_REWRITE_TAC[INTER_IDEMPOT];
54960   FULL_REWRITE_TAC[INFINITE];
54961   UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[];
54962   TYPE_THEN `CE i j` UNABBREV_TAC;
54963   FULL_REWRITE_TAC[FINITE_SING];
54964   ASM_REWRITE_TAC[];
54965   (* -D *)
54966   COPYH 1061;
54967   USEH 1061 (MATCH_MP INVERSE_BIJ);
54968   TYPE_THEN `h = INV g (cartesian UNIV UNIV) E` ABBREV_TAC ;
54969   TYPE_THEN `hh = (\ x. (A' (FST (h x)), B' (SND (h x))))` ABBREV_TAC ;
54970   TYPE_THEN `BIJ hh E (cartesian A B)` SUBAGOAL_TAC;
54971   TYPE_THEN `hh` UNABBREV_TAC;
54972   REWRITE_TAC[BIJ];
54973   SUBCONJ_TAC;
54974   REWRITE_TAC[INJ];
54975   CONJ_TAC;
54976   REWRITE_TAC[cartesian];
54977   TYPE_THEN `A` UNABBREV_TAC;
54978   TYPE_THEN `B` UNABBREV_TAC;
54979   REWRITE_TAC[IMAGE;PAIR_SPLIT ];
54980   MESON_TAC[];
54981   FULL_REWRITE_TAC[PAIR_SPLIT];
54982   TYPE_THEN `h x = h y` SUBAGOAL_TAC;
54983   REWRITE_TAC[PAIR_SPLIT];
54984   ASM_MESON_TAC[];
54985   FULL_REWRITE_TAC[BIJ;INJ];
54986   FIRST_ASSUM IMATCH_MP_TAC ;
54987   ASM_REWRITE_TAC[];
54988   REWRITE_TAC[SURJ];
54989   CONJ_TAC;
54990   FULL_REWRITE_TAC[INJ];
54991   FIRST_ASSUM IMATCH_MP_TAC ;
54992   ASM_REWRITE_TAC[];
54993   USEH 807 (REWRITE_RULE[cartesian;PAIR_SPLIT]);
54994   REWRITE_TAC[PAIR_SPLIT];
54995   TYPE_THEN `FST x` UNABBREV_TAC;
54996   TYPE_THEN `SND x` UNABBREV_TAC;
54997   TYPE_THEN `A` UNABBREV_TAC;
54998   TYPE_THEN `B` UNABBREV_TAC;
54999   USEH 6050 (REWRITE_RULE[IMAGE]);
55000   USEH 2264 (REWRITE_RULE[IMAGE]);
55001   TYPE_THEN `x'` UNABBREV_TAC;
55002   TYPE_THEN `y` UNABBREV_TAC;
55003   TYPE_THEN `g (x'',x)` EXISTS_TAC;
55004   (* -- *)
55005   TYPE_THEN `h (g (x'',x)) = (x'',x)` SUBAGOAL_TAC;
55006   TYPE_THEN `h` UNABBREV_TAC;
55007   IMATCH_MP_TAC  inv_comp_left;
55008   ASM_REWRITE_TAC[];
55009   REWRITE_TAC[cartesian_univ];
55010   ASM_REWRITE_TAC[];
55011   TYPE_THEN `E` UNABBREV_TAC;
55012   IMATCH_MP_TAC  image_imp;
55013   REWRITE_TAC[cartesian_univ];
55014   (* -E *)
55015   TYPE_THEN `G = mk_graph_t (A UNION B,E,(\ e . {(FST (hh e)), (SND (hh e)) }))` ABBREV_TAC   ;
55016   TYPE_THEN `graph_isomorphic k33_graph G` SUBAGOAL_TAC;
55017   TYPE_THEN `G` UNABBREV_TAC;
55018   IMATCH_MP_TAC  k33_iso;
55019   ASM_REWRITE_TAC[];
55020   TYPE_THEN `A` UNABBREV_TAC;
55021   TYPE_THEN `B` UNABBREV_TAC;
55022   (* -- *)
55023   REWRITE_TAC[HAS_SIZE] ;
55024   TYPE_THEN `FINITE (IMAGE A' UNIV) /\ FINITE (IMAGE B' UNIV)` SUBAGOAL_TAC;
55025   ASSUME_TAC three_t_size3;
55026   FULL_REWRITE_TAC[HAS_SIZE];
55027   CONJ_TAC THEN IMATCH_MP_TAC  FINITE_IMAGE THEN ASM_REWRITE_TAC[];
55028   ASM_REWRITE_TAC[];
55029   ASSUME_TAC three_t_size3;
55030   FULL_REWRITE_TAC[HAS_SIZE];
55031   TYPE_THEN `(CARD (IMAGE A' UNIV) = 3) /\ (CARD (IMAGE B' UNIV) = 3)` SUBAGOAL_TAC;
55032   USEH 6784 SYM;
55033   ASM_REWRITE_TAC[];
55034   CONJ_TAC THEN IMATCH_MP_TAC  (INR CARD_IMAGE_INJ) THEN ASM_MESON_TAC[];
55035   ASM_REWRITE_TAC[];
55036   PROOF_BY_CONTR_TAC;
55037   USEH 9575 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]);
55038   TYPE_THEN `u` UNABBREV_TAC;
55039   ASM_MESON_TAC[];
55040   (* -F *)
55041   THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph;
55042   ASM_REWRITE_TAC[k33_isgraph];
55043   THM_INTRO_TAC[] k33_nonplanar;
55044   FULL_REWRITE_TAC[planar_graph];
55045   UNDH 3419 THEN ASM_REWRITE_TAC[];
55046   TYPE_THEN `G` EXISTS_TAC;
55047   THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_symm;
55048   ASM_REWRITE_TAC[k33_isgraph];
55049   ASM_REWRITE_TAC[];
55050   REWRITE_TAC[plane_graph];
55051   ASM_REWRITE_TAC[];
55052   (* - *)
55053   SUBCONJ_TAC;
55054   TYPE_THEN `G` UNABBREV_TAC;
55055   REWRITE_TAC[graph_vertex_mk_graph];
55056   REWRITE_TAC[UNION;SUBSET];
55057   TYPE_THEN `A` UNABBREV_TAC;
55058   TYPE_THEN `B` UNABBREV_TAC;
55059   USEH 986 (REWRITE_RULE[IMAGE]);
55060   FIRST_ASSUM DISJ_CASES_TAC;
55061   TYPE_THEN `x` UNABBREV_TAC;
55062   UNDH 2402 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]);
55063   TYPE_THEN `x` UNABBREV_TAC;
55064   UNDH 7678 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]);
55065   (* - *)
55066   SUBCONJ_TAC;
55067   TYPE_THEN `G` UNABBREV_TAC;
55068   REWRITE_TAC[graph_edge_mk_graph];
55069   TYPE_THEN `E` UNABBREV_TAC;
55070   REWRITE_TAC[IMAGE;SUBSET];
55071   TYPE_THEN `x` UNABBREV_TAC;
55072   TYPE_THEN `g` UNABBREV_TAC;
55073   TYPE_THEN `?i j. (x' = (i,j))` SUBAGOAL_TAC;
55074   REWRITE_TAC[PAIR_SPLIT];
55075   MESON_TAC[];
55076   TYPE_THEN `x' ` UNABBREV_TAC;
55077   GBETA_TAC;
55078   IMATCH_MP_TAC  simple_arc_end_simple;
55079   TYPE_THEN `(A' i)` EXISTS_TAC;
55080   TYPE_THEN `(B' j)` EXISTS_TAC;
55081   ASM_REWRITE_TAC[];
55082   (* - *)
55083   SUBCONJ_TAC;
55084   TYPE_THEN `G` UNABBREV_TAC;
55085   REWRITE_TAC[graph_edge_mk_graph;graph_inc_mk_graph;graph_vertex_mk_graph];
55086   KILLH 6876 THEN KILLH 5591 THEN KILLH 6365;
55087   FULL_REWRITE_TAC[graph_edge_mk_graph];
55088   TYPE_THEN `E` UNABBREV_TAC;
55089   USEH 1953 (REWRITE_RULE[IMAGE;cartesian_univ]);
55090   TYPE_THEN `e` UNABBREV_TAC;
55091   TYPE_THEN `hh` UNABBREV_TAC;
55092   (* -- *)
55093   TYPE_THEN `h (g (x)) = x` SUBAGOAL_TAC;
55094   TYPE_THEN `h` UNABBREV_TAC;
55095   IMATCH_MP_TAC  inv_comp_left;
55096   ASM_REWRITE_TAC[cartesian_univ];
55097   ASM_REWRITE_TAC[];
55098   TYPE_THEN `?i j. (x = (i,j))` SUBAGOAL_TAC;
55099   REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[];
55100   TYPE_THEN `x` UNABBREV_TAC;
55101   TYPE_THEN `g` UNABBREV_TAC;
55102   GBETA_TAC;
55103   IMATCH_MP_TAC  EQ_EXT;
55104   REWRITE_TAC[INTER;UNION;INR in_pair];
55105   TYPE_THEN `A` UNABBREV_TAC;
55106   TYPE_THEN `B` UNABBREV_TAC;
55107   REWRITE_TAC[IMAGE];
55108   FULL_REWRITE_TAC[eq_sing; INTER; INR IN_SING];
55109   TYPE_THEN `x` UNABBREV_TAC;
55110   GBETA_TAC;
55111   ASM_MESON_TAC[];
55112   (* -G *)
55113   KILLH 7987 THEN KILLH 6305 THEN KILLH 5812 THEN KILLH 3738 THEN KILLH 8499;
55114     TYPE_THEN `!e. E e ==> (?i j. (e = CE i j))` SUBAGOAL_TAC;
55115   TYPE_THEN `E` UNABBREV_TAC;
55116   TYPE_THEN `g` UNABBREV_TAC;
55117   USEH 7673 (REWRITE_RULE[cartesian_univ;IMAGE]);
55118   TYPE_THEN `(? i j. x = (i,j))` SUBAGOAL_TAC;
55119   REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[];
55120   TYPE_THEN `x` UNABBREV_TAC;
55121   TYPE_THEN `e''` UNABBREV_TAC;
55122   GBETA_TAC;
55123   MESON_TAC[];
55124   (* - *)
55125   TYPE_THEN `G` UNABBREV_TAC;
55126   FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph];
55127   KILLH 4886 THEN KILLH 6107 THEN KILLH 6780 THEN KILLH 1344;
55128   COPYH  1159;
55129   TSPECH `e` 1159;
55130   TSPECH `e'` 1159;
55131   TYPE_THEN `e` UNABBREV_TAC;
55132   TYPE_THEN `e'` UNABBREV_TAC;
55133   KILLH 5790 THEN KILLH 6409 THEN KILLH 5249 THEN KILLH 5804;
55134   REWRITE_TAC[INTER;SUBSET;UNION];
55135   TYPE_THEN `(i' = i)` ASM_CASES_TAC;
55136   DISJ1_TAC;
55137   FULL_REWRITE_TAC[eq_sing;INTER;INR IN_SING];
55138   TYPE_THEN `A` UNABBREV_TAC;
55139   REWRITE_TAC[IMAGE];
55140   NAME_CONFLICT_TAC;
55141   TYPE_THEN `i'` UNABBREV_TAC;
55142   TYPE_THEN `i` EXISTS_TAC;
55143   TYPE_THEN `~(j' = j)` SUBAGOAL_TAC;
55144   TYPE_THEN `j'` UNABBREV_TAC;
55145   ASM_REWRITE_TAC[];
55146   UNDH 221 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]);
55147   UNDH 7790 THEN ASM_REWRITE_TAC[];
55148   FIRST_ASSUM IMATCH_MP_TAC ;
55149   ASM_REWRITE_TAC[];
55150   (* - *)
55151   TYPE_THEN `(i' = i) \/ (j' = j)` SUBAGOAL_TAC;
55152   FIRST_ASSUM IMATCH_MP_TAC ;
55153   USEH 5273 (REWRITE_RULE[INTER;EQ_EMPTY]);
55154   ASM_MESON_TAC[];
55155   REWRH 5596;
55156   TYPE_THEN `j'` UNABBREV_TAC;
55157   DISJ2_TAC;
55158   (* - *)
55159   TYPE_THEN `x = B' j` BACK_TAC;
55160   ASM_REWRITE_TAC[];
55161   TYPE_THEN `B` UNABBREV_TAC;
55162   IMATCH_MP_TAC  image_imp;
55163   (* - *)
55164   USEH 3532  (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
55165   UNDH 9432 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]);
55166   UNDH 7528 THEN ASM_REWRITE_TAC[];
55167   FIRST_ASSUM IMATCH_MP_TAC ;
55168   ASM_REWRITE_TAC[];
55169   (* Tue Jan  4 15:3282:39 EST 2005 *)
55170   ]);;
55171   (* }}} *)
55172
55173 let simple_arc_midpoint = prove_by_refinement(
55174   `!C v w. simple_arc_end C v w ==>
55175         (?u. (C u /\ ~(u = v) /\ ~(u = w)))`,
55176   (* {{{ proof *)
55177   [
55178   REP_BASIC_TAC;
55179   THM_INTRO_TAC[`C`] simple_arc_infinite;
55180   IMATCH_MP_TAC  simple_arc_end_simple;
55181   UNIFY_EXISTS_TAC;
55182   ASM_REWRITE_TAC[];
55183   THM_INTRO_TAC[`C`;`{v,w}`;] INFINITE_DIFF_FINITE;
55184   ASM_REWRITE_TAC[];
55185   THM_INTRO_TAC[`v`;`w`] pair_size_2;
55186   ASM_MESON_TAC[simple_arc_end_distinct];
55187   FULL_REWRITE_TAC[HAS_SIZE];
55188   ASM_REWRITE_TAC[];
55189   USEH 3168 (MATCH_MP INFINITE_NONEMPTY);
55190   FULL_REWRITE_TAC[DIFF;EMPTY_EXISTS;INR in_pair];
55191   TYPE_THEN `u` EXISTS_TAC;
55192   ASM_MESON_TAC[];
55193   ]);;
55194   (* }}} *)
55195
55196 let simple_arc_choose_end = prove_by_refinement(
55197   `!C. simple_arc top2 C ==> (?v w. simple_arc_end C v w)`,
55198   (* {{{ proof *)
55199   [
55200   REWRITE_TAC[simple_arc;simple_arc_end];
55201   FULL_REWRITE_TAC[top2_unions];
55202   LEFT_TAC "f";
55203   LEFT_TAC "f";
55204   TYPE_THEN  `f` EXISTS_TAC;
55205   TYPE_THEN `f(&0)` EXISTS_TAC;
55206   TYPE_THEN `f(&1)` EXISTS_TAC;
55207   ASM_REWRITE_TAC[];
55208   ]);;
55209   (* }}} *)
55210
55211 let cut_arc_replace = prove_by_refinement(
55212   `!A B u v. A SUBSET B /\ simple_arc top2 A /\ simple_arc top2 B /\
55213       A u /\ A v /\ ~(u = v) ==> (cut_arc B u v = cut_arc A u v)`,
55214   (* {{{ proof *)
55215   [
55216   REP_BASIC_TAC;
55217   IMATCH_MP_TAC  cut_arc_unique;
55218   ASM_REWRITE_TAC[];
55219   CONJ_TAC;
55220   IMATCH_MP_TAC  SUBSET_TRANS;
55221   TYPE_THEN `A` EXISTS_TAC;
55222   ASM_REWRITE_TAC[];
55223   IMATCH_MP_TAC  cut_arc_subset;
55224   ASM_REWRITE_TAC[];
55225   IMATCH_MP_TAC  cut_arc_simple;
55226   ASM_REWRITE_TAC[];
55227   ]);;
55228   (* }}} *)
55229
55230 let cut_arc_order = prove_by_refinement(
55231   `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==>
55232      ~(cut_arc C v u w)`,
55233   (* {{{ proof *)
55234   [
55235   REP_BASIC_TAC;
55236   THM_INTRO_TAC[`C`;`u`;`v`;`w`] cut_arc_inter;
55237   ASM_REWRITE_TAC[];
55238   USEH 1187 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
55239   TSPECH `w` 5795;
55240   COPYH 1985;
55241   UNDH 1985 THEN REWRITE_TAC [];
55242   IMATCH_MP_TAC  EQ_SYM;
55243   FIRST_ASSUM IMATCH_MP_TAC ;
55244   ASM_REWRITE_TAC[];
55245   IMATCH_MP_TAC  simple_arc_end_end2;
55246   TYPE_THEN `u` EXISTS_TAC;
55247   IMATCH_MP_TAC  cut_arc_simple;
55248   ASM_REWRITE_TAC[];
55249   CONJ_TAC;
55250   IMATCH_MP_TAC  simple_arc_end_simple;
55251   ASM_MESON_TAC[];
55252   IMATCH_MP_TAC  simple_arc_end_end2;
55253   ASM_MESON_TAC[];
55254   ]);;
55255   (* }}} *)
55256
55257
55258 (* First direction  of Jordan curve theorem. *)
55259
55260 let jordan_curve_no_inj3 = prove_by_refinement(
55261   `!C p.
55262      simple_closed_curve top2 C /\
55263      INJ p (UNIV:three_t ->bool) (euclid 2) /\
55264      (!i. ~C (p i)) /\
55265      (!i j A. simple_arc_end A (p i) (p j) ==> ~(A INTER C = EMPTY))
55266      ==> F`,
55267   (* {{{ proof *)
55268   [
55269   REP_BASIC_TAC;
55270   THM_INTRO_TAC[`C`] jordan_curve_seg3;
55271   ASM_REWRITE_TAC[];
55272   (* - *)
55273   TYPE_THEN `!i. ?v w. simple_arc_end (s i) v w` SUBAGOAL_TAC;
55274   THM_INTRO_TAC[`s i`] simple_arc_choose_end;
55275   ASM_MESON_TAC[];
55276   UNIFY_EXISTS_TAC;
55277   ASM_REWRITE_TAC[];
55278   LEFTH 4671 "v";
55279   LEFTH 2518 "w";
55280   (* - *)
55281   TYPE_THEN `!i. ?B. s i B /\ ~(B = v i) /\ ~(B = w i)` SUBAGOAL_TAC;
55282   THM_INTRO_TAC[`s i`;`v i`;`w i`] simple_arc_midpoint;
55283   ASM_REWRITE_TAC[];
55284   TYPE_THEN `u` EXISTS_TAC;
55285   ASM_REWRITE_TAC[];
55286   LEFTH 9437 "B";
55287   (* -A *)
55288   TYPE_THEN `!i. euclid 2 (p i)` SUBAGOAL_TAC;
55289   FULL_REWRITE_TAC[INJ];
55290   ASM_REWRITE_TAC[];
55291   (* - *)
55292   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;
55293   IMATCH_MP_TAC  jordan_curve_access;
55294   TYPE_THEN `v j` EXISTS_TAC;
55295   TYPE_THEN `w j` EXISTS_TAC;
55296   ASM_REWRITE_TAC[];
55297   (* -- *)
55298   THM_INTRO_TAC[`i`] three_t_not_sing;
55299   TYPE_THEN `p j` EXISTS_TAC;
55300   ASM_REWRITE_TAC[];
55301   UNDH 7630 THEN FULL_REWRITE_TAC[INJ];
55302   FIRST_ASSUM IMATCH_MP_TAC ;
55303   ASM_REWRITE_TAC[];
55304   LEFTH 4024 "E";
55305   LEFTH 1449 "E";
55306   (* -B *)
55307   TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ C u ==> (j = j') /\ s j u` SUBAGOAL_TAC;
55308   COPYH 807;
55309   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
55310   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
55311   USEH 6239 (REWRITE_RULE[INTER;SUBSET]);
55312   USEH 4225 (REWRITE_RULE[INTER;SUBSET]);
55313   SUBCONJ_TAC;
55314   FIRST_ASSUM IMATCH_MP_TAC ;
55315   USEH 9012 (REWRITE_RULE[EQ_EMPTY;INTER]);
55316   ASM_MESON_TAC[];
55317   ASM_MESON_TAC[];
55318   (* - *)
55319   TYPE_THEN `!i j. (p i = p j) ==> (i = j)` SUBAGOAL_TAC;
55320   FULL_REWRITE_TAC[INJ];
55321   FIRST_ASSUM IMATCH_MP_TAC ;
55322   ASM_REWRITE_TAC[];
55323   (* - *)
55324   TYPE_THEN `!i j. E i j (p i)` SUBAGOAL_TAC;
55325   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
55326   USEH 3415 (MATCH_MP simple_arc_end_end);
55327   ASM_REWRITE_TAC[];
55328   (* - *)
55329   TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ ~C u ==> (i = i')` SUBAGOAL_TAC;
55330   PROOF_BY_CONTR_TAC;
55331   (* -- *)
55332   TYPE_THEN `u = p i` ASM_CASES_TAC;
55333   TYPE_THEN `u` UNABBREV_TAC;
55334   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
55335   UNDH 8557 THEN DISCH_THEN (THM_INTRO_TAC[`p i`]);
55336   ASM_REWRITE_TAC[];
55337   ASM_MESON_TAC[];
55338   UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`i`;`cut_arc (E i' j') (p i') (p i)`]);
55339   IMATCH_MP_TAC  cut_arc_simple;
55340   ASM_REWRITE_TAC[];
55341   CONJ_TAC;
55342   IMATCH_MP_TAC  simple_arc_end_simple;
55343   UNIFY_EXISTS_TAC;
55344   ASM_REWRITE_TAC[];
55345   ASM_MESON_TAC[];
55346   UNDH 1303 THEN ASM_REWRITE_TAC[];
55347   (* -- *)
55348   TYPE_THEN `u = p i'` ASM_CASES_TAC;
55349   TYPE_THEN `u` UNABBREV_TAC;
55350   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
55351   UNDH 3041 THEN DISCH_THEN (THM_INTRO_TAC[`p i'`]);
55352   ASM_REWRITE_TAC[];
55353   UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`cut_arc (E i j) (p i) (p i')`]);
55354   IMATCH_MP_TAC  cut_arc_simple;
55355   ASM_REWRITE_TAC[];
55356   IMATCH_MP_TAC  simple_arc_end_simple;
55357   UNIFY_EXISTS_TAC;
55358   ASM_REWRITE_TAC[];
55359   UNDH 9380 THEN ASM_REWRITE_TAC[];
55360   (* -- *)
55361   COPYH 807;
55362   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
55363   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
55364   TYPE_THEN `cut_arc (E i j) (p i) u INTER C = EMPTY` SUBAGOAL_TAC;
55365   FIRST_ASSUM IMATCH_MP_TAC ;
55366   ASM_REWRITE_TAC[];
55367   TYPE_THEN `cut_arc (E i' j') (p i') u INTER C = EMPTY` SUBAGOAL_TAC;
55368   FIRST_ASSUM  IMATCH_MP_TAC ;
55369   ASM_REWRITE_TAC[];
55370   THM_INTRO_TAC[`E i j`;`p i`;`u`] cut_arc_simple;
55371   ASM_REWRITE_TAC[];
55372   IMATCH_MP_TAC  simple_arc_end_simple;
55373   UNIFY_EXISTS_TAC;
55374   ASM_REWRITE_TAC[];
55375   THM_INTRO_TAC[`E i' j'`;`p i'`;`u`] cut_arc_simple;
55376   ASM_REWRITE_TAC[];
55377   IMATCH_MP_TAC  simple_arc_end_simple;
55378   UNIFY_EXISTS_TAC;
55379   ASM_REWRITE_TAC[];
55380   (* -- *)
55381   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;
55382   ASM_REWRITE_TAC[];
55383   CONJ_TAC;
55384   IMATCH_MP_TAC  simple_arc_end_symm;
55385   ASM_REWRITE_TAC[];
55386   UNDH 3113 THEN ASM_REWRITE_TAC[];
55387   FIRST_ASSUM IMATCH_MP_TAC ;
55388   ASM_REWRITE_TAC[];
55389   (* -- *)
55390   UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`U`]);
55391   ASM_REWRITE_TAC[];
55392   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[];
55393   (* -C *)
55394   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;
55395   IMATCH_MP_TAC  simple_arc_end_restriction;
55396   CONJ_TAC;
55397   IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
55398   (* -- *)
55399   CONJ_TAC;
55400   IMATCH_MP_TAC  top_closed_unions;
55401   REWRITE_TAC[top2_top];
55402   CONJ_TAC;
55403   IMATCH_MP_TAC  FINITE_IMAGE;
55404   IMATCH_MP_TAC  FINITE_SUBSET;
55405   TYPE_THEN   `UNIV:three_t -> bool` EXISTS_TAC ;
55406   REWRITE_TAC[three_t_finite];
55407   REWRITE_TAC[SUBSET;IMAGE];
55408   TYPE_THEN `x` UNABBREV_TAC;
55409   ASM_MESON_TAC[simple_arc_end_closed];
55410   (* -- *)
55411   CONJ_TAC;
55412   ASM_MESON_TAC[simple_arc_end_end_closed2];
55413   (* -- *)
55414   CONJ_TAC;
55415   REWRITE_TAC[EQ_EMPTY;INTER;UNIONS;IMAGE;INR IN_SING ];
55416   TYPE_THEN `u` UNABBREV_TAC;
55417   TYPE_THEN `x` UNABBREV_TAC;
55418   UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x'`;`B j`]);
55419   ASM_REWRITE_TAC[];
55420   IMATCH_MP_TAC  subset_imp;
55421   TYPE_THEN `s j` EXISTS_TAC;
55422   ASM_REWRITE_TAC[];
55423   UNDH 7917 THEN ASM_REWRITE_TAC[];
55424   (* -- *)
55425   REWRITE_TAC[EMPTY_EXISTS];
55426   CONJ_TAC;
55427   TYPE_THEN `p i` EXISTS_TAC;
55428   REWRITE_TAC[INTER;UNIONS;IMAGE];
55429   ASM_REWRITE_TAC[];
55430   CONV_TAC (dropq_conv "u");
55431   THM_INTRO_TAC[`j`] three_t_not_sing;
55432   TYPE_THEN `j'` EXISTS_TAC;
55433   ASM_REWRITE_TAC[];
55434   REWRITE_TAC[INTER];
55435   TYPE_THEN `B j` EXISTS_TAC;
55436   ASM_REWRITE_TAC[INR IN_SING ];
55437   IMATCH_MP_TAC  simple_arc_end_end2;
55438   ASM_MESON_TAC[];
55439   (* - *)
55440   LEFTH 4870 "E''";
55441   LEFTH 4064 "E''";
55442   LEFTH 544 "u''";
55443   LEFTH 659 "u''";
55444   LEFTH 239 "u''";
55445   TYPE_THEN `u'' =  (\ i j. B j)` SUBAGOAL_TAC;
55446   IMATCH_MP_TAC  EQ_EXT;
55447   IMATCH_MP_TAC  EQ_EXT;
55448   TSPECH `x` 3583;
55449   TSPECH `x'` 7705;
55450   USEH 2213 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
55451   IMATCH_MP_TAC  EQ_SYM;
55452   FIRST_ASSUM IMATCH_MP_TAC ;
55453   USEH 3027 SYM;
55454   ASM_REWRITE_TAC[];
55455   TYPE_THEN `u''` UNABBREV_TAC;
55456   (* - *)
55457   LEFTH 1162 "u";
55458   LEFTH 3727 "u";
55459   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;
55460   IMATCH_MP_TAC  simple_arc_end_restriction;
55461   CONJ_TAC;
55462   IMATCH_MP_TAC  simple_arc_end_simple;
55463   ASM_MESON_TAC [];
55464   (* -- *)
55465   CONJ_TAC;
55466   ASM_MESON_TAC[simple_arc_end_end_closed];
55467   CONJ_TAC;
55468   ASM_MESON_TAC[simple_arc_end_closed];
55469   (* -- *)
55470   CONJ_TAC;
55471   PROOF_BY_CONTR_TAC;
55472   USEH 4139 (REWRITE_RULE[INTER;EMPTY_EXISTS;INR IN_SING]);
55473   TYPE_THEN `u'` UNABBREV_TAC;
55474   TSPECH `i` 2275;
55475   TSPECH `j` 631;
55476   USEH 9848 (REWRITE_RULE[eq_sing;INR IN_SING;INTER;UNIONS;IMAGE]);
55477   TYPE_THEN `u''` UNABBREV_TAC;
55478   UNDH 9165 THEN REWRITE_TAC[];
55479   UNDH 3778 THEN DISCH_THEN IMATCH_MP_TAC ;
55480   UNDH 1277 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
55481   TYPE_THEN `u i j` EXISTS_TAC;
55482   ASM_REWRITE_TAC[];
55483   TYPE_THEN `C (u i j)` SUBAGOAL_TAC;
55484   IMATCH_MP_TAC  subset_imp;
55485   TYPE_THEN `s j` EXISTS_TAC;
55486   ASM_REWRITE_TAC[];
55487   UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x`;`u i j`]);
55488   ASM_REWRITE_TAC[];
55489   IMATCH_MP_TAC  subset_imp;
55490   TYPE_THEN `E'' i j` EXISTS_TAC;
55491   ASM_REWRITE_TAC[];
55492   TYPE_THEN `j` UNABBREV_TAC;
55493   ASM_REWRITE_TAC[];
55494   (* -- *)
55495   REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ];
55496   CONJ_TAC;
55497   TYPE_THEN `u i j` EXISTS_TAC;
55498   IMATCH_MP_TAC  simple_arc_end_end;
55499   ASM_MESON_TAC[];
55500   (* -- *)
55501   TYPE_THEN `B j` EXISTS_TAC;
55502   ASM_REWRITE_TAC[];
55503   IMATCH_MP_TAC  simple_arc_end_end2;
55504   ASM_MESON_TAC[];
55505   LEFTH 5131 "E'";
55506   LEFTH 6920 "E'";
55507   (* -D *)
55508   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;
55509   PROOF_BY_CONTR_TAC;
55510   (* -- *)
55511   TYPE_THEN `cut_arc (E i j) q (B j)   = cut_arc (E'' i j) q (B j)` SUBAGOAL_TAC;
55512   IMATCH_MP_TAC  cut_arc_replace;
55513   ASM_REWRITE_TAC[];
55514   CONJ_TAC;
55515   IMATCH_MP_TAC  simple_arc_end_simple;
55516   ASM_MESON_TAC[];
55517   CONJ_TAC;
55518   IMATCH_MP_TAC  simple_arc_end_simple;
55519   ASM_MESON_TAC[];
55520   IMATCH_MP_TAC  simple_arc_end_end2;
55521   ASM_MESON_TAC[];
55522   (* -- *)
55523   REWRH 4315;
55524   TYPE_THEN `E'' i j x` SUBAGOAL_TAC;
55525   IMATCH_MP_TAC  subset_imp;
55526   TYPE_THEN `cut_arc (E'' i j) q (B j)` EXISTS_TAC;
55527   ASM_REWRITE_TAC[];
55528   IMATCH_MP_TAC  cut_arc_subset;
55529   ASM_REWRITE_TAC[];
55530   CONJ_TAC;
55531   IMATCH_MP_TAC  simple_arc_end_simple;
55532   ASM_MESON_TAC[];
55533   IMATCH_MP_TAC  simple_arc_end_end2;
55534   ASM_MESON_TAC[];
55535   (* -- *)
55536   UNDH 2275 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
55537   USEH 9848 (REWRITE_RULE[INTER;UNIONS;IMAGE;eq_sing;INR IN_SING]);
55538   TYPE_THEN `x = u i j` SUBAGOAL_TAC;
55539   FIRST_ASSUM IMATCH_MP_TAC ;
55540   ASM_REWRITE_TAC[];
55541   CONV_TAC (dropq_conv "u");
55542   TYPE_THEN `k` EXISTS_TAC;
55543   ASM_REWRITE_TAC[];
55544   TYPE_THEN `x` UNABBREV_TAC;
55545   (* -- *)
55546   THM_INTRO_TAC[`E'' i j`;`q`;`B j`;`u i j`] cut_arc_order;
55547   ASM_REWRITE_TAC[];
55548   IMATCH_MP_TAC  simple_arc_end_symm;
55549   ASM_REWRITE_TAC[];
55550   UNDH 1152 THEN ASM_REWRITE_TAC[];
55551   ONCE_REWRITE_TAC[cut_arc_symm];
55552   ASM_REWRITE_TAC[];
55553   (* -Da *)
55554   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;
55555   LEFTH 2832 "ua";
55556   LEFTH 6021 "ua";
55557   LEFTH 4322 "u'";
55558   LEFTH 1946 "u'";
55559   TYPE_THEN `u'` EXISTS_TAC;
55560   TSPECH `i` 1323;
55561   TSPECH `j` 1285;
55562   ASM_REWRITE_TAC[];
55563   USEH 7215 (REWRITE_RULE[INTER;INR IN_SING;eq_sing;]);
55564   TYPE_THEN `ua i j` UNABBREV_TAC;
55565   ASM_REWRITE_TAC[];
55566   KILLH 2832;
55567   (* - *)
55568   TYPE_THEN `!i j. E' i j SUBSET E i j` SUBAGOAL_TAC;
55569   IMATCH_MP_TAC  SUBSET_TRANS;
55570   TYPE_THEN `E'' i j` EXISTS_TAC;
55571   ASM_MESON_TAC[];
55572   (* - *)
55573   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;
55574   TSPECH `i` 7629;
55575   TSPECH `j` 6300;
55576   THM_INTRO_TAC[`E' i j`;`u i j`;`u' i j`] simple_arc_midpoint;
55577   ASM_REWRITE_TAC[];
55578   TYPE_THEN `q = u''` ABBREV_TAC ;
55579   TYPE_THEN `u''` UNABBREV_TAC;
55580   TYPE_THEN `q` EXISTS_TAC;
55581   ASM_REWRITE_TAC[];
55582   SUBCONJ_TAC;
55583   IMATCH_MP_TAC  subset_imp;
55584   TYPE_THEN `E' i j` EXISTS_TAC;
55585   ASM_REWRITE_TAC[];
55586   (* -- *)
55587   SUBCONJ_TAC;
55588   IMATCH_MP_TAC  subset_imp;
55589   TYPE_THEN `E' i j` EXISTS_TAC;
55590   ASM_REWRITE_TAC[];
55591   (* -- *)
55592   SUBCONJ_TAC;
55593   USEH 3228 (REWRITE_RULE[INR IN_SING;eq_sing;INTER]);
55594   ASM_MESON_TAC[];
55595   TSPECH `i` 6619;
55596   TSPECH `j` 4357;
55597   FIRST_ASSUM IMATCH_MP_TAC ;
55598   TYPE_THEN `q` EXISTS_TAC;
55599   TYPE_THEN `q` EXISTS_TAC;
55600   ASM_REWRITE_TAC[];
55601   SUBCONJ_TAC;
55602   UNDH 9552 THEN REWRITE_TAC[];
55603   TYPE_THEN `q` UNABBREV_TAC;
55604   ASM_REWRITE_TAC[];
55605   THM_INTRO_TAC[`E i j`;`q`;`B j`] cut_arc_simple;
55606   ASM_REWRITE_TAC[];
55607   CONJ_TAC;
55608   IMATCH_MP_TAC  simple_arc_end_simple;
55609   ASM_MESON_TAC[];
55610   IMATCH_MP_TAC  simple_arc_end_end2;
55611   ASM_MESON_TAC[];
55612   IMATCH_MP_TAC  simple_arc_end_end;
55613   UNIFY_EXISTS_TAC;
55614   ASM_REWRITE_TAC[];
55615   LEFTH 7093 "q";
55616   LEFTH 7917 "q";
55617   (* -E *)
55618   TYPE_THEN `CA = (\ i j. cut_arc (E i j) (p i) (q i j))` ABBREV_TAC ;
55619   TYPE_THEN `CB = (\ i j. cut_arc (E i j) (q i j) (B j))` ABBREV_TAC ;
55620   TYPE_THEN `!i j. ~(q i j = p i)` SUBAGOAL_TAC;
55621   TSPECH `i` 3615;
55622   TSPECH `j` 524;
55623   THM_INTRO_TAC[`j`] three_t_not_sing;
55624   UNDH 2577 THEN REWRITE_TAC[];
55625   FIRST_ASSUM IMATCH_MP_TAC ;
55626   ASM_REWRITE_TAC[];
55627   (* - *)
55628   TYPE_THEN `!i j. ~(q i j = B j)` SUBAGOAL_TAC;
55629   ASM_MESON_TAC[];
55630   (* - *)
55631   TYPE_THEN `!i j. simple_arc_end (CA i j) (p i) (q i j)` SUBAGOAL_TAC;
55632   TYPE_THEN `CA` UNABBREV_TAC;
55633   IMATCH_MP_TAC  cut_arc_simple;
55634   ASM_REWRITE_TAC[];
55635   IMATCH_MP_TAC simple_arc_end_simple;
55636   ASM_MESON_TAC[];
55637   (* - *)
55638   TYPE_THEN `!i j. simple_arc_end (CB i j) (q i j) (B j)` SUBAGOAL_TAC;
55639   TYPE_THEN `CB` UNABBREV_TAC;
55640   IMATCH_MP_TAC  cut_arc_simple;
55641   ASM_REWRITE_TAC[];
55642   CONJ_TAC;
55643   IMATCH_MP_TAC  simple_arc_end_simple;
55644   ASM_MESON_TAC[];
55645   IMATCH_MP_TAC  simple_arc_end_end2;
55646   ASM_MESON_TAC[];
55647   (* -F *)
55648   THM_INTRO_TAC[`q`;`p`;`CA`;`B`;`CB`] no_k33_planar_graph_data THENL [ALL_TAC;ASM_REWRITE_TAC[]];
55649   ASM_REWRITE_TAC[];
55650   TYPE_THEN `(!i j. simple_arc_end (CB i j) (B j) (q i j)) ` SUBAGOAL_TAC;
55651   IMATCH_MP_TAC  simple_arc_end_symm;
55652   ASM_REWRITE_TAC[];
55653   ASM_REWRITE_TAC[];
55654   (* - *)
55655   TYPE_THEN `!i j. CA i j INTER C = EMPTY` SUBAGOAL_TAC;
55656   UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
55657   TYPE_THEN `CA` UNABBREV_TAC;
55658   FIRST_ASSUM IMATCH_MP_TAC ;
55659   ASM_REWRITE_TAC[];
55660   USEH 6239 (REWRITE_RULE[INTER;SUBSET]);
55661   ASM_MESON_TAC[];
55662   (* - *)
55663   TYPE_THEN `!i j j' u. CB i j u /\ E i j' u ==> (j = j')` SUBAGOAL_TAC;
55664   FIRST_ASSUM IMATCH_MP_TAC ;
55665   TYPE_THEN `i` EXISTS_TAC;
55666   TYPE_THEN `q i j` EXISTS_TAC;
55667   TYPE_THEN `u''` EXISTS_TAC;
55668   ASM_REWRITE_TAC[];
55669   TYPE_THEN `CB` UNABBREV_TAC;
55670   ASM_REWRITE_TAC[];
55671   (* - *)
55672   TYPE_THEN `!i j. CB i j = cut_arc (E'' i j) (q i j) (B j)` SUBAGOAL_TAC;
55673   TYPE_THEN `CB` UNABBREV_TAC;
55674   IMATCH_MP_TAC  cut_arc_replace;
55675   ASM_REWRITE_TAC[];
55676   TYPE_THEN `simple_arc top2 (E i j)` SUBAGOAL_TAC;
55677   IMATCH_MP_TAC  simple_arc_end_simple;
55678   ASM_MESON_TAC[];
55679   ASM_REWRITE_TAC[];
55680   ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
55681   (* - *)
55682   TYPE_THEN `!i i' j j' u. ~(i = i') /\ CB i j u /\ E i' j' u ==> (j = j') /\ s j u` SUBAGOAL_TAC;
55683   FIRST_ASSUM IMATCH_MP_TAC ;
55684   TYPE_THEN `i` EXISTS_TAC;
55685   TYPE_THEN `i'` EXISTS_TAC;
55686   ASM_REWRITE_TAC[];
55687   TYPE_THEN `CB` UNABBREV_TAC;
55688   SUBCONJ_TAC;
55689   IMATCH_MP_TAC  subset_imp;
55690   TYPE_THEN `cut_arc (E i j) (q i j) (B j)` EXISTS_TAC;
55691   ASM_REWRITE_TAC[];
55692   IMATCH_MP_TAC  SUBSET_TRANS;
55693   TYPE_THEN `E'' i j` EXISTS_TAC;
55694   ASM_REWRITE_TAC[];
55695   IMATCH_MP_TAC  cut_arc_subset;
55696   ASM_REWRITE_TAC[];
55697   ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
55698   PROOF_BY_CONTR_TAC;
55699   UNDH 3113 THEN REWRITE_TAC[];
55700   UNDH 6138 THEN DISCH_THEN (IMATCH_MP_TAC );
55701   TYPE_THEN `j` EXISTS_TAC;
55702   TYPE_THEN `j'` EXISTS_TAC;
55703   TYPE_THEN `u''` EXISTS_TAC;
55704   ASM_REWRITE_TAC[];
55705   (* -G *)
55706   USEH 9121 GSYM;
55707   TYPE_THEN `!i j. CB i j SUBSET E i j` SUBAGOAL_TAC;
55708   TYPE_THEN `CB` UNABBREV_TAC;
55709   IMATCH_MP_TAC  cut_arc_subset;
55710   ASM_REWRITE_TAC[];
55711   ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
55712   (* - *)
55713   TYPE_THEN `(!i j i' j'. ~(CB i j INTER CB i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC;
55714   USEH 2001  (REWRITE_RULE [INTER;EMPTY_EXISTS]);
55715   TYPE_THEN `i = i'` ASM_CASES_TAC;
55716   UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]);
55717   ASM_REWRITE_TAC[];
55718   IMATCH_MP_TAC  subset_imp;
55719   TYPE_THEN `CB i' j'` EXISTS_TAC;
55720   ASM_REWRITE_TAC[];
55721   ASM_REWRITE_TAC[];
55722   (* -- *)
55723   UNDH 3773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]);
55724   ASM_REWRITE_TAC[];
55725   IMATCH_MP_TAC  subset_imp;
55726   TYPE_THEN `CB i' j'` EXISTS_TAC;
55727   ASM_REWRITE_TAC[];
55728   TYPE_THEN `j'` UNABBREV_TAC;
55729   ASM_REWRITE_TAC[];
55730   (* - *)
55731   TYPE_THEN `!i j. CA i j SUBSET E i j` SUBAGOAL_TAC;
55732   TYPE_THEN `CA` UNABBREV_TAC;
55733   IMATCH_MP_TAC  cut_arc_subset;
55734   ASM_REWRITE_TAC[];
55735   ASM_MESON_TAC[simple_arc_end_simple];
55736   (* -H *)
55737   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;
55738   TYPE_THEN `i = i'` ASM_CASES_TAC;
55739   ASM_REWRITE_TAC[];
55740   TYPE_THEN `i'` UNABBREV_TAC;
55741   UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]);
55742   ASM_REWRITE_TAC[];
55743   IMATCH_MP_TAC  subset_imp;
55744   TYPE_THEN `CA i j'` EXISTS_TAC;
55745   ASM_REWRITE_TAC[];
55746   TYPE_THEN `j'` UNABBREV_TAC;
55747   THM_INTRO_TAC[`E i j`;`q i j`;`p i`;`B j`] cut_arc_inter;
55748   ASM_REWRITE_TAC[];
55749   USEH 699 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
55750   FIRST_ASSUM IMATCH_MP_TAC ;
55751   TYPE_THEN `CA` UNABBREV_TAC;
55752   TYPE_THEN `CB` UNABBREV_TAC;
55753   ASM_REWRITE_TAC[];
55754   PROOF_BY_CONTR_TAC;
55755   UNDH 3773 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]);
55756   ASM_REWRITE_TAC[];
55757   IMATCH_MP_TAC  subset_imp;
55758   TYPE_THEN `CA i' j'` EXISTS_TAC;
55759   ASM_REWRITE_TAC[];
55760   TYPE_THEN `j'` UNABBREV_TAC;
55761   (* -- *)
55762   USEH 682 (REWRITE_RULE[INTER;EQ_EMPTY]);
55763   UNDH 218 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`u''`]);
55764   UNDH 2186 THEN ASM_REWRITE_TAC[];
55765   IMATCH_MP_TAC  subset_imp;
55766   TYPE_THEN `s j` EXISTS_TAC;
55767   ASM_REWRITE_TAC[];
55768   ASM_REWRITE_TAC[];
55769   (* -I *)
55770   CONJ_TAC;
55771   UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`q i j`]);
55772   CONJ_TAC;
55773   TYPE_THEN `CB` UNABBREV_TAC;
55774   ASM_MESON_TAC[simple_arc_end_end];
55775   ASM_REWRITE_TAC[];
55776   ASM_MESON_TAC[simple_arc_end_end2];
55777   TYPE_THEN `i'` UNABBREV_TAC;
55778   TYPE_THEN `j'` UNABBREV_TAC;
55779   (* - *)
55780   USEH 6538 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
55781   UNDH 6138 THEN DISCH_THEN IMATCH_MP_TAC ;
55782   TYPE_THEN `j` EXISTS_TAC;
55783   TYPE_THEN `j'` EXISTS_TAC;
55784   TYPE_THEN `u''` EXISTS_TAC;
55785   CONJ_TAC;
55786   IMATCH_MP_TAC  subset_imp;
55787   TYPE_THEN `CA i j` EXISTS_TAC;
55788   ASM_REWRITE_TAC[];
55789   CONJ_TAC;
55790   IMATCH_MP_TAC  subset_imp;
55791   TYPE_THEN `CA i' j'` EXISTS_TAC;
55792   ASM_REWRITE_TAC[];
55793   UNDH 682 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER ];
55794   UNDH 7281 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
55795  UNIFY_EXISTS_TAC;
55796   ASM_REWRITE_TAC[];
55797   (* Sun Jan 16 08:48:56 EST 2005 *)
55798
55799   ]);;
55800   (* }}} *)
55801
55802 (* ------------------------------------------------------------------ *)
55803 (* SECTION CC *)
55804 (* ------------------------------------------------------------------ *)
55805
55806 (* finish off Jordan curve *)
55807
55808 let simple_closed_curve_compact = prove_by_refinement(
55809   `!C. simple_closed_curve top2 C ==> compact top2 C`,
55810   (* {{{ proof *)
55811
55812   [
55813   REWRITE_TAC[simple_closed_curve];
55814   TYPE_THEN `C` UNABBREV_TAC;
55815   IMATCH_MP_TAC  image_compact;
55816   UNIFY_EXISTS_TAC;
55817   ASM_REWRITE_TAC[];
55818   FULL_REWRITE_TAC[top2_unions];
55819   CONJ_TAC;
55820   REWRITE_TAC[interval_compact];
55821   REWRITE_TAC[IMAGE;SUBSET];
55822   FULL_REWRITE_TAC[INJ];
55823   TYPE_THEN `x` UNABBREV_TAC;
55824   TYPE_THEN `x' = &1` ASM_CASES_TAC;
55825   TYPE_THEN `x'` UNABBREV_TAC;
55826   USEH 5825 SYM;
55827   ASM_REWRITE_TAC[];
55828   FIRST_ASSUM IMATCH_MP_TAC ;
55829   REAL_ARITH_TAC;
55830   FIRST_ASSUM IMATCH_MP_TAC ;
55831   UNDH 6268 THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC;
55832   (* Sun Jan 16 09:13:09 EST 2005 *)
55833
55834   ]);;
55835
55836   (* }}} *)
55837
55838 let ymaxQexists_lemma = prove_by_refinement(
55839   `!C. simple_closed_curve top2 C ==>
55840          (?p. C p /\ (!q. C q ==> (q 1 <=. p 1)))`,
55841   (* {{{ proof *)
55842   [
55843   REP_BASIC_TAC;
55844   THM_INTRO_TAC[`1`;`2`] continuous_euclid1;
55845   FULL_REWRITE_TAC[GSYM top2];
55846   THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_max_real;
55847   ASM_REWRITE_TAC[];
55848   CONJ_TAC;
55849   IMATCH_MP_TAC  simple_closed_curve_compact;
55850   ASM_REWRITE_TAC[];
55851   FULL_REWRITE_TAC[simple_closed_curve];
55852   TYPE_THEN `C` UNABBREV_TAC;
55853   USEH 2198 GSYM;
55854   USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
55855   TSPECH `f (&0)` 9716;
55856   UNDH 5422 THEN ASM_REWRITE_TAC[];
55857   TYPE_THEN `&0` EXISTS_TAC;
55858   ASM_REWRITE_TAC[];
55859   REAL_ARITH_TAC;
55860   TYPE_THEN `x` EXISTS_TAC;
55861   FULL_REWRITE_TAC[coord];
55862   ASM_REWRITE_TAC[];
55863   (* Sun Jan 16 09:16:3282 EST 2005 *)
55864
55865   ]);;
55866   (* }}} *)
55867
55868 let yminQexists_lemma = prove_by_refinement(
55869   `!C. simple_closed_curve top2 C ==>
55870          (?p. C p /\ (!q. C q ==> (p 1 <=. q 1)))`,
55871   (* {{{ proof *)
55872   [
55873   REP_BASIC_TAC;
55874   THM_INTRO_TAC[`1`;`2`] continuous_euclid1;
55875   FULL_REWRITE_TAC[GSYM top2];
55876   THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_min_real;
55877   ASM_REWRITE_TAC[];
55878   CONJ_TAC;
55879   IMATCH_MP_TAC  simple_closed_curve_compact;
55880   ASM_REWRITE_TAC[];
55881   FULL_REWRITE_TAC[simple_closed_curve];
55882   TYPE_THEN `C` UNABBREV_TAC;
55883   USEH 2198 GSYM;
55884   USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
55885   TSPECH `f (&0)` 9716;
55886   UNDH 5422 THEN ASM_REWRITE_TAC[];
55887   TYPE_THEN `&0` EXISTS_TAC;
55888   ASM_REWRITE_TAC[];
55889   REAL_ARITH_TAC;
55890   TYPE_THEN `x` EXISTS_TAC;
55891   FULL_REWRITE_TAC[coord];
55892   ASM_REWRITE_TAC[];
55893   ]);;
55894   (* }}} *)
55895
55896 let xmaxQexists_lemma = prove_by_refinement(
55897   `!C. simple_closed_curve top2 C ==>
55898          (?p. C p /\ (!q. C q ==> (q 0 <=. p 0)))`,
55899   (* {{{ proof *)
55900   [
55901   REP_BASIC_TAC;
55902   THM_INTRO_TAC[`0`;`2`] continuous_euclid1;
55903   FULL_REWRITE_TAC[GSYM top2];
55904   THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_max_real;
55905   ASM_REWRITE_TAC[];
55906   CONJ_TAC;
55907   IMATCH_MP_TAC  simple_closed_curve_compact;
55908   ASM_REWRITE_TAC[];
55909   FULL_REWRITE_TAC[simple_closed_curve];
55910   TYPE_THEN `C` UNABBREV_TAC;
55911   USEH 2198 GSYM;
55912   USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
55913   TSPECH `f (&0)` 9716;
55914   UNDH 5422 THEN ASM_REWRITE_TAC[];
55915   TYPE_THEN `&0` EXISTS_TAC;
55916   ASM_REWRITE_TAC[];
55917   REAL_ARITH_TAC;
55918   TYPE_THEN `x` EXISTS_TAC;
55919   FULL_REWRITE_TAC[coord];
55920   ASM_REWRITE_TAC[];
55921   ]);;
55922   (* }}} *)
55923
55924 let xminQexists_lemma = prove_by_refinement(
55925   `!C. simple_closed_curve top2 C ==>
55926          (?p. C p /\ (!q. C q ==> (p 0 <=. q 0)))`,
55927   (* {{{ proof *)
55928   [
55929   REP_BASIC_TAC;
55930   THM_INTRO_TAC[`0`;`2`] continuous_euclid1;
55931   FULL_REWRITE_TAC[GSYM top2];
55932   THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_min_real;
55933   ASM_REWRITE_TAC[];
55934   CONJ_TAC;
55935   IMATCH_MP_TAC  simple_closed_curve_compact;
55936   ASM_REWRITE_TAC[];
55937   FULL_REWRITE_TAC[simple_closed_curve];
55938   TYPE_THEN `C` UNABBREV_TAC;
55939   USEH 2198 GSYM;
55940   USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
55941   TSPECH `f (&0)` 9716;
55942   UNDH 5422 THEN ASM_REWRITE_TAC[];
55943   TYPE_THEN `&0` EXISTS_TAC;
55944   ASM_REWRITE_TAC[];
55945   REAL_ARITH_TAC;
55946   TYPE_THEN `x` EXISTS_TAC;
55947   FULL_REWRITE_TAC[coord];
55948   ASM_REWRITE_TAC[];
55949   ]);;
55950   (* }}} *)
55951
55952 (* state pSC *)
55953 let ymaxQ = jordan_def `ymaxQ C = supm { y | ?x. (C (point(x,y))) }`;;
55954 let yminQ = jordan_def `yminQ C = inf { y | ?x. (C (point(x,y))) }`;;
55955 let xmaxQ = jordan_def `xmaxQ C = supm { x | ?y. (C (point(x,y))) }`;;
55956 let xminQ = jordan_def `xminQ C = inf { x | ?y. (C (point(x,y))) }`;;
55957
55958 let inf_unique = prove_by_refinement(
55959   `!X s. X s /\ (!t. X t ==> (s <= t)) ==> (s = inf X)`,
55960   (* {{{ proof *)
55961   [
55962   REP_BASIC_TAC;
55963   THM_INTRO_TAC[`X`] inf_LB;
55964   REWRITE_TAC[EMPTY_EXISTS];
55965   CONJ_TAC;
55966   UNIFY_EXISTS_TAC;
55967   ASM_REWRITE_TAC[];
55968   TYPE_THEN `s` EXISTS_TAC;
55969   FIRST_ASSUM IMATCH_MP_TAC ;
55970   ASM_REWRITE_TAC[];
55971   TYPE_THEN   `(s <= inf X) /\ (inf X <= s)` BACK_TAC;
55972   UNDH 9491 THEN UNDH 1818 THEN REAL_ARITH_TAC;
55973   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
55974   FIRST_ASSUM IMATCH_MP_TAC ;
55975   ASM_REWRITE_TAC[];
55976   ASM_REWRITE_TAC[];
55977   ]);;
55978   (* }}} *)
55979
55980 let supm_unique = prove_by_refinement(
55981   `!X s. X s /\ (!t. X t ==> (t <= s)) ==> (s = supm X)`,
55982   (* {{{ proof *)
55983   [
55984   REP_BASIC_TAC;
55985   THM_INTRO_TAC[`X`] supm_UB;
55986   REWRITE_TAC[EMPTY_EXISTS];
55987   CONJ_TAC;
55988   UNIFY_EXISTS_TAC;
55989   ASM_REWRITE_TAC[];
55990   TYPE_THEN `s` EXISTS_TAC;
55991   FIRST_ASSUM IMATCH_MP_TAC ;
55992   ASM_REWRITE_TAC[];
55993   TYPE_THEN   `(s <= supm X) /\ (supm X <= s)` BACK_TAC;
55994   UNDH 4025 THEN UNDH 5913 THEN REAL_ARITH_TAC;
55995   CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
55996   ASM_REWRITE_TAC[];
55997   FIRST_ASSUM IMATCH_MP_TAC ;
55998   ASM_REWRITE_TAC[];
55999   (* Sun Jan 16 09:42:06 EST 2005 *)
56000
56001   ]);;
56002   (* }}} *)
56003
56004 let euclid2_point = prove_by_refinement(
56005   `!p. euclid 2 p ==> (point (p 0, p 1) = p)`,
56006   (* {{{ proof *)
56007   [
56008   REP_BASIC_TAC;
56009   USEH 7802 (MATCH_MP   point_onto);
56010   TYPE_THEN `p` UNABBREV_TAC;
56011   REWRITE_TAC[point_inj];
56012   REWRITE_TAC[coord01];
56013   ]);;
56014   (* }}} *)
56015
56016 let ymaxQ_exists = prove_by_refinement(
56017   `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = ymaxQ C))`,
56018   (* {{{ proof *)
56019   [
56020   REP_BASIC_TAC;
56021   THM_INTRO_TAC[`C`] ymaxQexists_lemma;
56022   ASM_REWRITE_TAC[];
56023   TYPE_THEN `p` EXISTS_TAC;
56024   ASM_REWRITE_TAC[];
56025   REWRITE_TAC[ymaxQ];
56026   IMATCH_MP_TAC  supm_unique;
56027   CONJ_TAC;
56028   TYPE_THEN `p 0` EXISTS_TAC;
56029   TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
56030   IMATCH_MP_TAC  subset_imp;
56031   TYPE_THEN `C` EXISTS_TAC;
56032   ASM_SIMP_TAC[simple_closed_curve_euclid];
56033   ASM_SIMP_TAC[euclid2_point];
56034   TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC;
56035   REWRITE_TAC[coord01];
56036   UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
56037   FIRST_ASSUM IMATCH_MP_TAC ;
56038   TYPE_THEN `A = point(x,t)` ABBREV_TAC  ;
56039   REWRITE_TAC[ETA_AX];
56040   ASM_REWRITE_TAC[];
56041   ]);;
56042   (* }}} *)
56043
56044 let yminQ_exists = prove_by_refinement(
56045   `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = yminQ C))`,
56046   (* {{{ proof *)
56047   [
56048   REP_BASIC_TAC;
56049   THM_INTRO_TAC[`C`] yminQexists_lemma;
56050   ASM_REWRITE_TAC[];
56051   TYPE_THEN `p` EXISTS_TAC;
56052   ASM_REWRITE_TAC[];
56053   REWRITE_TAC[yminQ];
56054   IMATCH_MP_TAC  inf_unique;
56055   CONJ_TAC;
56056   TYPE_THEN `p 0` EXISTS_TAC;
56057   TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
56058   IMATCH_MP_TAC  subset_imp;
56059   TYPE_THEN `C` EXISTS_TAC;
56060   ASM_SIMP_TAC[simple_closed_curve_euclid];
56061   ASM_SIMP_TAC[euclid2_point];
56062   TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC;
56063   REWRITE_TAC[coord01];
56064   UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
56065   FIRST_ASSUM IMATCH_MP_TAC ;
56066   TYPE_THEN `A = point(x,t)` ABBREV_TAC  ;
56067   REWRITE_TAC[ETA_AX];
56068   ASM_REWRITE_TAC[];
56069   ]);;
56070   (* }}} *)
56071
56072 let xmaxQ_exists = prove_by_refinement(
56073   `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xmaxQ C))`,
56074   (* {{{ proof *)
56075   [
56076   REP_BASIC_TAC;
56077   THM_INTRO_TAC[`C`] xmaxQexists_lemma;
56078   ASM_REWRITE_TAC[];
56079   TYPE_THEN `p` EXISTS_TAC;
56080   ASM_REWRITE_TAC[];
56081   REWRITE_TAC[xmaxQ];
56082   IMATCH_MP_TAC  supm_unique;
56083   CONJ_TAC;
56084   TYPE_THEN `p 1` EXISTS_TAC;
56085   TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
56086   IMATCH_MP_TAC  subset_imp;
56087   TYPE_THEN `C` EXISTS_TAC;
56088   ASM_SIMP_TAC[simple_closed_curve_euclid];
56089   ASM_SIMP_TAC[euclid2_point];
56090   TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC;
56091   REWRITE_TAC[coord01];
56092   UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
56093   FIRST_ASSUM IMATCH_MP_TAC ;
56094   TYPE_THEN `A = point(t,y)` ABBREV_TAC  ;
56095   REWRITE_TAC[ETA_AX];
56096   ASM_REWRITE_TAC[];
56097   ]);;
56098   (* }}} *)
56099
56100 let xminQ_exists = prove_by_refinement(
56101   `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xminQ C))`,
56102   (* {{{ proof *)
56103   [
56104   REP_BASIC_TAC;
56105   THM_INTRO_TAC[`C`] xminQexists_lemma;
56106   ASM_REWRITE_TAC[];
56107   TYPE_THEN `p` EXISTS_TAC;
56108   ASM_REWRITE_TAC[];
56109   REWRITE_TAC[xminQ];
56110   IMATCH_MP_TAC  inf_unique;
56111   CONJ_TAC;
56112   TYPE_THEN `p 1` EXISTS_TAC;
56113   TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
56114   IMATCH_MP_TAC  subset_imp;
56115   TYPE_THEN `C` EXISTS_TAC;
56116   ASM_SIMP_TAC[simple_closed_curve_euclid];
56117   ASM_SIMP_TAC[euclid2_point];
56118   TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC;
56119   REWRITE_TAC[coord01];
56120   UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
56121   FIRST_ASSUM IMATCH_MP_TAC ;
56122   TYPE_THEN `A = point(t,y)` ABBREV_TAC  ;
56123   REWRITE_TAC[ETA_AX];
56124   ASM_REWRITE_TAC[];
56125   ]);;
56126   (* }}} *)
56127
56128 let ymaxQ_max = prove_by_refinement(
56129   `!C p. simple_closed_curve top2 C /\ C p ==> (p 1 <= ymaxQ C)`,
56130   (* {{{ proof *)
56131   [
56132   REP_BASIC_TAC;
56133   REWRITE_TAC[ymaxQ];
56134   THM_INTRO_TAC[`C`] ymaxQexists_lemma;
56135   ASM_REWRITE_TAC[];
56136   TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
56137   IMATCH_MP_TAC  subset_imp;
56138   TYPE_THEN `C` EXISTS_TAC;
56139   ASM_REWRITE_TAC[];
56140   IMATCH_MP_TAC  simple_closed_curve_euclid;
56141   ASM_REWRITE_TAC[];
56142   (* - *)
56143   THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] supm_UB;
56144   REWRITE_TAC[EMPTY_EXISTS];
56145   (* -- *)
56146   CONJ_TAC;
56147   TYPE_THEN `p 1` EXISTS_TAC;
56148   TYPE_THEN `p 0` EXISTS_TAC;
56149   ASM_SIMP_TAC[euclid2_point];
56150   TYPE_THEN `p' 1` EXISTS_TAC;
56151   TSPECH `point(x',x)` 1647;
56152   FULL_REWRITE_TAC[coord01];
56153   ASM_REWRITE_TAC[];
56154   (* - *)
56155   FIRST_ASSUM IMATCH_MP_TAC ;
56156   TYPE_THEN `p 0` EXISTS_TAC;
56157   ASM_SIMP_TAC[euclid2_point];
56158   ]);;
56159   (* }}} *)
56160
56161 let yminQ_min = prove_by_refinement(
56162   `!C p. simple_closed_curve top2 C /\ C p ==> (yminQ C <= p 1)`,
56163   (* {{{ proof *)
56164   [
56165   REP_BASIC_TAC;
56166   REWRITE_TAC[yminQ];
56167   THM_INTRO_TAC[`C`] yminQexists_lemma;
56168   ASM_REWRITE_TAC[];
56169   TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
56170   IMATCH_MP_TAC  subset_imp;
56171   TYPE_THEN `C` EXISTS_TAC;
56172   ASM_REWRITE_TAC[];
56173   IMATCH_MP_TAC  simple_closed_curve_euclid;
56174   ASM_REWRITE_TAC[];
56175   (* - *)
56176   THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] inf_LB;
56177   REWRITE_TAC[EMPTY_EXISTS];
56178   (* -- *)
56179   CONJ_TAC;
56180   TYPE_THEN `p 1` EXISTS_TAC;
56181   TYPE_THEN `p 0` EXISTS_TAC;
56182   ASM_SIMP_TAC[euclid2_point];
56183   TYPE_THEN `p' 1` EXISTS_TAC;
56184   TSPECH `point(x',x)` 2887;
56185   FULL_REWRITE_TAC[coord01];
56186   ASM_REWRITE_TAC[];
56187   (* - *)
56188   FIRST_ASSUM IMATCH_MP_TAC ;
56189   TYPE_THEN `p 0` EXISTS_TAC;
56190   ASM_SIMP_TAC[euclid2_point];
56191   ]);;
56192   (* }}} *)
56193
56194 let xmaxQ_max = prove_by_refinement(
56195   `!C p. simple_closed_curve top2 C /\ C p ==> (p 0 <= xmaxQ C)`,
56196   (* {{{ proof *)
56197   [
56198   REP_BASIC_TAC;
56199   REWRITE_TAC[xmaxQ];
56200   THM_INTRO_TAC[`C`] xmaxQexists_lemma;
56201   ASM_REWRITE_TAC[];
56202   TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
56203   IMATCH_MP_TAC  subset_imp;
56204   TYPE_THEN `C` EXISTS_TAC;
56205   ASM_REWRITE_TAC[];
56206   IMATCH_MP_TAC  simple_closed_curve_euclid;
56207   ASM_REWRITE_TAC[];
56208   (* - *)
56209   THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] supm_UB;
56210   REWRITE_TAC[EMPTY_EXISTS];
56211   (* -- *)
56212   CONJ_TAC;
56213   TYPE_THEN `p 0` EXISTS_TAC;
56214   TYPE_THEN `p 1` EXISTS_TAC;
56215   ASM_SIMP_TAC[euclid2_point];
56216   TYPE_THEN `p' 0` EXISTS_TAC;
56217   TSPECH `point(x,y)` 3013;
56218   FULL_REWRITE_TAC[coord01];
56219   ASM_REWRITE_TAC[];
56220   (* - *)
56221   FIRST_ASSUM IMATCH_MP_TAC ;
56222   TYPE_THEN `p 1` EXISTS_TAC;
56223   ASM_SIMP_TAC[euclid2_point];
56224   ]);;
56225   (* }}} *)
56226
56227 let xminQ_min = prove_by_refinement(
56228   `!C p. simple_closed_curve top2 C /\ C p ==> (xminQ C <= p 0)`,
56229   (* {{{ proof *)
56230   [
56231   REP_BASIC_TAC;
56232   REWRITE_TAC[xminQ];
56233   THM_INTRO_TAC[`C`] xminQexists_lemma;
56234   ASM_REWRITE_TAC[];
56235   TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
56236   IMATCH_MP_TAC  subset_imp;
56237   TYPE_THEN `C` EXISTS_TAC;
56238   ASM_REWRITE_TAC[];
56239   IMATCH_MP_TAC  simple_closed_curve_euclid;
56240   ASM_REWRITE_TAC[];
56241   (* - *)
56242   THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] inf_LB;
56243   REWRITE_TAC[EMPTY_EXISTS];
56244   (* -- *)
56245   CONJ_TAC;
56246   TYPE_THEN `p 0` EXISTS_TAC;
56247   TYPE_THEN `p 1` EXISTS_TAC;
56248   ASM_SIMP_TAC[euclid2_point];
56249   TYPE_THEN `p' 0` EXISTS_TAC;
56250   TSPECH `point(x,y)` 4062;
56251   FULL_REWRITE_TAC[coord01];
56252   ASM_REWRITE_TAC[];
56253   (* - *)
56254   FIRST_ASSUM IMATCH_MP_TAC ;
56255   TYPE_THEN `p 1` EXISTS_TAC;
56256   ASM_SIMP_TAC[euclid2_point];
56257   (* Sun Jan 16 13:15:02 EST 2005 *)
56258   ]);;
56259   (* }}} *)
56260
56261 extend_simp_rewrites[prove_by_refinement(
56262   `!x. x <=. x`,
56263   (* {{{ proof *)
56264   [
56265   REP_BASIC_TAC;
56266   REAL_ARITH_TAC;
56267   ])];;
56268   (* }}} *)
56269
56270 let real012 = prove_by_refinement(
56271   `&0 < &1 /\ &0 <= &1 /\ &0 <= &1 / &2 /\ &0 < &1 / &2 /\ &1/ &2 < &1 /\ &1 / &2 <= &1 `,
56272   (* {{{ proof *)
56273   [
56274   CONJ_TAC;
56275   REAL_ARITH_TAC;
56276   CONJ_TAC;
56277   REAL_ARITH_TAC;
56278   CONJ_TAC;
56279   IMATCH_MP_TAC  REAL_LE_RDIV;
56280   REAL_ARITH_TAC;
56281   CONJ_TAC;
56282   IMATCH_MP_TAC  REAL_LT_DIV;
56283   REAL_ARITH_TAC;
56284   CONJ_TAC;
56285   IMATCH_MP_TAC  REAL_LT_1;
56286   REAL_ARITH_TAC;
56287   IMATCH_MP_TAC  REAL_LE_LDIV;
56288   REAL_ARITH_TAC;
56289   ]);;
56290   (* }}} *)
56291
56292 extend_simp_rewrites[real012];;
56293
56294 let simple_closed_curve_nonempty = prove_by_refinement(
56295   `!C. simple_closed_curve top2 C ==> (?p. C p)`,
56296   (* {{{ proof *)
56297   [
56298   REWRITE_TAC[simple_closed_curve];
56299   KILLH 5825;
56300   TYPE_THEN `f (&0)` EXISTS_TAC;
56301   TYPE_THEN `C` UNABBREV_TAC;
56302   IMATCH_MP_TAC  image_imp;
56303   ASM_RSIMP_TAC[];
56304   ]);;
56305   (* }}} *)
56306
56307 let simple_closed_curve_2pt = prove_by_refinement(
56308   `!C p. simple_closed_curve top2 C /\ C p ==> (?q. C q /\ ~(q = p))`,
56309   (* {{{ proof *)
56310   [
56311   REWRITE_TAC[simple_closed_curve];
56312   USEH 5825 GSYM;
56313   TYPE_THEN `~(f (&0) = f( &1 / &2))` SUBAGOAL_TAC;
56314   FULL_REWRITE_TAC[INJ];
56315   TYPE_THEN `&0 = &1 / &2` SUBAGOAL_TAC;
56316   FIRST_ASSUM IMATCH_MP_TAC ;
56317   ASM_REWRITE_TAC[];
56318   (* --- *)
56319   ASM_RSIMP_TAC [];
56320   TYPE_THEN `&0 < &2` SUBAGOAL_TAC;
56321   REAL_ARITH_TAC;
56322   TYPE_THEN `&0 < &1 / &2` SUBAGOAL_TAC;
56323   ASM_RSIMP_TAC[];
56324   UNDH 4792 THEN UNDH 3735 THEN REAL_ARITH_TAC;
56325   (* - *)
56326   TYPE_THEN `C (f (&1 / &2))` SUBAGOAL_TAC;
56327   TYPE_THEN `C` UNABBREV_TAC;
56328   IMATCH_MP_TAC  image_imp;
56329   ASM_RSIMP_TAC[];
56330   (* - *)
56331   TYPE_THEN `p = f (&0)` ASM_CASES_TAC;
56332   TYPE_THEN `p` UNABBREV_TAC;
56333   TYPE_THEN `f (&1 / &2)` EXISTS_TAC;
56334   ASM_REWRITE_TAC[];
56335   TYPE_THEN `f (&0)` EXISTS_TAC;
56336   ASM_REWRITE_TAC[];
56337   IMATCH_MP_TAC  image_imp;
56338   ASM_RSIMP_TAC[];
56339   ]);;
56340   (* }}} *)
56341
56342 let xmin_le_xmax = prove_by_refinement(
56343   `!C. simple_closed_curve top2 C ==> (xminQ C <= xmaxQ C)`,
56344   (* {{{ proof *)
56345   [
56346   REP_BASIC_TAC;
56347   THM_INTRO_TAC[`C`] xminQ_exists;
56348   ASM_REWRITE_TAC[];
56349   THM_INTRO_TAC[`C`;`p`] xmaxQ_max;
56350   ASM_REWRITE_TAC[];
56351   USEH 6458 GSYM;
56352   ASM_REWRITE_TAC[];
56353   ]);;
56354   (* }}} *)
56355
56356 let ymin_le_ymax = prove_by_refinement(
56357   `!C. simple_closed_curve top2 C ==> (yminQ C <= ymaxQ C)`,
56358   (* {{{ proof *)
56359   [
56360   REP_BASIC_TAC;
56361   THM_INTRO_TAC[`C`] yminQ_exists;
56362   ASM_REWRITE_TAC[];
56363   THM_INTRO_TAC[`C`;`p`] ymaxQ_max;
56364   ASM_REWRITE_TAC[];
56365   USEH 4513 GSYM;
56366   ASM_REWRITE_TAC[];
56367   ]);;
56368   (* }}} *)
56369
56370 let simple_closed_curve_nsubset_arc = prove_by_refinement(
56371   `!C E. simple_closed_curve top2 C /\ simple_arc top2 E ==>
56372      ~(C SUBSET E)`,
56373   (* {{{ proof *)
56374   [
56375   REP_BASIC_TAC;
56376   THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
56377   ASM_REWRITE_TAC[];
56378   THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
56379   ASM_REWRITE_TAC[];
56380   THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut;
56381   ASM_REWRITE_TAC[];
56382   TYPE_THEN `C' SUBSET E /\ C'' SUBSET E` SUBAGOAL_TAC;
56383   TYPE_THEN `C` UNABBREV_TAC;
56384   UNDH 6378 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
56385   THM_INTRO_TAC[`E`;`p`;`q`;`C'`] cut_arc_unique;
56386   ASM_REWRITE_TAC[];
56387   THM_INTRO_TAC[`E`;`p`;`q`;`C''`] cut_arc_unique;
56388   ASM_REWRITE_TAC[];
56389   TYPE_THEN `cut_arc E p q` UNABBREV_TAC;
56390   TYPE_THEN `C''` UNABBREV_TAC;
56391   FULL_REWRITE_TAC[INTER_IDEMPOT];
56392   TYPE_THEN `C'` UNABBREV_TAC;
56393   THM_INTRO_TAC[`{p,q}`] simple_arc_infinite;
56394   IMATCH_MP_TAC  simple_arc_end_simple;
56395  UNIFY_EXISTS_TAC;
56396   ASM_REWRITE_TAC[];
56397   FULL_REWRITE_TAC[INFINITE];
56398   FULL_REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
56399   ASM_REWRITE_TAC[];
56400   (* Sun Jan 16 15:22:30 EST 2005 *)
56401   ]);;
56402   (* }}} *)
56403
56404 let xmin_lt_xmax = prove_by_refinement(
56405   `!C. simple_closed_curve top2 C ==> (xminQ C < xmaxQ C)`,
56406   (* {{{ proof *)
56407   [
56408   REP_BASIC_TAC;
56409   REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
56410   ASM_SIMP_TAC [xmin_le_xmax];
56411   THM_INTRO_TAC[`C`] ymin_le_ymax;
56412   ASM_REWRITE_TAC[];
56413   TYPE_THEN `yminQ C < ymaxQ C` SUBAGOAL_TAC;
56414   REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
56415   ASM_SIMP_TAC[ymin_le_ymax];
56416   TYPE_THEN `!p. C p ==> (p = point(xminQ C,yminQ C))` SUBAGOAL_TAC;
56417   TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
56418   IMATCH_MP_TAC  subset_imp;
56419   TYPE_THEN `C` EXISTS_TAC;
56420   ASM_REWRITE_TAC[];
56421   IMATCH_MP_TAC  simple_closed_curve_euclid;
56422   ASM_REWRITE_TAC[];
56423   USEH 7802 (MATCH_MP point_onto);
56424 (*** Modified by JRH for proper right associativity of "="
56425   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;REAL_ARITH `x = y = (x <= y) /\ (y <= x)`];
56426  ***)
56427   ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_LE_ANTISYM];
56428   TYPE_THEN `(FST p' = p 0) /\ (SND p' = p 1)` SUBAGOAL_TAC;
56429   ASM_REWRITE_TAC[coord01];
56430   KILLH 5687;
56431   ASM_REWRITE_TAC[];
56432   CONJ_TAC;
56433   CONJ_TAC;
56434   IMATCH_MP_TAC  xmaxQ_max;
56435   ASM_REWRITE_TAC[];
56436   USEH 5418 GSYM;
56437   ASM_REWRITE_TAC[];
56438   IMATCH_MP_TAC  xminQ_min;
56439   ASM_REWRITE_TAC[];
56440   (* --- *)
56441   CONJ_TAC;
56442   IMATCH_MP_TAC  ymaxQ_max;
56443   ASM_REWRITE_TAC[];
56444   TYPE_THEN `ymaxQ C` UNABBREV_TAC;
56445   IMATCH_MP_TAC  yminQ_min;
56446   ASM_REWRITE_TAC[];
56447   (* -- *)
56448   THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
56449   ASM_REWRITE_TAC[];
56450   COPYH 9414;
56451   TSPECH `p` 9414;
56452   TYPE_THEN `point(xminQ C,yminQ C)` UNABBREV_TAC;
56453   THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
56454   ASM_REWRITE_TAC[];
56455   ASM_MESON_TAC[];
56456   (* -A  BACK ON *)
56457   TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC;
56458   IMATCH_MP_TAC  subset_imp;
56459   TYPE_THEN `C` EXISTS_TAC;
56460   ASM_REWRITE_TAC[];
56461   IMATCH_MP_TAC  simple_closed_curve_euclid;
56462   ASM_REWRITE_TAC[];
56463   (* - *)
56464   TYPE_THEN `!p. C p ==> (p 0 = xmaxQ C)` SUBAGOAL_TAC;
56465   REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`];
56466   CONJ_TAC;
56467   IMATCH_MP_TAC  xmaxQ_max;
56468   ASM_REWRITE_TAC[];
56469   TYPE_THEN `xmaxQ C` UNABBREV_TAC;
56470   IMATCH_MP_TAC  xminQ_min;
56471   ASM_REWRITE_TAC[];
56472   (* - *)
56473   TYPE_THEN `!p. C p ==> (yminQ C <= p 1 /\ p 1 <= ymaxQ C)` SUBAGOAL_TAC;
56474   CONJ_TAC;
56475   IMATCH_MP_TAC  yminQ_min;
56476   ASM_REWRITE_TAC[];
56477   IMATCH_MP_TAC  ymaxQ_max;
56478   ASM_REWRITE_TAC[];
56479   (* - *)
56480   TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC;
56481   THM_INTRO_TAC[`C`] yminQ_exists;
56482   ASM_REWRITE_TAC[];
56483   TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ;
56484   TYPE_THEN `p` UNABBREV_TAC;
56485   ASM_REWRITE_TAC[];
56486   TSPECH `p` 2734;
56487   USEH 7802 (MATCH_MP point_onto);
56488   TYPE_THEN `p` UNABBREV_TAC;
56489   REWRITE_TAC[point_inj];
56490   REWRITE_TAC[PAIR_SPLIT];
56491   TYPE_THEN `yminQ C` UNABBREV_TAC;
56492   REWRITE_TAC[coord01];
56493   TSPECH `point p'` 111;
56494   TYPE_THEN `xmaxQ C` UNABBREV_TAC;
56495   TYPE_THEN `xminQ C` UNABBREV_TAC;
56496   REWRITE_TAC[coord01];
56497   (* - *)
56498   TYPE_THEN `C (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC;
56499   THM_INTRO_TAC[`C`] ymaxQ_exists;
56500   ASM_REWRITE_TAC[];
56501   TYPE_THEN `p = point(xminQ C, ymaxQ C)` BACK_TAC ;
56502   TYPE_THEN `p` UNABBREV_TAC;
56503   ASM_REWRITE_TAC[];
56504   TSPECH `p` 2734;
56505   USEH 7802 (MATCH_MP point_onto);
56506   TYPE_THEN `p` UNABBREV_TAC;
56507   REWRITE_TAC[point_inj];
56508   REWRITE_TAC[PAIR_SPLIT];
56509   TYPE_THEN `ymaxQ C` UNABBREV_TAC;
56510   REWRITE_TAC[coord01];
56511   TSPECH `point p'` 111;
56512   TYPE_THEN `xmaxQ C` UNABBREV_TAC;
56513   TYPE_THEN `xminQ C` UNABBREV_TAC;
56514   REWRITE_TAC[coord01];
56515   (* - *)
56516   TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC;
56517   ASM_SIMP_TAC [SUBSET;mk_segment_v];
56518   TYPE_THEN `x 1` EXISTS_TAC;
56519   TYPE_THEN `yminQ C <= x 1 /\ x 1 <= ymaxQ C ` SUBAGOAL_TAC;
56520   FIRST_ASSUM IMATCH_MP_TAC ;
56521   ASM_REWRITE_TAC[];
56522   ASM_REWRITE_TAC[];
56523   TSPECH `x` 2734;
56524   USEH 1837 (MATCH_MP point_onto);
56525   TYPE_THEN `x` UNABBREV_TAC;
56526   REWRITE_TAC[point_inj];
56527   REWRITE_TAC[PAIR_SPLIT;coord01];
56528   TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC;
56529   REWRITE_TAC[coord01];
56530   ASM_REWRITE_TAC[];
56531   TYPE_THEN `q = point p` ABBREV_TAC ;
56532   FIRST_ASSUM IMATCH_MP_TAC ;
56533   ASM_REWRITE_TAC[];
56534   (* -B *)
56535   THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xminQ C,ymaxQ C))`] simple_closed_curve_nsubset_arc;
56536   ASM_REWRITE_TAC[];
56537   IMATCH_MP_TAC  simple_arc_end_simple;
56538   TYPE_THEN `point(xmaxQ C,yminQ C)` EXISTS_TAC;
56539   TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC;
56540   IMATCH_MP_TAC  mk_segment_simple_arc_end;
56541   REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ];
56542   UNDH 1234 THEN UNDH 5378 THEN REAL_ARITH_TAC;
56543   ASM_MESON_TAC[];
56544   (* Sun Jan 16 15:26:36 EST 2005 *)
56545
56546   ]);;
56547   (* }}} *)
56548
56549 let ymin_lt_ymax = prove_by_refinement(
56550   `!C. simple_closed_curve top2 C ==> (yminQ C < ymaxQ C)`,
56551   (* {{{ proof *)
56552   [
56553   REP_BASIC_TAC;
56554   REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
56555   ASM_SIMP_TAC [ymin_le_ymax];
56556   THM_INTRO_TAC[`C`] xmin_lt_xmax;
56557   ASM_REWRITE_TAC[];
56558   (* - *)
56559   TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC;
56560   IMATCH_MP_TAC  subset_imp;
56561   TYPE_THEN `C` EXISTS_TAC;
56562   ASM_REWRITE_TAC[];
56563   IMATCH_MP_TAC  simple_closed_curve_euclid;
56564   ASM_REWRITE_TAC[];
56565   (* - *)
56566   TYPE_THEN `!p. C p ==> (p 1 = ymaxQ C)` SUBAGOAL_TAC;
56567   REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`];
56568   CONJ_TAC;
56569   IMATCH_MP_TAC  ymaxQ_max;
56570   ASM_REWRITE_TAC[];
56571   TYPE_THEN `ymaxQ C` UNABBREV_TAC;
56572   IMATCH_MP_TAC  yminQ_min;
56573   ASM_REWRITE_TAC[];
56574   (* - *)
56575   TYPE_THEN `!p. C p ==> (xminQ C <= p 0 /\ p 0 <= xmaxQ C)` SUBAGOAL_TAC;
56576   CONJ_TAC;
56577   IMATCH_MP_TAC  xminQ_min;
56578   ASM_REWRITE_TAC[];
56579   IMATCH_MP_TAC  xmaxQ_max;
56580   ASM_REWRITE_TAC[];
56581   (* - *)
56582   TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC;
56583   THM_INTRO_TAC[`C`] xminQ_exists;
56584   ASM_REWRITE_TAC[];
56585   TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ;
56586   TYPE_THEN `p` UNABBREV_TAC;
56587   ASM_REWRITE_TAC[];
56588   TSPECH `p` 2734;
56589   USEH 7802 (MATCH_MP point_onto);
56590   TYPE_THEN `p` UNABBREV_TAC;
56591   REWRITE_TAC[point_inj];
56592   REWRITE_TAC[PAIR_SPLIT];
56593   TYPE_THEN `xminQ C` UNABBREV_TAC;
56594   REWRITE_TAC[coord01];
56595   TSPECH `point p'` 4874;
56596   TYPE_THEN `ymaxQ C` UNABBREV_TAC;
56597   TYPE_THEN `yminQ C` UNABBREV_TAC;
56598   REWRITE_TAC[coord01];
56599   (* - *)
56600   TYPE_THEN `C (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC;
56601   THM_INTRO_TAC[`C`] xmaxQ_exists;
56602   ASM_REWRITE_TAC[];
56603   TYPE_THEN `p = point(xmaxQ C, yminQ C)` BACK_TAC ;
56604   TYPE_THEN `p` UNABBREV_TAC;
56605   ASM_REWRITE_TAC[];
56606   TSPECH `p` 2734;
56607   USEH 7802 (MATCH_MP point_onto);
56608   TYPE_THEN `p` UNABBREV_TAC;
56609   REWRITE_TAC[point_inj];
56610   REWRITE_TAC[PAIR_SPLIT];
56611   TYPE_THEN `xmaxQ C` UNABBREV_TAC;
56612   REWRITE_TAC[coord01];
56613   TSPECH `point p'` 4874;
56614   TYPE_THEN `ymaxQ C` UNABBREV_TAC;
56615   TYPE_THEN `yminQ C` UNABBREV_TAC;
56616   REWRITE_TAC[coord01];
56617   (* - *)
56618   TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC;
56619   TYPE_THEN `xminQ C <= xmaxQ C` SUBAGOAL_TAC;
56620   UNDH 5679 THEN REAL_ARITH_TAC;
56621   ASM_SIMP_TAC [SUBSET;mk_segment_h];
56622   TYPE_THEN `x 0` EXISTS_TAC;
56623   TYPE_THEN `xminQ C <= x 0 /\ x 0 <= xmaxQ C ` SUBAGOAL_TAC;
56624   FIRST_ASSUM IMATCH_MP_TAC ;
56625   ASM_REWRITE_TAC[];
56626   ASM_REWRITE_TAC[];
56627   TSPECH `x` 2734;
56628   USEH 1837 (MATCH_MP point_onto);
56629   TYPE_THEN `x` UNABBREV_TAC;
56630   REWRITE_TAC[point_inj];
56631   REWRITE_TAC[PAIR_SPLIT;coord01];
56632   TYPE_THEN `SND  p = point p 1` SUBAGOAL_TAC;
56633   REWRITE_TAC[coord01];
56634   ASM_REWRITE_TAC[];
56635   TYPE_THEN `q = point p` ABBREV_TAC ;
56636   FIRST_ASSUM IMATCH_MP_TAC ;
56637   ASM_REWRITE_TAC[];
56638   (* -B *)
56639   THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xmaxQ C,yminQ C))`] simple_closed_curve_nsubset_arc;
56640   ASM_REWRITE_TAC[];
56641   IMATCH_MP_TAC  simple_arc_end_simple;
56642   TYPE_THEN `point(xminQ C,ymaxQ C)` EXISTS_TAC;
56643   TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC;
56644   IMATCH_MP_TAC  mk_segment_simple_arc_end;
56645   REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ];
56646   UNDH 5418 THEN UNDH 5679 THEN REAL_ARITH_TAC;
56647   ASM_MESON_TAC[];
56648   (* Sun Jan 16 15:39:56 EST 2005 *)
56649
56650   ]);;
56651   (* }}} *)
56652
56653 let simple_closed_curve_closed = prove_by_refinement(
56654   `!C. simple_closed_curve top2 C ==> (closed_ top2 C)`,
56655   (* {{{ proof *)
56656   [
56657   REP_BASIC_TAC;
56658   THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
56659   ASM_REWRITE_TAC[];
56660   THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
56661   ASM_REWRITE_TAC[];
56662   THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut;
56663   ASM_REWRITE_TAC[];
56664   TYPE_THEN `C` UNABBREV_TAC;
56665   IMATCH_MP_TAC  closed_union;
56666   REWRITE_TAC[top2_top];
56667   CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_closed THEN UNIFY_EXISTS_TAC  THEN ASM_REWRITE_TAC[];
56668   (* Sun Jan 16 16:43:23 EST 2005 *)
56669
56670   ]);;
56671   (* }}} *)
56672
56673 let simple_closed_curve_mk_C = prove_by_refinement(
56674   `!Q.  simple_closed_curve top2 Q ==>
56675        ?C v1 v2. simple_arc_end C v1 v2 /\
56676        (C INTER Q = {v1,v2}) /\
56677        (v2 1 = yminQ Q) /\
56678        (v1 1 = ymaxQ Q) /\
56679        (!x. C x ==>
56680            (x 1 = yminQ Q) \/ (x 1 = ymaxQ Q) \/ (xmaxQ Q < x 0))`,
56681   (* {{{ proof *)
56682   [
56683   REP_BASIC_TAC;
56684   TYPE_THEN `Ca = mk_segment (point(xminQ Q,yminQ Q)) (point(xmaxQ Q + &1,yminQ Q))` ABBREV_TAC ;
56685   (* - *)
56686   TYPE_THEN `xminQ Q <= xmaxQ Q + &1` SUBAGOAL_TAC;
56687   IMATCH_MP_TAC  REAL_LE_TRANS;
56688   TYPE_THEN `xmaxQ Q` EXISTS_TAC;
56689   CONJ_TAC;
56690   IMATCH_MP_TAC xmin_le_xmax;
56691   ASM_REWRITE_TAC[];
56692   REAL_ARITH_TAC;
56693   (* - *)
56694   THM_INTRO_TAC[`Ca`;`Ca INTER Q`;`{(point(xmaxQ Q + &1,yminQ Q))}`] simple_arc_end_restriction;
56695   SUBCONJ_TAC;
56696   TYPE_THEN `Ca` UNABBREV_TAC;
56697   IMATCH_MP_TAC  simple_arc_end_simple;
56698   THM_INTRO_TAC[`point(xminQ Q,yminQ Q)`;`point(xmaxQ Q + &1,yminQ Q)`] mk_segment_simple_arc_end;
56699   REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT];
56700   THM_INTRO_TAC[`Q`] xmin_lt_xmax;
56701   ASM_REWRITE_TAC[];
56702   UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC;
56703   ASM_MESON_TAC[];
56704   (* -- *)
56705   CONJ_TAC;
56706   IMATCH_MP_TAC  closed_inter2;
56707   REWRITE_TAC[top2_top];
56708   CONJ_TAC;
56709   IMATCH_MP_TAC  simple_arc_end_closed;
56710   ASM_MESON_TAC[simple_arc_choose_end];
56711   IMATCH_MP_TAC  simple_closed_curve_closed;
56712   ASM_REWRITE_TAC[];
56713   (* -- *)
56714   REWRITE_TAC[EMPTY_EXISTS;INTER;];
56715   REWRITE_TAC[INR IN_SING;EQ_EMPTY];
56716   CONJ_TAC;
56717   IMATCH_MP_TAC  closed_point;
56718   REWRITE_TAC[euclid_point];
56719   (* -- *)
56720   CONJ_TAC;
56721   TYPE_THEN `x` UNABBREV_TAC;
56722   THM_INTRO_TAC[`Q`] xmaxQ_max;
56723   TSPECH  `(point (xmaxQ Q + &1, yminQ Q))` 9371;
56724   REWRH 3532;
56725   FULL_REWRITE_TAC[coord01];
56726   UNDH 3234 THEN REAL_ARITH_TAC;
56727   (* -- *)
56728   CONJ_TAC;
56729   THM_INTRO_TAC[`Q`] yminQ_exists;
56730   ASM_REWRITE_TAC[];
56731   TYPE_THEN `p` EXISTS_TAC;
56732   ASM_REWRITE_TAC[];
56733   TYPE_THEN `Ca` UNABBREV_TAC;
56734   ASM_SIMP_TAC[mk_segment_h];
56735   TYPE_THEN `p 0` EXISTS_TAC;
56736   TYPE_THEN `yminQ Q` UNABBREV_TAC;
56737   (* --- *)
56738   CONJ_TAC;
56739   IMATCH_MP_TAC  xminQ_min;
56740   ASM_REWRITE_TAC[];
56741   CONJ_TAC;
56742   IMATCH_MP_TAC  REAL_LE_TRANS;
56743   TYPE_THEN `xmaxQ Q` EXISTS_TAC;
56744   CONJ_TAC;
56745   IMATCH_MP_TAC  xmaxQ_max;
56746   ASM_REWRITE_TAC[];
56747   REAL_ARITH_TAC;
56748   IMATCH_MP_TAC  (GSYM euclid2_point);
56749   IMATCH_MP_TAC  subset_imp;
56750   TYPE_THEN `Q` EXISTS_TAC;
56751   ASM_REWRITE_TAC[];
56752   IMATCH_MP_TAC  simple_closed_curve_euclid;
56753   ASM_REWRITE_TAC[];
56754   (* -- *)
56755   CONV_TAC (dropq_conv "u");
56756   TYPE_THEN `Ca` UNABBREV_TAC;
56757   ASM_SIMP_TAC[mk_segment_h];
56758   REWRITE_TAC[point_inj; PAIR_SPLIT;];
56759   CONV_TAC (dropq_conv "t");
56760   ASM_REWRITE_TAC[];
56761   REAL_ARITH_TAC;
56762   (* -A *)
56763   TYPE_THEN `Cb = mk_segment(point(xminQ Q,ymaxQ Q)) (point(xmaxQ Q + &1,ymaxQ Q))` ABBREV_TAC ;
56764   THM_INTRO_TAC[`Cb`;`Cb INTER Q`;`{(point(xmaxQ Q + &1,ymaxQ Q))}`] simple_arc_end_restriction;
56765   SUBCONJ_TAC;
56766   TYPE_THEN `Cb` UNABBREV_TAC;
56767   IMATCH_MP_TAC  simple_arc_end_simple;
56768   THM_INTRO_TAC[`point(xminQ Q,ymaxQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] mk_segment_simple_arc_end;
56769   REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT];
56770   THM_INTRO_TAC[`Q`] xmin_lt_xmax;
56771   ASM_REWRITE_TAC[];
56772   UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC;
56773   ASM_MESON_TAC[];
56774   (* -- *)
56775   CONJ_TAC;
56776   IMATCH_MP_TAC  closed_inter2;
56777   REWRITE_TAC[top2_top];
56778   CONJ_TAC;
56779   IMATCH_MP_TAC  simple_arc_end_closed;
56780   ASM_MESON_TAC[simple_arc_choose_end];
56781   IMATCH_MP_TAC  simple_closed_curve_closed;
56782   ASM_REWRITE_TAC[];
56783   (* -- *)
56784   REWRITE_TAC[EMPTY_EXISTS;INTER;];
56785   REWRITE_TAC[INR IN_SING;EQ_EMPTY];
56786   CONJ_TAC;
56787   IMATCH_MP_TAC  closed_point;
56788   REWRITE_TAC[euclid_point];
56789   (* -- *)
56790   CONJ_TAC;
56791   TYPE_THEN `x` UNABBREV_TAC;
56792   THM_INTRO_TAC[`Q`] xmaxQ_max;
56793   TSPECH  `(point (xmaxQ Q + &1, ymaxQ Q))` 9371;
56794   REWRH 5576;
56795   FULL_REWRITE_TAC[coord01];
56796   UNDH 3234 THEN REAL_ARITH_TAC;
56797   (* -- *)
56798   CONJ_TAC;
56799   THM_INTRO_TAC[`Q`] ymaxQ_exists;
56800   ASM_REWRITE_TAC[];
56801   TYPE_THEN `p` EXISTS_TAC;
56802   ASM_REWRITE_TAC[];
56803   TYPE_THEN `Cb` UNABBREV_TAC;
56804   ASM_SIMP_TAC[mk_segment_h];
56805   TYPE_THEN `p 0` EXISTS_TAC;
56806   TYPE_THEN `ymaxQ Q` UNABBREV_TAC;
56807   (* --- *)
56808   CONJ_TAC;
56809   IMATCH_MP_TAC  xminQ_min;
56810   ASM_REWRITE_TAC[];
56811   CONJ_TAC;
56812   IMATCH_MP_TAC  REAL_LE_TRANS;
56813   TYPE_THEN `xmaxQ Q` EXISTS_TAC;
56814   CONJ_TAC;
56815   IMATCH_MP_TAC  xmaxQ_max;
56816   ASM_REWRITE_TAC[];
56817   REAL_ARITH_TAC;
56818   IMATCH_MP_TAC  (GSYM euclid2_point);
56819   IMATCH_MP_TAC  subset_imp;
56820   TYPE_THEN `Q` EXISTS_TAC;
56821   ASM_REWRITE_TAC[];
56822   IMATCH_MP_TAC  simple_closed_curve_euclid;
56823   ASM_REWRITE_TAC[];
56824   (* -- *)
56825   CONV_TAC (dropq_conv "u");
56826   TYPE_THEN `Cb` UNABBREV_TAC;
56827   ASM_SIMP_TAC[mk_segment_h];
56828   REWRITE_TAC[point_inj; PAIR_SPLIT;];
56829   CONV_TAC (dropq_conv "t");
56830   ASM_REWRITE_TAC[];
56831   REAL_ARITH_TAC;
56832   (* -B *)
56833   TYPE_THEN `Cu = mk_segment (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` ABBREV_TAC ;
56834   TYPE_THEN `simple_arc_end Cu (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` SUBAGOAL_TAC;
56835   TYPE_THEN `Cu` UNABBREV_TAC;
56836   IMATCH_MP_TAC  mk_segment_simple_arc_end;
56837   REWRITE_TAC[euclid_point];
56838   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56839   THM_INTRO_TAC[`Q`] ymin_lt_ymax;
56840   ASM_REWRITE_TAC[];
56841   UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC;
56842   (* - *)
56843   TYPE_THEN `yminQ Q <= ymaxQ Q` SUBAGOAL_TAC;
56844   IMATCH_MP_TAC  ymin_le_ymax;
56845   ASM_REWRITE_TAC[];
56846   (* - *)
56847   TYPE_THEN `v' = point (xmaxQ Q + &1,yminQ Q)` SUBAGOAL_TAC;
56848   USEH 1212 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
56849   ASM_REWRITE_TAC[];
56850   TYPE_THEN `v'` UNABBREV_TAC;
56851   (* - *)
56852   TYPE_THEN `v''' = point (xmaxQ Q + &1,ymaxQ Q)` SUBAGOAL_TAC;
56853   USEH 7634 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
56854   ASM_REWRITE_TAC[];
56855   TYPE_THEN `v'''` UNABBREV_TAC;
56856   (* - *)
56857   THM_INTRO_TAC[`C'`;`Cu`;`v`;`point(xmaxQ Q + &1,yminQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] simple_arc_end_trans;
56858   ASM_REWRITE_TAC[];
56859   REWRITE_TAC[eq_sing;INR IN_SING;INTER;];
56860   CONJ_TAC;
56861   CONJ_TAC;
56862   IMATCH_MP_TAC  simple_arc_end_end2;
56863   UNIFY_EXISTS_TAC;
56864   ASM_REWRITE_TAC[];
56865   TYPE_THEN `Cu` UNABBREV_TAC;
56866   REWRITE_TAC[mk_segment_end];
56867   TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
56868   IMATCH_MP_TAC  subset_imp;
56869   TYPE_THEN `C'` EXISTS_TAC;
56870   ASM_REWRITE_TAC[];
56871   IMATCH_MP_TAC  simple_arc_euclid;
56872   IMATCH_MP_TAC  simple_arc_end_simple;
56873   ASM_MESON_TAC[];
56874   USEH 2838 (MATCH_MP point_onto);
56875   TYPE_THEN `u` UNABBREV_TAC;
56876   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56877   CONJ_TAC;
56878   TYPE_THEN `Cu` UNABBREV_TAC;
56879   UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
56880   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56881   ASM_REWRITE_TAC[];
56882   TYPE_THEN `Ca (point p)` SUBAGOAL_TAC;
56883   ASM_MESON_TAC[subset_imp];
56884   TYPE_THEN `Ca` UNABBREV_TAC;
56885   UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]);
56886   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56887   ASM_REWRITE_TAC[];
56888   (* -C *)
56889   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;
56890   CONJ_TAC;
56891   REWRITE_TAC[INTER;eq_sing;INR IN_SING];
56892   CONJ_TAC;
56893   CONJ_TAC;
56894   IMATCH_MP_TAC  simple_arc_end_end;
56895   ASM_MESON_TAC[];
56896   USEH 2123 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
56897   ASM_REWRITE_TAC[];
56898   USEH 579 (REWRITE_RULE[UNION]);
56899   FIRST_ASSUM DISJ_CASES_TAC;
56900   USEH 2123 (REWRITE_RULE[eq_sing;INTER;INR IN_SING]);
56901   FIRST_ASSUM IMATCH_MP_TAC ;
56902   ASM_REWRITE_TAC[];
56903   IMATCH_MP_TAC  subset_imp;
56904   TYPE_THEN `C'` EXISTS_TAC;
56905   ASM_REWRITE_TAC[];
56906   PROOF_BY_CONTR_TAC;
56907   TYPE_THEN `Cu` UNABBREV_TAC;
56908   TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
56909   IMATCH_MP_TAC  subset_imp;
56910   TYPE_THEN `Q` EXISTS_TAC;
56911   ASM_REWRITE_TAC[];
56912   IMATCH_MP_TAC  simple_closed_curve_euclid;
56913   ASM_REWRITE_TAC[];
56914   USEH 2838 (MATCH_MP point_onto);
56915   TYPE_THEN `u` UNABBREV_TAC;
56916   UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
56917   FULL_REWRITE_TAC[PAIR_SPLIT;point_inj];
56918   THM_INTRO_TAC[`Q`] xmaxQ_max;
56919   TSPECH `(point p)` 9371;
56920   REWRH 375;
56921   TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC;
56922   REWRITE_TAC[coord01];
56923   TYPE_THEN `FST p` UNABBREV_TAC;
56924   TYPE_THEN `point p 0` UNABBREV_TAC;
56925   UNDH 3234 THEN REAL_ARITH_TAC;
56926   (* -- *)
56927   CONJ_TAC;
56928   REWRITE_TAC[eq_sing;INR IN_SING;INTER];
56929   CONJ_TAC;
56930   CONJ_TAC;
56931   REWRITE_TAC[UNION];
56932   DISJ2_TAC;
56933   IMATCH_MP_TAC  simple_arc_end_end2;
56934   ASM_MESON_TAC[];
56935   IMATCH_MP_TAC  simple_arc_end_end2;
56936   ASM_MESON_TAC[];
56937   TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
56938   IMATCH_MP_TAC  subset_imp;
56939   TYPE_THEN `C''` EXISTS_TAC;
56940   ASM_REWRITE_TAC[];
56941   IMATCH_MP_TAC  simple_arc_euclid;
56942   IMATCH_MP_TAC  simple_arc_end_simple;
56943   ASM_MESON_TAC[];
56944   USEH 2838 (MATCH_MP point_onto);
56945   TYPE_THEN `u` UNABBREV_TAC;
56946   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56947   (* --- *)
56948   USEH 311 (REWRITE_RULE[UNION]);
56949   FIRST_ASSUM DISJ_CASES_TAC;
56950   PROOF_BY_CONTR_TAC;
56951   TYPE_THEN `Ca (point p) /\ Cb (point p)` SUBAGOAL_TAC;
56952   CONJ_TAC THEN IMATCH_MP_TAC  subset_imp THEN ASM_MESON_TAC[];
56953   TYPE_THEN `Ca` UNABBREV_TAC;
56954   TYPE_THEN `Cb` UNABBREV_TAC;
56955   UNDH 4559 THEN UNDH 3719 THEN ASM_SIMP_TAC[mk_segment_h];
56956   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56957   TYPE_THEN `SND p` UNABBREV_TAC;
56958   THM_INTRO_TAC[`Q`] ymin_lt_ymax;
56959   ASM_REWRITE_TAC[];
56960   UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC;
56961   THM_INTRO_TAC[`p`] (GSYM coord01);
56962   ASM_REWRITE_TAC[];
56963   CONJ_TAC;
56964   TYPE_THEN `Cu` UNABBREV_TAC;
56965   UNDH 5078 THEN ASM_SIMP_TAC[mk_segment_v];
56966   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56967   ASM_MESON_TAC[];
56968   TYPE_THEN `Cb (point p)` SUBAGOAL_TAC;
56969   IMATCH_MP_TAC  subset_imp;
56970   TYPE_THEN `C''` EXISTS_TAC;
56971   ASM_MESON_TAC[];
56972   TYPE_THEN `Cb` UNABBREV_TAC;
56973   UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]);
56974   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56975   ASM_MESON_TAC[];
56976   (* -- *)
56977   TYPE_THEN `!x. C' x ==> (x 1 = yminQ Q)` SUBAGOAL_TAC;
56978   TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
56979   IMATCH_MP_TAC  subset_imp;
56980   TYPE_THEN `C'` EXISTS_TAC;
56981   ASM_REWRITE_TAC[];
56982   IMATCH_MP_TAC  simple_arc_euclid;
56983   IMATCH_MP_TAC  simple_arc_end_simple;
56984   ASM_MESON_TAC[];
56985   USEH 1837 (MATCH_MP point_onto);
56986   TYPE_THEN `x` UNABBREV_TAC;
56987   TYPE_THEN `Ca (point p)` SUBAGOAL_TAC;
56988   ASM_MESON_TAC[subset_imp];
56989   TYPE_THEN `Ca` UNABBREV_TAC;
56990   UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]);
56991   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
56992   ASM_REWRITE_TAC[coord01];
56993   CONJ_TAC;
56994   FIRST_ASSUM IMATCH_MP_TAC ;
56995   IMATCH_MP_TAC  simple_arc_end_end;
56996   ASM_MESON_TAC[];
56997   (* -- *)
56998   USEH 9465 (REWRITE_RULE[UNION]);
56999   FIRST_ASSUM DISJ_CASES_TAC;
57000   DISJ1_TAC;
57001   FIRST_ASSUM IMATCH_MP_TAC ;
57002   ASM_REWRITE_TAC[];
57003   DISJ2_TAC;
57004   IMATCH_MP_TAC  (REAL_ARITH  `(u + &1  = v) ==> (u < v)`);
57005   TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
57006   IMATCH_MP_TAC  subset_imp;
57007   TYPE_THEN `Cu` EXISTS_TAC;
57008   ASM_REWRITE_TAC[];
57009   IMATCH_MP_TAC  simple_arc_euclid;
57010   IMATCH_MP_TAC  simple_arc_end_simple;
57011   ASM_MESON_TAC[];
57012   USEH 1837 (MATCH_MP point_onto);
57013   TYPE_THEN `x` UNABBREV_TAC;
57014   TYPE_THEN `Cu` UNABBREV_TAC;
57015   UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
57016   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
57017   ASM_SIMP_TAC[coord01];
57018   (* -D *)
57019   TYPE_THEN `Cf = C' UNION Cu` ABBREV_TAC ;
57020   KILLH 7427 THEN KILLH 6091 THEN KILLH 7407 THEN KILLH 1428 THEN KILLH 2123 THEN KILLH 7904 THEN KILLH 700 THEN KILLH 3022;
57021   (* - *)
57022   TYPE_THEN `!x. C'' x ==> (x 1 = ymaxQ Q)` SUBAGOAL_TAC;
57023   TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
57024   IMATCH_MP_TAC  subset_imp;
57025   TYPE_THEN `C''` EXISTS_TAC;
57026   ASM_REWRITE_TAC[];
57027   IMATCH_MP_TAC  simple_arc_euclid;
57028   IMATCH_MP_TAC  simple_arc_end_simple;
57029   ASM_MESON_TAC[];
57030  USEH 1837 (MATCH_MP point_onto);
57031   TYPE_THEN `x` UNABBREV_TAC;
57032   TYPE_THEN `Cb (point p)` SUBAGOAL_TAC;
57033   ASM_MESON_TAC[subset_imp];
57034   TYPE_THEN `Cb` UNABBREV_TAC;
57035   UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]);
57036   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
57037   ASM_REWRITE_TAC[coord01];
57038   (* - *)
57039   TYPE_THEN `C'' INTER Q = {v''}` SUBAGOAL_TAC;
57040   REWRITE_TAC[eq_sing;INR IN_SING;INTER;];
57041   USEH 6873 (REWRITE_RULE[SUBSET]);
57042   USEH 6548 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57043   ASM_MESON_TAC[];
57044   (* - *)
57045   THM_INTRO_TAC[`Cf`;`C''`;`v`;`point(xmaxQ Q + &1,ymaxQ Q)`;`v''`] simple_arc_end_trans;
57046   ASM_REWRITE_TAC[];
57047   IMATCH_MP_TAC  simple_arc_end_symm;
57048   ASM_REWRITE_TAC[];
57049   TYPE_THEN `Cf UNION C''` EXISTS_TAC;
57050   TYPE_THEN `v''` EXISTS_TAC;
57051   TYPE_THEN `v` EXISTS_TAC;
57052   ASM_REWRITE_TAC[];
57053   (* -E *)
57054   CONJ_TAC;
57055   IMATCH_MP_TAC  simple_arc_end_symm;
57056   ASM_REWRITE_TAC[];
57057   (* - *)
57058   CONJ_TAC;
57059   IMATCH_MP_TAC  SUBSET_ANTISYM;
57060   REWRITE_TAC[SUBSET;INTER ;INR in_pair;];
57061   CONJ_TAC;
57062   USEH 3594 (REWRITE_RULE[UNION]);
57063   FIRST_ASSUM DISJ_CASES_TAC;
57064   DISJ1_TAC;
57065   USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57066   FIRST_ASSUM IMATCH_MP_TAC ;
57067   ASM_REWRITE_TAC[];
57068   DISJ2_TAC;
57069   USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57070   FIRST_ASSUM IMATCH_MP_TAC ;
57071   ASM_REWRITE_TAC[];
57072   REWRITE_TAC[UNION];
57073   FIRST_ASSUM DISJ_CASES_TAC;
57074   TYPE_THEN `x` UNABBREV_TAC;
57075   USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57076   ASM_REWRITE_TAC[];
57077   TYPE_THEN `x` UNABBREV_TAC;
57078   USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57079   ASM_REWRITE_TAC[];
57080   (* - *)
57081   CONJ_TAC;
57082   FIRST_ASSUM IMATCH_MP_TAC ;
57083   USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57084   ASM_REWRITE_TAC[];
57085   USEH 3594 (REWRITE_RULE[UNION]);
57086   FIRST_ASSUM DISJ_CASES_TAC;
57087   ASM_MESON_TAC[];
57088   ASM_MESON_TAC[];
57089   (* Sun Jan 16 18:43:03 EST 2005 *)
57090   ]);;
57091   (* }}} *)
57092
57093 let simple_arc_end_IVT = prove_by_refinement(
57094   `!C v w i y. simple_arc_end C v w /\ v i <= y /\ y <= w i ==>
57095            (?u. C u /\ (u i = y)) `,
57096   (* {{{ proof *)
57097   [
57098   REP_BASIC_TAC;
57099   THM_INTRO_TAC[`C`] simple_arc_connected;
57100   IMATCH_MP_TAC  simple_arc_end_simple;
57101   UNIFY_EXISTS_TAC;
57102   ASM_REWRITE_TAC[];
57103   (* - *)
57104   THM_INTRO_TAC[`i`;`2`] continuous_euclid1;
57105   FULL_REWRITE_TAC[GSYM top2];
57106   (* - *)
57107   THM_INTRO_TAC[`coord i`;`top2`;`top_of_metric(UNIV,d_real)`;`C`] connect_image;
57108   ASM_REWRITE_TAC[];
57109   ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions];
57110   (* - *)
57111   TYPE_THEN `!u. C u ==> (IMAGE (coord i) C) (u i)` SUBAGOAL_TAC;
57112   TYPE_THEN `u i = coord i u` SUBAGOAL_TAC;
57113   REWRITE_TAC[coord];
57114   ASM_REWRITE_TAC[];
57115   IMATCH_MP_TAC  image_imp;
57116   ASM_REWRITE_TAC[];
57117   (* - *)
57118   THM_INTRO_TAC[`IMAGE (coord i) C`;`v i`;`w i`] connected_nogap;
57119   ASM_REWRITE_TAC[];
57120   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
57121   IMATCH_MP_TAC  simple_arc_end_end;
57122   ASM_MESON_TAC[];
57123   IMATCH_MP_TAC  simple_arc_end_end2;
57124   ASM_MESON_TAC[];
57125   (* - *)
57126   USEH 9674 (REWRITE_RULE[SUBSET;IMAGE;coord]);
57127   USEH 8862 GSYM;
57128   FIRST_ASSUM IMATCH_MP_TAC ;
57129   ASM_REWRITE_TAC[];
57130   (* Mon Jan 17 07:07:14 EST 2005 *)
57131
57132   ]);;
57133   (* }}} *)
57134
57135 let simple_closed_curve_mk_ABD = prove_by_refinement(
57136   `!Q v1 v2. simple_closed_curve top2 Q /\
57137        Q v1 /\ Q v2 /\ (v2 1 = yminQ Q) /\ (v1 1 = ymaxQ Q) ==>
57138        (?A B D w1 w2.
57139           simple_arc_end A v1 v2 /\
57140           simple_arc_end B v1 v2 /\
57141           (A UNION B = Q) /\
57142           (A INTER B = {v1,v2}) /\
57143           ~(w1 = v1) /\
57144           ~(w1 = v2) /\
57145           ~(w2 = v1) /\
57146           ~(w2 = v2) /\
57147           A w1 /\ B w2 /\
57148           simple_arc_end D w1 w2 /\
57149           (D INTER Q = {w1,w2}) /\
57150           (!x. D x ==>
57151               (yminQ Q < x 1) /\ (x 1 < ymaxQ Q) /\ (x 0 <= xmaxQ Q))
57152        )`,
57153   (* {{{ proof *)
57154   [
57155   REP_BASIC_TAC;
57156   TYPE_THEN `ymid = (yminQ Q + ymaxQ Q)/(&2)` ABBREV_TAC ;
57157   TYPE_THEN `yminQ Q < ymaxQ Q` SUBAGOAL_TAC;
57158   IMATCH_MP_TAC  ymin_lt_ymax;
57159   ASM_REWRITE_TAC[];
57160   TYPE_THEN `yminQ Q < ymid /\ ymid < ymaxQ Q` SUBAGOAL_TAC;
57161   TYPE_THEN `ymid` UNABBREV_TAC;
57162   CONJ_TAC THENL[IMATCH_MP_TAC  real_middle1_lt;IMATCH_MP_TAC  real_middle2_lt] THEN ASM_REWRITE_TAC[];
57163   (* - *)
57164   TYPE_THEN `~(v1 = v2)` SUBAGOAL_TAC;
57165   TYPE_THEN `v2` UNABBREV_TAC;
57166   TYPE_THEN `v1 1` UNABBREV_TAC;
57167   UNDH 6716 THEN UNDH 6486 THEN REAL_ARITH_TAC;
57168   (* - *)
57169   THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_cut;
57170   ASM_REWRITE_TAC[];
57171   TYPE_THEN `A = C'` ABBREV_TAC ;
57172   TYPE_THEN `C'` UNABBREV_TAC;
57173   TYPE_THEN `B = C''` ABBREV_TAC ;
57174   TYPE_THEN `C''` UNABBREV_TAC;
57175   TYPE_THEN `A` EXISTS_TAC;
57176   TYPE_THEN `B` EXISTS_TAC;
57177   ASM_REWRITE_TAC[];
57178   (* - *)
57179   TYPE_THEN `C = mk_segment (point(xminQ Q,ymid)) (point(xmaxQ Q,ymid))` ABBREV_TAC ;
57180   TYPE_THEN `xminQ Q <= xmaxQ Q` SUBAGOAL_TAC;
57181   IMATCH_MP_TAC  xmin_le_xmax;
57182   ASM_REWRITE_TAC[];
57183   THM_INTRO_TAC[`(point(xminQ Q,ymid))`;`point(xmaxQ Q,ymid)`] mk_segment_simple_arc_end;
57184   REWRITE_TAC[point_inj;PAIR_SPLIT;euclid_point];
57185   TYPE_THEN `xminQ Q < xmaxQ Q` SUBAGOAL_TAC;
57186   IMATCH_MP_TAC  xmin_lt_xmax;
57187   ASM_REWRITE_TAC[];
57188   UNDH 3331 THEN UNDH 9105 THEN REAL_ARITH_TAC;
57189   (* - *)
57190   TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
57191   IMATCH_MP_TAC  simple_arc_end_simple;
57192   TYPE_THEN `C` UNABBREV_TAC;
57193   ASM_MESON_TAC[];
57194   (* - *)
57195   TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC;
57196   IMATCH_MP_TAC  subset_imp;
57197   TYPE_THEN `C` EXISTS_TAC;
57198   ASM_REWRITE_TAC[];
57199   IMATCH_MP_TAC  simple_arc_euclid;
57200   ASM_REWRITE_TAC[];
57201   (* - *)
57202   TYPE_THEN `!x. C x ==> (x 1 = ymid)` SUBAGOAL_TAC;
57203   TSPECH `x` 2734;
57204   USEH 1837 (MATCH_MP point_onto);
57205   TYPE_THEN `x` UNABBREV_TAC;
57206   TYPE_THEN `C` UNABBREV_TAC;
57207   UNDH 3980 THEN (ASM_SIMP_TAC[mk_segment_h]);
57208   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
57209   ASM_REWRITE_TAC[coord01];
57210   (* -A *)
57211   TYPE_THEN `!x. C x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q` SUBAGOAL_TAC;
57212   TSPECH `x` 2734;
57213   USEH 1837 (MATCH_MP point_onto);
57214   TYPE_THEN `x` UNABBREV_TAC;
57215   TYPE_THEN `C` UNABBREV_TAC;
57216   UNDH 3980 THEN UNDH 8406 THEN (SIMP_TAC[mk_segment_h]);
57217   FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
57218   ASM_REWRITE_TAC[coord01];
57219   (* - *)
57220   THM_INTRO_TAC[`C`;`A INTER C`;`B INTER C`] simple_arc_end_restriction;
57221   ASM_REWRITE_TAC[];
57222   (* -- *)
57223   THM_INTRO_TAC[] top2_top;
57224   TYPE_THEN `!E v v'. simple_arc_end E v v' ==> closed_ top2 E` SUBAGOAL_TAC;
57225   IMATCH_MP_TAC  simple_arc_end_closed;
57226   ASM_MESON_TAC[];
57227   CONJ_TAC;
57228   IMATCH_MP_TAC  closed_inter2;
57229   ASM_MESON_TAC[];
57230   CONJ_TAC;
57231   IMATCH_MP_TAC  closed_inter2;
57232   ASM_MESON_TAC[];
57233   REWRITE_TAC[INTER;EMPTY_EXISTS];
57234   REWRITE_TAC[EQ_EMPTY];
57235   CONJ_TAC;
57236   TYPE_THEN `(x 1 = ymid)` SUBAGOAL_TAC;
57237   FIRST_ASSUM IMATCH_MP_TAC ;
57238   ASM_REWRITE_TAC[];
57239   USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57240   TSPECH `x` 6622 ;
57241   USEH 3537 (REWRITE_RULE[INTER;INR in_pair]);
57242   REWRH 6257;
57243   FIRST_ASSUM DISJ_CASES_TAC;
57244   TYPE_THEN `x` UNABBREV_TAC;
57245   TYPE_THEN `v2 1` UNABBREV_TAC;
57246   UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC;
57247   TYPE_THEN `x` UNABBREV_TAC;
57248   TYPE_THEN `v1 1` UNABBREV_TAC;
57249   UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC;
57250   (* --  *)
57251   TYPE_THEN `!E. simple_arc_end E v1 v2 /\ (E SUBSET Q) ==> (?u. C u /\ E u)` BACK_TAC;
57252   CONJ_TAC;
57253   UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`A`]);
57254   ASM_REWRITE_TAC[];
57255   TYPE_THEN `Q` UNABBREV_TAC;
57256   REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
57257   ASM_MESON_TAC[];
57258   UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`B`]);
57259   ASM_REWRITE_TAC[];
57260   TYPE_THEN `Q` UNABBREV_TAC;
57261   REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
57262   ASM_MESON_TAC[];
57263   (* --B intermediate value theorem needed *)
57264   THM_INTRO_TAC[`E`;`v2`;`v1`;`1`;`ymid`] simple_arc_end_IVT;
57265   ASM_REWRITE_TAC[];
57266   CONJ_TAC;
57267   IMATCH_MP_TAC  simple_arc_end_symm;
57268   ASM_REWRITE_TAC[];
57269   UNDH 3172 THEN UNDH 8976 THEN REAL_ARITH_TAC;
57270   TYPE_THEN `u` EXISTS_TAC;
57271   ASM_REWRITE_TAC[];
57272   TYPE_THEN `C` UNABBREV_TAC;
57273   TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
57274   IMATCH_MP_TAC  subset_imp;
57275   TYPE_THEN `E` EXISTS_TAC;
57276   ASM_REWRITE_TAC[];
57277   IMATCH_MP_TAC  simple_arc_euclid;
57278   IMATCH_MP_TAC  simple_arc_end_simple;
57279   ASM_MESON_TAC[];
57280   USEH 2838 (MATCH_MP point_onto);
57281   TYPE_THEN `u` UNABBREV_TAC;
57282   UNDH 8406 THEN SIMP_TAC[mk_segment_h];
57283   REWRITE_TAC[point_inj;PAIR_SPLIT];
57284   TYPE_THEN `FST p` EXISTS_TAC;
57285   USEH 6779 GSYM;
57286   ASM_REWRITE_TAC[coord01];
57287   (* -- *)
57288   TYPE_THEN `Q (point p)` SUBAGOAL_TAC;
57289   ASM_MESON_TAC[subset_imp];
57290   THM_INTRO_TAC[`Q`;`point p`] xminQ_min;
57291   ASM_REWRITE_TAC[];
57292   THM_INTRO_TAC[`Q`;`point p`] xmaxQ_max;
57293   ASM_REWRITE_TAC[];
57294   ASM_REWRITE_TAC[GSYM coord01];
57295   (* -C *)
57296   TYPE_THEN `D = C'''` ABBREV_TAC ;
57297   TYPE_THEN `C'''` UNABBREV_TAC;
57298   TYPE_THEN `w1 = v` ABBREV_TAC ;
57299   TYPE_THEN `v` UNABBREV_TAC;
57300   TYPE_THEN `w2 = v'` ABBREV_TAC ;
57301   TYPE_THEN `v'` UNABBREV_TAC;
57302   TYPE_THEN `D` EXISTS_TAC;
57303   TYPE_THEN `w1` EXISTS_TAC;
57304   TYPE_THEN `w2` EXISTS_TAC;
57305   ASM_REWRITE_TAC[];
57306   (* - *)
57307   TYPE_THEN `A w1 /\ B w2` SUBAGOAL_TAC;
57308   USEH 5104  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57309   USEH 7194  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57310   ASM_REWRITE_TAC[];
57311   ASM_REWRITE_TAC[];
57312   (* - *)
57313   TYPE_THEN `D INTER Q = {w1,w2}` SUBAGOAL_TAC;
57314   TYPE_THEN `Q` UNABBREV_TAC;
57315   IMATCH_MP_TAC  EQ_EXT;
57316   REWRITE_TAC[INTER;UNION;INR in_pair];
57317   UNDH 5104 THEN UNDH 7194 THEN UNDH 2332 THEN (REWRITE_TAC [eq_sing;INR IN_SING;INTER;SUBSET]) THEN MESON_TAC[];
57318   ASM_REWRITE_TAC[];
57319   (* - *)
57320   TYPE_THEN `(!x. D x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q)` SUBAGOAL_TAC;
57321   TYPE_THEN `C x` SUBAGOAL_TAC;
57322   ASM_MESON_TAC[subset_imp];
57323   FIRST_ASSUM IMATCH_MP_TAC ;
57324   ASM_REWRITE_TAC[];
57325   ASM_REWRITE_TAC[];
57326   (* -D *)
57327   TYPE_THEN `~(v1 1 = ymid)` SUBAGOAL_TAC;
57328   TYPE_THEN `v1 1` UNABBREV_TAC;
57329   UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC;
57330   TYPE_THEN `~(v2 1 = ymid)` SUBAGOAL_TAC;
57331   TYPE_THEN `v2 1` UNABBREV_TAC;
57332   UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC;
57333   (* - *)
57334   TYPE_THEN `!w. D w ==> (w 1 = ymid)` SUBAGOAL_TAC;
57335   FIRST_ASSUM IMATCH_MP_TAC ;
57336   ASM_MESON_TAC[subset_imp];
57337   (* - *)
57338   TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC;
57339   USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57340   USEH 5003 (REWRITE_RULE[INTER;INR in_pair]);
57341   UNDH 6817 THEN MESON_TAC[];
57342   TYPE_THEN `!w v. (D w) /\ ~(v 1 = ymid) ==> ~(w = v)` SUBAGOAL_TAC;
57343   TYPE_THEN `v''` UNABBREV_TAC;
57344   UNDH 5813 THEN ASM_REWRITE_TAC[];
57345   FIRST_ASSUM IMATCH_MP_TAC ;
57346   ASM_REWRITE_TAC[];
57347   (* - *)
57348   REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC  THEN ASM_REWRITE_TAC[];
57349   (* Mon Jan 17 07:35:06 EST 2005 *)
57350   ]);;
57351   (* }}} *)
57352
57353 let one_sided_jordan_curve = jordan_def `one_sided_jordan_curve Q <=>
57354    (!v w. euclid 2 v /\ euclid 2 w /\ ~Q v /\ ~Q w /\ ~(v = w) ==>
57355        (?C. simple_arc_end C v w /\ (C INTER Q = EMPTY)))`;;
57356
57357 let simple_closed_curve_mk_E = prove_by_refinement(
57358   `!Q C D . simple_closed_curve top2 Q /\ one_sided_jordan_curve Q /\
57359     ~(C SUBSET Q) /\ ~(D SUBSET Q) /\
57360     simple_arc top2 C /\ simple_arc top2 D /\ (C INTER D = EMPTY) ==>
57361    (?E x1 x2. simple_arc_end E x1 x2 /\
57362        (E INTER C = {x2}) /\ (E INTER D = {x1}) /\ (E INTER Q = EMPTY))`,
57363   (* {{{ proof *)
57364
57365   [
57366   REP_BASIC_TAC;
57367   TYPE_THEN `?c. C c /\ ~Q c` SUBAGOAL_TAC;
57368   FULL_REWRITE_TAC[SUBSET];
57369   ASM_MESON_TAC[];
57370   TYPE_THEN `?d. D d /\ ~Q d` SUBAGOAL_TAC;
57371   FULL_REWRITE_TAC[SUBSET];
57372   ASM_MESON_TAC[];
57373   (* - *)
57374   FULL_REWRITE_TAC[one_sided_jordan_curve];
57375   (* - *)
57376   TYPE_THEN `!R x. simple_arc top2 R /\ R x ==> euclid 2 x` SUBAGOAL_TAC;
57377   IMATCH_MP_TAC  subset_imp;
57378   TYPE_THEN `R` EXISTS_TAC;
57379   ASM_REWRITE_TAC[];
57380   IMATCH_MP_TAC  simple_arc_euclid;
57381   ASM_REWRITE_TAC[];
57382   (* - *)
57383   UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`c`;`d`]);
57384   ASM_REWRITE_TAC[];
57385   USEH 6641 (REWRITE_RULE[INTER;EQ_EMPTY]);
57386   ASM_MESON_TAC[];
57387   (* - *)
57388   THM_INTRO_TAC[`C'`;`C`;`D`] simple_arc_end_restriction;
57389   ASM_REWRITE_TAC[EMPTY_EXISTS; INTER_EMPTY; ];
57390   CONJ_TAC;
57391   IMATCH_MP_TAC  simple_arc_end_simple;
57392   ASM_MESON_TAC[];
57393   CONJ_TAC;
57394   IMATCH_MP_TAC  simple_arc_end_closed;
57395   IMATCH_MP_TAC  simple_arc_choose_end;
57396   ASM_REWRITE_TAC[];
57397   CONJ_TAC;
57398   IMATCH_MP_TAC  simple_arc_end_closed;
57399   IMATCH_MP_TAC  simple_arc_choose_end;
57400   ASM_REWRITE_TAC[];
57401   REWRITE_TAC[INTER];
57402   CONJ_TAC;
57403   UNIFY_EXISTS_TAC;
57404   ASM_REWRITE_TAC[];
57405   IMATCH_MP_TAC  simple_arc_end_end;
57406   UNIFY_EXISTS_TAC;
57407   ASM_REWRITE_TAC[];
57408   UNIFY_EXISTS_TAC;
57409   ASM_REWRITE_TAC[];
57410   IMATCH_MP_TAC  simple_arc_end_end2;
57411   UNIFY_EXISTS_TAC;
57412   ASM_REWRITE_TAC[];
57413   (* -A *)
57414   TYPE_THEN `E = C''` ABBREV_TAC ;
57415   TYPE_THEN `C''` UNABBREV_TAC;
57416   TYPE_THEN `E` EXISTS_TAC;
57417   TYPE_THEN `v'` EXISTS_TAC;
57418   TYPE_THEN `v` EXISTS_TAC;
57419   ASM_REWRITE_TAC[];
57420   CONJ_TAC;
57421   IMATCH_MP_TAC  simple_arc_end_symm;
57422   ASM_REWRITE_TAC[];
57423   (* - *)
57424   UNDH 3420 THEN UNDH 5123 THEN (REWRITE_TAC[EQ_EMPTY;INTER;SUBSET]) THEN MESON_TAC[];
57425   (* Mon Jan 17 08:50:35 EST 2005 *)
57426   ]);;
57427
57428   (* }}} *)
57429
57430 let jordan_curve_k33_data = jordan_def
57431   `jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 <=>
57432      simple_closed_curve top2 Q /\
57433      simple_arc_end A v1 v2 /\
57434      simple_arc_end B v1 v2 /\
57435      simple_arc_end C v1 v2 /\
57436      simple_arc_end D w1 w2 /\
57437      simple_arc_end E x1 x2 /\
57438           ~(w1 = v1) /\
57439           ~(w1 = v2) /\
57440           ~(w2 = v1) /\
57441           ~(w2 = v2) /\
57442           A w1 /\ B w2 /\
57443        (A UNION B = Q) /\
57444        (A INTER B = {v1,v2}) /\
57445        (D INTER Q = {w1,w2}) /\
57446        (C INTER D = EMPTY) /\
57447        (C INTER Q = {v1,v2}) /\
57448        (E INTER C = {x2}) /\
57449        (E INTER D = {x1}) /\
57450        (E INTER Q = EMPTY)`;;
57451
57452
57453 let jordan_curve_k33_data_exist = prove_by_refinement(
57454   `!Q. simple_closed_curve top2 Q /\ one_sided_jordan_curve Q ==>
57455     (?A B C D E v1 v2 w1 w2 x1 x2.
57456          jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2)`,
57457   (* {{{ proof *)
57458   [
57459   REWRITE_TAC[jordan_curve_k33_data];
57460   THM_INTRO_TAC[`Q`] simple_closed_curve_mk_C;
57461   ASM_REWRITE_TAC[];
57462   THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_curve_mk_ABD;
57463   ASM_REWRITE_TAC[];
57464   USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57465   USEH 7606 (REWRITE_RULE[INTER;INR in_pair]);
57466   ASM_MESON_TAC[];
57467   (* - *)
57468   TYPE_THEN `A` EXISTS_TAC;
57469   TYPE_THEN `B` EXISTS_TAC;
57470   TYPE_THEN `C` EXISTS_TAC;
57471   TYPE_THEN `D` EXISTS_TAC;
57472   (* - *)
57473   TYPE_THEN `C INTER D = EMPTY` SUBAGOAL_TAC;
57474   PROOF_BY_CONTR_TAC;
57475   USEH 7282 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
57476   TSPECH `u` 3184;
57477   TSPECH `u` 9655;
57478   UNDH 1134 THEN UNDH 2424 THEN UNDH 920 THEN UNDH 4468 THEN REAL_ARITH_TAC;
57479   (* - *)
57480   THM_INTRO_TAC[`Q`;`C`;`D`] simple_closed_curve_mk_E;
57481   ASM_REWRITE_TAC[];
57482   (* - *)
57483   TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
57484   IMATCH_MP_TAC  simple_arc_end_simple;
57485   ASM_MESON_TAC[];
57486   TYPE_THEN `simple_arc top2 D` SUBAGOAL_TAC;
57487   IMATCH_MP_TAC  simple_arc_end_simple;
57488   ASM_MESON_TAC[];
57489   ASM_REWRITE_TAC[];
57490   (* -- *)
57491   TYPE_THEN `!R y1 y2. (R INTER Q = {y1,y2}) /\ simple_arc_end R y1 y2 ==> ~(R SUBSET Q)` SUBAGOAL_TAC;
57492   TYPE_THEN `R SUBSET {y1,y2}` SUBAGOAL_TAC;
57493   USEH 842 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57494   UNDH 4643 THEN UNDH 5847 THEN (REWRITE_TAC [SUBSET;INR in_pair;INTER]) THEN MESON_TAC[];
57495   TYPE_THEN `FINITE R` SUBAGOAL_TAC;
57496   IMATCH_MP_TAC  FINITE_SUBSET;
57497   TYPE_THEN `{y1,y2}` EXISTS_TAC;
57498   ASM_REWRITE_TAC[];
57499   REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
57500   THM_INTRO_TAC[`R`] simple_arc_infinite;
57501   IMATCH_MP_TAC  simple_arc_end_simple;
57502   ASM_MESON_TAC[];
57503   FULL_REWRITE_TAC[INFINITE];
57504   ASM_MESON_TAC[];
57505   CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[];
57506   UNIFY_EXISTS_TAC;
57507   ASM_REWRITE_TAC[];
57508   UNIFY_EXISTS_TAC;
57509   ASM_REWRITE_TAC[];
57510   (* -A *)
57511   TYPE_THEN `E` EXISTS_TAC;
57512   TYPE_THEN `v1` EXISTS_TAC;
57513   TYPE_THEN `v2` EXISTS_TAC;
57514   TYPE_THEN `w1` EXISTS_TAC;
57515   TYPE_THEN `w2` EXISTS_TAC;
57516   TYPE_THEN `x1` EXISTS_TAC;
57517   TYPE_THEN `x2` EXISTS_TAC;
57518   ASM_REWRITE_TAC[];
57519   (* Mon Jan 17 09:26:35 EST 2005 *)
57520
57521   ]);;
57522   (* }}} *)
57523
57524 let has_size_insert = prove_by_refinement(
57525   `!X (x:A) n.  ~(X x) /\ X HAS_SIZE n ==>
57526           (x INSERT X HAS_SIZE SUC n)`,
57527   (* {{{ proof *)
57528   [
57529   REWRITE_TAC[HAS_SIZE];
57530   ASM_SIMP_TAC [FINITE_RULES];
57531   TYPE_THEN `n` UNABBREV_TAC;
57532   IMATCH_MP_TAC  (GSYM card_suc_insert);
57533   ASM_REWRITE_TAC[];
57534   (* Mon Jan 17 09:33:11 EST 2005 *)
57535
57536   ]);;
57537   (* }}} *)
57538
57539 let jordan_curve_x = prove_by_refinement(
57540   `!Q A B C D E v1 v2 w1 w2 x1 x2.
57541       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
57542       ~(Q x1) /\ ~(Q x2) /\ ~(A x1) /\ ~(A x2) /\ ~(B x1) /\ ~(B x2) /\
57543        ~C x1 /\ C x2 /\ D x1 /\ ~D x2 /\ E x1 /\ E x2`,
57544   (* {{{ proof *)
57545   [
57546   REWRITE_TAC[jordan_curve_k33_data];
57547   TYPE_THEN `E x1 /\ E x2` SUBAGOAL_TAC;
57548   ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_end];
57549   ASM_REWRITE_TAC[];
57550   (* - *)
57551   TYPE_THEN `~Q x1 /\ ~Q x2` SUBAGOAL_TAC;
57552   USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]);
57553   ASM_MESON_TAC[];
57554   ASM_REWRITE_TAC[];
57555   (* - *)
57556   TYPE_THEN `~A x1 /\ ~A x2 /\ ~B x1 /\ ~B x2` SUBAGOAL_TAC;
57557   TYPE_THEN `Q` UNABBREV_TAC;
57558   FULL_REWRITE_TAC[UNION;DE_MORGAN_THM;];
57559   ASM_REWRITE_TAC[];
57560   ASM_REWRITE_TAC[];
57561   (* - *)
57562   TYPE_THEN `D x1` SUBAGOAL_TAC;
57563   USEH 4975 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
57564   ASM_REWRITE_TAC[];
57565   TYPE_THEN `C x2` SUBAGOAL_TAC;
57566   USEH 1536 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
57567   ASM_REWRITE_TAC[];
57568   ASM_REWRITE_TAC[];
57569   (* - *)
57570   THM_INTRO_TAC[`E`;`x1`;`x2`] simple_arc_end_distinct;
57571   ASM_REWRITE_TAC[];
57572   CONJ_TAC;
57573   USEH 1536 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57574   ASM_MESON_TAC[];
57575   USEH 4975 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
57576   ASM_MESON_TAC[];
57577   (* Mon Jan 17 09:56:00 EST 2005 *)
57578
57579   ]);;
57580   (* }}} *)
57581
57582 let jordan_curve_v = prove_by_refinement(
57583   `!Q A B C D E v1 v2 w1 w2 x1 x2.
57584       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
57585     Q v1 /\ Q v2 /\ A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2 /\
57586     ~D v1 /\ ~D v2 /\ ~E v1 /\ ~E v2`,
57587   (* {{{ proof *)
57588   [
57589   REWRITE_TAC[jordan_curve_k33_data];
57590   TYPE_THEN `A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2` SUBAGOAL_TAC;
57591   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
57592   ASM_REWRITE_TAC[];
57593   TYPE_THEN `Q v1 /\ Q v2` SUBAGOAL_TAC;
57594   TYPE_THEN `Q` UNABBREV_TAC;
57595   REWRITE_TAC[UNION];
57596   ASM_REWRITE_TAC[];
57597   ASM_REWRITE_TAC[];
57598   (* - *)
57599   TYPE_THEN `~E v1 /\ ~E v2` SUBAGOAL_TAC;
57600   USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]);
57601   ASM_MESON_TAC[];
57602   ASM_REWRITE_TAC[];
57603   (* - *)
57604   USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57605   USEH 5003 (REWRITE_RULE[INTER;INR in_pair]);
57606   ASM_MESON_TAC[];
57607   (* Mon Jan 17 10:06:12 EST 2005 *)
57608
57609   ]);;
57610   (* }}} *)
57611
57612 let jordan_curve_w = prove_by_refinement(
57613   `!Q A B C D E v1 v2 w1 w2 x1 x2.
57614       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
57615    Q w1 /\ Q w2 /\ A w1 /\ ~A w2 /\ ~B w1 /\ B w2 /\ ~C w1 /\ ~C w2 /\
57616    D w1 /\ D w2 /\ ~E w1 /\ ~E w2`,
57617   (* {{{ proof *)
57618   [
57619   REWRITE_TAC[jordan_curve_k33_data];
57620   ASM_REWRITE_TAC[];
57621   TYPE_THEN `Q w1 /\ Q w2` SUBAGOAL_TAC;
57622   TYPE_THEN `Q` UNABBREV_TAC;
57623   REWRITE_TAC[UNION];
57624   ASM_REWRITE_TAC[];
57625   ASM_REWRITE_TAC[];
57626   (* - *)
57627   TYPE_THEN `~E w1 /\ ~E w2` SUBAGOAL_TAC;
57628   USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER;]);
57629   ASM_MESON_TAC[];
57630   ASM_REWRITE_TAC[];
57631   (* - *)
57632   TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC;
57633   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
57634   ASM_REWRITE_TAC[];
57635   (* - *)
57636   TYPE_THEN `~C w1 /\ ~C w2` SUBAGOAL_TAC;
57637   USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57638   USEH 7606 (REWRITE_RULE[INTER;INR in_pair]);
57639   ASM_MESON_TAC[];
57640   ASM_REWRITE_TAC[];
57641   (* - *)
57642   USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57643   USEH 6622 (REWRITE_RULE[INTER;INR in_pair]);
57644   ASM_MESON_TAC[];
57645   (* Mon Jan 17 10:14:46 EST 2005 *)
57646
57647   ]);;
57648   (* }}} *)
57649
57650 let jordan_curve_AP_size3 = prove_by_refinement(
57651   `!Q A B C D E v1 v2 w1 w2 x1 x2.
57652       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
57653       ({w1,w2,x2} HAS_SIZE 3)`,
57654   (* {{{ proof *)
57655   [
57656   REP_BASIC_TAC;
57657   COPYH 2122;
57658   USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
57659   (* - *)
57660   TYPE_THEN `{w1,w2,x2} = x2 INSERT {w1,w2}` SUBAGOAL_TAC;
57661   IMATCH_MP_TAC  EQ_EXT;
57662   REWRITE_TAC[INR IN_INSERT];
57663   MESON_TAC[];
57664   TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC;
57665   ARITH_TAC ;
57666   ASM_REWRITE_TAC[];
57667   IMATCH_MP_TAC  has_size_insert;
57668   REWRITE_TAC[INR in_pair];
57669   REWRITE_TAC[DE_MORGAN_THM];
57670   (* - *)
57671   CONJ_TAC;
57672   ASM_MESON_TAC[jordan_curve_w;jordan_curve_x];
57673   (* - *)
57674   IMATCH_MP_TAC  pair_size_2;
57675   ASM_MESON_TAC[jordan_curve_w];
57676   (* Mon Jan 17 10:18:45 EST 2005 *)
57677   ]);;
57678   (* }}} *)
57679
57680 let jordan_curve_BP_size3 = prove_by_refinement(
57681   `!Q A B C D E v1 v2 w1 w2 x1 x2.
57682       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
57683       ({v1,v2,x1} HAS_SIZE 3)`,
57684   (* {{{ proof *)
57685   [
57686   REP_BASIC_TAC;
57687   COPYH 2122;
57688   USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
57689   (* - *)
57690   TYPE_THEN `{v1,v2,x1} = x1 INSERT {v1,v2}` SUBAGOAL_TAC;
57691   IMATCH_MP_TAC  EQ_EXT;
57692   REWRITE_TAC[INR IN_INSERT];
57693   MESON_TAC[];
57694   TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC;
57695   ARITH_TAC ;
57696   ASM_REWRITE_TAC[];
57697   IMATCH_MP_TAC  has_size_insert;
57698   REWRITE_TAC[INR in_pair];
57699   REWRITE_TAC[DE_MORGAN_THM];
57700   (* - *)
57701   CONJ_TAC;
57702   COPYH 2122;
57703   USEH 2122 (MATCH_MP jordan_curve_v);
57704   USEH 2122 (MATCH_MP jordan_curve_x);
57705   UNDH 2724 THEN UNDH 3425 THEN UNDH 7579 THEN MESON_TAC[];
57706   (* - *)
57707   IMATCH_MP_TAC  pair_size_2;
57708   USEH 2191 (MATCH_MP simple_arc_end_distinct);
57709   ASM_MESON_TAC[];
57710   (* Mon Jan 17 10:26:14 EST 2005 *)
57711   ]);;
57712   (* }}} *)
57713
57714 let jordan_curve_AP_BP_empty = prove_by_refinement(
57715   `!Q A B C D E v1 v2 w1 w2 x1 x2.
57716       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
57717       ({w1,w2,x2} INTER {v1,v2,x1} = EMPTY)`,
57718   (* {{{ proof *)
57719   [
57720   REP_BASIC_TAC;
57721   COPYH 2122;
57722   USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
57723   PROOF_BY_CONTR_TAC;
57724   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
57725   TYPE_THEN `(u = x2) \/ (u = x1) \/ ({w1,w2} u /\ {v1,v2} u)` SUBAGOAL_TAC;
57726   PROOF_BY_CONTR_TAC;
57727   FULL_REWRITE_TAC[DE_MORGAN_THM];
57728   FULL_REWRITE_TAC[INR IN_INSERT];
57729   UNDH 911 THEN UNDH 96 THEN UNDH 5829 THEN UNDH 4124 THEN UNDH 8311 THEN MESON_TAC[];
57730   (* - *)
57731   UNDH 7992 THEN REP_CASES_TAC;
57732   TYPE_THEN `u` UNABBREV_TAC;
57733   FULL_REWRITE_TAC[INR IN_INSERT];
57734   COPYH 2122;
57735   USEH 2122 (MATCH_MP jordan_curve_v);
57736   USEH 2122 (MATCH_MP jordan_curve_x);
57737   ASM_MESON_TAC[];
57738   (* - *)
57739   TYPE_THEN `u` UNABBREV_TAC;
57740   FULL_REWRITE_TAC[INR IN_INSERT];
57741   COPYH 2122;
57742   USEH 2122 (MATCH_MP jordan_curve_w);
57743   USEH 2122 (MATCH_MP jordan_curve_x);
57744   ASM_MESON_TAC[];
57745   (* - *)
57746   FULL_REWRITE_TAC[INR IN_INSERT];
57747   COPYH 2122;
57748   USEH 2122 (MATCH_MP jordan_curve_w);
57749   USEH 2122 (MATCH_MP jordan_curve_v);
57750   ASM_MESON_TAC[];
57751   (* Mon Jan 17 10:36:27 EST 2005  *)
57752
57753   ]);;
57754   (* }}} *)
57755
57756 let has_size_drop_le = prove_by_refinement(
57757   `!n X (x:A) . FINITE X /\ CARD X <=| n ==>
57758      FINITE (x INSERT X) /\ CARD (x INSERT X) <=| SUC n`,
57759   (* {{{ proof *)
57760   [
57761   REP_BASIC_TAC;
57762   ASM_SIMP_TAC[CARD_CLAUSES];
57763   CONJ_TAC;
57764   ASM_MESON_TAC[FINITE_RULES];
57765   COND_CASES_TAC;
57766   UNDH 2770 THEN ARITH_TAC;
57767   UNDH 2770 THEN ARITH_TAC;
57768   (* Mon Jan 17 10:45:48 EST 2005 *)
57769   ]);;
57770   (* }}} *)
57771
57772 let has_size_le9 = prove_by_refinement(
57773   `!(x1:A) x2 x3 x4 x5 x6 x7 x8 x9.
57774     CARD {x1,x2,x3,x4,x5,x6,x7,x8,x9} <=| 9 /\
57775     FINITE {x1,x2,x3,x4,x5,x6,x7,x8,x9}`,
57776   (* {{{ proof *)
57777   [
57778   REP_BASIC_TAC;
57779   THM_INTRO_TAC[`0`;`EMPTY:A->bool`;`x9`] has_size_drop_le;
57780   REWRITE_TAC[FINITE_RULES;CARD_CLAUSES];
57781   ARITH_TAC;
57782   (* - *)
57783   THM_INTRO_TAC[`SUC 0`;`{x9}`;`x8`] has_size_drop_le;
57784   ASM_REWRITE_TAC[];
57785   (* - *)
57786   THM_INTRO_TAC[`SUC(SUC 0)`;`{x8,x9}`;`x7`] has_size_drop_le;
57787   ASM_REWRITE_TAC[];
57788   THM_INTRO_TAC[`SUC(SUC(SUC 0))`;`{x7,x8,x9}`;`x6`] has_size_drop_le;
57789   ASM_REWRITE_TAC[];
57790   THM_INTRO_TAC[`SUC(SUC(SUC(SUC 0)))`;`{x6,x7,x8,x9}`;`x5`] has_size_drop_le;
57791   ASM_REWRITE_TAC[];
57792   THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC 0))))`;`{x5,x6,x7,x8,x9}`;`x4`] has_size_drop_le;
57793   ASM_REWRITE_TAC[];
57794   THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC 0)))))`;`{x4,x5,x6,x7,x8,x9}`;`x3`] has_size_drop_le;
57795   ASM_REWRITE_TAC[];
57796   THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC 0))))))`;`{x3,x4,x5,x6,x7,x8,x9}`;`x2`] has_size_drop_le;
57797   ASM_REWRITE_TAC[];
57798 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;
57799   ASM_REWRITE_TAC[];
57800   ASM_REWRITE_TAC[];
57801   UNDH 457 THEN ARITH_TAC;
57802   (* Mon Jan 17 10:58:38 EST 2005 *)
57803
57804   ]);;
57805   (* }}} *)
57806
57807 let card_surj_bij = prove_by_refinement(
57808   `!(f:A->B) X Y . FINITE X /\ CARD X <=| CARD Y /\
57809      (!y. Y y ==> ?x. X x /\ (f x = y)) ==>
57810       BIJ f X Y`,
57811   (* {{{ proof *)
57812   [
57813   REP_BASIC_TAC;
57814   THM_INTRO_TAC[`f`;`X`] CARD_IMAGE_LE;
57815   ASM_REWRITE_TAC[];
57816   THM_INTRO_TAC[`f`;`X`] FINITE_IMAGE;
57817   ASM_REWRITE_TAC[];
57818   TYPE_THEN `Y SUBSET IMAGE f X` SUBAGOAL_TAC;
57819   REWRITE_TAC[SUBSET;IMAGE];
57820   ASM_MESON_TAC[];
57821   TYPE_THEN `FINITE Y` SUBAGOAL_TAC;
57822   IMATCH_MP_TAC  FINITE_SUBSET;
57823   ASM_MESON_TAC[];
57824   (* - *)
57825   TYPE_THEN `CARD Y <=| CARD (IMAGE f X)` SUBAGOAL_TAC;
57826   IMATCH_MP_TAC  CARD_SUBSET;
57827   ASM_REWRITE_TAC[];
57828   TYPE_THEN `(CARD Y = CARD (IMAGE f X)) /\ (CARD (IMAGE f X) = CARD X)` SUBAGOAL_TAC;
57829   UNDH 5809 THEN UNDH 8940 THEN UNDH 3182 THEN ARITH_TAC;
57830   (* - *)
57831   TYPE_THEN `Y = IMAGE f X` SUBAGOAL_TAC;
57832   IMATCH_MP_TAC  CARD_SUBSET_EQ;
57833   ASM_REWRITE_TAC[];
57834   (* - *)
57835   REWRITE_TAC[BIJ];
57836   TYPE_THEN `SURJ f X Y` SUBAGOAL_TAC;
57837   REWRITE_TAC[SURJ];
57838   TYPE_THEN `Y` UNABBREV_TAC;
57839   ASM_REWRITE_TAC[];
57840   IMATCH_MP_TAC  image_imp;
57841   ASM_REWRITE_TAC[];
57842   ASM_REWRITE_TAC[];
57843   (* - *)
57844   REWRITE_TAC[INJ];
57845   CONJ_TAC;
57846   IMATCH_MP_TAC  image_imp;
57847   ASM_REWRITE_TAC[];
57848   PROOF_BY_CONTR_TAC;
57849   TYPE_THEN `Z = X DELETE x` ABBREV_TAC ;
57850   (* -A *)
57851   TYPE_THEN `IMAGE f Z = Y` SUBAGOAL_TAC;
57852   TYPE_THEN `Y` UNABBREV_TAC;
57853   IMATCH_MP_TAC  SUBSET_ANTISYM;
57854   CONJ_TAC;
57855   IMATCH_MP_TAC  IMAGE_SUBSET;
57856   TYPE_THEN `Z` UNABBREV_TAC;
57857   REWRITE_TAC[DELETE;SUBSET];
57858   ASM_REWRITE_TAC[];
57859   (* -- *)
57860   REWRITE_TAC[SUBSET;IMAGE];
57861   TYPE_THEN `x'` UNABBREV_TAC;
57862   TYPE_THEN `x'' = x` ASM_CASES_TAC;
57863   TYPE_THEN `x''` UNABBREV_TAC;
57864   TYPE_THEN `y` EXISTS_TAC;
57865   ASM_REWRITE_TAC[];
57866   TYPE_THEN `Z` UNABBREV_TAC;
57867   REWRITE_TAC[DELETE];
57868   ASM_REWRITE_TAC[];
57869   (* -- *)
57870   TYPE_THEN `x''` EXISTS_TAC;
57871   TYPE_THEN `Z` UNABBREV_TAC;
57872   REWRITE_TAC[DELETE];
57873   ASM_REWRITE_TAC[];
57874   (* - *)
57875   TYPE_THEN `FINITE Z` SUBAGOAL_TAC;
57876   TYPE_THEN `Z` UNABBREV_TAC;
57877   REWRITE_TAC[FINITE_DELETE];
57878   ASM_REWRITE_TAC[];
57879   TYPE_THEN `CARD Z <| CARD X` SUBAGOAL_TAC;
57880   THM_INTRO_TAC[`x`;`X`] CARD_SUC_DELETE;
57881   ASM_REWRITE_TAC[];
57882   TYPE_THEN `Z` UNABBREV_TAC;
57883   UNDH 481 THEN ARITH_TAC;
57884   (* - *)
57885   TYPE_THEN `CARD Y <= CARD Z` SUBAGOAL_TAC;
57886   TYPE_THEN `Y` UNABBREV_TAC;
57887   IMATCH_MP_TAC  CARD_IMAGE_LE;
57888   ASM_REWRITE_TAC[];
57889   UNDH 9361 THEN UNDH 6773 THEN UNDH 7923 THEN UNDH 193 THEN ARITH_TAC;
57890   (* Mon Jan 17 15:04:48 EST 2005 *)
57891
57892   ]);;
57893   (* }}} *)
57894
57895 let select_inter = jordan_def
57896   `select_inter A C = @x. A (x:A) /\ C x` ;;
57897
57898 let k33f = jordan_def
57899   `k33f (A:A->bool) B E = (select_inter A E, select_inter B E)`;;
57900
57901 let incf = jordan_def
57902   `incf (f:A-> (B#B)) E = { (FST (f E)) , (SND(f E)) }`;;
57903
57904 let k33f_value = prove_by_refinement(
57905   `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==>
57906      (k33f A B E = (a,b))`,
57907   (* {{{ proof *)
57908   [
57909   REP_BASIC_TAC;
57910   REWRITE_TAC[k33f;PAIR_SPLIT];
57911   CONJ_TAC;
57912   REWRITE_TAC[select_inter];
57913   USEH 5597 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57914   USEH 9224 (REWRITE_RULE[INTER;INR IN_SING]);
57915   ASM_REWRITE_TAC[];
57916   REWRITE_TAC[select_inter];
57917   USEH 6985 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57918   USEH 5555 (REWRITE_RULE[INTER;INR IN_SING]);
57919   ASM_REWRITE_TAC[];
57920   (* Mon Jan 17 15:18:50 EST 2005 *)
57921   ]);;
57922   (* }}} *)
57923
57924 let incf_value = prove_by_refinement(
57925   `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==>
57926     (incf (k33f A B) E = {a,b})`,
57927   (* {{{ proof *)
57928   [
57929   REWRITE_TAC[incf];
57930   THM_INTRO_TAC[`A`;`B`;`E`;`a`;`b`] k33f_value;
57931   ASM_REWRITE_TAC[];
57932   ASM_REWRITE_TAC[];
57933   (* Mon Jan 17 15:22:22 EST 2005 *)
57934   ]);;
57935   (* }}} *)
57936
57937 let incf_V = prove_by_refinement(
57938   `!(A:A->bool) B E . SING(A INTER E) /\ SING(B INTER E) ==>
57939     (incf (k33f A B) E = E INTER (A UNION B))`,
57940   (* {{{ proof *)
57941   [
57942   REWRITE_TAC[SING];
57943   THM_INTRO_TAC[`A`;`B`;`E`;`x`;`x'`] incf_value;
57944   ASM_REWRITE_TAC[];
57945   ASM_REWRITE_TAC[];
57946   REWRITE_TAC[UNION_OVER_INTER];
57947   ONCE_REWRITE_TAC[INTER_COMM];
57948   ASM_REWRITE_TAC[];
57949   IMATCH_MP_TAC  EQ_EXT;
57950   REWRITE_TAC[UNION;INR IN_SING;INR in_pair];
57951   MESON_TAC[];
57952   (* Mon Jan 17 15:31:21 EST 2005 *)
57953   ]);;
57954   (* }}} *)
57955
57956 let k33f_E = prove_by_refinement(
57957   `!Q A B C D E v1 v2 w1 w2 x1 x2.
57958       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
57959     ({w1,w2,x2} INTER E = {x2}) /\
57960     ({v1,v2,x1} INTER E = {x1}) `,
57961   (* {{{ proof *)
57962   [
57963   REP_BASIC_TAC;
57964   COPYH 2122;
57965   USEH 2122(MATCH_MP jordan_curve_w);
57966   COPYH 2122;
57967   USEH 2122(MATCH_MP jordan_curve_x);
57968   USEH 2122(MATCH_MP jordan_curve_v);
57969   CONJ_TAC;
57970   REWRITE_TAC[INTER;INR IN_INSERT;eq_sing];
57971   ASM_REWRITE_TAC[];
57972   ASM_MESON_TAC[];
57973   REWRITE_TAC[INTER;INR IN_INSERT;eq_sing];
57974   ASM_REWRITE_TAC[];
57975   ASM_MESON_TAC[];
57976   (* Mon Jan 17 15:40:01 EST 2005 *)
57977   ]);;
57978   (* }}} *)
57979
57980 let k33f_cut_lemma = prove_by_refinement(
57981   `!C v1 v2 w A B. simple_arc_end C v1 v2 /\
57982          C w /\ ~(w = v1) /\ ~(w = v2) /\
57983          (A INTER C = {v1,v2}) /\
57984          (B INTER C = {w}) ==>
57985          (A INTER (cut_arc C v1 w) = {v1}) /\
57986          (B INTER (cut_arc C v1 w) = {w})
57987          `,
57988   (* {{{ proof *)
57989   [
57990   REP_BASIC_TAC;
57991   USEH 8436 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
57992   THM_INTRO_TAC[`C`;`w`;`v1`;`v2`] cut_arc_inter;
57993   ASM_REWRITE_TAC[];
57994   FULL_REWRITE_TAC[eq_sing;INR IN_INSERT;INTER;];
57995   (* - *)
57996   TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
57997   IMATCH_MP_TAC  simple_arc_end_simple;
57998   ASM_MESON_TAC[];
57999   (* - *)
58000   TYPE_THEN `C v1 /\ C v2 ` SUBAGOAL_TAC;
58001   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
58002   (* - *)
58003   TYPE_THEN `simple_arc_end (cut_arc C v1 w) v1 w` SUBAGOAL_TAC;
58004   IMATCH_MP_TAC  cut_arc_simple;
58005   ASM_REWRITE_TAC[];
58006   (* - *)
58007   TYPE_THEN `simple_arc_end (cut_arc C v2 w) v2 w` SUBAGOAL_TAC;
58008   IMATCH_MP_TAC  cut_arc_simple;
58009   ASM_REWRITE_TAC[];
58010   ASM_REWRITE_TAC[];
58011   (* - *)
58012   TYPE_THEN `cut_arc C v1 w SUBSET C ` SUBAGOAL_TAC;
58013   IMATCH_MP_TAC  cut_arc_subset;
58014   ASM_REWRITE_TAC[];
58015   TYPE_THEN `cut_arc C v2 w SUBSET C ` SUBAGOAL_TAC;
58016   IMATCH_MP_TAC  cut_arc_subset;
58017   ASM_REWRITE_TAC[];
58018   (* -A *)
58019   TYPE_THEN `cut_arc C w v1 = cut_arc C v1 w` SUBAGOAL_TAC;
58020   MESON_TAC [cut_arc_symm];
58021   TYPE_THEN `cut_arc C w v1` UNABBREV_TAC;
58022   TYPE_THEN `cut_arc C w v2 = cut_arc C v2 w` SUBAGOAL_TAC;
58023   MESON_TAC [cut_arc_symm];
58024   TYPE_THEN `cut_arc C w v2` UNABBREV_TAC;
58025   (* - *)
58026   CONJ_TAC;
58027   CONJ_TAC;
58028   CONJ_TAC;
58029   ASM_MESON_TAC[];
58030   IMATCH_MP_TAC  simple_arc_end_end;
58031   ASM_MESON_TAC[];
58032   TYPE_THEN `C u` SUBAGOAL_TAC;
58033   ASM_MESON_TAC[subset_imp];
58034   TSPECH `u` 2825;
58035   REWRH 9519;
58036   FIRST_ASSUM DISJ_CASES_TAC;
58037   ASM_REWRITE_TAC[];
58038   TYPE_THEN `u` UNABBREV_TAC;
58039   UNDH 6835 THEN DISCH_THEN (THM_INTRO_TAC[`v2`]);
58040   ASM_REWRITE_TAC[];
58041   IMATCH_MP_TAC  simple_arc_end_end;
58042   ASM_MESON_TAC[];
58043   ASM_MESON_TAC[];
58044   (* - *)
58045   UNDH 6153 THEN DISCH_THEN  IMATCH_MP_TAC ;
58046   ASM_REWRITE_TAC[];
58047   ASM_MESON_TAC[subset_imp];
58048   (* Mon Jan 17 16:10:38 EST 2005 *)
58049
58050   ]);;
58051   (* }}} *)
58052
58053 let k33f_cut = prove_by_refinement(
58054   `!C v1 v2 w A B. simple_arc_end C v1 v2 /\
58055          C w /\ ~(w = v1) /\ ~(w = v2) /\
58056          (A INTER C = {v1,v2}) /\
58057          (B INTER C = {w}) ==>
58058          (A INTER (cut_arc C v1 w) = {v1}) /\
58059          (B INTER (cut_arc C v1 w) = {w}) /\
58060          (A INTER (cut_arc C v2 w) = {v2}) /\
58061          (B INTER (cut_arc C v2 w) = {w})`,
58062   (* {{{ proof *)
58063   [
58064   REP_BASIC_TAC;
58065   THM_INTRO_TAC[`C`;`v1`;`v2`;`w`;`A`;`B`] k33f_cut_lemma;
58066   ASM_REWRITE_TAC[];
58067   ASM_REWRITE_TAC[];
58068   THM_INTRO_TAC[`C`;`v2`;`v1`;`w`;`A`;`B`] k33f_cut_lemma;
58069   ASM_REWRITE_TAC[];
58070   CONJ_TAC;
58071   IMATCH_MP_TAC  simple_arc_end_symm;
58072   ASM_REWRITE_TAC[];
58073   IMATCH_MP_TAC  EQ_EXT;
58074   REWRITE_TAC[INR IN_INSERT];
58075   MESON_TAC[];
58076   ASM_REWRITE_TAC[];
58077   (* Mon Jan 17 16:13:48 EST 2005 *)
58078   ]);;
58079   (* }}} *)
58080
58081 let jordan_curve_k33 = jordan_def
58082     `jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2 =
58083        mk_graph_t ({w1,w2,x2} UNION {v1,v2,x1},
58084          {E,
58085           (cut_arc A v1 w1), (cut_arc A v2 w1),
58086           (cut_arc B v1 w2), (cut_arc B v2 w2),
58087           (cut_arc C v1 x2), (cut_arc C v2 x2),
58088           (cut_arc D w1 x1),( cut_arc D w2 x1)},
58089          (\ e. {(FST (k33f {w1,w2,x2} {v1,v2,x1} e)),
58090                 (SND (k33f {w1,w2,x2} {v1,v2,x1} e)) }))`;;
58091
58092 let jordan_curve_AP_euclid = prove_by_refinement(
58093   `!Q A B C D E v1 v2 w1 w2 x1 x2 .
58094       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
58095       {w1,w2,x2} UNION {v1,v2,x1} SUBSET euclid 2`,
58096   (* {{{ proof *)
58097
58098   [
58099   REP_BASIC_TAC;
58100   COPYH 2122;
58101   USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
58102   REWRITE_TAC[UNION;SUBSET;INR IN_INSERT];
58103   IMATCH_MP_TAC  subset_imp;
58104   TYPE_THEN `simple_arc top2 A /\  simple_arc top2 D /\ simple_arc top2 E` SUBAGOAL_TAC;
58105   REPEAT CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
58106   USEH 9474 (MATCH_MP simple_arc_euclid);
58107   USEH 6512 (MATCH_MP simple_arc_euclid);
58108   USEH 7513 (MATCH_MP simple_arc_euclid);
58109   COPYH 2122;
58110   USEH 2122 (MATCH_MP jordan_curve_x);
58111   COPYH 2122;
58112   USEH 2122 (MATCH_MP jordan_curve_v);
58113   COPYH 2122;
58114   USEH 2122 (MATCH_MP jordan_curve_w);
58115   UNDH 2244 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN ASM_MESON_TAC[];
58116   (* Mon Jan 17 17:05:26 EST 2005 *)
58117   ]);;
58118
58119   (* }}} *)
58120
58121 let cut_arc_simple2 = prove_by_refinement(
58122   `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==>
58123        simple_arc top2 (cut_arc C v w)`,
58124   (* {{{ proof *)
58125   [
58126   REP_BASIC_TAC;
58127   THM_INTRO_TAC[`C`;`v`;`w`] cut_arc_simple;
58128   ASM_REWRITE_TAC[];
58129   IMATCH_MP_TAC  simple_arc_end_simple;
58130   ASM_MESON_TAC[];
58131   ]);;
58132   (* }}} *)
58133
58134 let jordan_curve_k33_plane_criterion = prove_by_refinement(
58135   `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
58136       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58137      (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
58138      (graph G) /\
58139      (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\
58140           (SING ({v1,v2,x1} INTER e))) /\
58141      (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
58142         e INTER e' SUBSET graph_vertex G) ==>
58143      plane_graph G
58144     `,
58145   (* {{{ proof *)
58146   [
58147   REP_BASIC_TAC;
58148   REWRITE_TAC[plane_graph];
58149   ASM_REWRITE_TAC[];
58150   TYPE_THEN `G` UNABBREV_TAC;
58151   FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph];
58152   CONJ_TAC;
58153   IMATCH_MP_TAC  jordan_curve_AP_euclid;
58154   UNIFY_EXISTS_TAC;
58155   ASM_REWRITE_TAC[];
58156   (* - *)
58157   CONJ_TAC;
58158   REWRITE_TAC[SUBSET;INR IN_INSERT];
58159   FIRST_ASSUM DISJ_CASES_TAC;
58160   TYPE_THEN `x` UNABBREV_TAC;
58161   FULL_REWRITE_TAC[jordan_curve_k33_data];
58162   ASM_MESON_TAC[simple_arc_end_simple];
58163   KILLH 8072;
58164   (* -- *)
58165   TYPE_THEN `simple_arc top2 A /\ simple_arc top2 B /\ simple_arc top2 C /\ simple_arc top2 D` SUBAGOAL_TAC;
58166   FULL_REWRITE_TAC[jordan_curve_k33_data];
58167   REPEAT CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
58168   (* -- *)
58169   COPYH 2122;
58170   USEH  2122 (MATCH_MP jordan_curve_v);
58171   COPYH 2122;
58172   USEH  2122 (MATCH_MP jordan_curve_x);
58173   USEH  2122 (MATCH_MP jordan_curve_w);
58174   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[];
58175   (* -A *)
58176   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;
58177   REWRITE_TAC[incf];
58178   ASM_REWRITE_TAC[];
58179   IMATCH_MP_TAC  incf_V;
58180   FIRST_ASSUM IMATCH_MP_TAC ;
58181   ASM_REWRITE_TAC[];
58182   (* Mon Jan 17 17:27:23 EST 2005 *)
58183
58184   ]);;
58185   (* }}} *)
58186
58187 (* ------------------------------------------------------------------ *)
58188 (* SECTION DD *)
58189 (* ------------------------------------------------------------------ *)
58190
58191
58192 let cartesian_size = prove_by_refinement(
58193   `!(A:A->bool) (B:B->bool) m n. A HAS_SIZE m /\ B HAS_SIZE n ==>
58194     cartesian A B HAS_SIZE (m *| n)`,
58195   (* {{{ proof *)
58196
58197   [
58198   REP_BASIC_TAC;
58199   THM_INTRO_TAC[`A`;`B`] CARD_PRODUCT;
58200   FULL_REWRITE_TAC[HAS_SIZE];
58201   ASM_REWRITE_TAC[];
58202   FULL_REWRITE_TAC[IN];
58203   TYPE_THEN `cartesian A B = {(x,y) | A x /\ B y}` SUBAGOAL_TAC;
58204   REWRITE_TAC[cartesian];
58205   ASM_REWRITE_TAC[];
58206   REWRITE_TAC[HAS_SIZE];
58207   ASM_REWRITE_TAC[];
58208   FULL_REWRITE_TAC[HAS_SIZE];
58209   ASM_REWRITE_TAC[];
58210   (* - *)
58211   IMATCH_MP_TAC  (INR FINITE_PRODUCT);
58212   ASM_REWRITE_TAC[];
58213   (* Mon Jan 17 19:37:49 EST 2005 *)
58214
58215   ]);;
58216
58217   (* }}} *)
58218
58219 let jordan_k33f_bij = prove_by_refinement(
58220   `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
58221       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58222      (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))  ==>
58223     (BIJ (k33f {w1,w2,x2} {v1,v2,x1})
58224       (graph_edge G)
58225       (cartesian {w1,w2,x2} {v1,v2,x1})) /\
58226     (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\
58227           (SING ({v1,v2,x1} INTER e))) `,
58228   (* {{{ proof *)
58229   [
58230   REP_BASIC_TAC;
58231   TYPE_THEN `G` UNABBREV_TAC;
58232   TYPE_THEN `L = (graph_edge (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))` ABBREV_TAC ;
58233   FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph];
58234   (* - *)
58235   COPYH 2122;
58236   USEH 2122 (MATCH_MP k33f_E);
58237   (* - *)
58238   COPYH 2122;
58239   USEH 2122 (MATCH_MP jordan_curve_x);
58240   COPYH 2122;
58241   USEH 2122 (MATCH_MP jordan_curve_v);
58242   COPYH 2122;
58243   USEH 2122 (MATCH_MP jordan_curve_w);
58244   COPYH 2122;
58245   USEH 2122 (REWRITE_RULE [jordan_curve_k33_data]);
58246   (* -A *)
58247   THM_INTRO_TAC[`A`;`v1`;`v2`;`w1`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
58248   ASM_REWRITE_TAC[];
58249   ONCE_REWRITE_TAC[FUN_EQ_THM];
58250   REWRITE_TAC[INTER;INR IN_INSERT];
58251   CONJ_TAC THEN ASM_MESON_TAC[];
58252   (* - *)
58253   THM_INTRO_TAC[`B`;`v1`;`v2`;`w2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
58254   ASM_REWRITE_TAC[];
58255   ONCE_REWRITE_TAC[FUN_EQ_THM];
58256   REWRITE_TAC[INTER;INR IN_INSERT];
58257   CONJ_TAC THEN ASM_MESON_TAC[];
58258   (* - *)
58259   THM_INTRO_TAC[`C`;`v1`;`v2`;`x2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
58260   ASM_REWRITE_TAC[];
58261   TYPE_THEN `~(x2 = v1 ) /\ ~(x2 = v2)` SUBAGOAL_TAC;
58262   ASM_MESON_TAC[];
58263   ASM_REWRITE_TAC[];
58264   ONCE_REWRITE_TAC[FUN_EQ_THM];
58265   REWRITE_TAC[INTER;INR IN_INSERT];
58266   CONJ_TAC THEN ASM_MESON_TAC[];
58267   (* - *)
58268   THM_INTRO_TAC[`D`;`w1`;`w2`;`x1`;`{w1,w2,x2}`;`{v1,v2,x1}`] k33f_cut;
58269   ASM_REWRITE_TAC[];
58270   TYPE_THEN `~(x1 = w1 ) /\ ~(x1 = w2)` SUBAGOAL_TAC;
58271   ASM_MESON_TAC[];
58272   ASM_REWRITE_TAC[];
58273   ONCE_REWRITE_TAC[FUN_EQ_THM];
58274   REWRITE_TAC[INTER;INR IN_INSERT];
58275   CONJ_TAC THEN ASM_MESON_TAC[];
58276   (* -B *)
58277   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
58278   CONJ_TAC;
58279   TYPE_THEN `L` UNABBREV_TAC;
58280   USEH 3555 (REWRITE_RULE[INR IN_INSERT]);
58281   TYPE_THEN `!U V (x:num->real). (U INTER V = {x}) ==> (SING (U INTER V))` SUBAGOAL_TAC;
58282   REWRITE_TAC[SING];
58283   UNIFY_EXISTS_TAC ;
58284   ASM_REWRITE_TAC[];
58285   (* -- *)
58286   UNDH 4488 THEN DISCH_THEN (fun t-> RULE_ASSUM_TAC  (fun s -> try (MATCH_MP t s) with failure -> s));
58287   FIRST_ASSUM DISJ_CASES_TAC;
58288   TYPE_THEN `e` UNABBREV_TAC;
58289   ASM_REWRITE_TAC[];
58290   KILLH 4869;
58291   UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_REWRITE_TAC[] ;
58292   (* -C *)
58293   IMATCH_MP_TAC card_surj_bij ;
58294   (* - *)
58295   SUBCONJ_TAC;
58296   TYPE_THEN `L` UNABBREV_TAC;
58297   REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
58298   (* - *)
58299   TYPE_THEN ` (cartesian {w1, w2, x2} {v1, v2, x1}) HAS_SIZE (3 *| 3)` SUBAGOAL_TAC;
58300   IMATCH_MP_TAC  cartesian_size;
58301   CONJ_TAC;
58302   IMATCH_MP_TAC  jordan_curve_AP_size3;
58303  UNIFY_EXISTS_TAC;
58304   ASM_REWRITE_TAC[];
58305   IMATCH_MP_TAC  jordan_curve_BP_size3;
58306  UNIFY_EXISTS_TAC;
58307   ASM_REWRITE_TAC[];
58308   CONJ_TAC;
58309   TYPE_THEN `L` UNABBREV_TAC;
58310   FULL_REWRITE_TAC[HAS_SIZE];
58311   ASM_REWRITE_TAC[];
58312   TYPE_THEN `3 *| 3 = 9` SUBAGOAL_TAC;
58313   ARITH_TAC;
58314   ASM_REWRITE_TAC[];
58315   MESON_TAC[has_size_le9];
58316   (* -D *)
58317   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;
58318   FULL_REWRITE_TAC[cartesian];
58319   TYPE_THEN `y` UNABBREV_TAC;
58320   REWRITE_TAC[PAIR_SPLIT];
58321   USEH 8489 (REWRITE_RULE[INR IN_INSERT]);
58322   USEH 7329 (REWRITE_RULE[INR IN_INSERT]);
58323   UNDH 1878 THEN UNDH 8866 THEN MESON_TAC[];
58324   (* - *)
58325   TYPE_THEN `?x. L x /\ ({w1,w2,x2} INTER x = {(FST y)}) /\ ({v1,v2,x1} INTER x = {(SND y)})` BACK_TAC;
58326   TYPE_THEN `x` EXISTS_TAC;
58327   ASM_REWRITE_TAC[];
58328   THM_INTRO_TAC[`{w1,w2,x2}`;`{v1,v2,x1}`;`x`;`FST y`;`SND y`] k33f_value;
58329   ASM_REWRITE_TAC[];
58330   USEH 5894 (REWRITE_RULE[]);
58331   ASM_REWRITE_TAC[];
58332   (* - *)
58333   TYPE_THEN `L` UNABBREV_TAC;
58334   REWRITE_TAC[INR IN_INSERT];
58335   UNDH 7966 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `y` UNABBREV_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[];
58336   (* Mon Jan 17 20:01:06 EST 2005 *)
58337   ]);;
58338
58339   (* }}} *)
58340
58341 let jordan_curve_k33_isk33 = prove_by_refinement(
58342   `!Q A B C D E v1 v2 w1 w2 x1 x2 .
58343       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
58344     graph_isomorphic k33_graph
58345          (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)`,
58346   (* {{{ proof *)
58347   [
58348   REWRITE_TAC[jordan_curve_k33];
58349   IMATCH_MP_TAC  k33_iso;
58350   (* - *)
58351   CONJ_TAC;
58352   IMATCH_MP_TAC  jordan_curve_AP_size3;
58353   UNIFY_EXISTS_TAC;
58354   ASM_REWRITE_TAC[];
58355   (* - *)
58356   CONJ_TAC;
58357   IMATCH_MP_TAC  jordan_curve_BP_size3;
58358   UNIFY_EXISTS_TAC;
58359   ASM_REWRITE_TAC[];
58360   (* - *)
58361   CONJ_TAC;
58362   IMATCH_MP_TAC  jordan_curve_AP_BP_empty;
58363   UNIFY_EXISTS_TAC;
58364   ASM_REWRITE_TAC[];
58365   (* - *)
58366   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;
58367   ASM_REWRITE_TAC[];
58368   KILLH 2219;
58369   FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;];
58370   TYPE_THEN `fn = k33f {w1,w2,x2} {v1,v2,x1}` ABBREV_TAC ;
58371   TYPE_THEN `(\ e. fn e) = fn` SUBAGOAL_TAC;
58372   IMATCH_MP_TAC  EQ_EXT;
58373   ASM_REWRITE_TAC[];
58374   (* Mon Jan 17 20:12:31 EST 2005 *)
58375   ]);;
58376   (* }}} *)
58377
58378 let jordan_curve_k33_data_inter = prove_by_refinement(
58379   `!Q A B C D E v1 v2 w1 w2 x1 x2 .
58380       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
58381      (A INTER B = {v1,v2}) /\
58382      (A INTER C = {v1,v2}) /\
58383      (A INTER D = {w1}) /\
58384      (A INTER E = EMPTY) /\
58385      (B INTER C = {v1,v2}) /\
58386      (B INTER D = {w2}) /\
58387      (B INTER E = EMPTY) /\
58388      (C INTER D = EMPTY) /\
58389      (C INTER E = {x2}) /\
58390      (D INTER E = {x1})`,
58391   (* {{{ proof *)
58392   [
58393   REWRITE_TAC[jordan_curve_k33_data];
58394   FULL_REWRITE_TAC[INTER_COMM];
58395   ASM_REWRITE_TAC[];
58396   (* - *)
58397   TYPE_THEN `(A INTER E = EMPTY ) /\ (B INTER E = EMPTY)` SUBAGOAL_TAC;
58398   TYPE_THEN `Q` UNABBREV_TAC;
58399   USEH 2576 (REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
58400   REWRITE_TAC[EQ_EMPTY;INTER];
58401   ASM_MESON_TAC[];
58402   ASM_REWRITE_TAC[];
58403   (* - *)
58404   TYPE_THEN `(A INTER C = {v1, v2}) /\ (B INTER C = {v1, v2})` SUBAGOAL_TAC;
58405   ONCE_REWRITE_TAC[FUN_EQ_THM];
58406   REWRITE_TAC[INTER;INR IN_INSERT];
58407   USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
58408   USEH 7606 (REWRITE_RULE[INTER;INR IN_INSERT]);
58409   TYPE_THEN `Q` UNABBREV_TAC;
58410   FULL_REWRITE_TAC[UNION];
58411   USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
58412   USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]);
58413   CONJ_TAC THEN ASM_MESON_TAC[];
58414   ASM_REWRITE_TAC[];
58415   (* -A *)
58416   REWRITE_TAC[INTER;eq_sing;INR IN_INSERT];
58417   TYPE_THEN `Q` UNABBREV_TAC;
58418   ASM_REWRITE_TAC[];
58419   USEH 1691 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
58420   USEH 4348 (REWRITE_RULE[INTER;UNION;INR IN_INSERT]);
58421   USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
58422   USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]);
58423   ASM_MESON_TAC[];
58424   (* Mon Jan 17 20:35:28 EST 2005 *)
58425   ]);;
58426   (* }}} *)
58427
58428 let jordan_curve_edge_inter = prove_by_refinement(
58429   `!Q A B C D E v1 v2 w1 w2 x1 x2 .
58430       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
58431     (!e e'. {A,B,C,D,E} e /\ {A,B,C,D,E} e' /\ ~(e = e') ==>
58432          (e INTER e' SUBSET ({w1,w2,x2} UNION {v1,v2,x1})))`,
58433   (* {{{ proof *)
58434   [
58435   REWRITE_TAC[INR IN_INSERT];
58436   TYPE_THEN `V = {w1, w2, x2} UNION {v1, v2, x1}` ABBREV_TAC ;
58437   TYPE_THEN `{v1,v2} SUBSET V /\ {w1} SUBSET V /\ EMPTY SUBSET V /\ {w2} SUBSET V /\ {x2} SUBSET V /\ {x1} SUBSET V` SUBAGOAL_TAC;
58438   TYPE_THEN `V` UNABBREV_TAC;
58439   REWRITE_TAC[SUBSET;UNION;INR IN_INSERT];
58440   REPEAT CONJ_TAC THEN MESON_TAC[];
58441   (* - *)
58442   JOIN 2 1 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
58443   USEH 2122 (MATCH_MP jordan_curve_k33_data_inter);
58444   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[];
58445   (* Mon Jan 17 20:46:56 EST 2005 *)
58446   ]);;
58447   (* }}} *)
58448
58449 let jordan_curve_k33_plane_criterion2 = prove_by_refinement(
58450   `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
58451       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58452      (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
58453      (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
58454         e INTER e' SUBSET graph_vertex G) ==>
58455      plane_graph G`,
58456   (* {{{ proof *)
58457   [
58458   REP_BASIC_TAC;
58459   IMATCH_MP_TAC  jordan_curve_k33_plane_criterion;
58460   UNIFY_EXISTS_TAC;
58461   ASM_REWRITE_TAC[];
58462   (* - *)
58463   SUBCONJ_TAC;
58464   THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph;
58465   REWRITE_TAC[k33_isgraph];
58466   TYPE_THEN `G` UNABBREV_TAC;
58467   IMATCH_MP_TAC  jordan_curve_k33_isk33;
58468   UNIFY_EXISTS_TAC;
58469   ASM_REWRITE_TAC[];
58470   TYPE_THEN `G` UNABBREV_TAC;
58471   ASM_REWRITE_TAC[];
58472   (* - *)
58473   ASM_MESON_TAC[jordan_k33f_bij];
58474   (* Tue Jan 18 06:14:19 EST 2005 *)
58475
58476   ]);;
58477   (* }}} *)
58478
58479 let jordan_curve_edge_arc = prove_by_refinement(
58480   `!Q A B C D E v1 v2 w1 w2 x1 x2 G e.
58481       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58482     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
58483     (graph_edge G e) ==> (simple_arc top2 e)`,
58484   (* {{{ proof *)
58485   [
58486   REP_BASIC_TAC;
58487   TYPE_THEN `G` UNABBREV_TAC;
58488   FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33];
58489   FULL_REWRITE_TAC[INR IN_INSERT];
58490   COPYH 2122;
58491   USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
58492   RULE_ASSUM_TAC   (fun s-> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
58493   (* - *)
58494   FIRST_ASSUM DISJ_CASES_TAC;
58495   TYPE_THEN `e` UNABBREV_TAC;
58496   ASM_REWRITE_TAC[];
58497   KILLH 4869;
58498   COPYH 2122;
58499   USEH 2122 (MATCH_MP jordan_curve_x);
58500   COPYH 2122;
58501   USEH 2122 (MATCH_MP jordan_curve_v);
58502   COPYH 2122;
58503   USEH 2122 (MATCH_MP jordan_curve_w);
58504   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[];
58505   (* Tue Jan 18 06:28:31 EST 2005 *)
58506
58507   ]);;
58508   (* }}} *)
58509
58510 let jordan_curve_guider_inj = prove_by_refinement(
58511   `!Q A B C D E v1 v2 w1 w2 x1 x2 G e U V.
58512       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58513     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
58514     (graph_edge G e) /\ {A,B,C,D,E} U /\ {A,B,C,D,E} V /\
58515      (e SUBSET U) /\ (e SUBSET V) ==> (U = V)  `,
58516   (* {{{ proof *)
58517   [
58518   REP_BASIC_TAC;
58519   PROOF_BY_CONTR_TAC;
58520   TYPE_THEN `INFINITE e` SUBAGOAL_TAC;
58521   IMATCH_MP_TAC  simple_arc_infinite;
58522   IMATCH_MP_TAC  jordan_curve_edge_arc;
58523   UNIFY_EXISTS_TAC;
58524   ASM_REWRITE_TAC[];
58525   (* - *)
58526   TYPE_THEN `(U INTER V) SUBSET ({w1,w2,x2} UNION {v1,v2,x1})` SUBAGOAL_TAC;
58527   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_edge_inter;
58528   ASM_REWRITE_TAC[];
58529   FIRST_ASSUM IMATCH_MP_TAC ;
58530   ASM_REWRITE_TAC[];
58531   (* - *)
58532   TYPE_THEN `e SUBSET {w1, w2, x2} UNION {v1, v2, x1}` SUBAGOAL_TAC;
58533   IMATCH_MP_TAC  SUBSET_TRANS;
58534   TYPE_THEN `U INTER V` EXISTS_TAC;
58535   ASM_REWRITE_TAC[];
58536   ASM_REWRITE_TAC [SUBSET;INTER];
58537   ASM_MESON_TAC[subset_imp];
58538   (* - *)
58539   TYPE_THEN `FINITE ({w1, w2, x2} UNION {v1, v2, x1})` SUBAGOAL_TAC;
58540   REWRITE_TAC[  FINITE_UNION];
58541   REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
58542   TYPE_THEN `FINITE e` SUBAGOAL_TAC;
58543   IMATCH_MP_TAC  FINITE_SUBSET;
58544   TYPE_THEN `{w1, w2, x2} UNION {v1, v2, x1}` EXISTS_TAC;
58545   ASM_REWRITE_TAC[];
58546   FULL_REWRITE_TAC[INFINITE];
58547   ASM_MESON_TAC[];
58548   (* Tue Jan 18 06:3282:02 EST 2005 *)
58549   ]);;
58550   (* }}} *)
58551
58552 let jordan_curve_guider_disj = prove_by_refinement(
58553   `!Q A B C D E v1 v2 w1 w2 x1 x2 .
58554       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
58555      ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(A = E) /\ ~(B = C) /\
58556      ~(B = D) /\ ~(B = E) /\ ~(C = D) /\ ~(C = E) /\ ~(D = E)`,
58557   (* {{{ proof *)
58558   [
58559   REP_BASIC_TAC;
58560   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_k33_data_inter;
58561   ASM_REWRITE_TAC[];
58562   PROOF_BY_CONTR_TAC;
58563   FULL_REWRITE_TAC[DE_MORGAN_THM];
58564   (* - *)
58565   TYPE_THEN `INFINITE A /\ INFINITE B /\ INFINITE C /\ INFINITE D /\ INFINITE E` SUBAGOAL_TAC;
58566   FULL_REWRITE_TAC[jordan_curve_k33_data];
58567   RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
58568   RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_infinite s) with failure -> s);
58569   ASM_REWRITE_TAC[];
58570   (* - *)
58571   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;
58572   ASM_REWRITE_TAC[];
58573   REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
58574   FULL_REWRITE_TAC[INFINITE];
58575   (* - *)
58576   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;
58577   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[];
58578   (* Tue Jan 18 07:01:04 EST 2005 *)
58579
58580   ]);;
58581   (* }}} *)
58582
58583 let jordan_curve_guider_enum = prove_by_refinement(
58584   `!Q A B C D E v1 v2 w1 w2 x1 x2 .
58585       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
58586     (E SUBSET E) /\
58587     (cut_arc A v1 w1 SUBSET A) /\
58588     (cut_arc A v2 w1 SUBSET A) /\
58589     (cut_arc B v1 w2 SUBSET B) /\
58590     (cut_arc B v2 w2 SUBSET B) /\
58591     (cut_arc C v1 x2 SUBSET C) /\
58592     (cut_arc C v2 x2 SUBSET C) /\
58593     (cut_arc D w1 x1 SUBSET D) /\
58594     (cut_arc D w2 x1 SUBSET D)`,
58595   (* {{{ proof *)
58596   [
58597   REWRITE_TAC[SUBSET_REFL];
58598   COPYH 2122;
58599   USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
58600   RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
58601   COPYH 2122 ;
58602   USEH 2122 (MATCH_MP jordan_curve_x);
58603   COPYH 2122 ;
58604   USEH 2122 (MATCH_MP jordan_curve_v);
58605   COPYH 2122 ;
58606   USEH 2122 (MATCH_MP jordan_curve_w);
58607   REPEAT CONJ_TAC THEN IMATCH_MP_TAC  cut_arc_subset THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
58608   (* Tue Jan 18 07:12:33 EST 2005 *)
58609   ]);;
58610   (* }}} *)
58611
58612 let jordan_curve_guider_exists = prove_by_refinement(
58613   `!Q A B C D E v1 v2 w1 w2 x1 x2 G e.
58614       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58615     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
58616     graph_edge G e ==>
58617    (?U. {A,B,C,D,E} U /\ e SUBSET U)`,
58618   (* {{{ proof *)
58619   [
58620   REWRITE_TAC[INR IN_INSERT];
58621   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum;
58622   ASM_REWRITE_TAC[];
58623   TYPE_THEN `G` UNABBREV_TAC;
58624   FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33];
58625   FULL_REWRITE_TAC[INR IN_INSERT];
58626   UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN UNIFY_EXISTS_TAC THEN ASM_REWRITE_TAC[];
58627   (* Tue Jan 18 07:43:50 EST 2005 *)
58628   ]);;
58629   (* }}} *)
58630
58631 let jordan_curve_guider_sep_lemma = prove_by_refinement(
58632   `!Q A B C D E v1 v2 w1 w2 x1 x2 G e .
58633       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58634     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
58635     graph_edge G e  ==>
58636    (((e SUBSET A) ==> (e = cut_arc A v1 w1) \/ (e = cut_arc A v2 w1)) /\
58637     ((e SUBSET B) ==> (e = cut_arc B v1 w2) \/ (e = cut_arc B v2 w2)) /\
58638     ((e SUBSET C) ==> (e = cut_arc C v1 x2) \/ (e = cut_arc C v2 x2)) /\
58639     ((e SUBSET D) ==> (e = cut_arc D w1 x1) \/ (e = cut_arc D w2 x1)) /\
58640     ((e SUBSET E) ==> (e = E)))
58641     `,
58642   (* {{{ proof *)
58643   [
58644   REP_BASIC_TAC;
58645   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum;
58646   ASM_REWRITE_TAC[];
58647   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_disj;
58648   ASM_REWRITE_TAC[];
58649   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`] jordan_curve_guider_inj;
58650   REWRH 1245;
58651   TYPE_THEN `G` UNABBREV_TAC;
58652   FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;INR IN_INSERT];
58653   REPEAT CONJ_TAC THEN UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_MESON_TAC[];
58654   (* Tue Jan 18 09:38:07 EST 2005 *)
58655   ]);;
58656   (* }}} *)
58657
58658 let cut_arc_inter_lemma = prove_by_refinement(
58659   `!X R u v w.  X u /\
58660      simple_arc_end R v w /\ R u /\ ~(u = v) /\ ~(u = w) ==>
58661     (cut_arc R v u INTER cut_arc R w u SUBSET X)`,
58662   (* {{{ proof *)
58663   [
58664   REP_BASIC_TAC;
58665   THM_INTRO_TAC[`R`;`u`;`v`;`w`] cut_arc_inter;
58666   ASM_REWRITE_TAC[];
58667   TYPE_THEN `cut_arc R u w = cut_arc R w u` SUBAGOAL_TAC;
58668   MESON_TAC[cut_arc_symm];
58669   TYPE_THEN `cut_arc R u w` UNABBREV_TAC;
58670   ASM_REWRITE_TAC[];
58671   REWRITE_TAC[SUBSET;INR IN_SING];
58672   TYPE_THEN `x` UNABBREV_TAC;
58673   ASM_REWRITE_TAC[];
58674   (* Tue Jan 18 09:55:17 EST 2005 *)
58675   ]);;
58676   (* }}} *)
58677
58678 let jordan_curve_cut_inter = prove_by_refinement(
58679   `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
58680       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58681    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==>
58682     (cut_arc A v1 w1 INTER cut_arc A v2 w1 SUBSET graph_vertex G) /\
58683     (cut_arc B v1 w2 INTER cut_arc B v2 w2 SUBSET graph_vertex G) /\
58684     (cut_arc C v1 x2 INTER cut_arc C v2 x2 SUBSET graph_vertex G) /\
58685     (cut_arc D w1 x1 INTER cut_arc D w2 x1 SUBSET graph_vertex G)
58686    `,
58687   (* {{{ proof *)
58688   [
58689   REP_BASIC_TAC;
58690   TYPE_THEN `G` UNABBREV_TAC;
58691   FULL_REWRITE_TAC[graph_vertex_mk_graph;jordan_curve_k33];
58692   COPYH 2122 ;
58693   COPYH 2122 ;
58694   COPYH 2122 ;
58695   USEH 2122 (MATCH_MP jordan_curve_x);
58696   USEH 2122 (MATCH_MP jordan_curve_v);
58697   USEH 2122 (MATCH_MP jordan_curve_w);
58698   FULL_REWRITE_TAC[jordan_curve_k33_data];
58699   REPEAT CONJ_TAC THEN IMATCH_MP_TAC  cut_arc_inter_lemma THEN ASM_REWRITE_TAC[UNION;INR IN_INSERT ] THEN ASM_MESON_TAC[] ;
58700   (* Tue Jan 18 10:00:14 EST 2005 *)
58701   ]);;
58702   (* }}} *)
58703
58704 let jordan_curve_guider_separate = prove_by_refinement(
58705   `!Q A B C D E v1 v2 w1 w2 x1 x2 G U e e'.
58706       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58707     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
58708     {A,B,C,D,E} U /\ e SUBSET U /\ e' SUBSET U /\
58709     graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
58710     (e INTER e' SUBSET graph_vertex G)
58711    `,
58712   (* {{{ proof *)
58713   [
58714   REP_BASIC_TAC;
58715   TYPE_THEN `?a b. ((e = a) \/ (e = b)) /\ ((e' = a) \/ (e' = b)) /\ (a INTER b SUBSET graph_vertex G)` BACK_TAC;
58716   TYPE_THEN `((e = a) /\ (e' = b)) \/ ((e = b) /\ (e' = a))` SUBAGOAL_TAC;
58717   ASM_MESON_TAC[];
58718   FIRST_ASSUM DISJ_CASES_TAC;
58719   ASM_MESON_TAC[];
58720   TYPE_THEN `e` UNABBREV_TAC;
58721   TYPE_THEN `e'` UNABBREV_TAC;
58722   FULL_REWRITE_TAC[INTER_COMM];
58723   ASM_REWRITE_TAC[];
58724   (* - *)
58725   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`] jordan_curve_cut_inter;
58726   ASM_REWRITE_TAC[];
58727   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`]  jordan_curve_guider_sep_lemma ;
58728   ASM_REWRITE_TAC[];
58729   THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e'`]  jordan_curve_guider_sep_lemma ;
58730   ASM_REWRITE_TAC[];
58731   FULL_REWRITE_TAC[INR IN_INSERT];
58732   TYPE_THEN `U = E` ASM_CASES_TAC;
58733   TYPE_THEN `U` UNABBREV_TAC;
58734   TYPE_THEN `E` UNABBREV_TAC;
58735   TYPE_THEN `e'` UNABBREV_TAC;
58736   UNDH 4836 THEN MESON_TAC[];
58737   REWRH 4440;
58738   TYPE_THEN `G` UNABBREV_TAC;
58739   UNDH 7811 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `U` UNABBREV_TAC THEN REP_BASIC_TAC;
58740   UNIFY_EXISTS_TAC;
58741   ASM_REWRITE_TAC[];
58742   KILLH 2881;
58743   UNIFY_EXISTS_TAC;
58744   ASM_REWRITE_TAC[];
58745   KILLH 2881 THEN KILLH 1255;
58746   UNIFY_EXISTS_TAC;
58747   ASM_REWRITE_TAC[];
58748   KILLH 2881 THEN KILLH 1255 THEN KILLH 2514;
58749   UNIFY_EXISTS_TAC;
58750   ASM_REWRITE_TAC[];
58751   (* Tue Jan 18 10:22:53 EST 2005 *)
58752   ]);;
58753   (* }}} *)
58754
58755 let jordan_curve_k33_plane = prove_by_refinement(
58756   `!Q A B C D E v1 v2 w1 w2 x1 x2 G .
58757       jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
58758     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==>
58759     plane_graph G`,
58760   (* {{{ proof *)
58761   [
58762   REP_BASIC_TAC;
58763   IMATCH_MP_TAC  jordan_curve_k33_plane_criterion2;
58764   UNIFY_EXISTS_TAC;
58765   ASM_REWRITE_TAC[];
58766   (* - *)
58767   TYPE_THEN `(?U. {A,B,C,D,E} U /\ e SUBSET U)` SUBAGOAL_TAC;
58768   IMATCH_MP_TAC  jordan_curve_guider_exists;
58769   UNIFY_EXISTS_TAC;
58770   ASM_REWRITE_TAC[];
58771 TYPE_THEN `(?U'. {A,B,C,D,E} U' /\ e' SUBSET U')` SUBAGOAL_TAC;
58772   IMATCH_MP_TAC  jordan_curve_guider_exists;
58773   UNIFY_EXISTS_TAC;
58774   ASM_REWRITE_TAC[];
58775   TYPE_THEN `U = U'` ASM_CASES_TAC;
58776   TYPE_THEN `U'` UNABBREV_TAC;
58777   IMATCH_MP_TAC  jordan_curve_guider_separate;
58778   UNIFY_EXISTS_TAC;
58779   ASM_REWRITE_TAC[];
58780   (* - *)
58781   IMATCH_MP_TAC  SUBSET_TRANS;
58782   TYPE_THEN `U INTER U'` EXISTS_TAC;
58783   CONJ_TAC;
58784   IMATCH_MP_TAC  subset_inter_pair;
58785   ASM_REWRITE_TAC[];
58786   REWRITE_TAC[jordan_curve_k33;graph_vertex_mk_graph];
58787   ASM_MESON_TAC[jordan_curve_edge_inter];
58788   (* Tue Jan 18 10:32:34 EST 2005 *)
58789   ]);;
58790   (* }}} *)
58791
58792 let jordan_curve_not_one_sided = prove_by_refinement(
58793   `!Q. simple_closed_curve top2 Q ==> ~(one_sided_jordan_curve Q)`,
58794   (* {{{ proof *)
58795
58796   [
58797   REP_BASIC_TAC;
58798   THM_INTRO_TAC[`Q`] jordan_curve_k33_data_exist;
58799   ASM_REWRITE_TAC[];
58800   TYPE_THEN `plane_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC;
58801   IMATCH_MP_TAC  jordan_curve_k33_plane;
58802   UNIFY_EXISTS_TAC;
58803   ASM_REWRITE_TAC[];
58804   (* - *)
58805   TYPE_THEN `graph_isomorphic k33_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC;
58806   IMATCH_MP_TAC  jordan_curve_k33_isk33;
58807   UNIFY_EXISTS_TAC;
58808   ASM_REWRITE_TAC[];
58809   THM_INTRO_TAC[] k33_nonplanar;
58810   FULL_REWRITE_TAC[planar_graph];
58811   UNDH 3419 THEN ASM_REWRITE_TAC[];
58812   UNIFY_EXISTS_TAC;
58813   ASM_REWRITE_TAC[];
58814   IMATCH_MP_TAC  graph_isomorphic_symm;
58815   ASM_REWRITE_TAC[];
58816   REWRITE_TAC[k33_isgraph];
58817   (* Tue Jan 18 10:43:40 EST 2005 *)
58818   ]);;
58819
58820   (* }}} *)
58821
58822 (*
58823 Tue Jan 18 10:44:07 EST 2005
58824
58825 I'M DONE! The Jordan Curve Theorem is proved.
58826
58827 The statements jordan_curve_not_one_sided
58828   and jordan_curve_no_inj3 give a form of the Jordan Curve Theorem.
58829
58830 Now lets put it in a simple form.
58831
58832 *)
58833
58834 let component_simple_arc_ver2 = prove_by_refinement(
58835   `!G x y. (closed_ top2 G ) /\ ~(x = y) ==>
58836       (component  (induced_top top2 (euclid 2 DIFF G)) x y <=>
58837         (?C. simple_arc_end C x y /\
58838              (C INTER G = EMPTY)))`,
58839   (* {{{ proof *)
58840   [
58841   (*
58842    string together :component-imp-connected, connected-induced2,
58843                     p_conn_conn, p_conn_hv_finite;
58844    other_direction : simple_arc_connected, connected-induced,
58845                     connected-component; *)
58846   REP_BASIC_TAC;
58847   ASSUME_TAC top2_top;
58848   THM_INTRO_TAC[`top2`;`(euclid 2 DIFF G)`] induced_top_top;
58849   ASM_REWRITE_TAC[];
58850   (* - *)
58851   TYPE_THEN `top2 (euclid 2 DIFF G)` SUBAGOAL_TAC;
58852   USEH 4142 (MATCH_MP closed_open);
58853   FULL_REWRITE_TAC[top2_unions;open_DEF ];
58854   ASM_REWRITE_TAC[];
58855   (* - *)
58856   TYPE_THEN `A = euclid 2 DIFF G` ABBREV_TAC ;
58857   TYPE_THEN `UNIONS (induced_top top2 A) = A` SUBAGOAL_TAC;
58858   THM_INTRO_TAC[`top2`;`A`] induced_top_support;
58859   ASM_REWRITE_TAC[top2_unions;];
58860   TYPE_THEN `A` UNABBREV_TAC;
58861   IMATCH_MP_TAC  EQ_EXT;
58862   REWRITE_TAC[INTER;DIFF];
58863   MESON_TAC[];
58864   (* - *)
58865   IMATCH_MP_TAC  EQ_ANTISYM;
58866   CONJ_TAC;
58867   THM_INTRO_TAC[`induced_top top2 A`;`x`] component_imp_connected;
58868   ASM_REWRITE_TAC[];
58869   THM_INTRO_TAC[`(top2)`;`A`;`(component  (induced_top top2 A) x)`] connected_induced2;
58870   ASM_REWRITE_TAC[top2_unions];
58871   IMATCH_MP_TAC  SUBSET_TRANS;
58872   TYPE_THEN `UNIONS (induced_top top2 A)` EXISTS_TAC;
58873   CONJ_TAC;
58874   KILLH 9392;
58875   REWRITE_TAC[component_unions];
58876   UNDH 250 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
58877   TYPE_THEN `A` UNABBREV_TAC;
58878   REWRITE_TAC[DIFF;SUBSET];
58879   ASM_REWRITE_TAC[];
58880   REWRH 486;
58881   (* --A *)
58882   TYPE_THEN `B = component  (induced_top top2 A) x` ABBREV_TAC ;
58883   TYPE_THEN `B x /\ B y` SUBAGOAL_TAC;
58884   TYPE_THEN `B` UNABBREV_TAC;
58885   ASM_REWRITE_TAC[];
58886   THM_INTRO_TAC[`(induced_top top2 A)`;`x`;`y`] component_replace;
58887   ASM_REWRITE_TAC[];
58888   ASM_REWRITE_TAC[];
58889   IMATCH_MP_TAC  component_symm;
58890   ASM_REWRITE_TAC[];
58891   (* -- *)
58892   ASSUME_TAC loc_path_conn_top2;
58893   TYPE_THEN `top_of_metric(A,d_euclid) = (induced_top top2 A)` SUBAGOAL_TAC;
58894   REWRITE_TAC[top2];
58895   ONCE_REWRITE_TAC[EQ_SYM_EQ];
58896   IMATCH_MP_TAC  top_of_metric_induced;
58897   TYPE_THEN `A` UNABBREV_TAC;
58898   REWRITE_TAC[DIFF;SUBSET];
58899   MESON_TAC[metric_euclid];
58900   (* -- *)
58901   TYPE_THEN `loc_path_conn (induced_top top2 A)` SUBAGOAL_TAC;
58902   THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
58903   FULL_REWRITE_TAC[top2];
58904   ASM_MESON_TAC[];
58905   ASM_MESON_TAC[];
58906   (* -- *)
58907   THM_INTRO_TAC[`top2`] loc_path_conn;
58908   REWRH 6586;
58909   TSPECH `A` 7522;
58910   REWRH 4569;
58911   TSPECH `x` 6750;
58912   TYPE_THEN `A x` SUBAGOAL_TAC;
58913   ASM_MESON_TAC[subset_imp];
58914   TYPE_THEN `top2 B` SUBAGOAL_TAC;
58915   TYPE_THEN `B` UNABBREV_TAC;
58916   ASM_MESON_TAC[path_eq_conn];
58917   (* --B *)
58918   THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn;
58919   ASM_REWRITE_TAC[];
58920   (* -- *)
58921   THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite;
58922   ASM_MESON_TAC[];
58923   REWRH 7914;
58924   TYPE_THEN `C` EXISTS_TAC;
58925   ASM_REWRITE_TAC[];
58926   PROOF_BY_CONTR_TAC;
58927   FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
58928   TYPE_THEN `B u` SUBAGOAL_TAC;
58929   ASM_MESON_TAC[subset_imp];
58930   TYPE_THEN `A u` SUBAGOAL_TAC;
58931   ASM_MESON_TAC[subset_imp];
58932   TYPE_THEN `A` UNABBREV_TAC;
58933   USEH 1911 (REWRITE_RULE[DIFF]);
58934   ASM_MESON_TAC[];
58935   (* -C *)
58936   (* other_direction : simple_arc_connected, connected-induced,
58937                     connected-component; *)
58938   THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple;
58939   ASM_REWRITE_TAC[];
58940   THM_INTRO_TAC[`C`] simple_arc_connected;
58941   ASM_REWRITE_TAC[];
58942   TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC;
58943   IMATCH_MP_TAC  simple_arc_euclid;
58944   ASM_REWRITE_TAC[];
58945   THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
58946   ASM_REWRITE_TAC[top2_unions];
58947   REWRH 8620;
58948   (* - *)
58949   TYPE_THEN `C SUBSET A` SUBAGOAL_TAC;
58950   TYPE_THEN `A` UNABBREV_TAC;
58951   ASM_REWRITE_TAC[DIFF_SUBSET];
58952   REWRH 9619;
58953   (* - *)
58954   THM_INTRO_TAC[`induced_top top2 A`;`C`;`x`] connected_component;
58955   ASM_REWRITE_TAC[];
58956   IMATCH_MP_TAC  simple_arc_end_end;
58957   ASM_MESON_TAC[];
58958   USEH 5951(REWRITE_RULE[SUBSET]);
58959   TSPECH `y` 4625;
58960   FIRST_ASSUM IMATCH_MP_TAC ;
58961   IMATCH_MP_TAC  simple_arc_end_end2;
58962   ASM_MESON_TAC[];
58963   (* Tue Jan 18 12:54:06 EST 2005 *)
58964
58965   ]);;
58966   (* }}} *)
58967
58968 let component_properties = prove_by_refinement(
58969   `!C A v. closed_ top2 C /\ (euclid 2 v) /\ ~C v /\
58970       (A = component  (induced_top top2 (euclid 2 DIFF C)) v) ==>
58971       top2 A /\ connected top2 A /\
58972      ~(A = EMPTY) /\ (A INTER C = EMPTY) /\ A v /\
58973       (A SUBSET euclid 2) /\
58974     (!w. ~(w = v) ==>
58975      (A w = (?P. simple_arc_end P v w /\ (P INTER C = EMPTY))))`,
58976   (* {{{ proof *)
58977   [
58978   REP_BASIC_TAC;
58979   (* - *)
58980   ASSUME_TAC top2_top;
58981   (* -A *)
58982   THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support;
58983   FULL_REWRITE_TAC[top2_unions];
58984   (* - *)
58985   TYPE_THEN `euclid 2 INTER (euclid 2 DIFF C) = euclid 2 DIFF C` SUBAGOAL_TAC;
58986   IMATCH_MP_TAC  EQ_EXT;
58987   REWRITE_TAC[INTER;DIFF];
58988   MESON_TAC[];
58989   REWRH 972;
58990   KILLH 105;
58991   (* - *)
58992   TYPE_THEN `top2 (euclid 2 DIFF C)` SUBAGOAL_TAC;
58993   THM_INTRO_TAC[`top2`;`C`] (REWRITE_RULE[open_DEF] closed_open);
58994   ASM_REWRITE_TAC[];
58995   FULL_REWRITE_TAC[top2_unions];
58996   ASM_REWRITE_TAC[];
58997   (* - *)
58998   THM_INTRO_TAC[`2`;`(euclid 2 DIFF C)`] loc_path_conn_euclid;
58999   REWRITE_TAC[GSYM top2];
59000   ASM_REWRITE_TAC[];
59001   (* - *)
59002   THM_INTRO_TAC[`2`;`euclid 2`] loc_path_conn_euclid;
59003   REWRITE_TAC[GSYM top2];
59004   THM_INTRO_TAC[`top2`] top_univ;
59005   REWRITE_TAC[top2_top];
59006   FULL_REWRITE_TAC[top2_unions];
59007   ASM_REWRITE_TAC[];
59008   FULL_REWRITE_TAC[GSYM top2];
59009   (* - *)
59010   USEH 7343 GSYM;
59011   ASM_REWRITE_TAC[];
59012   TYPE_THEN `A v` SUBAGOAL_TAC;
59013   TYPE_THEN `A` UNABBREV_TAC;
59014   IMATCH_MP_TAC  component_refl THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[DIFF];
59015   ASM_REWRITE_TAC[];
59016   (* - *)
59017   TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC THENL[ REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
59018   ASM_MESON_TAC[];
59019   ASM_REWRITE_TAC[];
59020   (* -B *)
59021   TYPE_THEN `A INTER C = EMPTY` SUBAGOAL_TAC;
59022   THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions;
59023   REWRH 7860;
59024   UNDH 4798 THEN REWRITE_TAC[INTER;SUBSET;DIFF;EQ_EMPTY] THEN MESON_TAC[];
59025   ASM_REWRITE_TAC[];
59026   (* - *)
59027   TYPE_THEN `A SUBSET euclid 2` SUBAGOAL_TAC;
59028   THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions;
59029   REWRH 7860;
59030   UNDH 4798 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
59031   ASM_REWRITE_TAC[];
59032   (* - *)
59033   TYPE_THEN `top_of_metric(euclid 2 DIFF C,d_euclid) = induced_top top2 (euclid 2 DIFF C)` SUBAGOAL_TAC;
59034   REWRITE_TAC[top2];
59035   IMATCH_MP_TAC  (GSYM top_of_metric_induced);
59036   REWRITE_TAC[metric_euclid];
59037   REWRITE_TAC[DIFF;SUBSET] THEN MESON_TAC[];
59038   (* - *)
59039   THM_INTRO_TAC[`2`;`euclid 2 DIFF C`] loc_path_euclid_cor;
59040   REWRITE_TAC[GSYM top2];
59041   ASM_REWRITE_TAC[];
59042   (* - *)
59043   THM_INTRO_TAC[`top2`] loc_path_conn;
59044   REWRH 6586;
59045   SUBCONJ_TAC;
59046   TYPE_THEN `A` UNABBREV_TAC;
59047   USEH 7626 GSYM;
59048   USEH 4421 GSYM;
59049   ASM_REWRITE_TAC[];
59050   USEH 1238 GSYM;
59051   ASM_REWRITE_TAC[];
59052   FIRST_ASSUM IMATCH_MP_TAC ;
59053   ASM_REWRITE_TAC[];
59054   REWRITE_TAC[DIFF];
59055   ASM_REWRITE_TAC[];
59056   (* -C *)
59057   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
59058   SUBCONJ_TAC;
59059   TYPE_THEN `A` UNABBREV_TAC;
59060   IMATCH_MP_TAC  component_simple_arc_ver2;
59061   ASM_REWRITE_TAC[];
59062   (* - *)
59063   TYPE_THEN `A = UNIONS ({v} INSERT {P | (?w. simple_arc_end P v w) /\ (P INTER C = {}) })` SUBAGOAL_TAC;
59064   IMATCH_MP_TAC  SUBSET_ANTISYM;
59065   CONJ_TAC;
59066   REWRITE_TAC[SUBSET;UNIONS];
59067   TYPE_THEN `x = v` ASM_CASES_TAC;
59068   TYPE_THEN `x` UNABBREV_TAC;
59069   TYPE_THEN `{v}` EXISTS_TAC;
59070   REWRITE_TAC[INR IN_INSERT];
59071   TSPECH `x` 9360;
59072   REWRH 8744;
59073   TYPE_THEN`P` EXISTS_TAC;
59074   REWRITE_TAC[INR IN_INSERT];
59075   ASM_REWRITE_TAC[];
59076   CONJ_TAC;
59077   DISJ2_TAC;
59078   ASM_MESON_TAC[simple_arc_end_simple];
59079   IMATCH_MP_TAC  simple_arc_end_end2;
59080   ASM_MESON_TAC[];
59081   (* -- *)
59082   REWRITE_TAC[UNIONS;INR IN_INSERT;SUBSET];
59083   FIRST_ASSUM DISJ_CASES_TAC;
59084   TYPE_THEN `u` UNABBREV_TAC;
59085   FULL_REWRITE_TAC[INR IN_INSERT];
59086   TYPE_THEN `x` UNABBREV_TAC;
59087   ASM_REWRITE_TAC[];
59088   (* -- *)
59089   TYPE_THEN `x = v` ASM_CASES_TAC;
59090   ASM_MESON_TAC[];
59091   TSPECH `x` 9360;
59092   ASM_REWRITE_TAC[];
59093   (* -- *)
59094   TYPE_THEN `x = w` ASM_CASES_TAC;
59095   TYPE_THEN `x` UNABBREV_TAC;
59096   ASM_MESON_TAC[];
59097   TYPE_THEN `cut_arc u v x` EXISTS_TAC;
59098   (* -- *)
59099   SUBCONJ_TAC;
59100   IMATCH_MP_TAC  cut_arc_simple;
59101   ASM_REWRITE_TAC[];
59102   ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end];
59103   (* -- *)
59104   THM_INTRO_TAC[`u`;`v`;`x`] cut_arc_subset;
59105   ASM_REWRITE_TAC[];
59106   ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end];
59107   ASM_REWRITE_TAC[];
59108   UNDH 4401 THEN UNDH 2627 THEN REWRITE_TAC[SUBSET;INTER;EQ_EMPTY] THEN MESON_TAC[];
59109   ASM_REWRITE_TAC[];
59110   IMATCH_MP_TAC  connected_unions_common;
59111   (* -D *)
59112   CONJ_TAC;
59113   FULL_REWRITE_TAC[INR IN_INSERT];
59114   FIRST_ASSUM DISJ_CASES_TAC;
59115   TYPE_THEN `Z` UNABBREV_TAC;
59116   IMATCH_MP_TAC  connected_sing;
59117   ASM_REWRITE_TAC[top2_unions];
59118   IMATCH_MP_TAC  simple_arc_connected;
59119   ASM_MESON_TAC[simple_arc_end_simple];
59120   (* - *)
59121   UNDH 281 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
59122   TYPE_THEN `v` EXISTS_TAC;
59123   FULL_REWRITE_TAC[INR IN_INSERT];
59124   TYPE_THEN `!Z. (Z = {v}) \/ (?w. simple_arc_end Z v w) /\ (Z INTER C = EMPTY) ==> Z v` SUBAGOAL_TAC;
59125   FIRST_ASSUM DISJ_CASES_TAC;
59126   TYPE_THEN `Z''` UNABBREV_TAC;
59127   REWRITE_TAC[INR IN_SING];
59128   IMATCH_MP_TAC  simple_arc_end_end;
59129   ASM_MESON_TAC[];
59130   ASM_MESON_TAC[];
59131   (* Tue Jan 18 19:38:27 EST 2005 *)
59132   ]);;
59133   (* }}} *)
59134
59135 let JORDAN_CURVE_THEOREM = prove_by_refinement(
59136   `!C. simple_closed_curve top2 C ==>
59137      (?A B.  top2 A /\ top2 B /\
59138        connected top2 A /\ connected top2 B /\
59139      ~(A = EMPTY) /\ ~(B = EMPTY) /\
59140       (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\
59141           (B INTER C = EMPTY) /\
59142          (A UNION B UNION C = euclid 2))`,
59143   (* {{{ proof *)
59144   [
59145   REP_BASIC_TAC;
59146   THM_INTRO_TAC[`C`] jordan_curve_not_one_sided;
59147   ASM_REWRITE_TAC[];
59148   FULL_REWRITE_TAC[one_sided_jordan_curve];
59149   ASM_REWRITE_TAC[];
59150   (* - *)
59151   LEFTH  1701 "v";
59152   LEFTH  7038 "w";
59153   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;
59154   ASM_MESON_TAC[];
59155   KILLH 9332;
59156   (* - *)
59157   TYPE_THEN `A = component  (induced_top top2 (euclid 2 DIFF C)) v` ABBREV_TAC ;
59158   TYPE_THEN `A` EXISTS_TAC;
59159   TYPE_THEN `B = component  (induced_top top2 (euclid 2 DIFF C)) w` ABBREV_TAC ;
59160   TYPE_THEN `B` EXISTS_TAC;
59161   (* - *)
59162   ASSUME_TAC top2_top;
59163   (* -A *)
59164   THM_INTRO_TAC[`C`] simple_closed_curve_closed;
59165   ASM_REWRITE_TAC[];
59166   THM_INTRO_TAC[`C`;`A`;`v`] component_properties;
59167   ASM_REWRITE_TAC[];
59168   THM_INTRO_TAC[`C`;`B`;`w`] component_properties;
59169   ASM_REWRITE_TAC[];
59170   ASM_REWRITE_TAC[];
59171   (* - *)
59172   SUBCONJ_TAC;
59173   PROOF_BY_CONTR_TAC;
59174   USEH 2797 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
59175   TYPE_THEN `u = v` ASM_CASES_TAC;
59176   TYPE_THEN `u` UNABBREV_TAC;
59177   TSPECH `v` 8396;
59178   REWRH 1610;
59179   TSPECH `P` 3407;
59180   UNDH 3395 THEN DISCH_THEN (THM_INTRO_TAC[]);
59181   IMATCH_MP_TAC  simple_arc_end_symm;
59182   ASM_REWRITE_TAC[];
59183   ASM_MESON_TAC[];
59184   (* -- *)
59185   TYPE_THEN `u = w` ASM_CASES_TAC;
59186   TYPE_THEN `u` UNABBREV_TAC;
59187   TSPECH `w` 9360;
59188   REWRH 3625;
59189   ASM_MESON_TAC[simple_arc_end_symm];
59190   (* -- *)
59191   TYPE_THEN `A` UNABBREV_TAC;
59192   TYPE_THEN `B` UNABBREV_TAC;
59193   USEH 9617 (MATCH_MP component_replace);
59194   USEH 8370 (MATCH_MP component_replace);
59195   TSPECH `v` 2427;
59196   TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) w` UNABBREV_TAC;
59197   TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) u` UNABBREV_TAC;
59198   TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) v v` SUBAGOAL_TAC;
59199   IMATCH_MP_TAC  component_refl;
59200   ASM_REWRITE_TAC[];
59201   THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support;
59202   FULL_REWRITE_TAC[top2_unions];
59203   ASM_REWRITE_TAC[];
59204   ASM_REWRITE_TAC [INTER;DIFF];
59205   REWRH 4538;
59206   USEH 1851 (MATCH_MP simple_arc_end_symm);
59207   ASM_MESON_TAC[];
59208   (* -B *)
59209   IMATCH_MP_TAC  SUBSET_ANTISYM;
59210   CONJ_TAC;
59211   REWRITE_TAC[union_subset];
59212   ASM_REWRITE_TAC[];
59213   IMATCH_MP_TAC  simple_closed_curve_euclid;
59214   ASM_REWRITE_TAC[];
59215   (* - *)
59216   PROOF_BY_CONTR_TAC;
59217   USEH 2025 (REWRITE_RULE[SUBSET;UNION]);
59218   LEFTH 2615 "x";
59219   TYPE_THEN `euclid 2 x /\ ~A x /\ ~ B x /\ ~ C x` SUBAGOAL_TAC;
59220   ASM_MESON_TAC[];
59221   (* - *)
59222   THM_INTRO_TAC[`v`;`w`;`x`] three_t_enum;
59223   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 ;
59224   ASM_MESON_TAC[jordan_curve_no_inj3];
59225   UNDH 6935 THEN ASM_REWRITE_TAC[];
59226   (* -C *)
59227   TYPE_THEN `~(x = w) /\ ~(x = v) /\ ~(v = w)` SUBAGOAL_TAC;
59228   ASM_REWRITE_TAC[];
59229   ASM_MESON_TAC[];
59230   SUBCONJ_TAC;
59231   REWRITE_TAC[INJ];
59232   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[]];
59233   (* - *)
59234   TYPE_THEN `!C'. simple_arc_end C' v x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC;
59235   ASM_MESON_TAC[];
59236   TYPE_THEN `!C'. simple_arc_end C' w x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC;
59237   ASM_MESON_TAC[];
59238   TYPE_THEN `!x A. ~simple_arc_end A x x` SUBAGOAL_TAC;
59239   USEH 3186 (MATCH_MP simple_arc_end_distinct);
59240   ASM_MESON_TAC[];
59241   KILLH 8396 THEN KILLH 9360 THEN KILLH 3221 THEN KILLH 4325;
59242   IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
59243   (* - *)
59244   TYPE_THEN `!C' w v. simple_arc_end C' w v = simple_arc_end C' v w` SUBAGOAL_TAC;
59245   MESON_TAC[simple_arc_end_symm];
59246   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];
59247   TYPE_THEN `!i. ~(C (f i))` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN ASM_REWRITE_TAC[];ALL_TAC];
59248   ASM_MESON_TAC[];
59249   (* Tue Jan 18 20:44:12 EST 2005 *)
59250   ]);;
59251   (* }}} *)
59252
59253 (* collect together the definitions in a single theorem.
59254    We leave out the definitions in the HOL-light distribution
59255    such as abs , sqrt, sum,
59256            IMAGE, INJ, INTER, EMPTY, UNION, SUBSET, UNIONS. *)
59257
59258 let JORDAN_CURVE_DEFS = prove_by_refinement(
59259   `(!x. euclid 2 x = (!n. 2 <=| n ==> (x n = &0))) /\
59260    (top2 = top_of_metric (euclid 2,d_euclid)) /\
59261    (!(X:A->bool) d. top_of_metric (X,d) =
59262          {A | ?F. F SUBSET open_balls (X,d) /\ (A = UNIONS F) }) /\
59263    (!(X:A->bool) d. open_balls(X,d) =
59264          {B | ?x r. (B = open_ball (X,d) x r) }) /\
59265    (!X d (x:A) r. open_ball (X,d) x r =
59266          {y | X x /\ X y /\ d x y < r}) /\
59267    (!U (Z:A->bool). connected U Z <=>
59268          Z SUBSET UNIONS U /\
59269          (!A B.
59270               U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B
59271               ==> Z SUBSET A \/ Z SUBSET B)) /\
59272    (!(C:A->bool) U. simple_closed_curve U C =
59273              (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
59274               continuous f (top_of_metric (UNIV,d_real)) U /\
59275               INJ f {x | &0 <= x /\ x < &1} (UNIONS U) /\
59276               (f (&0) = f (&1)))) /\
59277    (!(f:A->B) U V. continuous f U V =
59278          (!v. V v ==> U  { x | (UNIONS U) x /\ v (f x) })) /\
59279    (!x y. d_real x y = abs  (x - y)) /\
59280    (!x y. euclid 2 x /\ euclid 2 y
59281          ==> (d_euclid x y =
59282               sqrt (sum (0,2) (\i. (x i - y i) * (x i - y i)))))`,
59283   (* {{{ proof *)
59284   [
59285   REWRITE_TAC[simple_closed_curve;continuous;preimage;d_real;];
59286   REWRITE_TAC[d_euclid_n];
59287   REWRITE_TAC[euclid;top2;top_of_metric;open_balls;open_ball;connected;];
59288   (* Tue Jan 18 21:10:10 EST 2005 *)
59289   ]);;
59290   (* }}} *)
59291
59292 (* The interesting thing about these definitions is how the
59293    standard mathematical definitions are made total, as required
59294    by HOL.
59295
59296    "continuous": There is no requirement that the IMAGE of f is
59297    a subset of UNIONS V.  This is contrary to the common mathematical
59298    requirement that a function f:X->Y maps X to Y.  The constraint
59299    on the IMAGE for a simple_closed_curve is contained in the definition
59300    of INJ.
59301
59302    "simple_closed_curve": Continuity is required on the full real
59303    line, but injectivity is required only on the unit interval.
59304
59305    "connected": Here there is a requirement that Z is a subset of
59306    UNIONS U
59307
59308    "open_ball": If x is not in X, then the open ball is empty.
59309
59310 *)