text_formalization/hypermap/hypermap.hl

   1 (* ========================================================================== *)\r
   2 (* FLYSPECK - BOOK FORMALIZATION                                              *)\r
   3 (*                                                                            *)\r
   4 (* Chapter: Hypermap                                                          *)\r
   5 (* Author: Tran Nam Trung                                                     *)\r
   6 (* Date: 2010-02-09                                                           *)\r
   7 (* ========================================================================== *)\r
   8 \r
   9 \r
  10 module type Hypermap_type = sig\r
  11 \r
  12 end;;\r
  13 \r
  14 (* needs "Library/permutations.ml";; *)\r
  15 \r
  16 module Hypermap (* : Hypermap_type *) = struct\r
  17 \r
  18 prioritize_num();;\r
  19 \r
  20 \r
  21 parse_as_infix("POWER",(24,"right"));;\r
  22 \r
  23 parse_as_infix("belong",(11,"right"));;\r
  24 \r
  25 parse_as_infix("iso",(24,"right"));;\r
  26  \r
  27 (* The definition of the nth exponent of a map *)\r
  28 \r
  29   let EQ_SUC = SUC_INJ;; (* Harrison eliminated EQ_SUC because it duplicates SUC_INJ *)\r
  30 \r
  31 \r
  32 let POWER = new_recursive_definition num_RECURSION \r
  33   `(!(f:A->A). f POWER 0  = I) /\  \r
  34    (!(f:A->A) (n:num). f POWER (SUC n) = (f POWER n) o f)`;;\r
  35 \r
  36 let POWER_0 = prove(`!f:A->A. f POWER 0 = I`,\r
  37    REWRITE_TAC[POWER]);;\r
  38 \r
  39 let POWER_1 = prove(`!f:A->A. f POWER 1 = f`,\r
  40    REWRITE_TAC[POWER; ONE; I_O_ID]);;\r
  41 \r
  42 let POWER_2 = prove(`!f:A->A. f POWER 2 = f o f`,\r
  43    REWRITE_TAC[POWER; TWO; POWER_1]);;\r
  44 \r
  45 let orbit_map = new_definition `orbit_map (f:A->A)  (x:A) = {(f POWER n) x | n >= 0}`;;\r
  46 \r
  47 \r
  48 let ASM_ASM_SET_TAC = ASSUM_LIST (MP_TAC o end_itlist CONJ) THEN SET_TAC[];;\r
  49 \r
  50 let lemma_two_series_eq = prove(`!p:num->A q:num->A n:num. (!i:num. i <= n ==> p i = q i) ==> {p (i:num) | i <= n} = {q (i:num) | i <= n}`,\r
  51     REPEAT STRIP_TAC THEN ASM_ASM_SET_TAC);;\r
  52 \r
  53 let lemma_add_one_assumption = prove(`!P. !(n:num). (!i:num. i <= SUC n ==> P i) <=> (!i:num. i <= n ==> P i) /\ P (SUC n)`,\r
  54    REPEAT GEN_TAC\r
  55    THEN EQ_TAC\r
  56    THENL[STRIP_TAC\r
  57       THEN STRIP_TAC\r
  58       THENL[REPEAT STRIP_TAC\r
  59          THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`)\r
  60          THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= n:num ==> i <= SUC n`) th]); ALL_TAC]\r
  61       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `SUC n`)\r
  62       THEN SIMP_TAC[]; ALL_TAC]\r
  63    THEN STRIP_TAC\r
  64    THEN REPEAT STRIP_TAC\r
  65    THEN ASM_CASES_TAC `i:num = SUC n`\r
  66    THENL[POP_ASSUM SUBST1_TAC\r
  67        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
  68    THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC)\r
  69    THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE; LT_SUC_LE]\r
  70    THEN DISCH_TAC\r
  71    THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num` o  check (is_forall o concl))\r
  72    THEN ASM_REWRITE_TAC[]);;\r
  73 \r
  74 let lemma_sub_part = prove(`!P. !n:num m:num. (!i:num. i <= n ==> P i) /\ m <= n ==> (!i:num. i <= m ==> P i)`,\r
  75    REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `i:num`)\r
  76    THEN POP_ASSUM (fun th1-> POP_ASSUM (fun th2-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th1 th2)])));;\r
  77 \r
  78 (* the definition of hypermap *)\r
  79 \r
  80 let exist_hypermap = prove(`?H:((A->bool)#(A->A)#(A->A)#(A->A)). FINITE (FST H) /\ (FST(SND H)) permutes (FST H) /\ (FST(SND(SND H))) permutes (FST H) /\ (SND(SND(SND H))) permutes (FST H) /\ (FST(SND H)) o (FST(SND(SND  H))) o (SND(SND(SND H))) = I`,EXISTS_TAC\r
  81 `({},I,I,I):(A->bool)#(A->A)#(A->A)#(A->A)` THEN REWRITE_TAC[FINITE_RULES; PERMUTES_I; I_O_ID]);;\r
  82 \r
  83 let hypermap_tybij = (new_type_definition "hypermap" ("hypermap", "tuple_hypermap")exist_hypermap);;\r
  84 \r
  85 let dart = new_definition `dart (H:(A)hypermap) = FST (tuple_hypermap H)`;;\r
  86 \r
  87 let edge_map = new_definition `edge_map (H:(A)hypermap) = FST(SND(tuple_hypermap H))`;;\r
  88 \r
  89 let node_map = new_definition `node_map (H:(A)hypermap) = FST(SND(SND(tuple_hypermap H)))`;;\r
  90 \r
  91 let face_map = new_definition `face_map (H:(A)hypermap) = SND(SND(SND(tuple_hypermap H)))`;;\r
  92 \r
  93 let hypermap_lemma = prove(`!H:(A)hypermap. FINITE (dart H) /\ edge_map H\r
  94    permutes dart H /\ node_map H permutes dart H /\ face_map H permutes dart\r
  95    H /\ edge_map H o node_map H o face_map H = I`,\r
  96 \r
  97    ASM_REWRITE_TAC[hypermap_tybij;dart;edge_map; node_map; face_map]);;\r
  98 \r
  99 (* some technical lemmas *)\r
 100 \r
 101 let edge_map_and_darts = prove(`!(H:(A)hypermap). FINITE (dart H) /\ edge_map H permutes (dart H)`,\r
 102     REWRITE_TAC[hypermap_lemma]);;\r
 103 \r
 104 let node_map_and_darts = prove(`!(H:(A)hypermap). FINITE (dart H) /\ node_map H permutes (dart H)`,\r
 105     REWRITE_TAC[hypermap_lemma]);;\r
 106 \r
 107 let face_map_and_darts = prove(`!(H:(A)hypermap). FINITE (dart H) /\ face_map H permutes (dart H)`,\r
 108     REWRITE_TAC[hypermap_lemma]);;\r
 109 \r
 110 (* edges, nodes and faces of a hypermap *)\r
 111 \r
 112 let edge = new_definition `edge (H:(A)hypermap) (x:A) = orbit_map (edge_map H) x`;;\r
 113 \r
 114 let node = new_definition `node (H:(A)hypermap) (x:A) = orbit_map (node_map H) x`;;\r
 115 \r
 116 let face = new_definition `face (H:(A)hypermap) (x:A) = orbit_map (face_map H) x`;;\r
 117 \r
 118 \r
 119 (* We define the combinatorial component *)\r
 120 \r
 121 let go_one_step = new_definition `go_one_step (H:(A)hypermap) (x:A) (y:A) <=> (y = (edge_map H) x) \/ (y = (node_map H) x) \/ (y = (face_map H) x)`;;\r
 122 \r
 123 let is_path = new_recursive_definition num_RECURSION  `(is_path (H:(A)hypermap) (p:num->A) 0 <=> T)/\\r
 124 (is_path (H:(A)hypermap) (p:num->A) (SUC n) <=> ((is_path H p n) /\ go_one_step H (p n) (p (SUC n))))`;; \r
 125 \r
 126 let is_in_component = new_definition `is_in_component (H:(A)hypermap) (x:A) (y:A) <=> ?p:num->A n:num. p 0 = x /\ p n = y /\ is_path H p n`;;\r
 127 \r
 128 let comb_component = new_definition `comb_component (H:(A)hypermap) (x:A) = {y:A| is_in_component H x y}`;;\r
 129 \r
 130 \r
 131 (* some definitions on orbits *)\r
 132 \r
 133 let set_of_orbits = new_definition `set_of_orbits (D:A->bool) (f:A->A) = {orbit_map f x | x IN D}`;;\r
 134 \r
 135 let number_of_orbits = new_definition `number_of_orbits (D:A->bool) (f:A->A) = CARD(set_of_orbits D f)`;;\r
 136 \r
 137 \r
 138 (* the orbits on hypermaps*)\r
 139 \r
 140 let edge_set = new_definition `edge_set (H:(A)hypermap) = set_of_orbits (dart H) (edge_map H)`;;\r
 141 \r
 142 let node_set = new_definition `node_set  (H:(A)hypermap) = set_of_orbits (dart H) (node_map H)`;;\r
 143 \r
 144 let face_set = new_definition `face_set (H:(A)hypermap) = set_of_orbits (dart H) (face_map H)`;;\r
 145 \r
 146 \r
 147 let set_components = new_definition `set_components (H:(A)hypermap) (D:A->bool) = {comb_component H (x:A) | x IN D}`;;\r
 148 \r
 149 let set_part_components = new_definition `set_part_components (H:(A)hypermap) (D:A->bool) = {(comb_component H (x:A)) | x IN D}`;;\r
 150 \r
 151 let set_of_components = new_definition `set_of_components (H:(A)hypermap) = set_part_components H (dart H)`;;\r
 152 \r
 153 \r
 154 (* counting the numbers of edges, nodes, faces and combinatorial components *)\r
 155 \r
 156 let number_of_edges = new_definition `number_of_edges (H:(A)hypermap) = CARD (edge_set H)`;;\r
 157 \r
 158 let number_of_nodes = new_definition `number_of_nodes (H:(A)hypermap) = CARD (node_set H)`;;\r
 159 \r
 160 let number_of_faces = new_definition `number_of_faces (H:(A)hypermap) = CARD (face_set H)`;;\r
 161 \r
 162 let number_of_components = new_definition `number_of_components (H:(A)hypermap) = CARD (set_of_components H)`;;\r
 163 \r
 164 (* some special kinds of hypergraphs *)\r
 165 \r
 166 let plain_hypermap = new_definition `plain_hypermap (H:(A)hypermap) <=> edge_map H o edge_map H = I`;;\r
 167 \r
 168 let planar_hypermap = new_definition `planar_hypermap (H:(A)hypermap) <=>\r
 169     number_of_nodes H + number_of_edges H + number_of_faces H \r
 170     = (CARD (dart H)) + 2 * number_of_components H`;;\r
 171 \r
 172 let simple_hypermap = new_definition `simple_hypermap (H:(A)hypermap) <=>\r
 173     (!x:A. x IN dart H ==> (node H x) INTER (face H x) = {x})`;;\r
 174 \r
 175 \r
 176 (* a dart x is degenerate or nondegenerate *)\r
 177 \r
 178 let dart_degenerate = new_definition `dart_degenerate (H:(A)hypermap) (x:A)  \r
 179    <=> (edge_map H x = x \/ node_map H x = x \/ face_map H x = x)`;;\r
 180 \r
 181 let dart_nondegenerate = new_definition `dart_nondegenerate (H:(A)hypermap) (x:A) \r
 182    <=> ~(edge_map H x = x) /\ ~(node_map H x = x) /\ ~(face_map H x = x)`;;\r
 183 \r
 184 let is_edge_nondegenerate = new_definition `is_edge_nondegenerate (H:(A)hypermap) <=> (!x:A. x IN dart H ==> ~(edge_map H x = x))`;;\r
 185 \r
 186 let is_node_nondegenerate = new_definition `is_node_nondegenerate (H:(A)hypermap) <=> (!x:A. x IN dart H ==> ~(node_map H x = x))`;;\r
 187 \r
 188 let is_face_nondegenerate = new_definition `is_face_nondegenerate (H:(A)hypermap) <=> (!x:A. x IN dart H ==> ~(face_map H x = x))`;;\r
 189 \r
 190 \r
 191 (* some relationships of maps and orbits of maps *)\r
 192 \r
 193 let LEFT_MULT_MAP = prove(`!u:A->A v:A->A w:A->A. v = w  ==> u o v = u o w`, MESON_TAC[]);;\r
 194 \r
 195 let RIGHT_MULT_MAP = prove(`!u:A->A v:A->A w:A->A. u = v ==> u o w = v o w`, MESON_TAC[]);;\r
 196 \r
 197 let LEFT_INVERSE_EQUATION = prove(`!s:A->bool u:A->A v:A->A w:A->A. u permutes s /\ u o v = w ==> v = inverse u o w`,\r
 198    REPEAT STRIP_TAC THEN \r
 199    SUBGOAL_THEN `inverse (u:A->A) o u o (v:A->A) = inverse u o (w:A->A)` MP_TAC\r
 200    THENL[ ASM_MESON_TAC[]; REWRITE_TAC[o_ASSOC] \r
 201          THEN ASM_MESON_TAC[PERMUTES_INVERSES_o; I_O_ID]]);;\r
 202 \r
 203 let RIGHT_INVERSE_EQUATION = prove(`!s:A->bool u:A->A v:A->A w:A->A. v permutes s /\ u o v = w ==> u = w o inverse v`,\r
 204    REPEAT STRIP_TAC \r
 205    THEN SUBGOAL_THEN `(u:A->A) o (v:A->A) o inverse v = (w:A->A) o inverse v` MP_TAC\r
 206    THENL [ASM_MESON_TAC[o_ASSOC]; ASM_MESON_TAC[PERMUTES_INVERSES_o;I_O_ID]]);;\r
 207 \r
 208 let iterate_orbit = prove(`!(s:A->bool) (u:A->A). u permutes s ==> !(n:num) (x:A). x IN s ==> (u POWER n) x IN s`,\r
 209    REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP PERMUTES_IN_IMAGE)\r
 210    THEN INDUCT_TAC\r
 211    THENL[GEN_TAC THEN REWRITE_TAC[POWER; I_THM]; REPEAT GEN_TAC\r
 212       THEN REWRITE_TAC[POWER; o_DEF] THEN ASM_MESON_TAC[]]);;\r
 213 \r
 214 let orbit_subset = prove(`!(s:A->bool) (u:A->A). u permutes s ==> !(x:A). x IN s ==> (orbit_map u x) SUBSET s`,\r
 215    REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; orbit_map; IN_ELIM_THM] \r
 216    THEN ASM_MESON_TAC[iterate_orbit]);;\r
 217 \r
 218 let COM_POWER = prove(`!(n:num) (f:A->A). f POWER (SUC n) = f o (f POWER n)`,\r
 219    INDUCT_TAC THENL[REWRITE_TAC [ONE; POWER;I_O_ID]; ALL_TAC]\r
 220    THEN REPEAT STRIP_TAC THEN POP_ASSUM(ASSUME_TAC o GSYM o (ISPEC `f:A->A`))\r
 221    THEN ASM_REWRITE_TAC[POWER; o_ASSOC]);;\r
 222 \r
 223 let COM_POWER_FUNCTION = prove(`!f:A->A x:A n:num. f ((f POWER n) x) = (f POWER (SUC n)) x`,\r
 224     REPEAT GEN_TAC THEN MP_TAC (AP_THM (SPECL[`n:num`; `f:A->A`] COM_POWER) `x:A`) THEN REWRITE_TAC[o_THM; EQ_SYM]);;\r
 225 \r
 226 let POWER_FUNCTION = prove(`!f:A->A x:A n:num. (f POWER n) (f x) = (f POWER (SUC n)) x`,\r
 227     REPEAT GEN_TAC THEN MP_TAC (AP_THM (SPECL[`f:A->A`; `n:num`] (CONJUNCT2 POWER)) `x:A`) THEN REWRITE_TAC[o_THM; EQ_SYM]);;\r
 228 \r
 229 let addition_exponents = prove(`!m n (f:A->A). f POWER (m + n) = (f POWER m) o (f POWER n)`,\r
 230    INDUCT_TAC THENL [STRIP_TAC THEN REWRITE_TAC[ADD; POWER; I_O_ID]; ALL_TAC]\r
 231    THEN POP_ASSUM(ASSUME_TAC o GSYM o (ISPECL[`n:num`;`f:A->A`]))\r
 232    THEN REWRITE_TAC[COM_POWER; GSYM o_ASSOC]\r
 233    THEN ASM_REWRITE_TAC[COM_POWER; GSYM o_ASSOC; ADD]);;\r
 234 \r
 235 let multiplication_exponents = prove(`!m n (f:A->A). f POWER (m * n) = (f POWER n) POWER m`, \r
 236    INDUCT_TAC \r
 237    THENL [STRIP_TAC THEN REWRITE_TAC[MULT; POWER; I_O_ID]; ALL_TAC] \r
 238    THEN REPEAT GEN_TAC THEN POP_ASSUM(ASSUME_TAC o (SPECL[`n:num`; `f:A->A`]))\r
 239    THEN ASM_REWRITE_TAC[MULT; addition_exponents; POWER]);;\r
 240 \r
 241 let power_unit_map = prove(`!n f:A->A. f POWER n = I ==> !m. f POWER (m * n) = I`,\r
 242    REPLICATE_TAC 3 STRIP_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[MULT; POWER]; \r
 243     REWRITE_TAC[MULT; addition_exponents] THEN ASM_REWRITE_TAC[I_O_ID]]);;\r
 244 \r
 245 let power_map_fix_point = prove(`!n f:A->A x:A. (f POWER n) x = x ==> !m. (f POWER (m * n)) x = x`,\r
 246     REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC \r
 247     THENL [REWRITE_TAC[MULT; POWER; I_THM]; \r
 248     REWRITE_TAC[MULT; addition_exponents; o_DEF] THEN ASM_REWRITE_TAC[]]);;\r
 249 \r
 250 let lemma_add_exponent_function = prove(`!(p:A->A) m:num n:num x:A. (p POWER (m+n)) x =  (p POWER m) ((p POWER n) x)`, \r
 251    REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL[`m:num`;`n:num`; `p:A->A`] addition_exponents)\r
 252    THEN POP_ASSUM (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN REWRITE_TAC[o_THM]);;\r
 253 \r
 254 let iterate_map_valuation = prove(`!(p:A->A) (n:num) (x:A). p ((p POWER n) x) = (p POWER (SUC n)) x`,\r
 255    REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL[`n:num`; `p:A->A`] (GSYM COM_POWER))\r
 256    THEN POP_ASSUM (fun th -> (MP_TAC (AP_THM th `x:A`)))\r
 257    THEN REWRITE_TAC[o_THM]);;\r
 258 \r
 259 let iterate_map_valuation2 = prove(`!(p:A->A) (n:num) (x:A). (p POWER n) (p x) = (p POWER (SUC n)) x`,\r
 260    REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL[`p:A->A`; `n:num`] (CONJUNCT2 POWER))\r
 261    THEN POP_ASSUM (fun th -> (MP_TAC (AP_THM th `x:A`)))\r
 262    THEN REWRITE_TAC[o_THM; EQ_SYM]);;\r
 263 \r
 264 let in_orbit_lemma = prove(`!f:A->A n:num x:A y:A. y = (f POWER n) x ==> y IN orbit_map f x`,\r
 265    REPEAT STRIP_TAC THEN REWRITE_TAC[orbit_map;IN_ELIM_THM] \r
 266    THEN EXISTS_TAC `n:num` \r
 267    THEN ASM_REWRITE_TAC[ARITH_RULE `n:num >= 0`]);;\r
 268 \r
 269 let lemma_in_orbit = prove(`!f:A->A n:num x:A. (f POWER n) x IN orbit_map f x`,\r
 270    REPEAT STRIP_TAC\r
 271    THEN REWRITE_TAC[orbit_map;IN_ELIM_THM]\r
 272    THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_0; GE]);;\r
 273 \r
 274 let orbit_one_point = prove(`!f:A->A x:A. f x = x <=> orbit_map f x = {x}`,\r
 275   REPEAT GEN_TAC THEN EQ_TAC\r
 276   THENL[STRIP_TAC THEN REWRITE_TAC[EXTENSION;IN_SING] THEN GEN_TAC\r
 277     THEN REWRITE_TAC[orbit_map; IN_ELIM_THM]\r
 278     THEN EQ_TAC\r
 279     THENL[STRIP_TAC THEN MP_TAC(SPECL[`1`; `f:A->A`; `x:A`] power_map_fix_point)\r
 280        THEN ASM_REWRITE_TAC[POWER_1;MULT_CLAUSES]\r
 281        THEN DISCH_THEN (ASSUME_TAC o SPEC `n:num`)\r
 282        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
 283     THEN STRIP_TAC THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC [ARITH_RULE `0 >= 0`; POWER; I_THM]; ALL_TAC]\r
 284   THEN STRIP_TAC THEN MP_TAC (SPECL[`f:A->A`; `1`; `(x:A)`; `(f:A->A) (x:A)`] in_orbit_lemma)\r
 285   THEN ASM_REWRITE_TAC[POWER_1; IN_SING]);;\r
 286 \r
 287 let lemma_orbit_finite = prove(`!(s:A->bool) (p:A->A) (x:A). FINITE s /\ p permutes s ==> FINITE (orbit_map p x)`,\r
 288    REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:A IN s:A->bool`\r
 289    THENL[REPEAT STRIP_TAC \r
 290        THEN UNDISCH_THEN `(p:A->A) permutes (s:A->bool)` (MP_TAC o SPEC `x:A` o MATCH_MP orbit_subset)\r
 291        THEN ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC]\r
 292    THEN SUBGOAL_THEN `(p:A->A) x:A = x:A` MP_TAC\r
 293    THENL[ASM_MESON_TAC[permutes]; ALL_TAC]\r
 294    THEN ONCE_REWRITE_TAC[orbit_one_point] THEN DISCH_THEN SUBST1_TAC THEN ASSUME_TAC (CONJUNCT1 CARD_CLAUSES)\r
 295    THEN ASSUME_TAC (CONJUNCT1 FINITE_RULES) THEN MP_TAC(SPECL[`x:A`;`{}:A->bool`] (CONJUNCT2 FINITE_RULES))\r
 296    THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ARITH_TAC);;\r
 297 \r
 298 let orbit_cyclic = prove(`!(f:A->A) m:num (x:A). ~(m = 0) /\ (f POWER m) x = x ==> orbit_map f x = {(f POWER k) x | k < m}`, \r
 299    REPEAT STRIP_TAC THEN REWRITE_TAC[orbit_map; EXTENSION; IN_ELIM_THM] \r
 300    THEN GEN_TAC THEN EQ_TAC \r
 301    THENL [STRIP_TAC THEN ASM_REWRITE_TAC[] \r
 302       THEN FIND_ASSUM (MP_TAC o (SPEC `n:num`) o MATCH_MP DIVMOD_EXIST) `~(m:num = 0)` \r
 303      THEN REPEAT STRIP_TAC \r
 304      THEN UNDISCH_THEN `((f:A->A) POWER (m:num)) (x:A) = x` (ASSUME_TAC o (SPEC `q:num`) o MATCH_MP power_map_fix_point) \r
 305      THEN ASM_REWRITE_TAC[ADD_SYM; addition_exponents; o_DEF] \r
 306      THEN EXISTS_TAC `r:num` THEN ASM_SIMP_TAC[]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] \r
 307      THEN EXISTS_TAC `k:num` THEN SIMP_TAC[LE_0; GE]]);; \r
 308 \r
 309 (* Some obviuos facts about common hypermap maps *)\r
 310 \r
 311 let power_permutation = prove(`!(s:A->bool) (p:A->A). p permutes s  ==> !(n:num). (p POWER n) permutes s`, \r
 312    REPLICATE_TAC 3 STRIP_TAC THEN INDUCT_TAC \r
 313    THENL[REWRITE_TAC[POWER; PERMUTES_I]; REWRITE_TAC[POWER] THEN ASM_MESON_TAC[PERMUTES_COMPOSE]]);;\r
 314 \r
 315 let inverse_function = prove( `!s:A->bool p:A->A x:A y:A. p permutes s /\ p x = y ==> x = (inverse p) y`,\r
 316    REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o AP_TERM `inverse (p:A->A)`) THEN STRIP_TAC \r
 317    THEN MP_TAC (ISPECL[`inverse(p:A->A)`; `p:A->A`; `x:A`] o_THM) \r
 318    THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (ASSUME_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) \r
 319    THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[I_THM]);;\r
 320 \r
 321 let lemma_4functions = prove(`!f g h r. f o g o h o r = f o (g o h) o r `, REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_ASSOC]);;\r
 322 \r
 323 let lemma_power_inverse_map = prove(`!s:A->bool p:A->A n:num. p permutes s ==>  \r
 324    ((inverse p) POWER n) o (p POWER n) = I /\ (p POWER n) o ((inverse p) POWER n) = I`,\r
 325    REPEAT GEN_TAC\r
 326    THEN DISCH_THEN (LABEL_TAC "F1")\r
 327    THEN SUBGOAL_THEN `((p:A->A) POWER (n:num)) o ((inverse p) POWER n) = I` (LABEL_TAC "F2")\r
 328    THENL[SPEC_TAC(`n:num`, `n:num`)\r
 329       THEN INDUCT_TAC\r
 330       THENL[REWRITE_TAC[POWER_0; I_O_ID]; ALL_TAC]\r
 331       THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [COM_POWER]\r
 332       THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [POWER]\r
 333       THEN REWRITE_TAC[GSYM o_ASSOC]\r
 334       THEN REWRITE_TAC[lemma_4functions]\r
 335       THEN POP_ASSUM SUBST1_TAC\r
 336       THEN REWRITE_TAC[I_O_ID]\r
 337       THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th]); ALL_TAC]\r
 338    THEN ASM_REWRITE_TAC[]\r
 339    THEN REMOVE_THEN "F1" (LABEL_TAC "F1" o SPEC `n:num` o MATCH_MP power_permutation)\r
 340    THEN USE_THEN "F1" (fun th -> (REMOVE_THEN "F2" (fun th2 -> (MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ th th2))))))\r
 341    THEN DISCH_THEN (SUBST1_TAC o REWRITE_RULE[I_O_ID])\r
 342    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th]));;\r
 343 \r
 344 let lemma_power_inverse = prove(`!s:A->bool p:A->A n:num. p permutes s \r
 345     ==> (inverse p) POWER n = inverse (p POWER n) /\ inverse ((inverse p) POWER n) = p POWER n`,\r
 346    REPEAT GEN_TAC\r
 347    THEN DISCH_THEN (LABEL_TAC "F1")\r
 348    THEN USE_THEN "F1" (LABEL_TAC "F2"  o SPEC `n:num` o MATCH_MP power_permutation)\r
 349    THEN SUBGOAL_THEN `(inverse (p:A->A)) POWER (n:num) = inverse (p POWER n)` ASSUME_TAC\r
 350    THENL[REMOVE_THEN "F1" (MP_TAC o CONJUNCT1 o  SPEC `n:num` o MATCH_MP lemma_power_inverse_map)\r
 351       THEN DISCH_THEN (fun th1 -> (POP_ASSUM (fun th -> MP_TAC (MATCH_MP RIGHT_INVERSE_EQUATION (CONJ th th1)))))\r
 352       THEN REWRITE_TAC[I_O_ID]; ALL_TAC]\r
 353    THEN ASM_REWRITE_TAC[]\r
 354    THEN USE_THEN "F2" (fun th ->REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_INVERSE th]));;\r
 355 \r
 356 let inverse_power_function = prove(`!(s:A->bool) (p:A->A) n:num x:A y:A. p permutes s ==> (y = (p POWER n) x  <=> x = ((inverse p) POWER n) y)`,\r
 357    REPEAT GEN_TAC\r
 358    THEN DISCH_THEN (LABEL_TAC "F1")\r
 359    THEN USE_THEN "F1" (ASSUME_TAC  o SPEC `n:num` o MATCH_MP power_permutation)\r
 360    THEN POP_ASSUM (MP_TAC o SPECL[`x:A`; `y:A`] o MATCH_MP PERMUTES_INVERSE_EQ)\r
 361    THEN POP_ASSUM (SUBST1_TAC o SYM o CONJUNCT1 o SPEC `n:num` o MATCH_MP lemma_power_inverse)\r
 362    THEN MESON_TAC[]);;\r
 363 \r
 364 let edge_map_inverse_representation = prove(`!(H:(A)hypermap) (x:A) (y:A). y = edge_map H x <=> x = inverse (edge_map H) y`,\r
 365    REPEAT GEN_TAC \r
 366    THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INVERSE_EQ (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))))\r
 367    THEN MESON_TAC[EQ_SYM]);;\r
 368 \r
 369 let node_map_inverse_representation = prove(`!(H:(A)hypermap) (x:A) (y:A). y = node_map H x <=> x = inverse (node_map H) y`,\r
 370    REPEAT GEN_TAC \r
 371    THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INVERSE_EQ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))))\r
 372    THEN MESON_TAC[EQ_SYM]);;\r
 373 \r
 374 let face_map_inverse_representation = prove(`!(H:(A)hypermap) (x:A) (y:A). y = face_map H x <=> x = inverse (face_map H) y`,\r
 375    REPEAT GEN_TAC THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INVERSE_EQ (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))))))\r
 376    THEN MESON_TAC[EQ_SYM]);;\r
 377 \r
 378 let edge_map_injective = prove(`!(H:(A)hypermap) (x:A) (y:A). edge_map H x = edge_map H y <=> x = y`,\r
 379    REPEAT GEN_TAC \r
 380    THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INJECTIVE (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))))\r
 381    THEN MESON_TAC[EQ_SYM]);;\r
 382 \r
 383 let node_map_injective = prove(`!(H:(A)hypermap) (x:A) (y:A). node_map H x = node_map H y <=> x = y`,\r
 384    REPEAT GEN_TAC \r
 385    THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INJECTIVE (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))))\r
 386    THEN MESON_TAC[EQ_SYM]);;\r
 387 \r
 388 let face_map_injective = prove(`!(H:(A)hypermap) (x:A) (y:A). face_map H x = face_map H y <=> x = y`,\r
 389    REPEAT GEN_TAC THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INJECTIVE (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))))))\r
 390    THEN MESON_TAC[EQ_SYM]);;\r
 391 \r
 392 (* Some label_TAC *)\r
 393 \r
 394 let label_4Gs_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2(LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4"))) th;;\r
 395 \r
 396 let label_hypermap_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2(LABEL_TAC "H2") (CONJUNCTS_THEN2 (LABEL_TAC "H3") (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5")) )) (SPEC th hypermap_lemma);;\r
 397 \r
 398 let label_hypermap4_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2(LABEL_TAC "H2") (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4" o CONJUNCT1))) (SPEC th hypermap_lemma);;\r
 399 \r
 400 let label_hypermapG_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2(LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (CONJUNCTS_THEN2 (LABEL_TAC "G4") (LABEL_TAC "G5")) )) (SPEC th hypermap_lemma);;\r
 401 \r
 402 let label_strip3A_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "A1") (CONJUNCTS_THEN2(LABEL_TAC "A2")(LABEL_TAC "A3")) th;;\r
 403 \r
 404 (* Darts and its images under edge_map, node_map and face_map *)\r
 405 \r
 406 \r
 407 let lemma_dart_invariant = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> edge_map H x IN dart H /\ node_map H x IN dart H /\ face_map H x IN dart H`,\r
 408    REPEAT GEN_TAC THEN label_hypermap4_TAC `H:(A)hypermap` THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE]);;\r
 409 \r
 410 let lemma_dart_invariant_power_node = prove(`!(H:(A)hypermap) x:A n:num. x IN dart H ==> (node_map H POWER n) x IN dart H`,\r
 411    REPEAT GEN_TAC\r
 412    THEN REWRITE_TAC[MATCH_MP iterate_orbit (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))]);;\r
 413 \r
 414 let lemma_dart_invariant_power_face = prove(`!(H:(A)hypermap) x:A n:num. x IN dart H ==> (face_map H POWER n) x IN dart H`,\r
 415    REPEAT GEN_TAC\r
 416    THEN REWRITE_TAC[MATCH_MP iterate_orbit (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]);;\r
 417 \r
 418 let lemma_dart_inveriant_under_inverse_maps = prove(`!(H:(A)hypermap) x:A. x IN dart H \r
 419   ==> inverse(edge_map H) x IN dart H /\ inverse(node_map H) x IN dart H /\ inverse(face_map H) x IN dart H`,\r
 420    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1")\r
 421    THEN MP_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` edge_map_and_darts)))\r
 422    THEN USE_THEN "F1"(fun th-> DISCH_THEN (fun th1->REWRITE_TAC[REWRITE_RULE[th] (GSYM (SPEC `x:A` (MATCH_MP PERMUTES_IN_IMAGE th1)))]))\r
 423    THEN MP_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))\r
 424    THEN USE_THEN "F1"(fun th-> DISCH_THEN (fun th1->REWRITE_TAC[REWRITE_RULE[th] (GSYM (SPEC `x:A` (MATCH_MP PERMUTES_IN_IMAGE th1)))]))\r
 425    THEN MP_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts)))\r
 426    THEN USE_THEN "F1"(fun th-> DISCH_THEN (fun th1->REWRITE_TAC[REWRITE_RULE[th] (GSYM (SPEC `x:A` (MATCH_MP PERMUTES_IN_IMAGE th1)))])));;\r
 427 \r
 428 (* Some lemmas on the cardinality of finite series *)\r
 429 \r
 430 let IMAGE_SEG = prove(`!(n:num) (f:num->A). IMAGE f {i:num | i < n:num}  = {f (i:num) | i < n}`,\r
 431    REPEAT STRIP_TAC\r
 432    THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN SET_TAC[]);;\r
 433 \r
 434 let FINITE_SERIES = prove(`!(n:num) (f:num->A). FINITE {f(i) | i < n}`,\r
 435    REPEAT GEN_TAC\r
 436    THEN ONCE_REWRITE_TAC[SYM(SPECL[`n:num`; `f:num->A`] IMAGE_SEG)]\r
 437    THEN MATCH_MP_TAC FINITE_IMAGE\r
 438    THEN REWRITE_TAC[FINITE_NUMSEG_LT]);;\r
 439 \r
 440 let CARD_FINITE_SERIES_LE  = prove(`!(n:num) (f:num->A). CARD {f(i) | i < n} <= n`,\r
 441    REPEAT GEN_TAC\r
 442    THEN ONCE_REWRITE_TAC[SYM(SPECL[`n:num`; `f:num->A`] IMAGE_SEG)]\r
 443    THEN MP_TAC(ISPEC `f:num ->A` (MATCH_MP CARD_IMAGE_LE (SPEC `n:num` FINITE_NUMSEG_LT)))\r
 444    THEN REWRITE_TAC[CARD_NUMSEG_LT]);;\r
 445 \r
 446 let LEMMA_INJ = prove(`!(n:num) (f:num->A).(!i:num j:num. i < n /\ j < i ==> ~(f i = f j)) ==> (!i:num j:num. i < n /\ j < n /\ f i = f j ==> i = j)`,\r
 447    REPEAT GEN_TAC\r
 448    THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LT\r
 449    THEN STRIP_TAC THENL[ARITH_TAC; ALL_TAC]\r
 450    THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC]\r
 451    THEN ASM_MESON_TAC[]);;\r
 452 \r
 453 let LEMMA_INJ2 = prove(`!(n:num) (f:num->A).(!i:num j:num. i <= n /\ j < i ==> ~(f j = f i)) ==> (!i:num j:num. i <= n /\ j <= n /\ f i = f j ==> i = j)`,\r
 454    REPEAT GEN_TAC\r
 455    THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LT\r
 456    THEN STRIP_TAC THENL[ARITH_TAC; ALL_TAC]\r
 457    THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC]\r
 458    THEN ASM_MESON_TAC[]);;\r
 459 \r
 460 let CARD_FINITE_SERIES_EQ  = prove(`!(n:num) (f:num->A). (!i:num j:num. i < n /\  j < i ==> ~(f i = f j)) ==> CARD {f(i) | i < n} = n`,\r
 461    REPEAT GEN_TAC\r
 462    THEN DISCH_THEN (LABEL_TAC "F1" o MATCH_MP LEMMA_INJ)\r
 463    THEN ONCE_REWRITE_TAC[GSYM IMAGE_SEG]\r
 464    THEN GEN_REWRITE_TAC(RAND_CONV o ONCE_DEPTH_CONV) [GSYM (SPEC `n:num` CARD_NUMSEG_LT)]\r
 465    THEN MATCH_MP_TAC CARD_IMAGE_INJ\r
 466    THEN REWRITE_TAC[FINITE_NUMSEG_LT]\r
 467    THEN REWRITE_TAC[IN_ELIM_THM]\r
 468    THEN ASM_REWRITE_TAC[]);;\r
 469 \r
 470 let LM_AUX = prove(`!m n. m < n ==> ?k. ~(k = 0) /\ n = m + k`,\r
 471    REPEAT GEN_TAC THEN REWRITE_TAC[LT_EXISTS] \r
 472    THEN DISCH_THEN(X_CHOOSE_THEN `d:num` ASSUME_TAC)\r
 473    THEN EXISTS_TAC `SUC d` \r
 474    THEN ASM_REWRITE_TAC[ARITH_RULE `~(SUC d = 0)`]);;\r
 475 \r
 476 let LM1 = prove(`!s:A->bool p:A->A n:num m:num. p permutes s /\ p POWER (m+n) = p POWER m ==> p POWER n = I`,\r
 477    REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c1") (MP_TAC))\r
 478    THEN REWRITE_TAC[addition_exponents] THEN DISCH_TAC THEN\r
 479    REMOVE_THEN "c1" (ASSUME_TAC o (SPEC `m:num`) o MATCH_MP power_permutation)\r
 480    THEN MP_TAC (SPECL[`s:A->bool`; `(p:A->A) POWER (m:num)`;`(p:A->A) POWER (n:num)`; `(p:A->A) POWER (m:num)`] LEFT_INVERSE_EQUATION)\r
 481    THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o CONJUNCT2 o (MATCH_MP PERMUTES_INVERSES_o))\r
 482    THEN SIMP_TAC[]);;\r
 483 \r
 484 let lemma_sub_two_numbers = prove(`!m:num n:num p:num. m - n - p = m - (n + p)`, ARITH_TAC);;\r
 485 \r
 486 let NON_ZERO = prove(`!n:num. ~(SUC n = 0)`, REWRITE_TAC[GSYM LT_NZ; LT_0]);;\r
 487 \r
 488 let LT1_NZ = prove(`!n:num. 1 <= n <=> 0 < n`, ARITH_TAC);;\r
 489 \r
 490 let GE_1 = prove(`!n:num. 1 <= SUC n`, REWRITE_TAC[LT1_NZ; LT_NZ; NON_ZERO]);;\r
 491 \r
 492 let LT_PLUS = prove(`!n:num. n < SUC n`, ARITH_TAC);;\r
 493 \r
 494 let LE_PLUS = prove(`!n:num. n <= SUC n`, ARITH_TAC);;\r
 495 \r
 496 let LT_SUC_PRE = prove(`!n:num. 0 < n ==> n = SUC(PRE n)`, ARITH_TAC);;\r
 497 \r
 498 let LE_SUC_PRE = prove(`!n:num. 1 <= n ==> SUC(PRE n) = n`, REWRITE_TAC[LT1_NZ] THEN MESON_TAC[LT_SUC_PRE]);;\r
 499 \r
 500 let LT_PRE = prove(`!n:num. 0 < n ==> n = (PRE n) + 1`,\r
 501    GEN_TAC THEN DISCH_THEN (MP_TAC  o MATCH_MP LT_SUC_PRE) THEN REWRITE_TAC[ADD1]);;\r
 502 \r
 503 let SUC_PRE_2 = prove(`!n:num. 2 <= n ==> SUC (SUC (PRE (PRE n))) = n`, ARITH_TAC);;\r
 504  \r
 505 let LE_MOD_SUC = prove(`!n m. m MOD (SUC n) <= n`,\r
 506    REPEAT GEN_TAC\r
 507    THEN MP_TAC(CONJUNCT2(SPEC `m:num`(MATCH_MP DIVISION (SPEC `n:num` NON_ZERO))))\r
 508    THEN REWRITE_TAC[LT_SUC_LE]);;\r
 509 \r
 510 let LT0_LE1 = prove(`!n:num. 0 < n <=> 1 <= n`, ARITH_TAC);;\r
 511 \r
 512 let ZR_LT_1 = prove(`0 < 1`, ARITH_TAC);;\r
 513 \r
 514 let LT_RIGHT_SUC = prove(`!i:num n:num. i < n ==> i < SUC n`, ARITH_TAC);;\r
 515 \r
 516 let LE_RIGHT_SUC = prove(`!i:num n:num. i <= n ==> i <= SUC n`, ARITH_TAC);;\r
 517 \r
 518 let LT_PRE_LE = prove(`!i:num n:num. i < n ==> i <= PRE n`, ARITH_TAC);;\r
 519 \r
 520 let MOD_REFL = prove(`!m n. ~(n = 0) ==> ((m MOD n) MOD n = m MOD n)`,  (* in file ARITH.ML *)\r
 521     REPEAT GEN_TAC THEN DISCH_TAC THEN\r
 522     MP_TAC(SPECL [`m:num`; `n:num`; `1`] MOD_MOD) THEN\r
 523     ASM_REWRITE_TAC[MULT_CLAUSES; MULT_EQ_0] THEN\r
 524     REWRITE_TAC[ONE; NOT_SUC]);;\r
 525 let compare_left = prove(`!m:num n p. m + n = p ==> m <= p`, ARITH_TAC);;\r
 526 \r
 527 let compare_right = prove(`!m:num n p. m + n = p ==> n <= p`, ARITH_TAC);;\r
 528 \r
 529 let le_compare_left = prove(`!m:num n p. m + n <= p ==> m <= p`, ARITH_TAC);;\r
 530 \r
 531 let le_compare_right = prove(`!m:num n p. m + n <= p ==> n <= p`, ARITH_TAC);;\r
 532 \r
 533 let THREE = num_CONV `3`;;\r
 534 \r
 535 let SEGMENT_TO_ONE = prove(`!n:num. n <= 1 <=> n = 0 \/ n = 1`, ARITH_TAC);;\r
 536 \r
 537 let SEGMENT_TO_TWO = prove(`!n:num. n <= 2 <=> n = 0 \/ n = 1 \/ n = 2`, ARITH_TAC);;\r
 538 \r
 539 let EXPAND_SET_TWO_ELEMENTS = prove(`!p:num->A. {p (i:num) | i <= 1} = {p 0, p 1}`,\r
 540   GEN_TAC THEN REWRITE_TAC[SEGMENT_TO_ONE] THEN SET_TAC[]);;\r
 541 \r
 542 let EXPAND_SET_THREE_ELEMENTS = prove(`!p:num->A. {p (i:num) | i <= 2} = {p 0, p 1, p 2}`,\r
 543   GEN_TAC THEN REWRITE_TAC[SEGMENT_TO_TWO] THEN SET_TAC[]);;\r
 544 \r
 545 let lemma_add_one_assumption_lt = prove(`!P. !(n:num). (!i:num. i < SUC n ==> P i) <=> (!i:num. i < n ==> P i) /\ P n`,\r
 546  REPEAT GEN_TAC\r
 547    THEN ASM_CASES_TAC `n:num = 0`\r
 548    THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM ONE; CONJUNCT1 LT; ARITH_RULE `!i. i < 1 <=> i = 0`]\r
 549        THEN MESON_TAC[]; ALL_TAC]\r
 550    THEN POP_ASSUM (MP_TAC o MATCH_MP LT_SUC_PRE o REWRITE_RULE[GSYM LT_NZ])\r
 551    THEN DISCH_THEN (fun th-> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[LT_SUC_LE; lemma_add_one_assumption]);;\r
 552 \r
 553 (***********************************************************************)\r
 554 \r
 555 let is_inj_list = new_recursive_definition num_RECURSION  `(is_inj_list (p:num->A) 0 <=> T) /\ \r
 556    (is_inj_list (p:num->A) (SUC n) <=> ((is_inj_list p n) /\ (!i:num. i <= n ==> ~(p i = p (SUC n)))))`;; \r
 557 \r
 558 let lemma_sub_list = prove(`!p:num->A n:num. is_inj_list p n ==> (!i. i <= n ==> is_inj_list p i)`,\r
 559    GEN_TAC THEN INDUCT_TAC THENL[SIMP_TAC[is_inj_list; LE]; ALL_TAC]\r
 560    THEN STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[LE]\r
 561    THEN STRIP_TAC\r
 562    THENL[POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
 563    THEN UNDISCH_THEN `is_inj_list (p:num->A) (SUC n)` (MP_TAC o REWRITE_RULE[is_inj_list])\r
 564    THEN ASM_MESON_TAC[]);;\r
 565 \r
 566 let lemma_inj_list = prove(`!p:num->A n:num. is_inj_list p n <=> (!i:num j:num. i <= n /\ j < i ==> ~(p j = p i))`,\r
 567  GEN_TAC\r
 568    THEN INDUCT_TAC THENL[REWRITE_TAC[is_inj_list] THEN ARITH_TAC; ALL_TAC]\r
 569    THEN REWRITE_TAC[is_inj_list]\r
 570    THEN POP_ASSUM (fun th-> REWRITE_TAC[th; LE])\r
 571    THEN EQ_TAC\r
 572    THENL[DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
 573        THEN REPEAT GEN_TAC\r
 574        THEN STRIP_TAC\r
 575        THENL[POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC\r
 576            THEN ASM_REWRITE_TAC[LT_SUC_LE]; ALL_TAC]\r
 577        THEN ASM_MESON_TAC[]; ALL_TAC]\r
 578    THEN REWRITE_TAC[RIGHT_OR_DISTRIB]\r
 579    THEN SIMP_TAC[]\r
 580    THEN DISCH_TAC\r
 581    THEN GEN_TAC\r
 582    THEN POP_ASSUM (MP_TAC o SPECL[`SUC n`; `i:num`])\r
 583    THEN SIMP_TAC[EQ_REFL; ARITH_RULE `~(SUC n <= n)`; LT_SUC_LE]);;\r
 584 \r
 585 let lemma_inj_list2 = prove(`!p:num->A n:num. is_inj_list p n <=> (!i:num j:num. i <= n /\ j <= n  /\ p i = p j ==> i = j)`,\r
 586    REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_list]\r
 587    THEN EQ_TAC\r
 588    THENL[DISCH_TAC THEN MATCH_MP_TAC WLOG_LT\r
 589        THEN STRIP_TAC THENL[ARITH_TAC; ALL_TAC]\r
 590        THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC]\r
 591        THEN ASM_MESON_TAC[]; ALL_TAC]\r
 592    THEN DISCH_THEN (LABEL_TAC "F1") THEN REPEAT GEN_TAC\r
 593    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))\r
 594    THEN DISCH_TAC\r
 595    THEN REMOVE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`])\r
 596    THEN ASM_REWRITE_TAC[]\r
 597    THEN USE_THEN "F3"(fun th -> USE_THEN "F2" (fun th1 -> (ASSUME_TAC (MATCH_MP LTE_TRANS (CONJ th th1)))))\r
 598    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
 599    THEN REMOVE_THEN "F3" MP_TAC\r
 600    THEN ARITH_TAC);;\r
 601 \r
 602 let support_list = new_definition `support_list (p:num->A) (n:num) = {p (i:num) | i <= n}`;;\r
 603 \r
 604 let lemma_finite_list = prove(`!(p:num->A) (n:num). FINITE (support_list p n)`,\r
 605    REWRITE_TAC[support_list; GSYM LT_SUC_LE; FINITE_SERIES]);;\r
 606 \r
 607 let lemma_size_list = prove(`!(p:num->A) (n:num). is_inj_list p n ==> CARD (support_list p n) = SUC n`,\r
 608    REPEAT GEN_TAC\r
 609    THEN REWRITE_TAC[lemma_inj_list; support_list]\r
 610    THEN CONV_TAC ((LAND_CONV o ONCE_DEPTH_CONV) SYM_CONV)\r
 611    THEN REWRITE_TAC[GSYM LT_SUC_LE]\r
 612    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP CARD_FINITE_SERIES_EQ th]));;\r
 613 \r
 614 let in_list = new_definition `in_list (p:num->A) (n:num) (x:A) <=>  x IN support_list p n`;;\r
 615 \r
 616 let lemma_in_list = prove(`!p:num->A n:num x:A. in_list p n x <=> ?j:num. j <= n /\ x = p j`,\r
 617    REWRITE_TAC[in_list; support_list; IN_ELIM_THM]);;\r
 618 \r
 619 let lemma_in_list2 = prove(`!p:num->A n:num x:A j:num. j <= n /\ x = p j ==> in_list p n x`, MESON_TAC[lemma_in_list]);;\r
 620 \r
 621 let lemma_element_in_list = prove(`!p:num->A n:num i:num. i <= n ==> in_list p n (p i)`,\r
 622    REWRITE_TAC[lemma_in_list] THEN MESON_TAC[]);;\r
 623 \r
 624 let lemma_not_in_list = prove(`!p:num->A n:num x:A. ~(in_list p n x) <=> !j:num. j <= n ==> ~(x = p j)`,\r
 625    REPEAT GEN_TAC THEN REWRITE_TAC[lemma_in_list] THEN MESON_TAC[]);;\r
 626 \r
 627 let is_disjoint = new_definition `!p:num->A q:num->A n:num m:num. is_disjoint p q n m <=> DISJOINT (support_list p n) (support_list q m)`;;\r
 628 \r
 629 let lemma_set_disjoint = prove(`!s:A->bool t:A->bool. ~(DISJOINT s t) <=> ?x:A. x IN s /\ x IN t`, SET_TAC[IN_DISJOINT]);;\r
 630 \r
 631 let lemma_list_disjoint1 = prove(`!p:num->A q:num->A n:num m:num. is_disjoint p q n m <=> !i:num. i <= n ==> ~(in_list q m (p i))`,\r
 632    REPEAT GEN_TAC\r
 633    THEN EQ_TAC\r
 634    THENL[DISCH_THEN (LABEL_TAC "F1")\r
 635        THEN REPEAT STRIP_TAC\r
 636        THEN REMOVE_THEN "F1" MP_TAC THEN REWRITE_TAC[]\r
 637        THEN REWRITE_TAC[is_disjoint; lemma_set_disjoint]\r
 638        THEN REWRITE_TAC[GSYM in_list]\r
 639        THEN EXISTS_TAC `(p:num->A) i`\r
 640        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
 641        THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC]\r
 642    THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
 643    THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP]\r
 644    THEN REWRITE_TAC[is_disjoint; GSYM in_list; lemma_set_disjoint]\r
 645    THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[lemma_in_list]) (ASSUME_TAC)))\r
 646    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 MP_TAC (SUBST_ALL_TAC)))\r
 647    THEN ASM_MESON_TAC[]);;\r
 648 \r
 649 let lemma_list_disjoint2 = prove(`!p:num->A q:num->A n:num m:num. is_disjoint p q n m <=> !i:num. i <= m ==> ~(in_list p n (q i))`,\r
 650    REPEAT GEN_TAC\r
 651    THEN EQ_TAC\r
 652    THENL[DISCH_THEN (LABEL_TAC "F1")\r
 653        THEN REPEAT STRIP_TAC\r
 654        THEN REMOVE_THEN "F1" MP_TAC THEN REWRITE_TAC[]\r
 655        THEN REWRITE_TAC[is_disjoint; lemma_set_disjoint]\r
 656        THEN REWRITE_TAC[GSYM in_list]\r
 657        THEN EXISTS_TAC `(q:num->A) i`\r
 658        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
 659        THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC]\r
 660    THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
 661    THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP]\r
 662    THEN REWRITE_TAC[is_disjoint; GSYM in_list; lemma_set_disjoint]\r
 663    THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o REWRITE_RULE[lemma_in_list])))\r
 664    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 MP_TAC (SUBST_ALL_TAC)))\r
 665    THEN ASM_MESON_TAC[]);;\r
 666 \r
 667 let lemma_list_disjoint = prove(`!p:num->A q:num->A n:num m:num. is_disjoint p q n m \r
 668    <=> !i:num j:num. i <= n /\ j <= m ==> ~(p i = q j)`,\r
 669    REPEAT GEN_TAC THEN REWRITE_TAC[lemma_list_disjoint1; lemma_not_in_list] THEN MESON_TAC[]);;\r
 670 \r
 671 \r
 672 let glue = new_definition `!p:num->A q:num->A n:num. glue p q n = (\i:num. if i <= n then p i else q (i-n))`;;\r
 673 \r
 674 let start_glue_evaluation = prove(`!p:num->A q:num->A n:num. glue p q n 0 = p 0`,\r
 675    REPEAT GEN_TAC THEN REWRITE_TAC[glue; LE_0]);;\r
 676 \r
 677 let first_glue_evaluation = prove(`!p:num->A q:num->A n:num i:num. i <= n ==> glue p q n i = p i`,\r
 678    REPEAT GEN_TAC THEN REWRITE_TAC[glue] THEN SIMP_TAC[COND_ELIM_THM]);;\r
 679 \r
 680 let second_glue_evaluation = prove(`!p:num->A q:num->A n:num i:num. p n = q 0 ==> glue p q n (n + i) = q i`,\r
 681    REPEAT STRIP_TAC THEN REWRITE_TAC[glue]\r
 682    THEN ASM_CASES_TAC `i:num = 0`\r
 683    THENL[POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[ADD_0; LE_REFL; COND_ELIM_THM]; ALL_TAC]\r
 684    THEN POP_ASSUM ((X_CHOOSE_THEN `j:num` SUBST1_TAC) o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; CONJUNCT1 ADD])\r
 685    THEN SIMP_TAC[COND_ELIM_THM; ARITH_RULE `~((n:num) + (SUC j) <= n)`]\r
 686    THEN AP_TERM_TAC THEN REWRITE_TAC[ADD_SUB2]);;\r
 687 \r
 688 let is_glueing = new_definition `!p:num->A q:num->A n:num m:num. is_glueing p q n m \r
 689    <=> (p n = q 0) /\ (!j:num. 1 <= j /\ j <= m ==> ~(in_list p n (q j)))`;; \r
 690 \r
 691 let lemma_glueing_condition = prove(`!p:num->A q:num->A n:num m:num. is_inj_list p n /\ is_inj_list q m ==> (is_glueing p q n m\r
 692    <=> (p n = q 0) /\ (!i:num. i < n ==> ~(in_list q m (p i))))`,\r
 693  REPEAT GEN_TAC\r
 694    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FC") (LABEL_TAC "GC"))\r
 695    THEN REWRITE_TAC[is_glueing; lemma_not_in_list]\r
 696    THEN EQ_TAC\r
 697    THENL[DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
 698       THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th])\r
 699       THEN GEN_TAC\r
 700       THEN DISCH_THEN (LABEL_TAC "F3")\r
 701       THEN GEN_TAC\r
 702       THEN DISCH_THEN (LABEL_TAC "F5")\r
 703       THEN ASM_CASES_TAC `j:num = 0`\r
 704       THENL[POP_ASSUM SUBST1_TAC\r
 705          THEN USE_THEN "F1" (SUBST1_TAC o SYM)\r
 706          THEN USE_THEN "FC" (MP_TAC o  SPECL[`n:num`; `i:num`] o  REWRITE_RULE[lemma_inj_list])\r
 707          THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; LE_REFL]); ALL_TAC]\r
 708       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
 709       THEN DISCH_THEN (fun th-> POP_ASSUM (fun th1-> USE_THEN "F2" (fun th2 -> MP_TAC (GSYM (SPEC `i:num` (MATCH_MP th2 (CONJ th th1)))))))\r
 710       THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP LT_IMP_LE th]); ALL_TAC]\r
 711    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
 712    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th])\r
 713    THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))\r
 714    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5")\r
 715    THEN ASM_CASES_TAC `j':num = n:num`\r
 716    THENL[POP_ASSUM SUBST1_TAC\r
 717       THEN USE_THEN "F1" SUBST1_TAC\r
 718       THEN USE_THEN "GC" (MP_TAC o GSYM o  SPECL[`j:num`; `0`] o  REWRITE_RULE[lemma_inj_list])\r
 719       THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
 720       THEN USE_THEN "F3" (fun th-> REWRITE_TAC[REWRITE_RULE[LT1_NZ] th]); ALL_TAC]\r
 721    THEN POP_ASSUM (fun th-> (POP_ASSUM(fun th1-> ASSUME_TAC (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th)))))\r
 722    THEN USE_THEN "F2" (fun th-> POP_ASSUM (MP_TAC o GSYM o SPEC `j:num`o  MATCH_MP th))\r
 723    THEN POP_ASSUM (fun th-> REWRITE_TAC[th]));;\r
 724 \r
 725 let lemma_glue_inj_lists = prove(`!p:num->A q:num->A n:num m:num. is_inj_list p n /\ is_inj_list q m /\ is_glueing p q n m\r
 726    ==> is_inj_list (glue p q n) (n + m)`,\r
 727  REPEAT GEN_TAC\r
 728    THEN REWRITE_TAC[lemma_inj_list; is_glueing]\r
 729    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
 730    THEN REPEAT GEN_TAC\r
 731    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))\r
 732    THEN ASM_CASES_TAC `i:num <= n`\r
 733    THENL[POP_ASSUM (LABEL_TAC "F7")\r
 734        THEN USE_THEN "F6"(fun th-> USE_THEN "F7" (fun th1 -> (MP_TAC (MATCH_MP LTE_TRANS (CONJ th th1)))))\r
 735        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation (MATCH_MP LT_IMP_LE th)])\r
 736        THEN USE_THEN "F7" (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th])\r
 737        THEN USE_THEN "F1" (MATCH_MP_TAC)\r
 738        THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
 739    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
 740    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC))\r
 741    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
 742    THEN REMOVE_THEN "F5" (LABEL_TAC "F5" o REWRITE_RULE[GSYM ADD1; LE_ADD_LCANCEL; LE_SUC])\r
 743    THEN ASM_CASES_TAC `j:num <= n`\r
 744    THENL[POP_ASSUM (LABEL_TAC "F6")\r
 745       THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th])\r
 746       THEN USE_THEN "F4" (MP_TAC o SPEC `SUC d`)\r
 747       THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th; GE_1])\r
 748       THEN REWRITE_TAC[CONTRAPOS_THM]\r
 749       THEN DISCH_THEN (SUBST1_TAC o SYM)\r
 750       THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP lemma_element_in_list th]); ALL_TAC]\r
 751    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
 752    THEN DISCH_THEN (X_CHOOSE_THEN `e:num` (SUBST_ALL_TAC))\r
 753    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
 754    THEN USE_THEN "F6"(MP_TAC o REWRITE_RULE[LT_ADD_LCANCEL])\r
 755    THEN POP_ASSUM MP_TAC\r
 756    THEN REWRITE_TAC[IMP_IMP]\r
 757    THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]));;\r
 758 \r
 759 \r
 760 let join = new_definition `!p:num->A q:num->A n:num. join p q n = (\i:num. if i <= n then p i else q (PRE (i-n)))`;;\r
 761 \r
 762 let first_join_evaluation = prove(`!p:num->A q:num->A n:num i:num. i <= n ==> join p q n i = p i`,\r
 763    REPEAT GEN_TAC THEN REWRITE_TAC[join] THEN SIMP_TAC[COND_ELIM_THM]);;\r
 764 \r
 765 let second_join_evaluation = prove(`!p:num->A q:num->A n:num i:num. join p q n (n + (SUC i)) = q i`,\r
 766    REPEAT GEN_TAC THEN REWRITE_TAC[join]\r
 767    THEN SIMP_TAC[COND_ELIM_THM; ARITH_RULE `~((n:num) + (SUC i) <= n)`]\r
 768    THEN AP_TERM_TAC THEN REWRITE_TAC[ADD_SUB2; PRE]);;\r
 769 \r
 770 let lemma_join_inj_lists = prove(`!p:num->A q:num->A n:num m:num. is_inj_list p n /\ is_inj_list q m /\ is_disjoint p q n m\r
 771    ==> is_inj_list (join p q n) (n + m + 1)`,\r
 772  REPEAT GEN_TAC\r
 773    THEN REWRITE_TAC[lemma_inj_list]\r
 774    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
 775    THEN REPEAT GEN_TAC\r
 776    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))\r
 777    THEN ASM_CASES_TAC `i:num <= n`\r
 778    THENL[POP_ASSUM (LABEL_TAC "F6")\r
 779        THEN USE_THEN "F5"(fun th-> USE_THEN "F6" (fun th1 -> (MP_TAC (MATCH_MP LTE_TRANS (CONJ th th1)))))\r
 780        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation (MATCH_MP LT_IMP_LE th)])\r
 781        THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th])\r
 782        THEN REMOVE_THEN "F1" (MATCH_MP_TAC)\r
 783        THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
 784    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
 785    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC))\r
 786    THEN REWRITE_TAC[second_join_evaluation]\r
 787    THEN REMOVE_THEN "F4" (LABEL_TAC "F4" o REWRITE_RULE[GSYM ADD1; LE_ADD_LCANCEL; LE_SUC])\r
 788    THEN ASM_CASES_TAC `j:num <= n`\r
 789    THENL[POP_ASSUM (LABEL_TAC "F5")\r
 790        THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th])\r
 791        THEN POP_ASSUM  MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM]\r
 792        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[REWRITE_RULE[th] (SPECL[`p:num->A`; `q:num->A`; `n:num`; `m:num`] lemma_list_disjoint)]); ALL_TAC]\r
 793    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
 794    THEN DISCH_THEN (X_CHOOSE_THEN `e:num` (SUBST_ALL_TAC))\r
 795    THEN REWRITE_TAC[second_join_evaluation]\r
 796    THEN REMOVE_THEN "F5"(MP_TAC o REWRITE_RULE[LT_ADD_LCANCEL; LT_SUC])\r
 797    THEN POP_ASSUM MP_TAC\r
 798    THEN REWRITE_TAC[IMP_IMP]\r
 799    THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]));;\r
 800 \r
 801 \r
 802 (******************************************************************************)\r
 803 \r
 804 let inj_iterate_segment = prove(`!s:A->bool p:A->A (n:num). p permutes s /\ \r
 805    ~(n = 0) ==> (!m:num. ~(m = 0) /\ (m < n) ==> ~(p POWER m = I)) \r
 806    ==> (!i:num j:num. (i < n) /\ (j < i) ==> ~(p POWER i = p POWER j))`,\r
 807    REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c2") (ASSUME_TAC))\r
 808    THEN DISCH_THEN (LABEL_TAC "c3") THEN REPLICATE_TAC 3 STRIP_TAC\r
 809    THEN DISCH_THEN (LABEL_TAC "c4") THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LM_AUX)\r
 810    THEN REPEAT STRIP_TAC THEN REMOVE_THEN "c3" MP_TAC THEN\r
 811    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP]\r
 812    THEN EXISTS_TAC `k:num` THEN MP_TAC (ARITH_RULE `(i:num < n:num) /\ (i = (j:num) + (k:num)) ==> k < n`)\r
 813    THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]\r
 814    THEN REMOVE_THEN "c4" MP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC\r
 815    THEN MP_TAC (ISPECL[`s:A->bool`; `p:A->A`; `k:num`; `j:num`] LM1) \r
 816    THEN ASM_REWRITE_TAC[]);;\r
 817 \r
 818 let inj_iterate_lemma = prove(`!s:A->bool p:A->A. p permutes s /\\r
 819    (!(n:num). ~(n = 0) ==> ~(p POWER n = I)) ==> (!m. CARD({p POWER k | k < m}) = m)`,\r
 820    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "c1") (LABEL_TAC "c2"))\r
 821    THEN GEN_TAC \r
 822    THEN SUBGOAL_THEN `!i:num j:num. i < (m:num) /\  j < i ==> ~((p:A->A) POWER i = p POWER j)` ASSUME_TAC\r
 823    THENL[REPEAT GEN_TAC THEN STRIP_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP LM_AUX)\r
 824       THEN STRIP_TAC THEN ASM_REWRITE_TAC[]  THEN STRIP_TAC\r
 825       THEN MP_TAC (ISPECL[`s:A->bool`; `p:A->A`; `k:num`; `j:num`] LM1) \r
 826       THEN ASM_REWRITE_TAC[]\r
 827       THEN STRIP_TAC THEN REMOVE_THEN "c2" (MP_TAC o SPEC(`k:num`)) \r
 828       THEN REWRITE_TAC[NOT_IMP]\r
 829       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
 830    THEN POP_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_SERIES_EQ)\r
 831    THEN SIMP_TAC[]);;  \r
 832 \r
 833 (* finite order theorem on every element in arbitrary finite group *)\r
 834 \r
 835 let finite_order = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> ?(n:num). ~(n = 0) /\ p POWER n = I`,\r
 836    REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
 837    THEN ASM_CASES_TAC `?(n:num). ~(n = 0) /\ (p:A->A) POWER n = I` \r
 838    THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
 839    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_EXISTS_THM; DE_MORGAN_THM; TAUT `!a b. ~(a /\ b) = (a ==> ~b)`])\r
 840    THEN DISCH_TAC THEN MP_TAC (ISPECL[`s:A->bool`; `p:A->A`] inj_iterate_lemma)\r
 841    THEN ASM_REWRITE_TAC[] THEN DISCH_TAC\r
 842    THEN ABBREV_TAC `md = SUC(CARD({p | p permutes (s:A->bool)}))`\r
 843    THEN MP_TAC (ISPECL[`{(p:A->A) POWER (k:num) | k < (md:num)}` ;`{p | p permutes (s:A->bool)}`] CARD_SUBSET)\r
 844    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP FINITE_PERMUTATIONS th])\r
 845    THEN SUBGOAL_THEN `{(p:A->A) POWER (k:num) | k < (md:num)} SUBSET {p | p permutes (s:A->bool)}` (fun th-> REWRITE_TAC[th])\r
 846    THENL[REWRITE_TAC[SUBSET; IN_ELIM_THM]\r
 847       THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))\r
 848       THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP power_permutation th]); ALL_TAC]\r
 849    THEN FIRST_X_ASSUM (SUBST1_TAC o SPEC `md:num` o check (is_forall o concl))\r
 850    THEN POP_ASSUM (SUBST1_TAC o SYM) THEN ARITH_TAC);;\r
 851 \r
 852 let lemma_order_permutation_exists = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s \r
 853    ==> ?n:num. ~(n = 0) /\ (p POWER n = I) /\ (!m:num. ~(m = 0) /\ (m < n) ==> ~(p POWER m = I))`,\r
 854    REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP finite_order)\r
 855    THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP]\r
 856    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [TAUT `(A ==> ~(~B /\ C)) <=> (~B /\ A ==> ~C)`]\r
 857    THEN MESON_TAC[]);;\r
 858 \r
 859 let lemma_order_permutation = new_specification["order_permutation"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_order_permutation_exists);;\r
 860 \r
 861 let inverse_element_lemma = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> ?j:num. inverse p = p POWER j`,\r
 862    REPEAT GEN_TAC\r
 863    THEN DISCH_THEN(fun th -> MP_TAC (MATCH_MP finite_order th) THEN ASSUME_TAC(CONJUNCT2 th))\r
 864    THEN REWRITE_TAC[GSYM LT_NZ]\r
 865    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (MP_TAC) (ASSUME_TAC)))\r
 866    THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP LT_SUC_PRE)\r
 867    THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[POWER]\r
 868    THEN POP_ASSUM (fun th -> (DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP RIGHT_INVERSE_EQUATION (CONJ th th1)))))\r
 869    THEN REWRITE_TAC[I_O_ID]\r
 870    THEN DISCH_THEN (ASSUME_TAC o SYM)\r
 871    THEN EXISTS_TAC `PRE n` THEN ASM_REWRITE_TAC[]);;\r
 872 \r
 873 let inverse_element_via_order = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> inverse p = p POWER (PRE (order_permutation s p))`, \r
 874    REPEAT GEN_TAC\r
 875    THEN DISCH_THEN (LABEL_TAC "F1")\r
 876    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_order_permutation)\r
 877    THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; CONJUNCT1 ADD]) (LABEL_TAC "F2" o CONJUNCT1))\r
 878    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
 879    THEN REWRITE_TAC[PRE]\r
 880    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[COM_POWER])\r
 881    THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 th) th1))))\r
 882    THEN DISCH_THEN (fun th-> REWRITE_TAC[REWRITE_RULE[I_O_ID] (SYM th)]));;\r
 883 \r
 884 let lemma_permutation_via_its_inverse = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> ?j:num. p = (inverse p) POWER j`,\r
 885    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
 886    THEN USE_THEN "F2" (ASSUME_TAC o MATCH_MP PERMUTES_INVERSE)\r
 887    THEN POP_ASSUM (fun th -> (REMOVE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP inverse_element_lemma (CONJ th2 th))))))\r
 888    THEN POP_ASSUM (SUBST1_TAC o MATCH_MP PERMUTES_INVERSE_INVERSE) THEN SIMP_TAC[]);;\r
 889 \r
 890 let power_inverse_element_lemma = prove(`!s:A->bool p:A->A n:num. FINITE s /\ p permutes s ==> ?j:num. (inverse p) POWER n = p POWER j`,\r
 891  REPLICATE_TAC 2 GEN_TAC\r
 892    THEN INDUCT_TAC\r
 893    THENL[STRIP_TAC\r
 894       THEN EXISTS_TAC `0`\r
 895       THEN REWRITE_TAC[POWER_0]; ALL_TAC]\r
 896    THEN DISCH_TAC\r
 897    THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))\r
 898    THEN ASM_REWRITE_TAC[]\r
 899    THEN STRIP_TAC\r
 900    THEN FIRST_X_ASSUM (MP_TAC o MATCH_MP  inverse_element_lemma)\r
 901    THEN DISCH_THEN (X_CHOOSE_THEN `i:num` ASSUME_TAC)\r
 902    THEN EXISTS_TAC `(j:num) + (i:num)`\r
 903    THEN REWRITE_TAC[POWER]\r
 904    THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th])\r
 905    THEN ASM_REWRITE_TAC[addition_exponents]);;\r
 906 \r
 907 let inverse_relation = prove(`!(s:A->bool) p:A->A x:A y:A. FINITE s /\ p permutes s /\ y = p x ==>(?k:num. x = (p POWER k) y)`, \r
 908    REPEAT STRIP_TAC THEN MP_TAC(SPECL[`s:A->bool`; `p:A->A`] inverse_element_lemma) \r
 909    THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `j:num` \r
 910    THEN POP_ASSUM(fun th -> REWRITE_TAC[SYM th]) \r
 911    THEN REWRITE_TAC[GSYM(ISPECL[`(inverse (p:A->A)):(A->A)`; `p:A->A`; `(x:A)`] o_THM)] \r
 912    THEN UNDISCH_THEN `p:A->A permutes s`(fun th-> REWRITE_TAC[CONJUNCT2 (MATCH_MP PERMUTES_INVERSES_o th);I_THM]));;\r
 913 \r
 914 let power_power_relation = prove(`!(s:A->bool) p:A->A x:A y:A n:num. FINITE s /\ p permutes s /\ (p POWER n) x = y ==> ?j:num. x = (p POWER j) y`,\r
 915    REPEAT GEN_TAC\r
 916    THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F1") MP_TAC))\r
 917    THEN USE_THEN "F1" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[MATCH_MP inverse_power_function th] o SYM))\r
 918    THEN POP_ASSUM (fun th1 -> POP_ASSUM (fun th-> MP_TAC (SPEC `n:num` (MATCH_MP power_inverse_element_lemma (CONJ th th1)))))\r
 919    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
 920    THEN DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[]);;\r
 921 \r
 922 let elim_power_function = prove(\r
 923    `!s:A->bool p:A->A x:A n:num m:num. p permutes s /\ (p POWER (m+n)) x = (p POWER m) x \r
 924    ==> (p POWER n) x = x`,\r
 925   REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c1") (MP_TAC)) \r
 926   THEN REWRITE_TAC[addition_exponents; o_THM] THEN DISCH_TAC \r
 927   THEN REMOVE_THEN "c1" (ASSUME_TAC o (SPEC `m:num`) o MATCH_MP power_permutation) \r
 928   THEN POP_ASSUM (MP_TAC o ISPECL[`((p:A->A) POWER (n:num)) (x:A)`; `x:A` ] o MATCH_MP PERMUTES_INJECTIVE) \r
 929   THEN ASM_REWRITE_TAC[]);;\r
 930 \r
 931 (* some properties of orbits *)\r
 932 \r
 933 let orbit_reflect = prove(`!f:A->A x:A. x IN (orbit_map f x)`, \r
 934    REPEAT GEN_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] \r
 935    THEN EXISTS_TAC `0` THEN REWRITE_TAC[POWER; ARITH_RULE `0>=0`;I_THM]);;\r
 936 \r
 937 let orbit_sym = prove(`!s:A->bool p:A->A x:A y:A. FINITE s /\ p permutes s\r
 938    ==> (x IN (orbit_map p y) ==> y IN (orbit_map p x))`, \r
 939    REPLICATE_TAC 5 STRIP_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] \r
 940    THEN  STRIP_TAC \r
 941    THEN FIND_ASSUM (ASSUME_TAC o (SPEC `n:num`) o MATCH_MP power_permutation) `p:A->A permutes (s:A->bool)` \r
 942    THEN POP_ASSUM (MP_TAC o (SPECL[`y:A`; `x:A`]) o MATCH_MP PERMUTES_INVERSE_EQ) \r
 943    THEN POP_ASSUM(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] \r
 944    THEN UNDISCH_THEN `p:A->A permutes s` (ASSUME_TAC o (SPEC `n:num`) o MATCH_MP power_permutation) \r
 945    THEN MP_TAC(SPECL[`s:A->bool`; `(p:A->A) POWER (n:num)`] inverse_element_lemma) \r
 946    THEN ASM_REWRITE_TAC[GSYM multiplication_exponents]\r
 947    THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC \r
 948    THEN EXISTS_TAC `(j:num) * (n:num)` \r
 949    THEN ASM_REWRITE_TAC[ARITH_RULE `(j:num) * (n:num) >= 0`]);;\r
 950 \r
 951 let orbit_trans = prove(`!f:A->A x:A y:A z:A. x IN orbit_map f y /\ y IN orbit_map f z \r
 952    ==> x IN orbit_map f z`,\r
 953    REPEAT GEN_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] \r
 954    THEN REPEAT STRIP_TAC THEN \r
 955    UNDISCH_THEN `x:A = ((f:A->A) POWER (n:num)) (y:A)` MP_TAC \r
 956    THEN  ASM_REWRITE_TAC[] \r
 957    THEN DISCH_THEN (ASSUME_TAC o SYM) THEN MP_TAC (SPECL[`n:num`; `n':num`; `f:A->A`] addition_exponents) \r
 958    THEN  DISCH_THEN(fun th -> MP_TAC (AP_THM th `z:A`)) \r
 959    THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN (ASSUME_TAC o SYM)\r
 960    THEN EXISTS_TAC `(n:num) + n'` \r
 961    THEN ASM_REWRITE_TAC[ARITH_RULE `(n:num) + (n':num) >= 0`]);;\r
 962 \r
 963 let partition_orbit = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s\r
 964    ==>(!x:A y:A. (orbit_map p x INTER orbit_map p y = {}) \/ (orbit_map p x = orbit_map p y))`, \r
 965    REPEAT STRIP_TAC THEN ASM_CASES_TAC `orbit_map (p:A->A)(x:A) INTER orbit_map (p:A->A) (y:A) = {}` \r
 966    THENL[ASM_REWRITE_TAC[]; ALL_TAC] \r
 967    THEN DISJ2_TAC THEN  POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] \r
 968    THEN REWRITE_TAC[INTER; IN_ELIM_THM] THEN STRIP_TAC \r
 969    THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `x':A`; `x:A`] orbit_sym) \r
 970    THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `x':A`; `y:A`] orbit_sym) \r
 971    THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC \r
 972    THEN EQ_TAC \r
 973    THENL[STRIP_TAC THEN MP_TAC (SPECL[`p:A->A`; `x'':A`; `x:A`;`x':A`] orbit_trans) \r
 974       THEN ASM_MESON_TAC[orbit_trans]; \r
 975       STRIP_TAC THEN MP_TAC (SPECL[`p:A->A`; `x'':A`; `y:A`;`x':A`] orbit_trans) \r
 976       THEN ASM_MESON_TAC[orbit_trans]]);;\r
 977 \r
 978 let card_orbit_le = prove(`!f:A->A n:num x:A. ~(n = 0) /\ (f POWER n) x = x ==> CARD(orbit_map f x) <= n`, \r
 979    REPEAT GEN_TAC \r
 980    THEN DISCH_THEN (fun th -> SUBST1_TAC (MATCH_MP orbit_cyclic th) \r
 981    THEN ASSUME_TAC (CONJUNCT1 th)) \r
 982    THEN MP_TAC (SPECL[`n:num`; `(\k. ((f:A->A) POWER k) (x:A))`] CARD_FINITE_SERIES_LE) \r
 983    THEN MESON_TAC[]);;\r
 984 \r
 985 \r
 986 (* some properties of hypermap *)\r
 987 \r
 988 let cyclic_maps = prove(`!D:A->bool e:A->A n:A->A f:A->A. \r
 989    (FINITE D) /\ e permutes D /\ n permutes D /\ f permutes D /\ e o n o f = I \r
 990     ==> (n o f o e = I) /\ (f o e o n = I)`, \r
 991    REPEAT STRIP_TAC \r
 992    THENL[MP_TAC (ISPECL[`D:A->bool`;`e:A->A`; `(n:A->A) o (f:A->A)`; `I:A->A`]\r
 993       LEFT_INVERSE_EQUATION) THEN ASM_REWRITE_TAC[I_O_ID] \r
 994       THEN FIND_ASSUM (ASSUME_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) `e:A->A permutes D:A->bool` \r
 995       THEN DISCH_TAC \r
 996       THEN MP_TAC (ISPECL[`(n:A->A)o(f:A->A)`;`inverse(e:A->A)`;`e:A->A` ] RIGHT_MULT_MAP) \r
 997       THEN ASM_REWRITE_TAC[o_ASSOC]; \r
 998       MP_TAC (ISPECL[`D:A->bool`;`(e:A->A)o(n:A->A)`;`(f:A->A)`; `I:A->A`] RIGHT_INVERSE_EQUATION) \r
 999       THEN ASM_REWRITE_TAC[I_O_ID; GSYM o_ASSOC] \r
1000       THEN DISCH_TAC  THEN MP_TAC (ISPECL[`D:A->bool`;`(e:A->A) o (n:A->A)`; `(f:A->A)`; `I:A->A`] RIGHT_INVERSE_EQUATION) \r
1001       THEN ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID] \r
1002       THEN FIND_ASSUM (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) `f:A->A permutes D:A->bool` \r
1003       THEN ASM_SIMP_TAC[]]);;\r
1004 \r
1005 let cyclic_inverses_maps = prove(`!D:A->bool e:A->A n:A->A f:A->A. \r
1006    (FINITE D) /\ e permutes D /\ n permutes D /\ f permutes D /\ e o n o f = I \r
1007    ==> inverse n o inverse e o inverse f = I`, \r
1008    \r
1009    REPEAT STRIP_TAC THEN MP_TAC (ISPECL[`D:A->bool`; `e:A->A`; `n:A->A`; `f:A->A`] cyclic_maps) \r
1010    THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC \r
1011    THEN  MP_TAC (ISPECL[`D:A->bool`;`f:A->A`; `(e:A->A) o (n:A->A)`; `I:A->A`] LEFT_INVERSE_EQUATION) \r
1012    THEN ASM_REWRITE_TAC[I_O_ID] THEN STRIP_TAC \r
1013    THEN MP_TAC (ISPECL[`D:A->bool`;`e:A->A`; `(n:A->A)`; `inverse(f:A->A)`] LEFT_INVERSE_EQUATION) \r
1014    THEN ASM_REWRITE_TAC[] THEN DISCH_TAC \r
1015    THEN  MP_TAC (ISPECL[`inverse(n:A->A)`; `n:A->A`; `inverse(e:A->A) o inverse(f:A->A)`] LEFT_MULT_MAP) \r
1016    THEN FIND_ASSUM (ASSUME_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) `n:A->A permutes D:A->bool` \r
1017    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SYM) THEN REWRITE_TAC[]);;\r
1018 \r
1019 let edge_refl = prove(`!H:(A)hypermap x:A. x IN edge H x`, REWRITE_TAC[edge; orbit_reflect]);;\r
1020 \r
1021 let node_refl = prove(`!H:(A)hypermap x:A. x IN node H x`, REWRITE_TAC[node; orbit_reflect]);;\r
1022 \r
1023 let face_refl = prove(`!H:(A)hypermap x:A. x IN face H x`, REWRITE_TAC[face; orbit_reflect]);;\r
1024 \r
1025 \r
1026 (* Hypermap cycle *)\r
1027 \r
1028 let hypermap_cyclic = prove(`!(H:(A)hypermap). (node_map H) o (face_map H) o (edge_map H) = I /\ (face_map H) o (edge_map H) o (node_map H) = I`, \r
1029    GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap`\r
1030    THEN MP_TAC(SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`; `node_map (H:(A)hypermap)`;`face_map (H:(A)hypermap)`] cyclic_maps) \r
1031    THEN ASM_REWRITE_TAC[]);;\r
1032 \r
1033 \r
1034 (* INVERSES HYPERMAP MAPS *)\r
1035 \r
1036 let label_cyclic_maps_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "H6") (LABEL_TAC "H7") (SPEC th hypermap_cyclic);;\r
1037 \r
1038 let inverse_hypermap_maps = prove(`!(H:(A)hypermap). inverse(edge_map H) = (node_map H) o (face_map H) /\ inverse(node_map H) = (face_map H) o (edge_map H) /\ inverse(face_map H) = (edge_map H) o (node_map H)`,\r
1039  GEN_TAC \r
1040    THEN STRIP_TAC\r
1041    THENL[MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))\r
1042        THEN DISCH_THEN (fun th-> MP_TAC(SYM(MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts)) th))))\r
1043        THEN REWRITE_TAC[I_O_ID]; ALL_TAC]\r
1044    THEN STRIP_TAC\r
1045    THENL[MP_TAC (CONJUNCT1(SPEC `H:(A)hypermap` hypermap_cyclic))\r
1046        THEN DISCH_THEN (fun th-> MP_TAC(SYM(MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)) th))))\r
1047        THEN REWRITE_TAC[I_O_ID]; ALL_TAC]\r
1048    THEN MP_TAC (CONJUNCT2(SPEC `H:(A)hypermap` hypermap_cyclic))\r
1049    THEN DISCH_THEN (fun th-> MP_TAC(SYM(MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) th))))\r
1050    THEN REWRITE_TAC[I_O_ID]);;\r
1051 \r
1052 let inverse2_hypermap_maps = prove(`!(H:(A)hypermap). edge_map H = inverse (face_map H) o inverse (node_map H) /\ node_map H = inverse (edge_map H) o inverse (face_map H) /\ face_map H = inverse (node_map H) o inverse(edge_map H)`,\r
1053  GEN_TAC\r
1054    THEN STRIP_TAC\r
1055    THENL[MP_TAC (SYM(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps))))\r
1056        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) th)]); ALL_TAC]\r
1057    THEN STRIP_TAC\r
1058    THENL[MP_TAC (SYM(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps))))\r
1059        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts)) th)]); ALL_TAC]\r
1060    THEN MP_TAC (SYM(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)))\r
1061    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)) th)]));;\r
1062 \r
1063 let lemmaZHQCZLX = prove(`!H:(A)hypermap. (simple_hypermap H /\ plain_hypermap H /\ (!x:A. x IN dart H ==> 3 <= CARD (face H x))) \r
1064    ==> (!x:A. x IN dart H ==> ~(node_map H x = x))`,\r
1065    GEN_TAC THEN REWRITE_TAC[simple_hypermap; plain_hypermap;face; node; GSYM GE] \r
1066    THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma)\r
1067    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "c1") (CONJUNCTS_THEN2 (LABEL_TAC "c2") (CONJUNCTS_THEN2 (LABEL_TAC "c3") (CONJUNCTS_THEN2 (LABEL_TAC "c4") (LABEL_TAC "c5")))))\r
1068    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c6") (CONJUNCTS_THEN2 (LABEL_TAC "c7") (LABEL_TAC "c8")))\r
1069    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "c9") \r
1070    THEN DISCH_THEN (LABEL_TAC "c10")\r
1071    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
1072    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`  \r
1073    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
1074    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
1075    THEN USE_THEN "c2" (MP_TAC o (SPEC `x:A`) o MATCH_MP PERMUTES_IN_IMAGE)\r
1076    THEN USE_THEN "c4" (MP_TAC o (SPEC `x:A`) o MATCH_MP PERMUTES_IN_IMAGE)\r
1077    THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC \r
1078    THEN ABBREV_TAC `y:A = (f:A->A) (x:A)` THEN ABBREV_TAC `z:A = (e:A->A) (x:A)`\r
1079    THEN USE_THEN "c7" MP_TAC THEN USE_THEN "c2" MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
1080    THEN DISCH_THEN (MP_TAC o MATCH_MP LEFT_INVERSE_EQUATION) \r
1081    THEN REWRITE_TAC[I_O_ID]\r
1082    THEN DISCH_THEN(fun th -> (ASSUME_TAC (SYM th)) \r
1083    THEN (ASSUME_TAC (AP_THM (SYM th) `x:A`)))\r
1084    THEN USE_THEN "c3" (MP_TAC o (SPECL[`x:A`;`x:A`]) o MATCH_MP PERMUTES_INVERSE_EQ)\r
1085    THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN USE_THEN "c5" MP_TAC\r
1086    THEN USE_THEN "c2" MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
1087    THEN DISCH_THEN (MP_TAC o MATCH_MP LEFT_INVERSE_EQUATION) THEN REWRITE_TAC[I_O_ID]\r
1088    THEN DISCH_THEN(fun th -> (ASSUME_TAC (SYM th)) \r
1089    THEN (MP_TAC (AP_THM (SYM th) `x:A`)))\r
1090    THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN (MP_TAC o SYM)\r
1091    THEN MP_TAC (SPECL[`D:A->bool`; `e:A->A`; `n:A->A`; `f:A->A`] cyclic_maps)\r
1092    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> MP_TAC (AP_THM (CONJUNCT2 th) `x:A`))\r
1093    THEN ASM_REWRITE_TAC[o_THM; I_THM] THEN DISCH_THEN (MP_TAC o AP_TERM `f:A->A`) \r
1094    THEN ASM_REWRITE_TAC[]\r
1095    THEN DISCH_THEN (LABEL_TAC "c11") THEN DISCH_THEN (LABEL_TAC "c12")\r
1096    THEN MP_TAC (SPECL[`f:A->A`; `2`; `z:A`; `y:A`] in_orbit_lemma) \r
1097    THEN ASM_REWRITE_TAC[POWER_2; o_THM]\r
1098    THEN DISCH_TAC THEN MP_TAC (SPECL[`D:A->bool`; `f:A->A`; `y:A`; `z:A`] orbit_sym)\r
1099    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "d1") \r
1100    THEN MP_TAC (SPECL[`n:A->A`; `1`; `y:A`; `z:A`] in_orbit_lemma)\r
1101    THEN ASM_REWRITE_TAC[POWER_1] THEN DISCH_THEN (LABEL_TAC "d2")\r
1102    THEN REMOVE_THEN "c6" (MP_TAC o (SPEC `y:A`))\r
1103    THEN UNDISCH_TAC `(y:A) IN D` THEN ASM_REWRITE_TAC[IN] THEN STRIP_TAC\r
1104    THEN ASM_REWRITE_TAC[] THEN STRIP_TAC\r
1105    THEN MP_TAC (SPECL[`orbit_map (n:A->A) (y:A)`;`orbit_map (f:A->A) (y:A)`;`z:A`] IN_INTER)\r
1106    THEN ASM_REWRITE_TAC[IN_SING] THEN STRIP_TAC\r
1107    THEN REMOVE_THEN "c11" MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC\r
1108    THEN MP_TAC (SPECL[`f:A->A`; `2`; `y:A`] card_orbit_le)\r
1109    THEN ASM_REWRITE_TAC[ARITH; POWER_2; o_DEF] THEN DISCH_TAC\r
1110    THEN REMOVE_THEN "c8" (MP_TAC o (SPEC `y:A`)) THEN ASM_REWRITE_TAC[IN]\r
1111    THEN POP_ASSUM MP_TAC THEN ARITH_TAC);;\r
1112 \r
1113 (* Definition of connected hypermap *)\r
1114 \r
1115 let connected_hypermap = new_definition `connected_hypermap (H:(A)hypermap) <=> number_of_components H = 1`;;\r
1116 \r
1117 \r
1118 (* Some facts on sets with one element or two elements *)\r
1119 \r
1120 let CARD_SINGLETON = prove(`!x:A. CARD{x} = 1`,  GEN_TAC THEN ASSUME_TAC (CONJUNCT1 CARD_CLAUSES)\r
1121   THEN ASSUME_TAC (CONJUNCT1 FINITE_RULES) THEN MP_TAC(SPECL[`x:A`;`{}:A->bool`] (CONJUNCT2 CARD_CLAUSES))\r
1122   THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ARITH_TAC);;\r
1123 \r
1124 let FINITE_SINGLETON = prove(`!x:A. FINITE {x}`, \r
1125   REPEAT STRIP_TAC THEN ASSUME_TAC (CONJUNCT1 FINITE_RULES)\r
1126   THEN MP_TAC (ISPECL[`x:A`; `{}:A->bool`] (CONJUNCT2 FINITE_RULES))\r
1127   THEN ASM_REWRITE_TAC[]);;\r
1128 \r
1129 let CARD_TWO_ELEMENTS = prove(`!x:A y:A. ~(x = y) ==> CARD {x ,y} = 2`,\r
1130   REPEAT STRIP_TAC\r
1131   THEN ASSUME_TAC(SPEC `y:A` FINITE_SINGLETON)\r
1132   THEN ASSUME_TAC(SPEC `y:A` CARD_SINGLETON)\r
1133   THEN MP_TAC(SPECL[`x:A`; `{y:A}`] (CONJUNCT2 CARD_CLAUSES))\r
1134   THEN ASM_REWRITE_TAC[IN_SING; TWO]);;\r
1135 \r
1136 let FINITE_TWO_ELEMENTS = prove(`!x:A y:A. FINITE {x ,y}`,\r
1137   REPEAT STRIP_TAC THEN ASSUME_TAC(SPEC `y:A` FINITE_SINGLETON)\r
1138   THEN MP_TAC(SPECL[`x:A`; `{y:A}`] (CONJUNCT2 FINITE_RULES))\r
1139   THEN ASM_REWRITE_TAC[]);;\r
1140 \r
1141 let CARD_ATLEAST_1 = prove(`!s:A->bool x:A. FINITE s /\ x IN s ==> 1 <= CARD s`,\r
1142   REPEAT STRIP_TAC\r
1143   THEN SUBGOAL_THEN `{x:A} SUBSET s` ASSUME_TAC\r
1144   THENL[ASM_ASM_SET_TAC; ALL_TAC]\r
1145   THEN ASSUME_TAC(SPEC `x:A` CARD_SINGLETON)\r
1146   THEN MP_TAC (SPECL[`{x:A}`; `s:A->bool`] CARD_SUBSET)\r
1147   THEN ASM_REWRITE_TAC[]);;\r
1148 \r
1149 let CARD_ATLEAST_2 = prove(`!s:A->bool x:A y:A. FINITE s /\ x IN s /\ y IN s /\ ~(x = y) ==> 2 <= CARD s`,\r
1150   REPEAT STRIP_TAC\r
1151   THEN SUBGOAL_THEN `{x:A, y:A} SUBSET s` ASSUME_TAC\r
1152   THENL[ASM_ASM_SET_TAC; ALL_TAC]\r
1153   THEN MP_TAC(SPECL[`x:A`;`y:A`] CARD_TWO_ELEMENTS)\r
1154   THEN ASM_REWRITE_TAC[]\r
1155   THEN DISCH_THEN (SUBST1_TAC o SYM)\r
1156   THEN MP_TAC(SPECL[`{x:A, y:A}`; `s:A->bool`] CARD_SUBSET)\r
1157   THEN ASM_REWRITE_TAC[]);;\r
1158 \r
1159 let orbit_single_lemma = prove(`!f:A->A x:A y:A. orbit_map f y = {x} ==> x = y`,\r
1160    REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV\r
1161    THEN REWRITE_TAC[GSYM IN_SING]\r
1162    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
1163    THEN MP_TAC (SPECL[`f:A->A`; `0`; `y:A`] lemma_in_orbit)\r
1164    THEN REWRITE_TAC[POWER_0; I_THM]);;\r
1165 \r
1166 (* Some lemmas about counting the orbits of a permutation *)\r
1167 \r
1168 let finite_orbits_lemma = prove(`!D:A->bool p:A->A. (FINITE D /\ p permutes D) ==> FINITE (set_of_orbits D p)`, \r
1169    REPEAT STRIP_TAC THEN SUBGOAL_THEN `IMAGE (\x:A. orbit_map (p:A->A) x) (D:A->bool) = set_of_orbits D p` ASSUME_TAC \r
1170    THENL[REWRITE_TAC[EXTENSION] THEN STRIP_TAC THEN EQ_TAC THENL[REWRITE_TAC[set_of_orbits;IMAGE;IN;IN_ELIM_THM];ALL_TAC] \r
1171    THEN REWRITE_TAC[set_of_orbits;IMAGE;IN;IN_ELIM_THM];ALL_TAC] \r
1172    THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) \r
1173    THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[]);;\r
1174 \r
1175 let lemma_disjoints = prove(`!(s:(A->bool)->bool) (t:A->bool). (!(v:A->bool). v IN s ==> DISJOINT t v) ==> DISJOINT t (UNIONS s)`, SET_TAC[]);;\r
1176 \r
1177 let lemma_partition = prove( `!s:A->bool p:A->A. FINITE s /\ p permutes s ==> s = UNIONS (set_of_orbits s p)`,\r
1178    REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION;IN_UNIONS] THEN  GEN_TAC THEN EQ_TAC \r
1179    THENL[MP_TAC (ISPECL[`p:A->A`;`x:A`] orbit_reflect) THEN REWRITE_TAC[set_of_orbits] \r
1180       THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(orbit_map p x):A->bool` THEN (ASM_ASM_SET_TAC); \r
1181       DISCH_THEN(X_CHOOSE_THEN `t:A->bool` MP_TAC) THEN REWRITE_TAC[IN_ELIM_THM;set_of_orbits] \r
1182       THEN STRIP_TAC THEN FIRST_ASSUM SUBST_ALL_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP  orbit_subset) THEN ASM_ASM_SET_TAC]);;\r
1183 \r
1184 let lemma_card_of_disjoint_covering = prove(`!(t:(A->bool)->bool). (FINITE t /\ (!u:A->bool. u IN t ==> FINITE u) \r
1185    /\ (!(s1:A->bool) (s2:A->bool). s1 IN t /\ s2 IN t /\ ~(s1 = s2) ==> DISJOINT s1 s2)) ==> CARD (UNIONS t) = nsum t (\u. CARD u)`,\r
1186    GEN_TAC\r
1187    THEN ABBREV_TAC `n = CARD (t:(A->bool)->bool)`\r
1188    THEN POP_ASSUM (MP_TAC)\r
1189    THEN REWRITE_TAC[IMP_IMP]\r
1190    THEN SPEC_TAC(`t:(A->bool)->bool`, `t:(A->bool)->bool`)\r
1191    THEN SPEC_TAC(`n:num`, `n:num`)\r
1192    THEN INDUCT_TAC\r
1193    THENL[REPEAT STRIP_TAC\r
1194        THEN UNDISCH_TAC `CARD (t:(A->bool)->bool) = 0`\r
1195        THEN UNDISCH_TAC `FINITE (t:(A->bool)->bool)`\r
1196        THEN REWRITE_TAC[IMP_IMP; GSYM HAS_SIZE; HAS_SIZE_0]\r
1197        THEN DISCH_THEN SUBST_ALL_TAC\r
1198        THEN REWRITE_TAC[SET_RULE `UNIONS {} = {}`]\r
1199        THEN REWRITE_TAC[CARD_CLAUSES; NSUM_CLAUSES]; ALL_TAC]\r
1200    THEN GEN_TAC\r
1201    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))))\r
1202    THEN MP_TAC (SPEC `n:num` NON_ZERO)\r
1203    THEN USE_THEN "F2" (SUBST1_TAC o SYM)\r
1204    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP CARD_EQ_0 th])\r
1205    THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]\r
1206    THEN DISCH_THEN (X_CHOOSE_THEN `u:A->bool` (LABEL_TAC "F6"))\r
1207    THEN SUBGOAL_THEN `FINITE (UNIONS (t:(A->bool)->bool))` (LABEL_TAC "F7")\r
1208    THENL[USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP FINITE_FINITE_UNIONS th])\r
1209        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
1210    THEN SUBGOAL_THEN `UNIONS (t:(A->bool)->bool) = (UNIONS (t DELETE (u:A->bool))) UNION u` (LABEL_TAC "F8")\r
1211    THENL[ASM_ASM_SET_TAC; ALL_TAC]\r
1212    THEN SUBGOAL_THEN `DISJOINT (UNIONS ((t:(A->bool)->bool) DELETE (u:A->bool))) u` (LABEL_TAC "F9")\r
1213    THENL[REWRITE_TAC[DISJOINT; INTER; EXTENSION; IN_ELIM_THM]\r
1214        THEN GEN_TAC\r
1215        THEN EQ_TAC\r
1216        THENL[REWRITE_TAC[IN_UNIONS]\r
1217           THEN STRIP_TAC\r
1218           THEN SUBGOAL_THEN `~(DISJOINT (u:A->bool) (t':A->bool))` ASSUME_TAC\r
1219           THENL[REWRITE_TAC[IN_DISJOINT]\r
1220               THEN EXISTS_TAC `x:A`\r
1221               THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])); ALL_TAC]\r
1222           THEN UNDISCH_TAC `t':A->bool IN (t:(A->bool)->bool) DELETE (u:A->bool)`\r
1223           THEN REWRITE_TAC[IN_DELETE]\r
1224           THEN STRIP_TAC\r
1225           THEN USE_THEN "F5" (MP_TAC o SPECL[`t':A->bool`; `u:A->bool`])\r
1226           THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
1227           THEN USE_THEN "F6" (fun th -> REWRITE_TAC[th])\r
1228           THEN ONCE_REWRITE_TAC[DISJOINT_SYM]\r
1229           THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
1230        THEN MESON_TAC[NOT_IN_EMPTY]; ALL_TAC]\r
1231    THEN USE_THEN "F3" (MP_TAC o ISPEC `u:A->bool` o  MATCH_MP CARD_DELETE)\r
1232    THEN USE_THEN "F6" (fun th -> REWRITE_TAC[th])\r
1233    THEN REMOVE_THEN "F2" SUBST1_TAC\r
1234    THEN REWRITE_TAC[ADD1; ADD_SUB]\r
1235    THEN DISCH_TAC\r
1236    THEN FIRST_X_ASSUM (MP_TAC o SPEC`(t:(A->bool)->bool) DELETE (u:A->bool)`)\r
1237    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
1238    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP FINITE_DELETE_IMP th])\r
1239    THEN SUBGOAL_THEN `!(u':A->bool). u' IN ((t:(A->bool)->bool) DELETE (u:A->bool)) ==> FINITE u'` (fun th -> REWRITE_TAC[th])\r
1240    THENL[REWRITE_TAC[IN_DELETE]\r
1241        THEN USE_THEN "F4" (fun th -> MESON_TAC[SPEC `u':A->bool` th]); ALL_TAC]\r
1242    THEN SUBGOAL_THEN `!s1:A->bool s2:A->bool. s1 IN ((t:(A->bool)->bool) DELETE (u:A->bool)) /\ s2 IN ((t:(A->bool)->bool) DELETE (u:A->bool)) /\ ~(s1 = s2) ==> DISJOINT s1 s2` (fun th -> REWRITE_TAC[th])\r
1243    THENL[REWRITE_TAC[IN_DELETE]\r
1244        THEN REMOVE_THEN "F5" (fun th -> MESON_TAC[th]); ALL_TAC]\r
1245    THEN DISCH_TAC\r
1246    THEN SUBGOAL_THEN `CARD (UNIONS (t:(A->bool)->bool)) = CARD(UNIONS (t DELETE (u:A->bool))) + CARD (u:A->bool)` ASSUME_TAC\r
1247    THENL[USE_THEN "F8" SUBST1_TAC\r
1248        THEN MATCH_MP_TAC CARD_UNION\r
1249        THEN USE_THEN "F9" (MP_TAC o REWRITE_RULE[DISJOINT])\r
1250        THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
1251        THEN USE_THEN "F6" (fun th -> (USE_THEN "F4" (fun ths -> REWRITE_TAC[MATCH_MP ths th])))\r
1252        THEN USE_THEN "F7" MP_TAC\r
1253        THEN USE_THEN "F8" SUBST1_TAC\r
1254        THEN REWRITE_TAC[FINITE_UNION]\r
1255        THEN SIMP_TAC[]; ALL_TAC]\r
1256    THEN USE_THEN "F3" (fun th -> (USE_THEN "F6" (fun th1 -> (MP_TAC (SPEC `(\u:A->bool. CARD u)` (MATCH_MP NSUM_DELETE  (CONJ th th1)))))))\r
1257    THEN POP_ASSUM MP_TAC\r
1258    THEN POP_ASSUM SUBST1_TAC\r
1259    THEN DISCH_THEN SUBST1_TAC\r
1260    THEN REWRITE_TAC[]\r
1261    THEN ARITH_TAC);;\r
1262 \r
1263 let card_partition_formula = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> CARD s = nsum (set_of_orbits s p) (\u:A->bool. CARD u)`,\r
1264    REPEAT GEN_TAC\r
1265    THEN DISCH_THEN (LABEL_TAC "F1")\r
1266    THEN USE_THEN "F1" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)  [MATCH_MP lemma_partition th])\r
1267    THEN MATCH_MP_TAC lemma_card_of_disjoint_covering\r
1268    THEN USE_THEN "F1" (fun th -> REWRITE_TAC [MATCH_MP finite_orbits_lemma th])\r
1269    THEN STRIP_TAC\r
1270    THENL[GEN_TAC\r
1271        THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
1272        THEN STRIP_TAC\r
1273        THEN POP_ASSUM SUBST1_TAC\r
1274        THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_orbit_finite th]); ALL_TAC]\r
1275    THEN REPEAT GEN_TAC\r
1276    THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
1277    THEN STRIP_TAC\r
1278    THEN POP_ASSUM MP_TAC\r
1279    THEN ASM_REWRITE_TAC[]\r
1280    THEN REWRITE_TAC[DISJOINT]\r
1281    THEN USE_THEN "F1" (MP_TAC o SPECL[`x:A`; `x':A`] o MATCH_MP partition_orbit)\r
1282    THEN MESON_TAC[]);;\r
1283 \r
1284 let lemma_card_lower_bound = prove(`!s:A->bool p:A->A m:num. FINITE s /\ p permutes s /\ (!x:A. x IN s ==> m <= CARD(orbit_map p x)) \r
1285    ==> (m * (number_of_orbits s p) <= CARD s)`,\r
1286    REPEAT GEN_TAC\r
1287    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
1288    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (LABEL_TAC "F4" (MATCH_MP finite_orbits_lemma (CONJ th1 th2))))))\r
1289    THEN SUBGOAL_THEN `!x:(A->bool). x IN set_of_orbits s p ==> (\u:A->bool. (m:num)) x <= (\u:A->bool. CARD u) x` ASSUME_TAC\r
1290    THENL[GEN_TAC\r
1291        THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
1292        THEN STRIP_TAC\r
1293        THEN POP_ASSUM SUBST1_TAC\r
1294        THEN REMOVE_THEN "F3" (MP_TAC o SPEC `x':A`)\r
1295        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
1296    THEN USE_THEN "F4" (fun th1 -> (POP_ASSUM (fun th2 -> (MP_TAC (MATCH_MP NSUM_LE (CONJ th1 th2))))))\r
1297    THEN USE_THEN "F4" (fun th -> REWRITE_TAC[MATCH_MP NSUM_CONST th])\r
1298    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC [GSYM(MATCH_MP card_partition_formula (CONJ th1 th2))])))\r
1299    THEN REWRITE_TAC[GSYM number_of_orbits]\r
1300    THEN ARITH_TAC);;\r
1301 \r
1302 let lemma_card_eq = prove(`!(s:A->bool) p:A->A m:num. FINITE s /\ p permutes s /\ (!x:A. x IN s ==> CARD(orbit_map p x) = m) \r
1303    ==> CARD s = m * (number_of_orbits s p)`,\r
1304    REPEAT GEN_TAC\r
1305    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3" o GSYM)))\r
1306    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (LABEL_TAC "F4" (MATCH_MP finite_orbits_lemma (CONJ th1 th2))))))\r
1307    THEN SUBGOAL_THEN `!x:(A->bool). x IN set_of_orbits s p ==> (\u:A->bool. (m:num)) x = (\u:A->bool. CARD u) x` ASSUME_TAC\r
1308    THENL[GEN_TAC\r
1309        THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
1310        THEN STRIP_TAC\r
1311        THEN POP_ASSUM SUBST1_TAC\r
1312        THEN REMOVE_THEN "F3" (MP_TAC o SPEC `x':A`)\r
1313        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
1314    THEN POP_ASSUM (fun th2 -> (MP_TAC (MATCH_MP NSUM_EQ th2)))   \r
1315    THEN USE_THEN "F4" (fun th -> REWRITE_TAC[MATCH_MP NSUM_CONST th])\r
1316    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC [GSYM(MATCH_MP card_partition_formula (CONJ th1 th2))])))\r
1317    THEN REWRITE_TAC[GSYM number_of_orbits]\r
1318    THEN ARITH_TAC);;\r
1319 \r
1320 let lemma_orbit_convolution_map = prove(`!p:A->A. p o p = I ==> (!x:A. orbit_map p x = {x, p x})`,\r
1321    REPEAT STRIP_TAC\r
1322    THEN POP_ASSUM (fun th -> MP_TAC (AP_THM th `x:A`))\r
1323    THEN REWRITE_TAC[GSYM POWER_2; I_THM]\r
1324    THEN MP_TAC (ARITH_RULE `~(2 = 0)`)\r
1325    THEN REWRITE_TAC[IMP_IMP]\r
1326    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP orbit_cyclic th])\r
1327    THEN REWRITE_TAC[TWO; LT_SUC_LE]\r
1328    THEN REWRITE_TAC[EXPAND_SET_TWO_ELEMENTS; POWER_0; POWER_1; I_THM]);;\r
1329 \r
1330 let lemma_nondegenerate_convolution = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s /\ p o p = I /\ \r
1331    (!x:A. x IN s ==> ~(p x = x)) ==> (!x:A. x IN s ==> FINITE (orbit_map p x) /\ CARD(orbit_map p x) = 2)`,\r
1332    REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2")(CONJUNCTS_THEN2 (LABEL_TAC "F3")(LABEL_TAC "F4"))))\r
1333    THEN GEN_TAC THEN (DISCH_THEN(LABEL_TAC "F5")) THEN USE_THEN "F2"(MP_TAC o SPEC `x:A` o MATCH_MP orbit_subset) THEN ASM_REWRITE_TAC[]\r
1334    THEN DISCH_THEN (LABEL_TAC "F6") THEN \r
1335    USE_THEN "F1"(fun th1 -> (USE_THEN "F6"(fun th2 -> (MP_TAC(MATCH_MP FINITE_SUBSET (CONJ th1 th2))))))\r
1336    THEN DISCH_THEN(LABEL_TAC "F7") THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`p:A->A`;`2`;`x:A`] card_orbit_le)\r
1337    THEN ASM_REWRITE_TAC[ARITH; SPEC `(p:A->A)` POWER_2;I_THM] THEN DISCH_THEN(LABEL_TAC "F8")\r
1338    THEN MP_TAC(ISPECL[`p:A->A`;`1`; `x:A`; `(p:A->A) (x:A)`] in_orbit_lemma) THEN REWRITE_TAC[POWER_1]\r
1339    THEN DISCH_THEN(LABEL_TAC "F9") THEN LABEL_TAC "F10" (ISPECL[`p:A->A`;`x:A`] orbit_reflect)\r
1340    THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (MP_TAC o REWRITE_RULE[th] o SPEC `x:A`))\r
1341    THEN USE_THEN "F10" MP_TAC THEN USE_THEN "F9" MP_TAC THEN USE_THEN "F7" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
1342    THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_ATLEAST_2)\r
1343    THEN USE_THEN "F8" MP_TAC THEN REWRITE_TAC[IMP_IMP; LE_ANTISYM]);;\r
1344 \r
1345 let lemmaTGJISOK = prove(`!H:(A)hypermap. connected_hypermap H /\ plain_hypermap H /\ planar_hypermap H /\\r
1346    (!x:A. x IN (dart H) ==> ~(edge_map H x = x) /\ (3 <= CARD(node H x))) \r
1347    ==> (CARD (dart H) <= (6*(number_of_faces H)-12))`,\r
1348 \r
1349    GEN_TAC THEN REWRITE_TAC[connected_hypermap; plain_hypermap; planar_hypermap]\r
1350    THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC) (MP_TAC )) THEN POP_ASSUM SUBST1_TAC THEN SIMP_TAC[ARITH]\r
1351    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
1352    THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==> CARD (edge H x) = 2` MP_TAC\r
1353    THENL[MP_TAC(SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] lemma_nondegenerate_convolution)\r
1354        THEN REWRITE_TAC[edge_map_and_darts; GSYM edge]\r
1355        THEN ASM_SIMP_TAC[]; ALL_TAC]\r
1356    THEN REWRITE_TAC[edge]\r
1357    THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_card_eq(REWRITE_RULE[GSYM CONJ_ASSOC] (CONJ (SPEC `H:(A)hypermap` edge_map_and_darts) th)))))\r
1358    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [number_of_orbits]\r
1359    THEN REWRITE_TAC[GSYM edge_set; GSYM number_of_edges]\r
1360    THEN DISCH_THEN (LABEL_TAC "F4")\r
1361    THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==> 3 <= CARD (node H x)` MP_TAC\r
1362    THENL[ASM_SIMP_TAC[]; ALL_TAC]\r
1363    THEN REWRITE_TAC[node]\r
1364    THEN DISCH_THEN (fun th->(MP_TAC (MATCH_MP lemma_card_lower_bound(REWRITE_RULE[GSYM CONJ_ASSOC] (CONJ (SPEC `H:(A)hypermap` node_map_and_darts) th)))))\r
1365    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [number_of_orbits]\r
1366    THEN REWRITE_TAC[GSYM node_set; GSYM number_of_nodes]\r
1367    THEN DISCH_TAC\r
1368    THEN REMOVE_THEN "F2" MP_TAC\r
1369    THEN POP_ASSUM MP_TAC\r
1370    THEN REMOVE_THEN "F4" SUBST1_TAC\r
1371    THEN ARITH_TAC);;\r
1372 \r
1373 (* We set up some lemmas on combinatorial commponents *)\r
1374 \r
1375 let lemma_subpath = prove(`!H:(A)hypermap p:num->A n:num. is_path H p n ==> (!i. i <= n ==> is_path H p i)`,\r
1376    REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[ SIMP_TAC[is_path; CONJUNCT1 LE]; ALL_TAC] \r
1377    THEN STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LE] THEN STRIP_TAC  \r
1378    THENL[ASM_REWRITE_TAC[]; UNDISCH_TAC `is_path (H:(A)hypermap) (p:num->A) (SUC n)` THEN ASM_REWRITE_TAC[is_path] THEN ASM_MESON_TAC[]]);;\r
1379 \r
1380 let lemma_path_subset = prove(`!H:(A)hypermap x:A p:num->A n:num. (x IN dart H) /\ (p 0 = x) /\ (is_path H p n) ==> p n IN dart H`,\r
1381    REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL[SIMP_TAC[is_path;go_one_step];ALL_TAC]\r
1382    THEN REWRITE_TAC[is_path]\r
1383    THEN DISCH_THEN (fun th-> POP_ASSUM (ASSUME_TAC o REWRITE_RULE[th]) THEN (MP_TAC(REWRITE_RULE[go_one_step] (CONJUNCT2(CONJUNCT2(CONJUNCT2 th))))))\r
1384    THEN STRIP_TAC\r
1385    THENL[POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]);\r
1386        POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]); ALL_TAC]\r
1387    THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]));;\r
1388 \r
1389 let lemma_component_subset = prove(`!H:(A)hypermap x:A. x IN dart H ==> comb_component H x SUBSET dart H`, \r
1390    REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC(SPEC `H:(A)hypermap` hypermap_lemma) \r
1391    THEN REWRITE_TAC[SUBSET;IN_ELIM_THM;comb_component] \r
1392    THEN GEN_TAC THEN REWRITE_TAC[is_in_component] THEN ASM_MESON_TAC[lemma_path_subset]);;\r
1393 \r
1394 let lemma_edge_subset = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> edge H x SUBSET dart H`, \r
1395    REWRITE_TAC[edge] THEN MESON_TAC[edge_map_and_darts; orbit_subset]);;\r
1396 \r
1397 let lemma_node_subset = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> node H x SUBSET dart H`, \r
1398    REWRITE_TAC[node] THEN MESON_TAC[ node_map_and_darts; orbit_subset]);;\r
1399 \r
1400 let lemma_face_subset = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> face H x SUBSET dart H`, \r
1401    REWRITE_TAC[face] THEN MESON_TAC[face_map_and_darts; orbit_subset]);;\r
1402 \r
1403 let lemma_component_reflect = prove(`!H:(A)hypermap x:A. x IN comb_component H x`, \r
1404    REPEAT STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component;is_in_component] \r
1405    THEN EXISTS_TAC `(\k:num. x:A)` THEN EXISTS_TAC `0` THEN MESON_TAC[is_path]);;\r
1406 \r
1407 (* The definition of path is exactly here *)\r
1408 \r
1409 let lemma_def_path = prove(`!H:(A)hypermap p:num->A n:num.(is_path H p n <=> (!i:num. i < n ==> go_one_step H (p i) (p (SUC i))))`,\r
1410    REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC \r
1411    THENL[REWRITE_TAC[is_path] THEN ARITH_TAC; ALL_TAC] \r
1412    THEN ASM_REWRITE_TAC[is_path]\r
1413    THEN REWRITE_TAC[lemma_add_one_assumption_lt]);;\r
1414 \r
1415 (* Three special paths *)\r
1416 \r
1417 let edge_path = new_definition `!(H:(A)hypermap) (x:A) (i:num). edge_path H x i  = ((edge_map H) POWER i) x`;;\r
1418 \r
1419 let node_path = new_definition `!(H:(A)hypermap) (x:A) (i:num). node_path H x i  = ((node_map H) POWER i) x`;;\r
1420 \r
1421 let face_path = new_definition `!(H:(A)hypermap) (x:A) (i:num). face_path H x i  = ((face_map H) POWER i) x`;;\r
1422 \r
1423 let lemma_edge_path = prove(`!(H:(A)hypermap) (x:A) k:num. is_path H (edge_path H x) k`,\r
1424    REPLICATE_TAC 2 GEN_TAC\r
1425      THEN INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC]\r
1426      THEN REWRITE_TAC[is_path] THEN ASM_REWRITE_TAC[]\r
1427      THEN REWRITE_TAC[go_one_step] THEN DISJ1_TAC THEN REWRITE_TAC[edge_path; COM_POWER; o_THM]);;\r
1428 \r
1429 let lemma_node_path = prove(`!(H:(A)hypermap) (x:A) k:num. is_path H (node_path H x) k`,\r
1430    REPLICATE_TAC 2 GEN_TAC\r
1431      THEN INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC]\r
1432      THEN REWRITE_TAC[is_path] THEN ASM_REWRITE_TAC[]\r
1433      THEN REWRITE_TAC[go_one_step] THEN DISJ2_TAC THEN DISJ1_TAC THEN REWRITE_TAC[node_path; COM_POWER; o_THM]);;\r
1434 \r
1435 let lemma_face_path = prove(`!(H:(A)hypermap) (x:A) k:num. is_path H (face_path H x) k`,\r
1436    REPLICATE_TAC 2 GEN_TAC\r
1437      THEN INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC]\r
1438      THEN REWRITE_TAC[is_path] THEN ASM_REWRITE_TAC[]\r
1439      THEN REWRITE_TAC[go_one_step] THEN DISJ2_TAC THEN DISJ2_TAC  THEN REWRITE_TAC[face_path; COM_POWER; o_THM]);;\r
1440 \r
1441 (* Some lemmas on concatenate paths *)\r
1442 \r
1443 let lemma_glue_paths = prove(`!(H:(A)hypermap) p:num->A q:num->A n:num m:num. is_path H p n /\ is_path H q m /\  (p n = q 0) \r
1444    ==> is_path H (glue p q n) (n + m)`,\r
1445    REPEAT GEN_TAC\r
1446    THEN REWRITE_TAC[lemma_def_path]\r
1447    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
1448    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4")\r
1449    THEN ASM_CASES_TAC `i:num < n:num`\r
1450    THENL[POP_ASSUM (LABEL_TAC "F5")\r
1451        THEN USE_THEN "F5" (fun th -> (MP_TAC (MATCH_MP LT_IMP_LE th)) THEN ASSUME_TAC (REWRITE_RULE[GSYM LE_SUC_LT] th))\r
1452        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th])\r
1453        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th])\r
1454        THEN POP_ASSUM (fun th-> USE_THEN "F1" (fun thm -> REWRITE_TAC[MATCH_MP thm th])); ALL_TAC]\r
1455    THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[NOT_LT])\r
1456    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS])\r
1457    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC)\r
1458    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
1459    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2(GSYM ADD)]\r
1460    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
1461    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
1462    THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[GSYM ADD1; LT_ADD_LCANCEL; LT_SUC])\r
1463    THEN DISCH_THEN(fun th-> USE_THEN "F2" (fun thm -> REWRITE_TAC[MATCH_MP thm th])));;\r
1464 \r
1465 let concatenate_two_paths = prove(`!H:(A)hypermap p:num->A q:num->A n:num m:num. is_path H p n /\ is_path H q m /\ (p n = q 0) \r
1466 ==> ?g:num->A. g 0 = p 0 /\ g (n+m) = q m /\ is_path H g (n+m) /\ (!i:num. i <= n ==> g i = p i) /\ (!i:num. i <= m ==> g (n+i) = q i)`,\r
1467    REPEAT GEN_TAC\r
1468    THEN DISCH_THEN ASSUME_TAC\r
1469    THEN EXISTS_TAC `glue (p:num->A) (q:num->A) (n:num)`\r
1470    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_glue_paths th] THEN ASSUME_TAC (CONJUNCT2 (CONJUNCT2 th)))\r
1471    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
1472    THEN SIMP_TAC[glue; LE_0; COND_ELIM_THM]);;\r
1473 \r
1474 let concatenate_paths = prove(`!H:(A)hypermap p:num->A q:num->A n:num m:num. is_path H p n /\ is_path H q m /\ (p n = q 0) \r
1475    ==> ?g:num->A. g 0 = p 0 /\ g (n+m) = q m /\ is_path H g (n+m)`,\r
1476    REPEAT GEN_TAC\r
1477    THEN DISCH_THEN (MP_TAC o MATCH_MP concatenate_two_paths) THEN MESON_TAC[]);;\r
1478 \r
1479 let lemma_component_trans = prove(`!H:(A)hypermap x:A y:A z:A. y IN comb_component H x /\ z IN comb_component H y \r
1480    ==> z IN comb_component H x`, \r
1481    REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component; is_in_component] \r
1482    THEN REPEAT STRIP_TAC \r
1483    THEN MP_TAC(ISPECL[`H:(A)hypermap`; `p:num->A`;`p':num->A`;`n:num`;`n':num`] concatenate_paths) \r
1484    THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);;\r
1485 \r
1486 let lemma_reverse_path = prove(`!H:(A)hypermap p:num->A n:num. is_path H p n ==> ?q:num->A m:num. q 0 = p n /\ q m = p 0 /\ is_path H q m`,\r
1487    REPLICATE_TAC 2 GEN_TAC\r
1488    THEN INDUCT_TAC\r
1489    THENL[REWRITE_TAC[is_path]\r
1490        THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `0`\r
1491        THEN REWRITE_TAC[is_path]; ALL_TAC]\r
1492    THEN REWRITE_TAC[is_path]\r
1493    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
1494    THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))\r
1495    THEN REMOVE_THEN "F1" (fun th -> REWRITE_TAC[th])\r
1496    THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A`(X_CHOOSE_THEN `m:num`(CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))))\r
1497    THEN USE_THEN "F2" MP_TAC\r
1498    THEN REWRITE_TAC[go_one_step]\r
1499    THEN STRIP_TAC\r
1500    THENL[MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma)\r
1501       THEN DISCH_THEN (fun th-> (POP_ASSUM (fun th1 -> (MP_TAC (MATCH_MP inverse_relation (CONJ (CONJUNCT1 th) (CONJ (CONJUNCT1(CONJUNCT2 th)) th1)))))))\r
1502       THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC)\r
1503       THEN REWRITE_TAC[GSYM edge_path]\r
1504       THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
1505       THEN USE_THEN "F5"(fun th1->(DISCH_THEN(fun th->(MP_TAC(MATCH_MP concatenate_two_paths (CONJ (SPECL[`H:(A)hypermap`; `(p:num->A) (SUC n)`; `k:num`] lemma_edge_path) (CONJ th1 (SYM th))))))))\r
1506       THEN STRIP_TAC\r
1507       THEN EXISTS_TAC `g':num->A`\r
1508       THEN EXISTS_TAC `(k:num) + (m:num)`\r
1509       THEN ASM_REWRITE_TAC[edge_path; POWER_0; I_THM];\r
1510     MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma)\r
1511       THEN DISCH_THEN(fun th->(POP_ASSUM(fun th1->(MP_TAC(MATCH_MP inverse_relation (CONJ(CONJUNCT1 th)(CONJ(CONJUNCT1(CONJUNCT2(CONJUNCT2 th))) th1)))))))\r
1512       THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC)\r
1513       THEN REWRITE_TAC[GSYM node_path]\r
1514       THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
1515       THEN USE_THEN "F5" (fun th1 -> (DISCH_THEN (fun th ->  (MP_TAC (MATCH_MP concatenate_two_paths (CONJ (SPECL[`H:(A)hypermap`; `(p:num->A) (SUC n)`; `k:num`] lemma_node_path) (CONJ th1 (SYM th))))))))\r
1516       THEN STRIP_TAC\r
1517       THEN EXISTS_TAC `g':num->A`\r
1518       THEN EXISTS_TAC `(k:num) + (m:num)`\r
1519       THEN ASM_REWRITE_TAC[node_path; POWER_0; I_THM]; ALL_TAC]\r
1520    THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma)\r
1521    THEN DISCH_THEN (fun th-> (POP_ASSUM (fun th1 -> (MP_TAC (MATCH_MP inverse_relation (CONJ (CONJUNCT1 th) (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2 th)))) th1)))))))\r
1522    THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC)\r
1523    THEN REWRITE_TAC[GSYM face_path]\r
1524    THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
1525    THEN USE_THEN "F5" (fun th1 -> (DISCH_THEN (fun th ->  (MP_TAC (MATCH_MP concatenate_two_paths (CONJ (SPECL[`H:(A)hypermap`; `(p:num->A) (SUC n)`; `k:num`] lemma_face_path) (CONJ th1 (SYM th))))))))\r
1526    THEN STRIP_TAC\r
1527    THEN EXISTS_TAC `g':num->A`\r
1528    THEN EXISTS_TAC `(k:num) + (m:num)`\r
1529    THEN ASM_REWRITE_TAC[face_path; POWER_0; I_THM]);;\r
1530 \r
1531 let lemma_component_symmetry = prove(`!H:(A)hypermap x:A y:A. y IN comb_component H x \r
1532    ==> x IN comb_component H y`,\r
1533    REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component; is_in_component] \r
1534    THEN REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_reverse_path) \r
1535    THEN ASM_REWRITE_TAC[]);;\r
1536 \r
1537 let partition_components = prove(`!(H:(A)hypermap) x:A y:A. \r
1538    comb_component H x = comb_component H y \/ comb_component H x INTER comb_component H y ={}`, \r
1539    REPEAT GEN_TAC THEN ASM_CASES_TAC `comb_component (H:(A)hypermap) (x:A) INTER comb_component H (y:A) ={}` \r
1540    THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] \r
1541    THEN DISCH_THEN (X_CHOOSE_THEN `t:A` MP_TAC) THEN REWRITE_TAC[INTER; IN_ELIM_THM] \r
1542    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[EXTENSION] \r
1543    THEN GEN_TAC THEN  EQ_TAC THENL[USE_THEN "F1" (LABEL_TAC "F3"  o MATCH_MP lemma_component_symmetry) \r
1544    THEN DISCH_THEN (LABEL_TAC "F4") \r
1545    THEN REMOVE_THEN "F4"(fun th1 -> REMOVE_THEN "F3" (fun th2 -> MP_TAC (MATCH_MP lemma_component_trans (CONJ th2 th1)))) \r
1546    THEN DISCH_THEN(fun th1 -> (REMOVE_THEN "F2" (fun th2 -> MP_TAC (MATCH_MP lemma_component_trans (CONJ th2 th1))))) THEN REWRITE_TAC[];ALL_TAC] \r
1547    THEN USE_THEN "F2" (LABEL_TAC "F5"  o MATCH_MP lemma_component_symmetry) \r
1548    THEN DISCH_THEN (LABEL_TAC "F6") \r
1549    THEN REMOVE_THEN "F6"(fun th1 -> REMOVE_THEN "F5" (fun th2 -> MP_TAC (MATCH_MP lemma_component_trans (CONJ th2 th1)))) \r
1550    THEN DISCH_THEN(fun th1 -> (REMOVE_THEN "F1" (fun th2 -> MP_TAC (MATCH_MP lemma_component_trans (CONJ th2 th1))))) \r
1551    THEN REWRITE_TAC[]);;\r
1552 \r
1553 let lemma_partition_by_components = prove(`!(H:(A)hypermap). dart H = UNIONS (set_of_components H)`,\r
1554   GEN_TAC THEN REWRITE_TAC[set_of_components; set_part_components; EXTENSION; IN_UNIONS]\r
1555   THEN GEN_TAC THEN EQ_TAC\r
1556   THENL[STRIP_TAC\r
1557           THEN REWRITE_TAC[IN_ELIM_THM]\r
1558           THEN MP_TAC (SPECL[`H:(A)hypermap`;`x:A`] lemma_component_reflect)\r
1559           THEN ASM_REWRITE_TAC[]\r
1560           THEN STRIP_TAC\r
1561           THEN EXISTS_TAC `comb_component (H:(A)hypermap) (x:A)`\r
1562           THEN ASM_REWRITE_TAC[]\r
1563           THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
1564   THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC\r
1565   THEN FIRST_ASSUM (MP_TAC o MATCH_MP lemma_component_subset) THEN ASM_ASM_SET_TAC);;\r
1566 \r
1567 (* We define the CONTOUR PATHS *)\r
1568 \r
1569 let one_step_contour = new_definition `one_step_contour (H:(A)hypermap) (x:A) (y:A) <=> (y = (face_map H) x) \/ (y = (inverse (node_map H)) x)`;;\r
1570 \r
1571 let is_contour = new_recursive_definition num_RECURSION  `(is_contour (H:(A)hypermap) (p:num->A) 0 <=> T)/\\r
1572             (is_contour (H:(A)hypermap) (p:num->A) (SUC n) <=> ((is_contour H p n) /\ one_step_contour H (p n) (p (SUC n))))`;; \r
1573 \r
1574 let lemma_subcontour = prove(`!H:(A)hypermap p:num->A n:num. is_contour H p n ==> (!i. i <= n ==> is_contour H p i)`,\r
1575    REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC \r
1576    THENL[SIMP_TAC[is_contour; CONJUNCT1 LE]; ALL_TAC] \r
1577    THEN STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LE]\r
1578    THEN STRIP_TAC \r
1579    THENL[ASM_REWRITE_TAC[]; \r
1580    UNDISCH_TAC `is_contour (H:(A)hypermap) (p:num->A) (SUC n)` THEN ASM_REWRITE_TAC[is_contour] THEN ASM_MESON_TAC[]]);;\r
1581 \r
1582 let lemma_def_contour = prove(`!H:(A)hypermap p:num->A n:num.(is_contour H p n <=> (!i:num. i < n ==> one_step_contour H (p i) (p (SUC i))))`,\r
1583    REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC \r
1584    THENL[REWRITE_TAC[is_contour] THEN ARITH_TAC; ALL_TAC] \r
1585    THEN ASM_REWRITE_TAC[is_contour] THEN REWRITE_TAC[lemma_add_one_assumption_lt]);;\r
1586 \r
1587 let lemma_glue_contours = prove(`!(H:(A)hypermap) p:num->A q:num->A n:num m:num. is_contour H p n /\ is_contour H q m /\  (p n = q 0) \r
1588    ==> is_contour H (glue p q n) (n + m)`,\r
1589  REPEAT GEN_TAC\r
1590    THEN REWRITE_TAC[lemma_def_contour]\r
1591    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
1592    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4")\r
1593    THEN ASM_CASES_TAC `i:num < n:num`\r
1594    THENL[POP_ASSUM (LABEL_TAC "F5")\r
1595        THEN USE_THEN "F5" (fun th -> (MP_TAC (MATCH_MP LT_IMP_LE th)) THEN ASSUME_TAC (REWRITE_RULE[GSYM LE_SUC_LT] th))\r
1596        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th])\r
1597        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th])\r
1598        THEN POP_ASSUM (fun th-> USE_THEN "F1" (fun thm -> REWRITE_TAC[MATCH_MP thm th])); ALL_TAC]\r
1599    THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[NOT_LT])\r
1600    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS])\r
1601    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC)\r
1602    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
1603    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2(GSYM ADD)]\r
1604    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
1605    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
1606    THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[GSYM ADD1; LT_ADD_LCANCEL; LT_SUC])\r
1607    THEN DISCH_THEN(fun th-> USE_THEN "F2" (fun thm -> REWRITE_TAC[MATCH_MP thm th])));;\r
1608 \r
1609 let concatenate_contours = prove(`!H:(A)hypermap p:num->A q:num->A n:num m:num. is_contour H p n /\ is_contour  H q m /\ (p n = q 0) \r
1610 ==> ?g:num->A. g 0 = p 0 /\ g (n+m) = q m /\ is_contour H g (n+m) /\ (!i:num. i <= n ==> g i = p i) /\ (!i:num. i <= m ==> g (n+i) = q i)`,\r
1611    REPEAT GEN_TAC\r
1612    THEN DISCH_THEN ASSUME_TAC\r
1613    THEN EXISTS_TAC `glue (p:num->A) (q:num->A) (n:num)`\r
1614    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_glue_contours th] THEN ASSUME_TAC (CONJUNCT2 (CONJUNCT2 th)))\r
1615    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
1616    THEN SIMP_TAC[glue; LE_0; COND_ELIM_THM]);;\r
1617 \r
1618 let node_contour = new_definition `!(H:(A)hypermap) (x:A) (i:num). node_contour H x i = ((inverse (node_map H)) POWER i) x`;;\r
1619 \r
1620 (* face contour is exactly: face_path *)\r
1621 \r
1622 let face_contour = new_definition `!(H:(A)hypermap) (x:A) (i:num). face_contour H x i  = ((face_map H) POWER i) x`;; \r
1623 \r
1624 let lemma_node_contour = prove(`!(H:(A)hypermap) (x:A) (k:num). is_contour H (node_contour H x) k`,\r
1625      REPLICATE_TAC 2 GEN_TAC\r
1626      THEN INDUCT_TAC THENL[REWRITE_TAC[is_contour]; ALL_TAC]\r
1627      THEN REWRITE_TAC[is_contour]\r
1628      THEN ASM_REWRITE_TAC[]\r
1629      THEN REWRITE_TAC[one_step_contour]\r
1630      THEN DISJ2_TAC THEN REWRITE_TAC[node_contour; COM_POWER; o_THM]);;\r
1631 \r
1632 let lemma_face_contour = prove(`!(H:(A)hypermap) (x:A) (k:num). is_contour H (face_contour H x) k`,\r
1633      REPLICATE_TAC 2 GEN_TAC\r
1634      THEN INDUCT_TAC THENL[REWRITE_TAC[is_contour]; ALL_TAC]\r
1635      THEN REWRITE_TAC[is_contour]\r
1636      THEN ASM_REWRITE_TAC[]\r
1637      THEN REWRITE_TAC[one_step_contour]\r
1638      THEN DISJ1_TAC THEN REWRITE_TAC[face_contour; COM_POWER; o_THM]);;\r
1639 \r
1640 let existence_contour = prove(`!(H:(A)hypermap) p:num->A n:num. is_path H p n ==> ?q:num->A m:num. q 0 = p 0 /\ q m = p n /\ is_contour H q m`,\r
1641    REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC\r
1642    THENL[REWRITE_TAC[is_path]\r
1643        THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[is_contour]; ALL_TAC]\r
1644    THEN REWRITE_TAC[is_path]\r
1645    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
1646    THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))\r
1647    THEN REMOVE_THEN "F1" (fun th -> REWRITE_TAC[th])\r
1648    THEN DISCH_THEN (X_CHOOSE_THEN `q:num->A`(X_CHOOSE_THEN `m:num`(CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))))\r
1649    THEN REMOVE_THEN "F2" MP_TAC\r
1650    THEN REWRITE_TAC[go_one_step]\r
1651    THEN STRIP_TAC\r
1652    THENL[ POP_ASSUM (LABEL_TAC "G1")\r
1653        THEN MP_TAC (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `0`] node_contour)\r
1654        THEN REWRITE_TAC[POWER_0; I_THM]\r
1655        THEN USE_THEN "F5" (fun th1 -> (DISCH_THEN (fun th2 -> MP_TAC(MATCH_MP concatenate_contours (CONJ th1 (CONJ (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `1`] lemma_node_contour) (SYM th2)))))))\r
1656        THEN REWRITE_TAC[GSYM ADD1]\r
1657        THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4" o CONJUNCT1))))\r
1658        THEN REMOVE_THEN "G3" MP_TAC\r
1659        THEN REWRITE_TAC[node_contour; POWER_1]\r
1660        THEN DISCH_THEN (LABEL_TAC "G2")\r
1661        THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma)\r
1662        THEN DISCH_THEN (fun th -> MP_TAC(MATCH_MP inverse_element_lemma (CONJ (CONJUNCT1 th) (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2 th)))))))\r
1663        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "G7" o SYM))\r
1664        THEN MP_TAC (SPECL[`H:(A)hypermap`; `(g:num->A) (SUC m)`; `0:num`] face_contour)\r
1665        THEN REWRITE_TAC[POWER_0; I_THM]\r
1666        THEN USE_THEN "G4" (fun th1 -> (DISCH_THEN (fun th2 -> MP_TAC(MATCH_MP concatenate_contours (CONJ th1 (CONJ (SPECL[`H:(A)hypermap`; `(g:num->A) (SUC m)`; `j:num`] lemma_face_contour) (SYM th2)))))))\r
1667        THEN REWRITE_TAC[face_contour]\r
1668        THEN DISCH_THEN (X_CHOOSE_THEN `w:num->A` STRIP_ASSUME_TAC)\r
1669        THEN EXISTS_TAC `w:num->A`\r
1670        THEN EXISTS_TAC `(SUC m) + (j:num)`\r
1671        THEN ASM_REWRITE_TAC[]\r
1672        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM]\r
1673        THEN REWRITE_TAC[GSYM inverse2_hypermap_maps];\r
1674        POP_ASSUM (LABEL_TAC "G1")\r
1675        THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma)\r
1676        THEN DISCH_THEN (fun th -> MP_TAC(MATCH_MP inverse_element_lemma (CONJ (CONJUNCT1 th) (CONJUNCT1(CONJUNCT2(CONJUNCT2 th))))))\r
1677        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "G7" o SYM))\r
1678        THEN MP_TAC (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `0:num`] node_contour)\r
1679        THEN REWRITE_TAC[POWER_0; I_THM]\r
1680        THEN USE_THEN "F5" (fun th1 -> (DISCH_THEN (fun th2 -> MP_TAC(MATCH_MP concatenate_contours (CONJ th1 (CONJ (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `j:num`] lemma_node_contour) (SYM th2)))))))\r
1681        THEN REWRITE_TAC[node_contour]\r
1682        THEN DISCH_THEN (X_CHOOSE_THEN `w:num->A` STRIP_ASSUME_TAC)\r
1683        THEN EXISTS_TAC `w:num->A`\r
1684        THEN EXISTS_TAC `(m:num) + (j:num)`\r
1685        THEN ASM_REWRITE_TAC[]\r
1686        THEN CONV_TAC SYM_CONV\r
1687        THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))]\r
1688        THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM]\r
1689        THEN REWRITE_TAC[GSYM POWER]\r
1690        THEN REWRITE_TAC[COM_POWER; o_THM]\r
1691        THEN USE_THEN "G7" SUBST1_TAC\r
1692        THEN REWRITE_TAC[node_map_inverse_representation]; ALL_TAC]\r
1693    THEN POP_ASSUM (LABEL_TAC "G1")\r
1694    THEN MP_TAC (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `0`] face_contour)\r
1695    THEN REWRITE_TAC[POWER_0; I_THM]\r
1696    THEN USE_THEN "F5" (fun th1 -> (DISCH_THEN (fun th2 -> MP_TAC(MATCH_MP concatenate_contours (CONJ th1 (CONJ (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `1`] lemma_face_contour) (SYM th2)))))))\r
1697    THEN REWRITE_TAC[GSYM ADD1]\r
1698    THEN STRIP_TAC\r
1699    THEN EXISTS_TAC `g:num->A`\r
1700    THEN EXISTS_TAC `(SUC m)`\r
1701    THEN ASM_REWRITE_TAC[face_contour; POWER_1]);;\r
1702 \r
1703 let lemmaKDAEDEX = prove(`!H:(A)hypermap x:A y:A. y IN comb_component H x \r
1704    ==> ?p:num->A n:num. (p 0 = x) /\ (p n = y) /\ (is_contour H p n)`, \r
1705    REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component; is_in_component] \r
1706    THEN REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP existence_contour) \r
1707    THEN REPEAT STRIP_TAC THEN EXISTS_TAC `q:num->A` THEN EXISTS_TAC `m:num` \r
1708    THEN ASM_REWRITE_TAC[]);;\r
1709 \r
1710 \r
1711 (* the definition of injectve contours *)\r
1712 \r
1713 let is_inj_contour = new_recursive_definition num_RECURSION  `(is_inj_contour (H:(A)hypermap) (p:num->A) 0 <=> T) /\ \r
1714         (is_inj_contour (H:(A)hypermap) (p:num->A) (SUC n) <=> ((is_inj_contour H p n) /\ one_step_contour H (p n) (p (SUC n)) /\ \r
1715                  (!i:num. i <= n ==> ~(p i = p (SUC n))) ))`;; \r
1716 \r
1717 let lemma_sub_inj_contour = prove(`!H:(A)hypermap p:num->A n:num. is_inj_contour H p n  ==> (!i. i <= n ==> is_inj_contour H p i)`,\r
1718    REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC \r
1719    THENL[SIMP_TAC[is_inj_contour; CONJUNCT1 LE]; ALL_TAC]\r
1720    THEN SIMP_TAC[lemma_add_one_assumption]\r
1721    THEN POP_ASSUM (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th o CONJUNCT1 o REWRITE_RULE[is_inj_contour]))\r
1722    THEN SIMP_TAC[]);;\r
1723 \r
1724 let identify_inj_contour = prove(`!(H:(A)hypermap) p:num->A q:num->A n:num. is_inj_contour H p n /\ (!i:num. i<= n ==> p i = q i) \r
1725    ==> is_inj_contour H q n`,\r
1726  REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC \r
1727    THENL[STRIP_TAC THEN REWRITE_TAC[is_inj_contour]; ALL_TAC]\r
1728    THEN POP_ASSUM (LABEL_TAC "F1")\r
1729    THEN REWRITE_TAC[is_inj_contour]\r
1730    THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))) MP_TAC)\r
1731    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[lemma_add_one_assumption])\r
1732    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (SUBST1_TAC o SYM))\r
1733    THEN REMOVE_THEN "F1" (fun th-> REMOVE_THEN "F2" (fun th1-> USE_THEN "F5" (fun th2-> REWRITE_TAC[MATCH_MP th (CONJ th1 th2)])))\r
1734    THEN USE_THEN "F5" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `n:num`)\r
1735    THEN REMOVE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
1736    THEN GEN_TAC THEN DISCH_THEN (fun th-> (POP_ASSUM (fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)]) THEN MP_TAC th))\r
1737    THEN ASM_SIMP_TAC[]);;\r
1738 \r
1739 let lemma_def_inj_contour = prove(`!(H:(A)hypermap) p:num->A n:num. \r
1740     is_inj_contour H p n <=> is_contour H p n /\ (!i:num j:num. i <= n /\ j < i ==> ~(p j = p i))`,\r
1741  REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC \r
1742    THENL[REWRITE_TAC[is_inj_contour; is_contour] THEN ARITH_TAC; ALL_TAC] \r
1743    THEN POP_ASSUM (fun th -> REWRITE_TAC[is_contour; is_inj_contour; th])\r
1744    THEN EQ_TAC \r
1745    THENL[SIMP_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1" o CONJUNCT2) (LABEL_TAC "F2" o CONJUNCT2))\r
1746        THEN REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LE] \r
1747        THEN STRIP_TAC\r
1748        THENL[FIRST_X_ASSUM SUBST_ALL_TAC\r
1749           THEN USE_THEN "F2" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP th (REWRITE_RULE[LT_SUC_LE] th1)])); ALL_TAC]\r
1750        THEN REMOVE_THEN "F1" (fun th-> (POP_ASSUM (fun th2-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP th (CONJ th1 th2)])))); ALL_TAC]\r
1751    THEN SIMP_TAC[]\r
1752    THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2)\r
1753    THEN STRIP_TAC\r
1754    THENL[REPEAT GEN_TAC THEN STRIP_TAC \r
1755        THEN FIRST_X_ASSUM (MP_TAC o SPECL[`i:num`; `j:num`])\r
1756        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
1757        THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (MATCH_MP LT_IMP_LE (SPEC `n:num` LT_PLUS)))]); ALL_TAC]\r
1758    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL; LT_SUC_LE] o SPEC `SUC n`)\r
1759    THEN SIMP_TAC[]);;\r
1760 \r
1761 (* The theory of walkup in detail here with many trial facts *)\r
1762 \r
1763 let isolated_dart = new_definition `!(H:(A)hypermap) (x:A). isolated_dart H x  <=> (edge_map H x = x /\ node_map H x = x /\ face_map H x = x)`;;\r
1764 \r
1765 let is_edge_degenerate = new_definition `is_edge_degenerate (H:(A)hypermap) (x:A) \r
1766    <=>  (edge_map H x = x) /\ ~(node_map H x = x) /\ ~(face_map H x = x)`;;\r
1767 \r
1768 let is_node_degenerate = new_definition `is_node_degenerate (H:(A)hypermap) (x:A) \r
1769    <=>  ~(edge_map H x = x) /\ (node_map H x = x) /\ ~(face_map H x = x)`;;\r
1770 \r
1771 let is_face_degenerate = new_definition `is_face_degenerate (H:(A)hypermap) (x:A) \r
1772    <=>  ~(edge_map H x = x) /\ ~(node_map H x = x) /\ (face_map H x = x)`;;\r
1773 \r
1774 \r
1775 let degenerate_lemma = prove(`!(H:(A)hypermap) (x:A). dart_degenerate H x \r
1776    <=> isolated_dart H x \/ is_edge_degenerate H x \/  is_node_degenerate H x \/  is_face_degenerate H x`, \r
1777    \r
1778 REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` hypermap_lemma) \r
1779    THEN REWRITE_TAC[dart_degenerate;isolated_dart; is_edge_degenerate; is_node_degenerate; is_face_degenerate] \r
1780    THEN POP_ASSUM (LABEL_TAC "F1") THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
1781    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
1782    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
1783    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` \r
1784    THEN MP_TAC(SPECL[`D:A->bool`; `e:A->A`;`n:A->A`;`f:A->A`] cyclic_maps) THEN ASM_REWRITE_TAC[] \r
1785    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) THEN EQ_TAC\r
1786    THENL[STRIP_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(n:A->A) (x:A) = x` \r
1787       THENL[ASM_REWRITE_TAC[] THEN USE_THEN "F3" (fun th -> (MP_TAC(AP_THM th `x:A`))) \r
1788       THEN ASM_REWRITE_TAC[o_THM;I_THM]; ASM_REWRITE_TAC[] THEN STRIP_TAC \r
1789       THEN USE_THEN "F2" (fun th -> (MP_TAC(AP_THM th `x:A`))) \r
1790       THEN ASM_REWRITE_TAC[o_THM;I_THM]] ; ASM_REWRITE_TAC[] \r
1791       THEN ASM_CASES_TAC `(e:A->A) (x:A) = x` \r
1792       THENL[ ASM_REWRITE_TAC[] THEN USE_THEN "F3" (fun th -> (MP_TAC(AP_THM th `x:A`))) \r
1793          THEN ASM_REWRITE_TAC[o_THM;I_THM]; ASM_REWRITE_TAC[] THEN STRIP_TAC \r
1794          THEN USE_THEN "F1" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]]; \r
1795       ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(e:A->A) (x:A) = x` \r
1796       THENL[ASM_REWRITE_TAC[] THEN USE_THEN "F2" (fun th -> (MP_TAC(AP_THM th `x:A`))) \r
1797          THEN ASM_REWRITE_TAC[o_THM;I_THM]; ASM_REWRITE_TAC[] THEN STRIP_TAC THEN \r
1798       USE_THEN "F1" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]]]; \r
1799       MESON_TAC[]]);;\r
1800 \r
1801 let lemma_category_darts = prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x \/ dart_degenerate H x`,\r
1802      REPEAT STRIP_TAC\r
1803      THEN ASM_CASES_TAC `dart_degenerate (H:(A)hypermap) (x:A)`\r
1804      THENL[ASM_REWRITE_TAC[]; ALL_TAC]\r
1805      THEN ASM_REWRITE_TAC[]\r
1806      THEN POP_ASSUM MP_TAC\r
1807      THEN REWRITE_TAC[dart_degenerate; dart_nondegenerate]\r
1808      THEN MESON_TAC[]);;\r
1809 \r
1810 (* Some trivial lemmas on PAIRS *)\r
1811 \r
1812 let lemma_pair_representation = prove(`!(S:((A->bool)#(A->A)#(A->A)#(A->A))). \r
1813     S = (FST S, FST (SND S), FST(SND(SND S)), SND(SND(SND S)))`,\r
1814     REWRITE_TAC[PAIR_SURJECTIVE]);;\r
1815 \r
1816 let lemma_pair_eq = prove(`!(S:((A->bool)#(A->A)#(A->A)#(A->A))) (U:((A->bool)#(A->A)#(A->A)#(A->A))). \r
1817    ((FST S = FST U) /\ (FST (SND S) = FST (SND U)) /\ (FST(SND(SND S)) = FST(SND(SND U))) /\ (SND(SND(SND S))) = SND(SND(SND U))) ==>(S = U)`, \r
1818     ASM_MESON_TAC[lemma_pair_representation]);;\r
1819 \r
1820 let lemma_hypermap_eq = prove(`!(H:(A)hypermap) (H':(A)hypermap). \r
1821     H = H' <=> dart H = dart H' /\ edge_map H = edge_map H' /\ node_map H = node_map H' /\ face_map H = face_map H'`, \r
1822     REPEAT GEN_TAC THEN  EQ_TAC \r
1823     THENL[ASM_MESON_TAC[hypermap_tybij; dart; edge_map; node_map; face_map]; ALL_TAC] \r
1824     THEN ASM_REWRITE_TAC[hypermap_tybij; dart; edge_map; node_map; face_map] \r
1825     THEN REPEAT STRIP_TAC \r
1826     THEN SUBGOAL_THEN `tuple_hypermap (H:(A)hypermap) = tuple_hypermap (H':(A)hypermap)` ASSUME_TAC \r
1827        THENL[ASM_MESON_TAC[lemma_pair_eq]; ASM_MESON_TAC[CONJUNCT1 hypermap_tybij]]);;\r
1828 \r
1829 let lemma_hypermap_rep = prove(`!(D:A->bool) (e:A->A) (n:A->A) (f:A->A). (FINITE D /\ e permutes D /\ n permutes D /\ f permutes D /\ (e o n o f = I)) ==> dart (hypermap (D,e,n,f)) = D /\ edge_map (hypermap (D,e,n,f)) = e /\ node_map (hypermap (D,e,n,f)) = n /\ face_map (hypermap (D,e,n,f)) = f`,\r
1830    REPEAT GEN_TAC\r
1831    THEN DISCH_TAC\r
1832    THEN MP_TAC (SPEC `(D:A->bool, e:A->A, n:A->A, f:A->A)` (CONJUNCT2 hypermap_tybij))\r
1833    THEN ASM_REWRITE_TAC[dart; edge_map; node_map; face_map]\r
1834    THEN DISCH_THEN SUBST1_TAC\r
1835    THEN REWRITE_TAC[]);;\r
1836 \r
1837 let shift = new_definition `shift (H:(A)hypermap) =  hypermap(dart H, node_map H, face_map H, edge_map H)`;;\r
1838 \r
1839 let shift_lemma = prove(`!(H:(A)hypermap). dart H = dart (shift H) /\ edge_map H = face_map (shift H) /\ node_map H = edge_map (shift H) /\ face_map H = node_map (shift H)`,\r
1840  GEN_TAC THEN REWRITE_TAC [shift]\r
1841    THEN label_hypermap4_TAC `H:(A)hypermap`\r
1842    THEN POP_ASSUM(fun th2->(POP_ASSUM(fun th1->(POP_ASSUM(fun th3->(POP_ASSUM(fun th->ASSUME_TAC(CONJ th (CONJ th1(CONJ th2 th3))))))))))\r
1843    THEN MP_TAC (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_cyclic))\r
1844    THEN POP_ASSUM(fun th->(DISCH_THEN(fun th1-> REWRITE_TAC[MATCH_MP lemma_hypermap_rep (REWRITE_RULE[GSYM CONJ_ASSOC](CONJ th th1))]))));;\r
1845 \r
1846 let double_shift_lemma = prove( `!(H:(A)hypermap). dart H = dart (shift(shift H)) /\ edge_map H = node_map (shift(shift H)) /\ node_map H = face_map (shift(shift H)) /\ face_map H = edge_map (shift (shift H))`, \r
1847    GEN_TAC THEN STRIP_ASSUME_TAC(SPEC `shift(H:(A)hypermap)` shift_lemma) \r
1848    THEN STRIP_ASSUME_TAC(SPEC `H:(A)hypermap` shift_lemma) THEN ASM_REWRITE_TAC[]);;\r
1849 \r
1850 (* the definition of walkups *)\r
1851 \r
1852 let edge_walkup = new_definition `edge_walkup (H:(A)hypermap) (x:A) = hypermap((dart H) DELETE x,inverse(swap(x, face_map H x) o face_map H) o inverse(swap(x, node_map H x) o node_map H) , swap(x, node_map H x) o node_map H, swap(x, face_map H x) o face_map H)`;;\r
1853 \r
1854 let node_walkup = new_definition `node_walkup (H:(A)hypermap) (x:A) = shift(shift(edge_walkup (shift H) x))`;;\r
1855 \r
1856 let face_walkup = new_definition `face_walkup (H:(A)hypermap) (x:A) = shift(edge_walkup (shift (shift H)) x)`;;\r
1857 \r
1858 let double_edge_walkup = new_definition `double_edge_walkup (H:(A)hypermap) (x:A) (y:A) = edge_walkup (edge_walkup H x) y`;;\r
1859 \r
1860 let double_node_walkup = new_definition `double_node_walkup (H:(A)hypermap) (x:A) (y:A) = node_walkup (node_walkup H x) y`;;\r
1861 \r
1862 let double_face_walkup = new_definition `double_face_walkup (H:(A)hypermap) (x:A) (y:A) = face_walkup (face_walkup H x) y`;;\r
1863 \r
1864 let walkup_permutes = prove(`!(D:A->bool) (p:A->A) (x:A). FINITE D /\p permutes D ==> (swap(x, p x) o p) permutes (D DELETE x)`,\r
1865    REPEAT STRIP_TAC THEN UNDISCH_THEN `FINITE (D:A->bool)` (fun th -> ASSUME_TAC th THEN MP_TAC(SPEC `x:A` (MATCH_MP FINITE_DELETE_IMP th))) \r
1866    THEN ASM_REWRITE_TAC[] THEN STRIP_TAC \r
1867    THEN ASM_CASES_TAC `x:A IN (D:A->bool)` \r
1868    THENL[MP_TAC (SET_RULE `(x:A) IN (D:A->bool) ==> (D = x INSERT (D DELETE x))`) \r
1869       THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `S = (D:A->bool) DELETE (x:A)` \r
1870       THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(ISPECL[`p:A->A`;`x:A`;`(S:A->bool)`] PERMUTES_INSERT_LEMMA) \r
1871       THEN ASM_REWRITE_TAC[]; ALL_TAC] \r
1872    THEN MP_TAC (SET_RULE `~((x:A) IN (D:A->bool)) ==> D DELETE x = D`) \r
1873    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC \r
1874    THEN UNDISCH_THEN `p:A->A permutes (D:A->bool)` (fun th -> ASSUME_TAC th THEN MP_TAC th) \r
1875    THEN GEN_REWRITE_TAC(LAND_CONV o ONCE_DEPTH_CONV) [permutes] \r
1876    THEN DISCH_THEN (MP_TAC o SPEC `x:A` o CONJUNCT1) THEN ASM_REWRITE_TAC[] \r
1877    THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[th; SWAP_REFL; I_O_ID]));;\r
1878 \r
1879 let PERMUTES_COMPOSITION = prove(`!p q s. p permutes s /\ q permutes s ==> (q o p) permutes s`,\r
1880    REWRITE_TAC[permutes; o_THM] THEN MESON_TAC[]);;\r
1881 \r
1882 let lemma_edge_walkup = prove(`!(H:(A)hypermap) (x:A). dart (edge_walkup H x) = dart H DELETE x /\ edge_map (edge_walkup H x) =  inverse(swap(x, face_map H x) o face_map H) o inverse(swap(x, node_map H x) o node_map H) /\ node_map (edge_walkup H x) =  swap(x, node_map H x) o node_map H /\ face_map (edge_walkup H x) =  swap(x, face_map H x) o face_map H`,\r
1883   REPEAT GEN_TAC THEN REWRITE_TAC[edge_walkup]\r
1884    THEN label_hypermap_TAC `H:(A)hypermap` \r
1885    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
1886    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
1887    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
1888    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` \r
1889    THEN ABBREV_TAC `n' = swap(x:A, (n:A->A) x) o n` \r
1890    THEN ABBREV_TAC `f' = swap(x:A, (f:A->A) x) o f` \r
1891    THEN ABBREV_TAC `D' = (D:A->bool) DELETE (x:A)`  \r
1892    THEN MP_TAC(ISPECL[`D:A->bool`;`n:A->A`; `x:A`] walkup_permutes) \r
1893    THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`D:A->bool`;`f:A->A`; `x:A`] walkup_permutes) \r
1894    THEN ASM_REWRITE_TAC[] \r
1895    THEN REPLICATE_TAC 2 STRIP_TAC \r
1896    THEN ABBREV_TAC `e' = inverse (f':A->A) o inverse (n':A->A)`    \r
1897    THEN SUBGOAL_THEN `(e':A->A) permutes (D':A->bool)` MP_TAC \r
1898    THENL[UNDISCH_THEN `(n':A->A) permutes (D':A->bool)` (MP_TAC o MATCH_MP PERMUTES_INVERSE) \r
1899        THEN UNDISCH_THEN `(f':A->A) permutes (D':A->bool)` (MP_TAC o MATCH_MP PERMUTES_INVERSE) \r
1900        THEN REPEAT STRIP_TAC THEN MP_TAC (ISPECL[`inverse(n':A->A)`; `inverse(f':A->A)`; `D':A->bool`] \r
1901        PERMUTES_COMPOSITION) THEN ASM_REWRITE_TAC[]; ALL_TAC] \r
1902    THEN STRIP_TAC THEN SUBGOAL_THEN `(e':A->A) o (n':A->A) o (f':A->A) = I` ASSUME_TAC \r
1903    THENL[MP_TAC ((ISPECL[`n':A->A`; `D':A->bool`] PERMUTES_INVERSES_o)) \r
1904       THEN ASM_REWRITE_TAC[] THEN MP_TAC ((ISPECL[`f':A->A`; `D':A->bool`] PERMUTES_INVERSES_o)) \r
1905       THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "e'" \r
1906       THEN REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[lemma_4functions] \r
1907       THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[I_O_ID]; ALL_TAC] \r
1908    THEN MP_TAC (SPECL[`D':A->bool`; `e':A->A`; `n':A->A`; `f':A->A`]  lemma_hypermap_rep)\r
1909    THEN MP_TAC (ISPECL[`D:A->bool`; `x:A`] FINITE_DELETE_IMP)\r
1910    THEN ASM_SIMP_TAC[]);;\r
1911 \r
1912 let node_map_walkup = prove(`!(H:(A)hypermap) (x:A) (y:A). node_map (edge_walkup H x) x = x /\ node_map (edge_walkup H x) (inverse (node_map H) x) = node_map H x /\ (~(y = x) /\ ~(y = inverse (node_map H) x) ==> node_map (edge_walkup H x) y = node_map H y)`,\r
1913    REPEAT GEN_TAC THEN LABEL_TAC "F1" (CONJUNCT1 (CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))) \r
1914    THEN REWRITE_TAC[CONJUNCT1 (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)))] \r
1915    THEN REWRITE_TAC[o_THM] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
1916    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN STRIP_TAC \r
1917    THENL[ABBREV_TAC `z = (n:A->A) (x:A)` THEN REWRITE_TAC[swap] THEN ASM_CASES_TAC `z:A = x:A` THENL[ASM_MESON_TAC[]; ASM_MESON_TAC[]]; ALL_TAC]\r
1918    THEN STRIP_TAC \r
1919    THENL[SUBGOAL_THEN `(n:A->A)(inverse(n) (x:A)) = x` (fun th-> REWRITE_TAC[th]) \r
1920       THENL[GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] \r
1921          THEN REMOVE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) \r
1922          THEN POP_ASSUM (fun th -> REWRITE_TAC[th; I_THM]); MESON_TAC[swap]];ALL_TAC]\r
1923    THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN SUBGOAL_THEN `~((n:A->A) (y:A) = n (x:A))` MP_TAC\r
1924    THENL[USE_THEN "F1"(MP_TAC o SPECL[`y:A`;`x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
1925    THEN STRIP_TAC THEN SUBGOAL_THEN `~((n:A->A) (y:A) = (x:A))` ASSUME_TAC\r
1926    THENL[STRIP_TAC THEN POP_ASSUM(fun th1 -> (USE_THEN "F1"(fun th2 -> MP_TAC(MATCH_MP inverse_function (CONJ th2 th1))))) THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
1927    THEN ASM_MESON_TAC[swap]);;\r
1928 \r
1929 let face_map_walkup = prove(`!(H:(A)hypermap) (x:A) (y:A). face_map (edge_walkup H x) x = x /\ face_map (edge_walkup H x) (inverse (face_map H) x) = face_map H x /\ (~(y = x) /\ ~(y = inverse (face_map H) x) ==> face_map (edge_walkup H x) y = face_map H y)`,\r
1930    REPEAT GEN_TAC THEN LABEL_TAC "F1" (CONJUNCT1 (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))) \r
1931    THEN REWRITE_TAC[CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)))] \r
1932    THEN REWRITE_TAC[o_THM] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
1933    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN STRIP_TAC \r
1934    THENL[ABBREV_TAC `z = (n:A->A) (x:A)` THEN REWRITE_TAC[swap] THEN ASM_CASES_TAC `z:A = x:A` THENL[ASM_MESON_TAC[]; ASM_MESON_TAC[]]; ALL_TAC]\r
1935    THEN STRIP_TAC \r
1936    THENL[SUBGOAL_THEN `(f:A->A)(inverse(f) (x:A)) = x` (fun th-> REWRITE_TAC[th]) \r
1937       THENL[GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] \r
1938          THEN REMOVE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) \r
1939       THEN POP_ASSUM (fun th -> REWRITE_TAC[th; I_THM]); MESON_TAC[swap]];ALL_TAC]\r
1940    THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN SUBGOAL_THEN `~((f:A->A) (y:A) = f (x:A))` MP_TAC\r
1941    THENL[USE_THEN "F1"(MP_TAC o SPECL[`y:A`;`x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
1942    THEN STRIP_TAC THEN SUBGOAL_THEN `~((f:A->A) (y:A) = (x:A))` ASSUME_TAC\r
1943    THENL[STRIP_TAC THEN POP_ASSUM(fun th1 -> (USE_THEN "F1"(fun th2 -> MP_TAC(MATCH_MP inverse_function (CONJ th2 th1))))) THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
1944    THEN ASM_MESON_TAC[swap]);;\r
1945 \r
1946 let lemma_edge_degenerate =  prove(`!(H:(A)hypermap) (x:A). (edge_map H x = x) <=> (face_map H x = (inverse (node_map H)) x)`,\r
1947    REPEAT STRIP_TAC THEN label_hypermap_TAC `H:(A)hypermap` \r
1948    THEN MP_TAC(AP_THM (SYM (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))) `x:A`)\r
1949    THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
1950    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
1951    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
1952    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
1953    THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC\r
1954    THENL[DISCH_TAC THEN REMOVE_THEN "F1" MP_TAC THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC]\r
1955    THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ th2 (SYM th1)) )))))\r
1956    THEN DISCH_TAC THEN USE_THEN "H4" (MP_TAC o ISPECL[`(e:A->A) (x:A)`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE)\r
1957    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
1958 \r
1959 let lemma_node_degenerate =  prove(`!(H:(A)hypermap) (x:A). (node_map H x = x) <=> (edge_map H x = (inverse (face_map H)) x)`,\r
1960    REPEAT STRIP_TAC THEN label_hypermap_TAC `H:(A)hypermap` \r
1961    THEN MP_TAC(AP_THM (SYM (CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))) `x:A`)\r
1962    THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
1963    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
1964    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
1965    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
1966    THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC\r
1967    THENL[DISCH_TAC THEN REMOVE_THEN "F1" MP_TAC THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC]\r
1968    THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ th2 (SYM th1)) )))))\r
1969    THEN DISCH_TAC THEN USE_THEN "H2" (MP_TAC o ISPECL[`(n:A->A) (x:A)`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE) \r
1970    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
1971 \r
1972 let lemma_face_degenerate =  prove(`!(H:(A)hypermap) (x:A). (face_map H x = x) <=> (node_map H x = (inverse (edge_map H)) x)`,\r
1973    REPEAT STRIP_TAC THEN label_hypermap_TAC `H:(A)hypermap` \r
1974    THEN MP_TAC(AP_THM (SYM (CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps))) `x:A`)\r
1975    THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
1976    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
1977    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
1978    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
1979    THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC\r
1980    THENL[DISCH_TAC THEN REMOVE_THEN "F1" MP_TAC THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC]\r
1981    THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ th2 (SYM th1)) )))))\r
1982    THEN DISCH_TAC THEN USE_THEN "H3" (MP_TAC o ISPECL[`(f:A->A) (x:A)`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE)\r
1983    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
1984 \r
1985 let fixed_point_lemma = prove(`!(D:A->bool) (p:A->A). p permutes D ==> (!(x:A). p x = x <=> inverse p x = x)`,\r
1986    REPEAT STRIP_TAC THEN EQ_TAC\r
1987    THENL[POP_ASSUM (fun th1 -> (DISCH_THEN(fun th2 -> (MP_TAC(MATCH_MP inverse_function (CONJ th1 th2))))))\r
1988    THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]); ALL_TAC]\r
1989    THEN DISCH_THEN (MP_TAC o AP_TERM `p:A->A`)\r
1990    THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM]\r
1991    THEN (POP_ASSUM (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o))\r
1992    THEN ASM_REWRITE_TAC[I_THM] THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]));;\r
1993 \r
1994 let non_fixed_point_lemma = prove(`!(s:A->bool) (p:A->A). p permutes s ==> (!(x:A). ~(p x = x) <=> ~(inverse p x = x))`,\r
1995    REPEAT STRIP_TAC THEN REWRITE_TAC[TAUT `(~p <=> ~q) <=> (p <=> q)`] \r
1996    THEN ASM_MESON_TAC[fixed_point_lemma]);;\r
1997 \r
1998 let lemma_inverse_maps_at_nondegenerate_dart = prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x ==> ~((inverse (edge_map H) x) = x) /\ ~((inverse (node_map H) x) = x) /\ ~((inverse (face_map H) x) = x)`,\r
1999      REPEAT GEN_TAC THEN REWRITE_TAC[dart_nondegenerate]\r
2000      THEN MESON_TAC[hypermap_lemma; non_fixed_point_lemma]);;\r
2001 \r
2002 let aux_permutes_conversion = prove(`!(D:A->bool) (p:A->A) (q:A->A) (x:A) (y:A). (p permutes D) /\ (q permutes D) \r
2003    ==> ((inverse p)((inverse q) x) = y <=> q ( p y) = x)`,\r
2004    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) \r
2005    THEN USE_THEN "F1" (MP_TAC o ISPECL[`y:A`; `inverse(q:A->A) (x:A)`] o MATCH_MP PERMUTES_INVERSE_EQ)\r
2006    THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) \r
2007    THEN USE_THEN "F2" (MP_TAC o ISPECL[`(p:A->A) (y:A)`; `(x:A)`] o MATCH_MP PERMUTES_INVERSE_EQ)\r
2008    THEN MESON_TAC[]);;\r
2009 \r
2010 let  edge_map_walkup   = prove(`!(H:(A)hypermap) (x:A) (y:A). edge_map (edge_walkup H x) x = x /\ ( ~(node_map H x = x) /\ ~(edge_map H x = x) ==> edge_map (edge_walkup H x) (node_map H x) = edge_map H x) /\ (~(inverse (face_map H)  x = x) /\ ~(inverse(edge_map H) x = x)  ==> edge_map (edge_walkup H x) (inverse(edge_map H) x) = inverse(face_map H) x) /\ (~(y = x) /\ ~(y = (inverse (edge_map H)) x) /\ ~(y = (node_map H) x) ==> (edge_map (edge_walkup H x)) y = edge_map H y)`,\r
2011    REPEAT GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN label_hypermapG_TAC `(edge_walkup (H:(A)hypermap) (x:A))`\r
2012    THEN LABEL_TAC "A1" (SPECL[`H:(A)hypermap`;`x:A`] node_map_walkup) THEN LABEL_TAC "A2" (SPECL[`H:(A)hypermap`;`x:A`] face_map_walkup)\r
2013    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
2014    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
2015    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
2016    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
2017    THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` \r
2018    THEN ABBREV_TAC `D' = dart (G:(A)hypermap)`\r
2019    THEN ABBREV_TAC `e' = edge_map (G:(A)hypermap)` \r
2020    THEN ABBREV_TAC `n' = node_map (G:(A)hypermap)` \r
2021    THEN ABBREV_TAC `f' = face_map (G:(A)hypermap)`\r
2022    THEN MP_TAC(CONJUNCT1 (SPEC `G:(A)hypermap` inverse2_hypermap_maps))\r
2023    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[o_THM] \r
2024    THEN STRIP_TAC\r
2025    THENL[REMOVE_THEN "A1" (MP_TAC o CONJUNCT1 o SPEC `y:A`)\r
2026       THEN DISCH_THEN (fun th -> (USE_THEN "G3" (fun th1 ->MP_TAC (MATCH_MP inverse_function (CONJ th1 th)))))\r
2027       THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REMOVE_THEN "A2" (MP_TAC o CONJUNCT1 o SPEC `y:A`)\r
2028       THEN DISCH_THEN (fun th -> (USE_THEN "G4" (fun th1 ->MP_TAC (MATCH_MP inverse_function (CONJ th1 th)))))\r
2029       THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2030    THEN STRIP_TAC \r
2031    THENL[MP_TAC (SPECL[`D':A->bool`; `f':A->A`; `n':A->A`; `(n:A->A) (x:A)`; `(e:A->A) (x:A)`] aux_permutes_conversion)\r
2032       THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
2033       THEN  STRIP_TAC \r
2034       THEN SUBGOAL_THEN `~((e:A->A) (x:A) = inverse (f:A->A) x)` ASSUME_TAC\r
2035       THENL[UNDISCH_THEN `~((n:A->A) (x:A) = x)` (MP_TAC o GSYM)\r
2036          THEN REWRITE_TAC[CONTRAPOS_THM]\r
2037          THEN USE_THEN "H2" (MP_TAC o SYM o  SPECL[`x:A`; `inverse(f:A->A) x:A`] o  MATCH_MP PERMUTES_INVERSE_EQ)\r
2038          THEN DISCH_THEN(fun th -> REWRITE_TAC[th])\r
2039          THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM]\r
2040          THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`] inverse2_hypermap_maps)))\r
2041          THEN ASM_REWRITE_TAC[]\r
2042          THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
2043          THEN DISCH_THEN (fun th -> MP_TAC (SYM th)) THEN SIMP_TAC[]; ALL_TAC]\r
2044      THEN REMOVE_THEN "A2" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(e:A->A) (x:A)`)\r
2045      THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
2046      THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))\r
2047      THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SYM(AP_THM th `x:A`)))\r
2048      THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
2049      THEN REMOVE_THEN "A1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC `x:A`) THEN REWRITE_TAC[]; ALL_TAC]\r
2050    THEN STRIP_TAC\r
2051    THENL[STRIP_TAC THEN MP_TAC (SPECL[`D':A->bool`; `f':A->A`; `n':A->A`; `inverse (e:A->A) (x:A)`; `inverse(f:A->A) (x:A)`] aux_permutes_conversion)\r
2052      THEN ASM_REWRITE_TAC[]\r
2053      THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
2054      THEN SUBGOAL_THEN `~((f:A->A) (x:A) = inverse (n:A->A) x)` ASSUME_TAC\r
2055      THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
2056         THEN USE_THEN "H4" (MP_TAC o SYM o  SPECL[`x:A`; `inverse(n:A->A) x:A`] o  MATCH_MP PERMUTES_INVERSE_EQ)\r
2057         THEN DISCH_THEN(fun th -> REWRITE_TAC[th])\r
2058         THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM]\r
2059         THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`] inverse2_hypermap_maps))\r
2060         THEN ASM_REWRITE_TAC[]\r
2061         THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
2062         THEN STRIP_TAC THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma)\r
2063         THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
2064      THEN SUBGOAL_THEN `~((f:A->A) (x:A) = x)` ASSUME_TAC\r
2065      THENL[UNDISCH_TAC `~(inverse (f:A->A) (x:A) = x)`\r
2066         THEN REWRITE_TAC[CONTRAPOS_THM]\r
2067         THEN STRIP_TAC THEN USE_THEN "H4" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma)\r
2068         THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
2069      THEN REMOVE_THEN "A1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(f:A->A) (x:A)`)\r
2070      THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
2071      THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM o_THM]\r
2072      THEN MP_TAC(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps))\r
2073      THEN ASM_REWRITE_TAC[] THEN  DISCH_THEN(fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2074    THEN STRIP_TAC THEN MP_TAC (ISPECL[`D':A->bool`; `f':A->A`; `n':A->A`; `y:A`; `(e:A->A) (y:A)`] aux_permutes_conversion)\r
2075    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
2076    THEN SUBGOAL_THEN `~((e:A->A) (y:A) = (inverse (f:A->A)) (x:A))` ASSUME_TAC\r
2077    THENL[STRIP_TAC THEN UNDISCH_THEN `~((y:A) = (n:A->A) (x:A))` MP_TAC THEN REWRITE_TAC[] \r
2078       THEN POP_ASSUM (MP_TAC o AP_TERM `inverse (e:A->A)`)\r
2079       THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM]\r
2080       THEN USE_THEN "H2" (MP_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o)\r
2081       THEN DISCH_THEN (fun th-> REWRITE_TAC[th; I_THM])\r
2082       THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM]\r
2083       THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse2_hypermap_maps)))\r
2084       THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2085    THEN SUBGOAL_THEN `~((e:A->A) (y:A) = (x:A))` ASSUME_TAC\r
2086    THENL[UNDISCH_TAC `~(y:A = inverse (e:A->A) (x:A))`\r
2087       THEN REWRITE_TAC[CONTRAPOS_THM] \r
2088       THEN DISCH_THEN (fun th -> (USE_THEN "H2" (fun th1 -> (MP_TAC (MATCH_MP inverse_function (CONJ th1 th))))))\r
2089       THEN REWRITE_TAC[]; ALL_TAC]\r
2090    THEN REMOVE_THEN "A2" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(e:A->A) (y:A)`)\r
2091    THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM] \r
2092    THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))\r
2093    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
2094    THEN SUBGOAL_THEN `~(inverse (n:A->A) (y:A) = inverse (n:A->A) (x:A))` ASSUME_TAC\r
2095    THENL[UNDISCH_TAC `~(y:A = x:A)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "H3" (MP_TAC o MATCH_MP PERMUTES_INVERSE)\r
2096       THEN DISCH_THEN (MP_TAC o ISPECL[`y:A`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE)\r
2097       THEN MESON_TAC[]; ALL_TAC]\r
2098    THEN SUBGOAL_THEN `~(inverse (n:A->A) (y:A) = x:A)` ASSUME_TAC\r
2099    THENL[UNDISCH_TAC `~(y:A = (n:A->A) (x:A))` \r
2100       THEN REWRITE_TAC[CONTRAPOS_THM]\r
2101       THEN DISCH_THEN (MP_TAC o AP_TERM `n:A->A`)\r
2102       THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM]\r
2103       THEN USE_THEN "H3" (MP_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o)\r
2104       THEN DISCH_THEN (fun th -> REWRITE_TAC[th; I_THM]); ALL_TAC]\r
2105    THEN DISCH_TAC THEN REMOVE_THEN "A1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(inverse (n:A->A)) (y:A)`)\r
2106    THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM] \r
2107    THEN USE_THEN "H3" (MP_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o)\r
2108    THEN DISCH_THEN (fun th -> REWRITE_TAC[th; I_THM]));;\r
2109 \r
2110 (* About orbits of permutations *)\r
2111 \r
2112 let power_list = new_definition `!p:A->A x:A. power_list p x = (\i:num. (p POWER i) x)`;;\r
2113 \r
2114 let inj_orbit = new_recursive_definition num_RECURSION \r
2115    `(inj_orbit (p:A->A) (x:A) 0 <=> T) /\ (inj_orbit (p:A->A) (x:A) (SUC n) \r
2116     <=> (inj_orbit p x n) /\ (!j:num. j <= n ==> ~((p POWER (SUC n)) x =  (p POWER j) x)))`;;\r
2117 \r
2118 let lemma_inj_orbit_via_list = prove(`!p:A->A x:A n:num. inj_orbit p x n <=> is_inj_list (power_list p x) n`,\r
2119    REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC\r
2120    THENL[REWRITE_TAC[inj_orbit; is_inj_list]; ALL_TAC]\r
2121    THEN REWRITE_TAC[inj_orbit; is_inj_list]\r
2122    THEN POP_ASSUM (fun th-> REWRITE_TAC[GSYM th; power_list])\r
2123    THEN MESON_TAC[EQ_SYM]);;\r
2124 \r
2125 let lemma_def_inj_orbit = prove(`!(p:A->A) (x:A) (n:num). (inj_orbit p x n \r
2126    <=> (!i:num j:num. i <= n /\ j < i ==> ~((p POWER i) x = (p POWER j) x)))`,\r
2127    REWRITE_TAC[lemma_inj_orbit_via_list; lemma_inj_list; power_list]\r
2128    THEN MESON_TAC[EQ_SYM]);;\r
2129 \r
2130 let lemma_inj_orbit = prove(`!p:A->A x:A n:num. inj_orbit p x n <=> (!i:num j:num. i <= n /\ j <= n  /\ (p POWER i) x = (p POWER j) x ==> i = j)`,\r
2131    REPEAT GEN_TAC\r
2132    THEN REWRITE_TAC[lemma_inj_orbit_via_list; lemma_inj_list2; power_list]);;\r
2133 \r
2134 let lemma_sub_inj_orbit = prove(`!(p:A->A) x:A n:num. inj_orbit p x n ==> !m:num. m <= n ==> inj_orbit p x m`,\r
2135    REWRITE_TAC[lemma_inj_orbit_via_list; lemma_sub_list]);;  \r
2136 \r
2137 let inj_orbit_step = prove(`!(s:A->bool) (p:A->A) (x:A) (n:num). (p permutes s) /\ (inj_orbit p x n) /\ ~((p POWER (SUC n:num)) x = x) \r
2138                             ==> (inj_orbit p x (SUC n))`,\r
2139    REPEAT STRIP_TAC \r
2140    THEN REWRITE_TAC[inj_orbit] THEN ASM_REWRITE_TAC[]\r
2141    THEN REPLICATE_TAC 2 STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o check(is_neg o concl))\r
2142    THEN REWRITE_TAC[CONTRAPOS_THM]\r
2143    THEN ASM_CASES_TAC `j:num = 0`\r
2144    THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
2145    THEN UNDISCH_TAC `j:num <= n:num` THEN REWRITE_TAC[GSYM LT_SUC_LE]\r
2146    THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` (LABEL_TAC "G"))\r
2147    THEN USE_THEN "G" SUBST1_TAC\r
2148    THEN UNDISCH_THEN `(p:A->A) permutes (s:A->bool)` (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC ( MATCH_MP elim_power_function (CONJ th1 th2))))))\r
2149    THEN MP_TAC(ARITH_RULE `~(j = 0) /\ SUC (n:num) = j + SUC (d:num) ==> SUC d <= n`)\r
2150    THEN ASM_REWRITE_TAC[]\r
2151    THEN REPEAT STRIP_TAC \r
2152    THEN MP_TAC(SPECL[`p:A->A`; `x:A`; `n:num`] lemma_def_inj_orbit)\r
2153    THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPECL[`SUC (d:num)`; `0`])\r
2154    THEN ASM_REWRITE_TAC[LT_NZ; POWER_0; ARITH; I_THM] THEN ARITH_TAC);;\r
2155 \r
2156 let lemma_subset_orbit = prove(`!(p:A->A) x:A n:num. {(p POWER (i:num)) x | i <= n} SUBSET orbit_map p x`,\r
2157    REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN GEN_TAC \r
2158    THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN STRIP_TAC\r
2159    THEN EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);;\r
2160 \r
2161 let lemma_segment_orbit = prove(`!(s:A->bool) (p:A->A) (x:A). FINITE s /\ p permutes s ==> (!m:num. m < CARD(orbit_map p x) ==> inj_orbit p x m)`,\r
2162    REPLICATE_TAC 4 STRIP_TAC THEN INDUCT_TAC\r
2163    THENL[REWRITE_TAC[inj_orbit]; ALL_TAC]\r
2164    THEN POP_ASSUM (LABEL_TAC "F1") THEN DISCH_THEN (LABEL_TAC "F2")\r
2165    THEN MP_TAC (ARITH_RULE `SUC (m:num) < CARD (orbit_map (p:A->A) (x:A)) ==> m < CARD (orbit_map p x)`)\r
2166    THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REMOVE_THEN "F1" MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC\r
2167    THEN MATCH_MP_TAC inj_orbit_step\r
2168    THEN EXISTS_TAC `s:A->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC\r
2169    THEN MP_TAC(SPECL[`p:A->A`; `SUC (m:num)`; `x:A`] card_orbit_le)\r
2170    THEN ASM_REWRITE_TAC[ARITH_RULE `~(SUC(d:num) = 0)`]\r
2171    THEN  REMOVE_THEN "F2" MP_TAC THEN ARITH_TAC);;\r
2172 \r
2173 let lemma_cycle_orbit = prove(`!(s:A->bool) (p:A->A) (x:A). FINITE s /\ p permutes s  ==> (p POWER (CARD(orbit_map p x))) x = x`,\r
2174    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
2175    THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect)\r
2176    THEN ABBREV_TAC `m = PRE (CARD (orbit_map (p:A->A) (x:A)))`\r
2177    THEN POP_ASSUM (LABEL_TAC "F3")\r
2178    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite o CONJ th))\r
2179    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_ATLEAST_1)\r
2180    THEN DISCH_THEN  (MP_TAC o SYM o MATCH_MP LE_SUC_PRE)\r
2181    THEN POP_ASSUM SUBST1_TAC\r
2182    THEN DISCH_THEN (LABEL_TAC "F3")\r
2183    THEN ASM_CASES_TAC `~(((p:A->A) POWER (SUC m)) (x:A) = x)`\r
2184    THENL[POP_ASSUM MP_TAC\r
2185        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (MP_TAC o SPECL[`x:A`; `m:num`] o MATCH_MP lemma_segment_orbit o CONJ th))\r
2186        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; LT_PLUS])\r
2187        THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
2188        THEN DISCH_THEN (MP_TAC o MATCH_MP inj_orbit_step)\r
2189        THEN REWRITE_TAC[lemma_inj_orbit_via_list]\r
2190        THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; power_list] o MATCH_MP lemma_size_list)\r
2191        THEN DISCH_TAC\r
2192        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite o CONJ th))\r
2193        THEN MP_TAC (SPECL[`p:A->A`; `x:A`; `SUC m`] lemma_subset_orbit) THEN REWRITE_TAC[IMP_IMP]\r
2194        THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_SUBSET)\r
2195        THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM SUBST1_TAC THEN ARITH_TAC; ALL_TAC]\r
2196    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[]) THEN POP_ASSUM SUBST1_TAC THEN SIMP_TAC[]);;\r
2197 \r
2198 let lemma_index_on_orbit = prove(`!s:A->bool p:A->A x:A y:A. FINITE s /\ p permutes s /\ y IN orbit_map p x \r
2199    ==> ?n:num. n < CARD (orbit_map p x) /\ y = (p POWER n) x`,\r
2200     REPEAT GEN_TAC\r
2201    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
2202    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> LABEL_TAC "FC" (CONJ th th1)))\r
2203    THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect)\r
2204    THEN USE_THEN "FC" (MP_TAC o SPEC `x:A` o  MATCH_MP lemma_orbit_finite)\r
2205    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[LT1_NZ; LT_NZ] o MATCH_MP CARD_ATLEAST_1)\r
2206    THEN USE_THEN "FC"(fun th->DISCH_THEN(fun th1-> (ASSUME_TAC(MATCH_MP orbit_cyclic (CONJ th1 (SPEC `x:A` (MATCH_MP lemma_cycle_orbit th)))))))\r
2207    THEN USE_THEN "F3" (MP_TAC) THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
2208    THEN REWRITE_TAC[IN_ELIM_THM]);;\r
2209 \r
2210 let lemma_congruence_on_orbit = prove(`!s:A->bool p:A->A x:A n:num m:num. FINITE s /\ p permutes s /\ n < CARD (orbit_map p x) /\ (p POWER n) x = (p POWER m) x ==> ?q:num. m = q * CARD (orbit_map p x) + n`,\r
2211  REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1")(CONJUNCTS_THEN2 (LABEL_TAC "F2")(CONJUNCTS_THEN2 (LABEL_TAC "F3")(LABEL_TAC "F4"))))\r
2212    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> LABEL_TAC "FC" (CONJ th th1)))\r
2213    THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect)\r
2214    THEN USE_THEN "FC" (MP_TAC o SPEC `x:A` o  MATCH_MP lemma_orbit_finite)\r
2215    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (LABEL_TAC "F5" o MATCH_MP CARD_ATLEAST_1)\r
2216    THEN USE_THEN "F5" (MP_TAC o REWRITE_RULE[LT1_NZ; LT_NZ])\r
2217    THEN DISCH_THEN (MP_TAC o SPEC `m:num` o MATCH_MP DIVMOD_EXIST)\r
2218    THEN DISCH_THEN (X_CHOOSE_THEN `q:num` (X_CHOOSE_THEN `r:num` (CONJUNCTS_THEN2 SUBST_ALL_TAC (LABEL_TAC "F6"))))\r
2219    THEN EXISTS_TAC `q:num` THEN REWRITE_TAC[EQ_ADD_LCANCEL]\r
2220    THEN USE_THEN "F4" (MP_TAC o ONCE_REWRITE_RULE[ADD_SYM])\r
2221    THEN REWRITE_TAC[lemma_add_exponent_function]\r
2222    THEN USE_THEN "FC" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_cycle_orbit)\r
2223    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP power_map_fix_point th])\r
2224    THEN DISCH_TAC\r
2225    THEN USE_THEN "FC" (MP_TAC o REWRITE_RULE[GSYM LE_SUC_LT] o SPECL[`x:A`; `PRE (CARD (orbit_map (p:A->A) (x:A)))`] o MATCH_MP lemma_segment_orbit)\r
2226    THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th; LE_REFL])\r
2227    THEN DISCH_THEN (MP_TAC o SPECL[`r:num`; `n:num`] o REWRITE_RULE[GSYM LT_SUC_LE] o REWRITE_RULE[lemma_inj_orbit])\r
2228    THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th; LE_REFL])\r
2229    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
2230    THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th])\r
2231    THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM th; EQ_SYM]));;\r
2232 \r
2233 \r
2234 (*******************************************)\r
2235 \r
2236 \r
2237 let is_edge_merge = new_definition `!(H:(A)hypermap) (x:A). is_edge_merge H x <=> dart_nondegenerate H x /\ ~(node_map H x IN edge H x)`;;\r
2238 \r
2239 let is_node_merge = new_definition `!(H:(A)hypermap) (x:A). is_node_merge H x <=> dart_nondegenerate H x /\ ~(face_map H x IN node H x)`;;\r
2240 \r
2241 let is_face_merge = new_definition `!(H:(A)hypermap) (x:A). is_face_merge H x <=> dart_nondegenerate H x /\ ~(edge_map H x IN face H x)`;;\r
2242 \r
2243 let is_edge_split = new_definition `!(H:(A)hypermap) (x:A). is_edge_split H x <=> dart_nondegenerate H x /\  node_map H x IN edge H x`;;\r
2244 \r
2245 let is_node_split = new_definition  `!(H:(A)hypermap) (x:A). is_node_split H x <=> dart_nondegenerate H x /\  face_map H x IN node H x`;;\r
2246 \r
2247 let is_face_split = new_definition  `!(H:(A)hypermap) (x:A). is_face_split H x  <=> dart_nondegenerate H x /\  edge_map H x IN face H x`;;\r
2248 \r
2249 let INVERSE_EVALUATION = prove(`!s:A->bool p:A->A x:A. FINITE s /\ p permutes s ==> ?j:num. (inverse p) x = (p POWER j) x`,\r
2250   REPEAT STRIP_TAC\r
2251   THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`] inverse_element_lemma)\r
2252   THEN ASM_REWRITE_TAC[]\r
2253   THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (fun th -> (ASSUME_TAC (AP_THM th `x:A`))))\r
2254   THEN EXISTS_TAC `j:num`\r
2255   THEN ASM_REWRITE_TAC[]);;\r
2256 \r
2257 let lemma_orbit_identity = prove(`!s:A->bool p:A->A  x:A y:A. FINITE s /\ p permutes s /\ y IN orbit_map p x \r
2258    ==> orbit_map p x = orbit_map p y`,\r
2259   REPEAT STRIP_TAC\r
2260   THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`] partition_orbit)\r
2261   THEN ASM_REWRITE_TAC[]\r
2262   THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `y:A`])\r
2263   THEN ASSUME_TAC (SPECL[`p:A->A`; `y:A`] orbit_reflect)\r
2264   THEN SUBGOAL_THEN `?z:A.z IN orbit_map (p:A->A) (x:A) INTER orbit_map (p:A->A) (y:A)` MP_TAC\r
2265   THENL[MP_TAC (ISPECL[`orbit_map (p:A->A) (x:A)`; `orbit_map (p:A->A) (y:A)`; `y:A`] IN_INTER)\r
2266         THEN ASM_REWRITE_TAC[]\r
2267         THEN DISCH_TAC THEN EXISTS_TAC `y:A`\r
2268         THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
2269   THEN REWRITE_TAC[MEMBER_NOT_EMPTY]\r
2270   THEN DISCH_THEN (fun th -> REWRITE_TAC[th]));;\r
2271 \r
2272 let lemma_edge_identity = prove(`!(H:(A)hypermap) x:A y:A. y IN edge H x ==>  edge H x =  edge H y`,\r
2273      REPEAT GEN_TAC THEN REWRITE_TAC[edge] THEN MESON_TAC[lemma_orbit_identity; hypermap_lemma]);;\r
2274 \r
2275 let lemma_node_identity = prove(`!(H:(A)hypermap) x:A y:A. y IN node H x ==>  node H x =  node H y`,\r
2276      REPEAT GEN_TAC THEN REWRITE_TAC[node] THEN MESON_TAC[lemma_orbit_identity; hypermap_lemma]);;\r
2277 \r
2278 let lemma_face_identity = prove(`!(H:(A)hypermap) x:A y:A. y IN face H x ==>  face H x =  face H y`,\r
2279      REPEAT GEN_TAC THEN REWRITE_TAC[face] THEN MESON_TAC[lemma_orbit_identity; hypermap_lemma]);;\r
2280 \r
2281 \r
2282 let lemma_orbit_disjoint = prove(`!s:A->bool p:A->A  x:A y:A. FINITE s /\ p permutes s /\ ~(y IN orbit_map p x) \r
2283    ==> orbit_map p x INTER orbit_map p y = {}`,\r
2284   REPEAT STRIP_TAC\r
2285   THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`] partition_orbit)\r
2286   THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `y:A`])\r
2287   THEN SUBGOAL_THEN `~(orbit_map (p:A->A) (x:A) = orbit_map (p:A->A) (y:A))` ASSUME_TAC\r
2288   THENL[POP_ASSUM MP_TAC\r
2289       THEN REWRITE_TAC[CONTRAPOS_THM]\r
2290       THEN DISCH_THEN SUBST1_TAC\r
2291       THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
2292   THEN ASM_REWRITE_TAC[]);;\r
2293 \r
2294 let INVERSE_POWER_MAP = prove(`!s:A->bool p:A->A n:num. FINITE s /\ p permutes s \r
2295   ==> (inverse p) o (p POWER (SUC n)) = p POWER n`,\r
2296   REPEAT STRIP_TAC THEN REWRITE_TAC[COM_POWER; o_ASSOC]\r
2297   THEN POP_ASSUM (MP_TAC o CONJUNCT2 o  MATCH_MP PERMUTES_INVERSES_o)\r
2298   THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[I_O_ID]);;\r
2299 \r
2300 let INVERSE_POWER_EVALUATION = prove(`!s:A->bool p:A->A x:A n:num. FINITE s /\ p permutes s \r
2301    ==> (inverse p)((p POWER (SUC n)) x) = (p POWER n) x`,\r
2302   REPEAT STRIP_TAC\r
2303   THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `n:num`] INVERSE_POWER_MAP)\r
2304   THEN ASM_REWRITE_TAC[]\r
2305   THEN DISCH_THEN (fun th -> (MP_TAC (AP_THM th `x:A`)))\r
2306   THEN REWRITE_TAC[o_THM]);;\r
2307 \r
2308 let lemma_in_disjoint = prove(`!s:A->bool t:A->bool x:A. s INTER  t = {} /\ x IN s ==> ~(x IN t)`,\r
2309   REPEAT STRIP_TAC\r
2310   THEN MP_TAC(SPECL[`s:A->bool`; `t:A->bool`; `x:A`] IN_INTER)\r
2311   THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_IN_EMPTY]);;\r
2312 \r
2313 let lemma_not_in_orbit = prove(`!s:A->bool p :A->A x:A y:A n:num. FINITE s /\ p permutes s /\ ~(y IN orbit_map p x) ==> ~(y = (p POWER n) x)`,\r
2314   REPEAT STRIP_TAC\r
2315   THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl))\r
2316   THEN REWRITE_TAC[]\r
2317   THEN REWRITE_TAC[orbit_map; IN_ELIM_THM]\r
2318   THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[GE; LE_0]);;\r
2319 \r
2320 let lemma_orbit_power = prove(`!(s:A->bool) (p:A->A) (x:A) (n:num). (FINITE s /\ p permutes s) ==> (orbit_map p x = orbit_map p ((p POWER n) x))`,\r
2321   REPEAT STRIP_TAC\r
2322   THEN MP_TAC(SPECL[`p:A->A`; `n:num`; `x:A`; `((p:A->A) POWER (n:num)) (x:A)` ] in_orbit_lemma)\r
2323   THEN SIMP_TAC[] THEN STRIP_TAC\r
2324   THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `x:A`; `((p:A->A) POWER (n:num)) (x:A)`] lemma_orbit_identity)\r
2325   THEN ASM_REWRITE_TAC[]);;\r
2326 \r
2327 let lemma_inverse_in_orbit = prove(`!s:A->bool p:A->A x:A. FINITE s /\ p permutes s ==> (inverse p) x IN orbit_map p x`,\r
2328   REPEAT GEN_TAC\r
2329   THEN DISCH_THEN (fun th -> (ASSUME_TAC th THEN MP_TAC(SPEC `x:A` (MATCH_MP INVERSE_EVALUATION th))))\r
2330   THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
2331   THEN POP_ASSUM (SUBST1_TAC o SPECL[`x:A`; `j:num`] o MATCH_MP lemma_orbit_power)\r
2332   THEN REWRITE_TAC[orbit_reflect]);;\r
2333 \r
2334 let lemmaFKSNTKR = prove(`!(H:(A)hypermap) (x:A). simple_hypermap H /\ x IN dart H /\ ~((edge_map H) x = x) /\ (dart_nondegenerate H x)\r
2335    /\ dart_nondegenerate H ((edge_map H) x) ==> ((edge_map H) ((edge_map H) x) = x ==> is_face_merge H x) /\ is_node_merge H x`,\r
2336   REPEAT GEN_TAC\r
2337   THEN REWRITE_TAC[simple_hypermap; dart_nondegenerate; is_face_merge; is_node_merge; node; face; o_THM]\r
2338   THEN STRIP_TAC\r
2339   THEN ASM_REWRITE_TAC[]\r
2340   THEN label_hypermap_TAC `H:(A)hypermap`\r
2341   THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
2342   THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
2343   THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
2344   THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
2345   THEN FIRST_X_ASSUM (MP_TAC o SPEC `(f:A->A) (x:A)` o check (is_forall o concl))\r
2346   THEN USE_THEN "H4" (MP_TAC o SYM o  SPEC `x:A` o MATCH_MP PERMUTES_IN_IMAGE)\r
2347   THEN ASM_REWRITE_TAC[]\r
2348   THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
2349   THEN DISCH_THEN (LABEL_TAC "FF")\r
2350   THEN STRIP_TAC\r
2351   THENL[USE_THEN "H2" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC(MATCH_MP inverse_function (CONJ th2 th3))))))\r
2352           THEN MP_TAC(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps))\r
2353           THEN ASM_REWRITE_TAC[] \r
2354           THEN DISCH_THEN SUBST1_TAC\r
2355           THEN REWRITE_TAC[o_THM]\r
2356           THEN DISCH_TAC\r
2357           THEN MP_TAC(SPECL[`n:A->A`; `1`;`(f:A->A) (x:A)`; `(e:A->A) (x:A)`] in_orbit_lemma)\r
2358           THEN POP_ASSUM (fun th -> ((ASSUME_TAC (SYM th)) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [POWER_1; th]))\r
2359           THEN SIMP_TAC[]\r
2360           THEN DISCH_THEN (LABEL_TAC "F2")\r
2361           THEN UNDISCH_TAC `~((n:A->A) ((e:A->A) (x:A)) = e x)`\r
2362           THEN REWRITE_TAC[CONTRAPOS_THM]\r
2363           THEN DISCH_THEN (LABEL_TAC "F3")\r
2364           THEN MP_TAC(SPECL[`f:A->A`; `1`;`(x:A)`; `(f:A->A) (x:A)`] in_orbit_lemma)\r
2365           THEN REWRITE_TAC[POWER_1]\r
2366           THEN DISCH_THEN (fun th3 -> (USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2367           THEN DISCH_THEN SUBST_ALL_TAC\r
2368           THEN REMOVE_THEN "F2" (fun th1 -> (REMOVE_THEN "F3" (fun th2 -> MP_TAC (CONJ th1 th2))))\r
2369           THEN REWRITE_TAC[GSYM IN_INTER]\r
2370           THEN USE_THEN "FF"  SUBST1_TAC\r
2371           THEN REWRITE_TAC[IN_SING]\r
2372           THEN DISCH_THEN (MP_TAC o AP_TERM `n:A->A`)\r
2373           THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
2374    THEN UNDISCH_TAC `~((f:A->A) (x:A) = x)`\r
2375    THEN REWRITE_TAC[CONTRAPOS_THM]\r
2376    THEN DISCH_TAC\r
2377    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (MP_TAC (SPECL[`(f:A->A) (x:A)`; `x:A`] (MATCH_MP orbit_sym (CONJ th1 th2)))))))\r
2378    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
2379    THEN DISCH_THEN (LABEL_TAC "F8")\r
2380    THEN MP_TAC(SPECL[`f:A->A`; `1`; `x:A`;`(f:A->A) (x:A)`] in_orbit_lemma)\r
2381    THEN REWRITE_TAC[POWER_1]\r
2382    THEN DISCH_TAC\r
2383    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPECL[`(f:A->A) (x:A)`; `x:A`] (MATCH_MP orbit_sym (CONJ th1 th2)))))))\r
2384    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
2385    THEN DISCH_THEN (LABEL_TAC "F9")\r
2386    THEN REMOVE_THEN "F8" (fun th1 -> (REMOVE_THEN "F9" (fun th2 -> MP_TAC (CONJ th1 th2))))\r
2387    THEN REWRITE_TAC[GSYM IN_INTER]\r
2388    THEN POP_ASSUM SUBST1_TAC\r
2389    THEN REWRITE_TAC[IN_SING]\r
2390    THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]));;\r
2391 \r
2392 \r
2393 (* PLANARITY *)\r
2394 \r
2395 let planar_ind = new_definition `planar_ind (H:(A)hypermap) = &(number_of_edges H) + &(number_of_nodes H) + &(number_of_faces H) - &(CARD (dart H)) - ((&2) * (&(number_of_components (H))))`;;\r
2396 \r
2397 \r
2398 (* some trivial lemmas *)\r
2399 \r
2400 let lemma_planar_hypermap = prove(`!(H:(A)hypermap). planar_hypermap H <=> planar_ind H = &0`,\r
2401   REWRITE_TAC[planar_hypermap; planar_ind;GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL]\r
2402   THEN REAL_ARITH_TAC);;\r
2403 \r
2404 let lemma_null_hypermap_planar_index = prove(`!(H:(A)hypermap). CARD (dart H) = 0 ==> planar_ind H = &0`,\r
2405 GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap`\r
2406   THEN USE_THEN "H1"(fun th -> REWRITE_TAC[MATCH_MP CARD_EQ_0 th])\r
2407   THEN REWRITE_TAC[planar_ind; number_of_edges; number_of_nodes; number_of_faces; number_of_components]\r
2408   THEN REWRITE_TAC[edge_set; node_set; face_set; set_of_components; set_part_components]\r
2409   THEN DISCH_THEN (LABEL_TAC "F1")\r
2410   THEN REMOVE_THEN "F1" (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)\r
2411   THEN SUBGOAL_THEN `!(p:A->A). set_of_orbits {} p = {}` (fun th ->  REWRITE_TAC[th]) THENL[REWRITE_TAC[set_of_orbits] THEN SET_TAC[]; ALL_TAC]\r
2412   THEN SUBGOAL_THEN `{comb_component (H:(A)hypermap) (x:A)| x IN {}} = {}` SUBST1_TAC THENL[SET_TAC[]; ALL_TAC]\r
2413   THEN REWRITE_TAC[CARD_CLAUSES] THEN REAL_ARITH_TAC);;\r
2414 \r
2415 let lemma_shift_component_invariant = prove(`!(H:(A)hypermap). set_of_components H = set_of_components (shift H)`,\r
2416 GEN_TAC THEN REWRITE_TAC[set_of_components]\r
2417   THEN REWRITE_TAC[GSYM shift_lemma]\r
2418   THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
2419   THEN REWRITE_TAC[set_part_components]\r
2420   THEN REWRITE_TAC[EXTENSION]\r
2421   THEN GEN_TAC THEN EQ_TAC\r
2422   THENL[REWRITE_TAC[IN_ELIM_THM]\r
2423        THEN STRIP_TAC THEN EXISTS_TAC `x':A`\r
2424        THEN ASM_REWRITE_TAC[]\r
2425        THEN REWRITE_TAC[comb_component; EXTENSION]\r
2426        THEN GEN_TAC THEN EQ_TAC\r
2427        THENL[REWRITE_TAC[IN_ELIM_THM]\r
2428                THEN REWRITE_TAC[is_in_component]\r
2429                THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A`\r
2430                THEN EXISTS_TAC `n:num`\r
2431                THEN ASM_REWRITE_TAC[]\r
2432                THEN POP_ASSUM MP_TAC\r
2433                THEN REWRITE_TAC[is_path; lemma_def_path]\r
2434                THEN DISCH_THEN (LABEL_TAC "F1")\r
2435                THEN REPEAT STRIP_TAC\r
2436                THEN REMOVE_THEN "F1" (MP_TAC o SPEC `i:num`)\r
2437                THEN ASM_REWRITE_TAC[]\r
2438                THEN REWRITE_TAC[go_one_step] THEN DISCH_TAC\r
2439                THEN REWRITE_TAC [GSYM shift_lemma]\r
2440                THEN POP_ASSUM MP_TAC THEN MESON_TAC[]; ALL_TAC]\r
2441        THEN REWRITE_TAC[IN_ELIM_THM]\r
2442        THEN REWRITE_TAC[is_in_component]\r
2443        THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A`\r
2444        THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]\r
2445        THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[is_path; lemma_def_path]\r
2446        THEN DISCH_THEN (LABEL_TAC "F1") THEN REPEAT STRIP_TAC\r
2447        THEN REMOVE_THEN "F1" (MP_TAC o SPEC `i:num`)\r
2448        THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step]\r
2449        THEN DISCH_TAC THEN ONCE_REWRITE_TAC [shift_lemma]\r
2450        THEN POP_ASSUM MP_TAC THEN MESON_TAC[]; ALL_TAC]\r
2451   THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC\r
2452   THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[]\r
2453   THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC\r
2454   THENL[REWRITE_TAC[comb_component; IN_ELIM_THM; is_in_component]\r
2455        THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A` THEN EXISTS_TAC `n:num`\r
2456        THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC\r
2457        THEN REWRITE_TAC[is_path; lemma_def_path]\r
2458        THEN DISCH_THEN (LABEL_TAC "F2")\r
2459        THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F2" (MP_TAC o SPEC `i:num`)\r
2460        THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step]\r
2461        THEN DISCH_TAC THEN ONCE_REWRITE_TAC [shift_lemma]\r
2462        THEN POP_ASSUM MP_TAC THEN MESON_TAC[]; ALL_TAC]\r
2463   THEN REWRITE_TAC[IN_ELIM_THM]\r
2464   THEN REWRITE_TAC[comb_component; is_in_component; IN_ELIM_THM]\r
2465   THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A`\r
2466   THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]\r
2467   THEN POP_ASSUM MP_TAC\r
2468   THEN REWRITE_TAC[is_path; lemma_def_path]\r
2469   THEN DISCH_THEN (LABEL_TAC "F2")\r
2470   THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F2" (MP_TAC o SPEC `i:num`)\r
2471   THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step]\r
2472   THEN DISCH_TAC THEN REWRITE_TAC[GSYM shift_lemma]\r
2473   THEN POP_ASSUM MP_TAC THEN MESON_TAC[]);;\r
2474 \r
2475 \r
2476 let lemma_planar_invariant_shift = prove(`!(H:(A)hypermap). planar_ind H = planar_ind (shift H)`,\r
2477     GEN_TAC THEN REWRITE_TAC[planar_ind; number_of_edges; number_of_nodes; number_of_faces; number_of_components]\r
2478     THEN ONCE_REWRITE_TAC[GSYM lemma_shift_component_invariant]\r
2479     THEN REWRITE_TAC[edge_set; node_set; face_set]\r
2480     THEN ONCE_REWRITE_TAC[GSYM shift_lemma]\r
2481     THEN REAL_ARITH_TAC);;\r
2482 \r
2483 let in_orbit_map1 = prove(`!p:A->A x:A. p x IN orbit_map p x`,\r
2484    REPEAT GEN_TAC THEN MP_TAC (SPECL[`p:A->A`; `1`; `x:A`; `(p:A->A) (x:A)`] in_orbit_lemma)\r
2485    THEN REWRITE_TAC[POWER_1]);;\r
2486 \r
2487 \r
2488 let lemma_orbit_eq = prove(`!p:A->A q:A->A x:A. (!n:num. (p POWER n) x = (q POWER n) x) ==> orbit_map p x = orbit_map q x`,\r
2489 REPEAT STRIP_TAC THEN REWRITE_TAC[orbit_map; EXTENSION; IN_ELIM_THM]\r
2490   THEN STRIP_TAC THEN EQ_TAC\r
2491   THENL[STRIP_TAC THEN EXISTS_TAC `n:num`\r
2492           THEN REWRITE_TAC[ARITH_RULE `n:num >= 0`]\r
2493           THEN FIRST_X_ASSUM (MP_TAC o SPEC `n:num` o check (is_forall o concl))\r
2494           THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2495   THEN STRIP_TAC THEN EXISTS_TAC `n:num`\r
2496   THEN REWRITE_TAC[ARITH_RULE `n:num >= 0`]\r
2497   THEN FIRST_X_ASSUM (MP_TAC o SYM o SPEC `n:num` o check (is_forall o concl))\r
2498   THEN ASM_REWRITE_TAC[]);;\r
2499 \r
2500 let lemma_not_in_orbit_powers = prove(`!s:A->bool p:A->A x:A y:A n:num m:num. FINITE s /\ p permutes s /\ ~(y IN orbit_map p x) ==> ~((p POWER n) y = (p POWER m) x)`,\r
2501 REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl))\r
2502   THEN REWRITE_TAC[]\r
2503   THEN MP_TAC(SPECL[`p:A->A`; `m:num`; `x:A`; `((p:A->A) POWER (m:num)) (x:A)`] in_orbit_lemma)\r
2504   THEN SIMP_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM)\r
2505   THEN DISCH_TAC THEN MP_TAC(SPECL[`p:A->A`; `y:A`] orbit_reflect)\r
2506   THEN MP_TAC(SPECL[`s:A->bool`; `p:A->A`; `y:A`; `n:num`] lemma_orbit_power)\r
2507   THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN STRIP_TAC\r
2508   THEN MP_TAC(SPECL[`p:A->A`; `y:A`; `((p:A->A) POWER (n:num)) (y:A)`; `x:A` ] orbit_trans)\r
2509   THEN ASM_REWRITE_TAC[]);;\r
2510 \r
2511 let lemma_walkup_nodes = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> (node_set H) DELETE (node H x) = (node_set (edge_walkup H x)) DELETE (node (edge_walkup H x) (inverse(node_map H) x))`,\r
2512    REPEAT GEN_TAC\r
2513    THEN label_hypermap_TAC `H:(A)hypermap`\r
2514    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
2515    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
2516    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
2517    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
2518    THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
2519    THEN ASM_REWRITE_TAC[]\r
2520    THEN STRIP_TAC\r
2521    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
2522    THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))`\r
2523    THEN LABEL_TAC "F1" (SPECL[`n:A->A`; `x:A`] orbit_reflect)\r
2524    THEN DISCH_THEN (LABEL_TAC "F2")\r
2525    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> MP_TAC(SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))\r
2526    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F3"))\r
2527    THEN USE_THEN "F3" ((LABEL_TAC "F4") o MATCH_MP in_orbit_lemma)\r
2528    THEN ASM_REWRITE_TAC[node_set; node]\r
2529    THEN REPEAT STRIP_TAC\r
2530    THEN REWRITE_TAC[set_of_orbits]\r
2531    THEN REWRITE_TAC[EXTENSION]\r
2532    THEN STRIP_TAC\r
2533    THEN REWRITE_TAC[IN_DELETE]\r
2534    THEN EQ_TAC\r
2535    THENL[REWRITE_TAC[IN_ELIM_THM]\r
2536   THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) (LABEL_TAC "F7"))\r
2537   THEN REMOVE_THEN "F6" SUBST_ALL_TAC\r
2538   THEN SUBGOAL_THEN `~(y:A IN orbit_map (n:A->A) (x:A))` (LABEL_TAC "F8")\r
2539   THENL[POP_ASSUM MP_TAC\r
2540           THEN REWRITE_TAC[CONTRAPOS_THM]\r
2541           THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2542           THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2543   THEN SUBGOAL_THEN `!m:num. ((n:A->A) POWER (m:num)) (y:A) =  ((n':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9")\r
2544   THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
2545           THEN  POP_ASSUM (LABEL_TAC "F9" o SYM)\r
2546           THEN  MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `y:A`; `m:num`; `j:num`] lemma_not_in_orbit_powers)\r
2547           THEN  ASM_REWRITE_TAC[]\r
2548           THEN  STRIP_TAC\r
2549           THEN  MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `y:A`; `m:num`; `0`] lemma_not_in_orbit_powers)\r
2550           THEN  ASM_REWRITE_TAC[POWER_0; I_THM]\r
2551           THEN  STRIP_TAC\r
2552           THEN  REWRITE_TAC[GSYM iterate_map_valuation]\r
2553           THEN  REMOVE_THEN "F9" SUBST1_TAC\r
2554           THEN  MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((n:A->A) POWER (m:num)) (y:A)`] node_map_walkup)))\r
2555           THEN  ASM_REWRITE_TAC[]\r
2556           THEN  DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2557   THEN SUBGOAL_THEN `~(((n:A->A) POWER (j:num)) (x:A) IN orbit_map n (y:A))` (LABEL_TAC "F10")\r
2558   THENL[ REMOVE_THEN "F8" MP_TAC\r
2559            THEN  REWRITE_TAC[CONTRAPOS_THM]\r
2560            THEN  USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2561            THEN  MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `j:num`] lemma_orbit_power)\r
2562            THEN  ASM_REWRITE_TAC[]\r
2563            THEN  DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
2564            THEN  DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
2565            THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
2566   THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq)\r
2567   THEN DISCH_THEN SUBST_ALL_TAC\r
2568   THEN STRIP_TAC\r
2569   THENL[EXISTS_TAC `y:A`\r
2570           THEN MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `y:A`; `0`; `0`] lemma_not_in_orbit_powers)\r
2571           THEN ASM_REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
2572   THEN POP_ASSUM MP_TAC\r
2573   THEN REWRITE_TAC[CONTRAPOS_THM]\r
2574   THEN DISCH_THEN SUBST1_TAC\r
2575   THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
2576   THEN REWRITE_TAC[IN_ELIM_THM]\r
2577   THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "FF")) (LABEL_TAC "F6"))) (LABEL_TAC "F7"))\r
2578   THEN REMOVE_THEN "F6" SUBST_ALL_TAC\r
2579      THEN SUBGOAL_THEN `y:A IN (D:A->bool) DELETE (x:A)` (LABEL_TAC "F8")\r
2580      THENL[FIND_ASSUM SUBST1_TAC `D':A->bool = (D:A->bool) DELETE x:A`\r
2581         THEN  ASM_ASM_SET_TAC; ALL_TAC]\r
2582      THEN SUBGOAL_THEN `!k:num. ~(((n':A->A) POWER k) (y:A) = x:A)` (LABEL_TAC "FG")\r
2583      THENL[GEN_TAC\r
2584              THEN MP_TAC (MESON[hypermap_lemma] `node_map (edge_walkup (H:(A)hypermap) (x:A)) permutes dart(edge_walkup H x)`)\r
2585              THEN ASM_REWRITE_TAC[]\r
2586              THEN DISCH_THEN (MP_TAC o SPECL[`k:num`; `y:A`] o MATCH_MP iterate_orbit)\r
2587              THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th])\r
2588              THEN REWRITE_TAC[IN_DELETE]\r
2589              THEN SIMP_TAC[]; ALL_TAC]\r
2590      THEN MP_TAC(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma)\r
2591      THEN ASM_REWRITE_TAC[]\r
2592      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2" o CONJUNCT1 o CONJUNCT2))\r
2593      THEN SUBGOAL_THEN `~(((n:A->A) POWER (j:num)) (x:A) IN orbit_map (n':A->A) (y:A))` (LABEL_TAC "FH")\r
2594      THENL[ USE_THEN "F7" MP_TAC\r
2595         THEN  REWRITE_TAC[CONTRAPOS_THM]\r
2596         THEN USE_THEN "G1" (fun th1 -> (USE_THEN "G2" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2597         THEN REWRITE_TAC[]; ALL_TAC]\r
2598      THEN SUBGOAL_THEN `!m:num. ((n:A->A) POWER (m:num)) (y:A) =  ((n':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9")\r
2599      THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
2600              THEN POP_ASSUM (LABEL_TAC "F9" o SYM)\r
2601              THEN REMOVE_THEN "FG" (LABEL_TAC "F10" o SPEC `m:num`)\r
2602              THEN MP_TAC(SPECL[`D':A->bool`; `n':A->A`; `y:A`; `((n:A->A) POWER (j:num)) (x:A)`; `0`; `m:num`] lemma_not_in_orbit_powers)\r
2603              THEN ASM_REWRITE_TAC[POWER_0; I_THM]\r
2604              THEN DISCH_THEN (LABEL_TAC "F11" o GSYM)\r
2605              THEN REWRITE_TAC[GSYM iterate_map_valuation]\r
2606              THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((n:A->A) POWER (m:num)) (y:A)`] node_map_walkup)))\r
2607              THEN ASM_REWRITE_TAC[]\r
2608              THEN USE_THEN "F9" (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [SYM th])\r
2609              THEN ASM_REWRITE_TAC[]\r
2610              THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2611      THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq)\r
2612      THEN DISCH_THEN (SUBST_ALL_TAC o SYM)\r
2613      THEN STRIP_TAC\r
2614      THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2615      THEN POP_ASSUM MP_TAC\r
2616      THEN REWRITE_TAC[CONTRAPOS_THM]\r
2617      THEN DISCH_THEN SUBST1_TAC\r
2618      THEN REWRITE_TAC[orbit_map; IN_ELIM_THM]\r
2619      THEN EXISTS_TAC `j:num` THEN ARITH_TAC);;\r
2620 \r
2621 \r
2622 let lemma_walkup_faces  = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> (face_set H) DELETE (face H x) = (face_set (edge_walkup H x)) DELETE (face (edge_walkup H x) (inverse(face_map H) x))`,\r
2623    REPEAT GEN_TAC\r
2624    THEN label_hypermap_TAC `H:(A)hypermap`\r
2625    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
2626    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
2627    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
2628    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
2629    THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
2630    THEN ASM_REWRITE_TAC[]\r
2631    THEN STRIP_TAC\r
2632    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
2633    THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))`\r
2634    THEN LABEL_TAC "F1" (SPECL[`f:A->A`; `x:A`] orbit_reflect)\r
2635    THEN DISCH_THEN (LABEL_TAC "F2")\r
2636    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> MP_TAC(SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))\r
2637    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F3"))\r
2638    THEN USE_THEN "F3" ((LABEL_TAC "F4") o MATCH_MP in_orbit_lemma)\r
2639    THEN ASM_REWRITE_TAC[face_set; face]\r
2640    THEN REPEAT STRIP_TAC\r
2641    THEN REWRITE_TAC[set_of_orbits]\r
2642    THEN REWRITE_TAC[EXTENSION]\r
2643    THEN STRIP_TAC\r
2644    THEN REWRITE_TAC[IN_DELETE]\r
2645    THEN EQ_TAC\r
2646    THENL[REWRITE_TAC[IN_ELIM_THM]\r
2647   THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) (LABEL_TAC "F7"))\r
2648   THEN REMOVE_THEN "F6" SUBST_ALL_TAC\r
2649   THEN SUBGOAL_THEN `~(y:A IN orbit_map (f:A->A) (x:A))` (LABEL_TAC "F8")\r
2650   THENL[POP_ASSUM MP_TAC\r
2651           THEN REWRITE_TAC[CONTRAPOS_THM]\r
2652           THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2653           THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2654   THEN SUBGOAL_THEN `!m:num. ((f:A->A) POWER (m:num)) (y:A) =  ((f':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9")\r
2655   THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
2656           THEN  POP_ASSUM (LABEL_TAC "F9" o SYM)\r
2657           THEN  MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `y:A`; `m:num`; `j:num`] lemma_not_in_orbit_powers)\r
2658           THEN  ASM_REWRITE_TAC[]\r
2659           THEN  STRIP_TAC\r
2660           THEN  MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `y:A`; `m:num`; `0`] lemma_not_in_orbit_powers)\r
2661           THEN  ASM_REWRITE_TAC[POWER_0; I_THM]\r
2662           THEN  STRIP_TAC\r
2663           THEN  REWRITE_TAC[GSYM iterate_map_valuation]\r
2664           THEN  REMOVE_THEN "F9" SUBST1_TAC\r
2665           THEN  MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((f:A->A) POWER (m:num)) (y:A)`] face_map_walkup)))\r
2666           THEN  ASM_REWRITE_TAC[]\r
2667           THEN  DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2668   THEN SUBGOAL_THEN `~(((f:A->A) POWER (j:num)) (x:A) IN orbit_map f (y:A))` (LABEL_TAC "F10")\r
2669   THENL[ REMOVE_THEN "F8" MP_TAC\r
2670            THEN  REWRITE_TAC[CONTRAPOS_THM]\r
2671            THEN  USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2672            THEN  MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `j:num`] lemma_orbit_power)\r
2673            THEN  ASM_REWRITE_TAC[]\r
2674            THEN  DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
2675            THEN  DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
2676            THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
2677   THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq)\r
2678   THEN DISCH_THEN SUBST_ALL_TAC\r
2679   THEN STRIP_TAC\r
2680   THENL[EXISTS_TAC `y:A`\r
2681           THEN MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `y:A`; `0`; `0`] lemma_not_in_orbit_powers)\r
2682           THEN ASM_REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
2683   THEN POP_ASSUM MP_TAC\r
2684   THEN REWRITE_TAC[CONTRAPOS_THM]\r
2685   THEN DISCH_THEN SUBST1_TAC\r
2686   THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
2687   THEN REWRITE_TAC[IN_ELIM_THM]\r
2688   THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "FF")) (LABEL_TAC "F6"))) (LABEL_TAC "F7"))\r
2689   THEN REMOVE_THEN "F6" SUBST_ALL_TAC\r
2690      THEN SUBGOAL_THEN `y:A IN (D:A->bool) DELETE (x:A)` (LABEL_TAC "F8")\r
2691      THENL[FIND_ASSUM SUBST1_TAC `D':A->bool = (D:A->bool) DELETE x:A`\r
2692         THEN  ASM_ASM_SET_TAC; ALL_TAC]\r
2693      THEN SUBGOAL_THEN `!k:num. ~(((f':A->A) POWER k) (y:A) = x:A)` (LABEL_TAC "FG")\r
2694      THENL[GEN_TAC\r
2695              THEN MP_TAC (MESON[hypermap_lemma] `face_map (edge_walkup (H:(A)hypermap) (x:A)) permutes dart(edge_walkup H x)`)\r
2696              THEN ASM_REWRITE_TAC[]\r
2697              THEN DISCH_THEN (MP_TAC o SPECL[`k:num`; `y:A`] o MATCH_MP iterate_orbit)\r
2698              THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th])\r
2699              THEN REWRITE_TAC[IN_DELETE]\r
2700              THEN SIMP_TAC[]; ALL_TAC]\r
2701      THEN MP_TAC(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma)\r
2702      THEN ASM_REWRITE_TAC[]\r
2703      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2" o CONJUNCT1 o  CONJUNCT2 o CONJUNCT2))\r
2704      THEN SUBGOAL_THEN `~(((f:A->A) POWER (j:num)) (x:A) IN orbit_map (f':A->A) (y:A))` (LABEL_TAC "FH")\r
2705      THENL[ USE_THEN "F7" MP_TAC\r
2706         THEN  REWRITE_TAC[CONTRAPOS_THM]\r
2707         THEN USE_THEN "G1" (fun th1 -> (USE_THEN "G2" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2708         THEN REWRITE_TAC[]; ALL_TAC]\r
2709      THEN SUBGOAL_THEN `!m:num. ((f:A->A) POWER (m:num)) (y:A) =  ((f':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9")\r
2710      THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
2711              THEN POP_ASSUM (LABEL_TAC "F9" o SYM)\r
2712              THEN REMOVE_THEN "FG" (LABEL_TAC "F10" o SPEC `m:num`)\r
2713              THEN MP_TAC(SPECL[`D':A->bool`; `f':A->A`; `y:A`; `((f:A->A) POWER (j:num)) (x:A)`; `0`; `m:num`] lemma_not_in_orbit_powers)\r
2714              THEN ASM_REWRITE_TAC[POWER_0; I_THM]\r
2715              THEN DISCH_THEN (LABEL_TAC "F11" o GSYM)\r
2716              THEN REWRITE_TAC[GSYM iterate_map_valuation]\r
2717              THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((f:A->A) POWER (m:num)) (y:A)`] face_map_walkup)))\r
2718              THEN ASM_REWRITE_TAC[]\r
2719              THEN USE_THEN "F9" (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [SYM th])\r
2720              THEN ASM_REWRITE_TAC[]\r
2721              THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2722      THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq)\r
2723      THEN DISCH_THEN (SUBST_ALL_TAC o SYM)\r
2724      THEN STRIP_TAC\r
2725      THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2726      THEN POP_ASSUM MP_TAC\r
2727      THEN REWRITE_TAC[CONTRAPOS_THM]\r
2728      THEN DISCH_THEN SUBST1_TAC\r
2729      THEN REWRITE_TAC[orbit_map; IN_ELIM_THM]\r
2730      THEN EXISTS_TAC `j:num` THEN ARITH_TAC);;\r
2731 \r
2732 \r
2733 let lemma_walkup_first_edge_eq = prove(`!(H:(A)hypermap) (x:A) (y:A).x IN dart H /\ ~(x IN edge H y) /\  ~(node_map H x IN edge H y) ==> edge H y = edge (edge_walkup H x) y /\ ~(inverse (edge_map H) x IN edge H y)`,\r
2734    REPEAT GEN_TAC\r
2735    THEN label_hypermap_TAC `H:(A)hypermap`\r
2736    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
2737    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
2738    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
2739    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
2740    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
2741    THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))`\r
2742    THEN REWRITE_TAC[edge]\r
2743    THEN ASM_REWRITE_TAC[]\r
2744    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F4")))\r
2745    THEN SUBGOAL_THEN `!m:num. ((e:A->A) POWER m) (y:A) = ((e':A->A) POWER m) (y:A)` ASSUME_TAC\r
2746    THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
2747      THEN REWRITE_TAC[GSYM iterate_map_valuation]\r
2748      THEN POP_ASSUM (SUBST1_TAC o SYM)\r
2749      THEN SUBGOAL_THEN `~(((e:A->A) POWER (m:num)) (y:A) = x:A)` (LABEL_TAC "F5")\r
2750      THENL[USE_THEN "F2" MP_TAC\r
2751             THEN REWRITE_TAC[CONTRAPOS_THM]\r
2752             THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV)\r
2753             THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC]\r
2754      THEN SUBGOAL_THEN `~(((e:A->A) POWER (m:num)) (y:A) = (inverse e) (x:A))` (LABEL_TAC "F6")\r
2755      THENL[USE_THEN "F2" MP_TAC\r
2756             THEN REWRITE_TAC[CONTRAPOS_THM]\r
2757             THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV)\r
2758             THEN DISCH_THEN (MP_TAC o AP_TERM `e:A->A`)\r
2759             THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV)[GSYM o_THM]\r
2760             THEN USE_THEN "H2" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_THM; iterate_map_valuation])\r
2761             THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC]\r
2762      THEN SUBGOAL_THEN `~(((e:A->A) POWER (m:num)) (y:A) = (n:A->A) (x:A))` (LABEL_TAC "F7")\r
2763      THENL[USE_THEN "F4" MP_TAC\r
2764             THEN REWRITE_TAC[CONTRAPOS_THM]\r
2765             THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV)\r
2766             THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC]\r
2767      THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((e:A->A) POWER (m:num)) (y:A)`] edge_map_walkup))))\r
2768      THEN ASM_REWRITE_TAC[]\r
2769      THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2770    THEN STRIP_TAC\r
2771    THENL[POP_ASSUM (MP_TAC o MATCH_MP lemma_orbit_eq)\r
2772            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
2773            THEN SIMP_TAC[]; ALL_TAC]\r
2774    THEN REMOVE_THEN "F2" MP_TAC\r
2775    THEN REWRITE_TAC[CONTRAPOS_THM]\r
2776    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (DISCH_THEN (fun th3 -> (ASSUME_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2777    THEN POP_ASSUM SUBST1_TAC\r
2778    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> MP_TAC (SPEC `x:A` (MATCH_MP lemma_inverse_in_orbit (CONJ th1 th2))))))\r
2779    THEN MATCH_MP_TAC orbit_sym\r
2780    THEN EXISTS_TAC `D:A->bool`\r
2781    THEN ASM_REWRITE_TAC[]);;\r
2782 \r
2783 \r
2784 let lemma_walkup_second_edge_eq = prove(`!(H:(A)hypermap) (x:A) (y:A).x IN dart H /\ y IN dart H /\ ~(y = x) /\  ~(node_map H x IN edge (edge_walkup H x) y) /\  ~((inverse (edge_map H)) x IN edge (edge_walkup H x) y)  ==> edge H y = edge (edge_walkup H x) y /\ ~(x IN edge H y) /\ ~ (node_map H x IN edge H y)`,\r
2785    REPEAT GEN_TAC\r
2786    THEN label_hypermap_TAC `H:(A)hypermap`\r
2787    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
2788    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
2789    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
2790    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
2791    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
2792    THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))`\r
2793    THEN REWRITE_TAC[edge]\r
2794    THEN ASM_REWRITE_TAC[]\r
2795    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))))\r
2796    THEN SUBGOAL_THEN `!m:num. ((e:A->A) POWER m) (y:A) = ((e':A->A) POWER m) (y:A)` ASSUME_TAC\r
2797    THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
2798         THEN REWRITE_TAC[GSYM iterate_map_valuation]\r
2799         THEN POP_ASSUM (SUBST1_TAC)\r
2800         THEN MP_TAC (SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma)\r
2801         THEN ASM_REWRITE_TAC[]\r
2802         THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2" o CONJUNCT1))\r
2803         THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
2804         THEN ASM_REWRITE_TAC[]\r
2805         THEN DISCH_THEN ASSUME_TAC\r
2806         THEN SUBGOAL_THEN `y:A IN D':A->bool` ASSUME_TAC\r
2807         THENL[POP_ASSUM SUBST1_TAC THEN ASM_ASM_SET_TAC; ALL_TAC]\r
2808        THEN USE_THEN "G2" (MP_TAC o MATCH_MP iterate_orbit)\r
2809        THEN DISCH_THEN (MP_TAC o SPECL[`m:num`; `y:A`])\r
2810        THEN ASM_REWRITE_TAC[]\r
2811        THEN ASM_REWRITE_TAC[IN_DELETE]\r
2812        THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2)\r
2813        THEN SUBGOAL_THEN `~(((e':A->A) POWER (m:num)) (y:A) = (inverse e) (x:A))` ASSUME_TAC\r
2814        THENL[USE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
2815                THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV)\r
2816                THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC]\r
2817        THEN SUBGOAL_THEN `~(((e':A->A) POWER (m:num)) (y:A) = (n:A->A) (x:A))` ASSUME_TAC\r
2818        THENL[USE_THEN "F4" MP_TAC\r
2819             THEN REWRITE_TAC[CONTRAPOS_THM]\r
2820             THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV)\r
2821             THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC]\r
2822        THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((e':A->A) POWER (m:num)) (y:A)`] edge_map_walkup))))\r
2823        THEN ASM_REWRITE_TAC[]\r
2824        THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC]\r
2825    THEN POP_ASSUM (LABEL_TAC "FF" o MATCH_MP lemma_orbit_eq)\r
2826    THEN USE_THEN "FF" (fun th -> REWRITE_TAC[th])\r
2827    THEN POP_ASSUM (SUBST_ALL_TAC o SYM)\r
2828    THEN STRIP_TAC\r
2829    THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
2830            THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (DISCH_THEN (fun th3 -> (ASSUME_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
2831            THEN POP_ASSUM SUBST1_TAC\r
2832            THEN MATCH_MP_TAC lemma_inverse_in_orbit\r
2833            THEN EXISTS_TAC `D:A->bool`\r
2834            THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2835    THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]));;\r
2836 \r
2837 let lemma_walkup_edges = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> (edge_set H) DIFF {edge H x, edge H (node_map H x)} = (edge_set (edge_walkup H x)) DIFF {edge (edge_walkup H x) (node_map H x), edge (edge_walkup H x) (inverse (edge_map H) x)}`,\r
2838    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1")\r
2839    THEN REWRITE_TAC[edge_set; edge] THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
2840    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
2841    THEN REWRITE_TAC[set_of_orbits; SET_RULE `s DIFF {a, b} = (s DELETE a) DELETE b`]\r
2842    THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC\r
2843    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`\r
2844    THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))`\r
2845    THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma)\r
2846    THEN ASM_REWRITE_TAC[]\r
2847    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2" o CONJUNCT1))\r
2848    THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
2849    THEN ASM_REWRITE_TAC[]\r
2850    THEN DISCH_THEN (LABEL_TAC "G1")\r
2851    THEN EQ_TAC THENL[REWRITE_TAC[IN_ELIM_THM; IN_DELETE]\r
2852       THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) ) (LABEL_TAC "F4")) (LABEL_TAC "F5"))\r
2853       THEN REMOVE_THEN "F3" SUBST_ALL_TAC\r
2854       THEN SUBGOAL_THEN `~(x:A IN orbit_map (e:A->A) (y:A))` (LABEL_TAC "F6")\r
2855       THENL[USE_THEN "F4" MP_TAC\r
2856          THEN REWRITE_TAC[CONTRAPOS_THM]\r
2857          THEN DISCH_TAC THEN MATCH_MP_TAC lemma_orbit_identity\r
2858          THEN EXISTS_TAC `D:A->bool`\r
2859          THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2860       THEN SUBGOAL_THEN `~(node_map (H:(A)hypermap) x:A IN orbit_map (e:A->A) (y:A))` (LABEL_TAC "F6")\r
2861       THENL[USE_THEN "F5" MP_TAC\r
2862          THEN REWRITE_TAC[CONTRAPOS_THM]\r
2863          THEN DISCH_TAC THEN MATCH_MP_TAC lemma_orbit_identity\r
2864          THEN EXISTS_TAC `D:A->bool`\r
2865          THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2866       THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_first_edge_eq)\r
2867       THEN ASM_REWRITE_TAC[edge]\r
2868       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))\r
2869       THEN STRIP_TAC\r
2870       THENL[STRIP_TAC\r
2871          THENL[EXISTS_TAC `y:A`\r
2872               THEN USE_THEN "F7" (fun th -> REWRITE_TAC[th])\r
2873               THEN SUBGOAL_THEN `~(y:A = x:A)` MP_TAC\r
2874               THENL[USE_THEN "F4" MP_TAC\r
2875                  THEN REWRITE_TAC[CONTRAPOS_THM]\r
2876                  THEN DISCH_THEN SUBST1_TAC\r
2877                  THEN SIMP_TAC[]; ALL_TAC] \r
2878               THEN USE_THEN "F2" MP_TAC\r
2879               THEN REWRITE_TAC[IMP_IMP]\r
2880               THEN ASM_ASM_SET_TAC; ALL_TAC]\r
2881          THEN USE_THEN "F6" MP_TAC\r
2882          THEN REWRITE_TAC[CONTRAPOS_THM]\r
2883          THEN DISCH_THEN SUBST1_TAC\r
2884          THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
2885       THEN USE_THEN "F8" MP_TAC\r
2886       THEN REWRITE_TAC[CONTRAPOS_THM]\r
2887       THEN DISCH_THEN SUBST1_TAC\r
2888       THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
2889    THEN REWRITE_TAC[IN_ELIM_THM; IN_DELETE]\r
2890    THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) ) (LABEL_TAC "F4")) (LABEL_TAC "F5"))\r
2891    THEN REMOVE_THEN "F3" SUBST_ALL_TAC\r
2892    THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)`\r
2893    THEN MP_TAC (SPEC `G:(A)hypermap` hypermap_lemma)\r
2894    THEN ASM_REWRITE_TAC[]\r
2895    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "GA") (LABEL_TAC "GB" o CONJUNCT1))\r
2896    THEN SUBGOAL_THEN `(y:A IN D:A->bool) /\ ~(y:A = x:A)` ASSUME_TAC\r
2897    THENL[USE_THEN "F2" MP_TAC\r
2898       THEN USE_THEN "G1" SUBST1_TAC\r
2899       THEN REWRITE_TAC[IN_DELETE]; ALL_TAC]\r
2900    THEN SUBGOAL_THEN `~(node_map (H:(A)hypermap) (x:A) IN orbit_map (e':A->A) (y:A))` (LABEL_TAC "F6")\r
2901    THENL[ USE_THEN "F4" MP_TAC\r
2902       THEN REWRITE_TAC[CONTRAPOS_THM]\r
2903       THEN DISCH_TAC\r
2904       THEN MATCH_MP_TAC lemma_orbit_identity\r
2905       THEN EXISTS_TAC `D':A->bool`\r
2906       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2907    THEN SUBGOAL_THEN `~((inverse(e:A->A)) (x:A) IN orbit_map (e':A->A) (y:A))` (LABEL_TAC "F7")\r
2908    THENL[USE_THEN "F5" MP_TAC\r
2909        THEN REWRITE_TAC[CONTRAPOS_THM]\r
2910        THEN DISCH_TAC\r
2911        THEN MATCH_MP_TAC lemma_orbit_identity\r
2912        THEN EXISTS_TAC `D':A->bool`\r
2913        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2914    THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_second_edge_eq)\r
2915    THEN ASM_REWRITE_TAC[edge]\r
2916    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F8") (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")))\r
2917    THEN STRIP_TAC\r
2918    THENL[STRIP_TAC\r
2919       THENL[EXISTS_TAC `y:A`\r
2920               THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2921       THEN USE_THEN "F7" MP_TAC\r
2922       THEN REWRITE_TAC[CONTRAPOS_THM]\r
2923       THEN DISCH_THEN SUBST1_TAC\r
2924       THEN MATCH_MP_TAC lemma_inverse_in_orbit\r
2925       THEN EXISTS_TAC `D:A->bool`\r
2926       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2927     THEN USE_THEN "F8" (SUBST_ALL_TAC o SYM)\r
2928     THEN POP_ASSUM MP_TAC\r
2929     THEN REWRITE_TAC[CONTRAPOS_THM]\r
2930     THEN DISCH_THEN SUBST1_TAC\r
2931     THEN REWRITE_TAC[orbit_reflect]);;\r
2932 \r
2933 let in_set_of_orbits = prove(`!s:A->bool p:A->A. p permutes s ==> (!x:A. x IN s <=> orbit_map p x IN set_of_orbits s p)`,\r
2934    REPEAT STRIP_TAC THEN EQ_TAC\r
2935    THENL[STRIP_TAC\r
2936        THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
2937        THEN EXISTS_TAC `x:A`\r
2938        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
2939    THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
2940    THEN STRIP_TAC\r
2941    THEN FIRST_ASSUM (MP_TAC o SPEC `x':A` o  MATCH_MP orbit_subset)\r
2942    THEN ASM_REWRITE_TAC[]\r
2943    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
2944    THEN MESON_TAC[orbit_reflect; SUBSET]);;\r
2945 \r
2946 let lemma_in_hypermap_orbits = prove(`!(H:(A)hypermap) x:A. (x IN dart H <=> edge H x IN  edge_set H) /\ (x IN dart H <=> node H x IN node_set H) /\ (x IN dart H <=> face H x IN face_set H)`,\r
2947   REPEAT GEN_TAC THEN REWRITE_TAC[edge; node;face; edge_set;node_set;face_set]\r
2948   THEN ASM_MESON_TAC[in_set_of_orbits; CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)]);;\r
2949 \r
2950 let lemma_in_edge_set = prove(`!(H:(A)hypermap) x:A. x IN dart H <=> edge H x IN edge_set H`, MESON_TAC[ lemma_in_hypermap_orbits]);;\r
2951 let lemma_in_node_set = prove(`!(H:(A)hypermap) x:A. x IN dart H <=> node H x IN node_set H`, MESON_TAC[ lemma_in_hypermap_orbits]);;\r
2952 let lemma_in_face_set = prove(`!(H:(A)hypermap) x:A. x IN dart H <=> face H x IN face_set H`, MESON_TAC[ lemma_in_hypermap_orbits]);;\r
2953 \r
2954 let lemma_edge_representation = prove(`!(H:(A)hypermap) u:A->bool. u IN edge_set H ==> ?x:A. x IN dart H /\ u = edge H x`,\r
2955    REPEAT GEN_TAC THEN REWRITE_TAC[edge_set; set_of_orbits; IN_ELIM_THM]\r
2956    THEN REWRITE_TAC[GSYM edge]);;\r
2957 \r
2958 let lemma_node_representation = prove(`!(H:(A)hypermap) u:A->bool. u IN node_set H ==> ?x:A. x IN dart H /\ u = node H x`,\r
2959    REPEAT GEN_TAC THEN REWRITE_TAC[node_set; set_of_orbits; IN_ELIM_THM]\r
2960    THEN REWRITE_TAC[GSYM node]);;\r
2961 \r
2962 let lemma_face_representation = prove(`!(H:(A)hypermap) u:A->bool. u IN face_set H ==> ?x:A. x IN dart H /\ u = face H x`,\r
2963    REPEAT GEN_TAC THEN REWRITE_TAC[face_set; set_of_orbits; IN_ELIM_THM]\r
2964    THEN REWRITE_TAC[GSYM face]);;\r
2965 \r
2966 let lemma_component_representation = prove(`!(H:(A)hypermap) u:A->bool. u IN set_of_components H ==> ?x:A. x IN dart H /\ u = comb_component H x`,\r
2967    REPEAT GEN_TAC THEN REWRITE_TAC[set_of_components; set_part_components; IN_ELIM_THM]\r
2968    THEN REWRITE_TAC[GSYM comb_component]);;\r
2969 \r
2970 let lemma_in_subset = prove(`!s t x. s SUBSET t /\ x IN s ==> x IN t`, SET_TAC[]);;\r
2971 \r
2972 let lemma_complement_two_edges = prove(`!(H:(A)hypermap) (x:A) (y:A). x IN dart H /\ y IN dart H \r
2973    ==> edge H x UNION edge H y = (dart H) DIFF (UNIONS (edge_set H DIFF {edge H x, edge H y}))`,\r
2974    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
2975    THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN EQ_TAC\r
2976    THENL[REWRITE_TAC[IN_UNION]\r
2977        THEN STRIP_TAC\r
2978        THENL[POP_ASSUM (LABEL_TAC "F3")\r
2979            THEN REWRITE_TAC[IN_DIFF; IN_UNIONS; IN_DELETE]\r
2980            THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_edge_subset)\r
2981            THEN DISCH_THEN (fun th-> USE_THEN "F3"(fun th1-> LABEL_TAC "F4" (MATCH_MP lemma_in_subset (CONJ th th1))))\r
2982            THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
2983            THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; GSYM DISJ_ASSOC]\r
2984            THEN GEN_TAC\r
2985            THEN ASM_CASES_TAC `t:A->bool IN edge_set (H:(A)hypermap)`\r
2986            THENL[DISJ2_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_edge_representation)\r
2987                THEN DISCH_THEN (X_CHOOSE_THEN `u:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") SUBST1_TAC))\r
2988                THEN ASM_CASES_TAC `x':A IN edge (H:(A)hypermap) (u:A)`\r
2989                THENL[POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th])\r
2990                    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th])\r
2991                    THEN DISJ1_TAC THEN SET_TAC[]; ALL_TAC]\r
2992                THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC]\r
2993            THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC]\r
2994        THEN POP_ASSUM (LABEL_TAC "F6")\r
2995        THEN REWRITE_TAC[IN_DIFF; IN_UNIONS; IN_DELETE]\r
2996        THEN USE_THEN "F2" (MP_TAC o MATCH_MP lemma_edge_subset)\r
2997        THEN DISCH_THEN (fun th-> USE_THEN "F6"(fun th1-> LABEL_TAC "F7" (MATCH_MP lemma_in_subset (CONJ th th1))))\r
2998        THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th])\r
2999        THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; GSYM DISJ_ASSOC]\r
3000        THEN GEN_TAC\r
3001        THEN ASM_CASES_TAC `t:A->bool IN edge_set (H:(A)hypermap)`\r
3002        THENL[DISJ2_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_edge_representation)\r
3003            THEN DISCH_THEN (X_CHOOSE_THEN `v:A` (CONJUNCTS_THEN2 (LABEL_TAC "F8") SUBST1_TAC))\r
3004            THEN ASM_CASES_TAC `x':A IN edge (H:(A)hypermap) (v:A)`\r
3005            THENL[POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th])\r
3006                THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th])\r
3007                THEN DISJ1_TAC THEN SET_TAC[]; ALL_TAC]\r
3008            THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC]\r
3009        THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC]\r
3010    THEN REWRITE_TAC[UNIONS; IN_DIFF; IN_ELIM_THM; IN_DIFF; NOT_EXISTS_THM; DE_MORGAN_THM]\r
3011    THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `edge (H:(A)hypermap) (x':A)`))\r
3012    THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[lemma_in_edge_set] th; edge_refl; SET_RULE `z:A IN {a, b} <=> z = a \/ z = b`])\r
3013    THEN STRIP_TAC\r
3014    THENL[REWRITE_TAC[IN_UNION]\r
3015        THEN DISJ1_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[edge_refl]; ALL_TAC]\r
3016    THEN REWRITE_TAC[IN_UNION]\r
3017    THEN DISJ2_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[edge_refl]);;\r
3018 \r
3019 let lemma_edge_complement = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> edge H x = dart H DIFF UNIONS (edge_set H DELETE edge H x)`,\r
3020    REPEAT STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] lemma_complement_two_edges)\r
3021    THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);;\r
3022 \r
3023 let lemma_in_walkup_dart = prove(`!(H:(A)hypermap) (x:A) (y:A). x IN dart H /\ y IN dart H /\ ~(y = x) ==> y IN dart (edge_walkup H x)`,\r
3024    REPEAT GEN_TAC THEN REWRITE_TAC[lemma_edge_walkup; IN_DELETE] THEN SIMP_TAC[]);;\r
3025 \r
3026 let lemma_edge_map_walkup_in_dart = prove(`!H:(A)hypermap x:A. x IN dart H /\ ~(edge_map H x = x) \r
3027     ==> (edge_map H x IN dart (edge_walkup H x)) /\ (inverse (edge_map H) x IN dart (edge_walkup H x))`,\r
3028        REPEAT GEN_TAC\r
3029        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3030        THEN REWRITE_TAC[lemma_edge_walkup]\r
3031        THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP lemma_dart_invariant)\r
3032        THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP lemma_dart_inveriant_under_inverse_maps)\r
3033        THEN MP_TAC (SPEC `x:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts))))\r
3034        THEN ASM_REWRITE_TAC[IN_DELETE]);;\r
3035 \r
3036 let lemma_node_map_walkup_in_dart = prove(`!H:(A)hypermap x:A. x IN dart H /\ ~(node_map H x = x) ==> (node_map H x IN dart (edge_walkup H x)) /\ (inverse (node_map H) x IN dart (edge_walkup H x))`,\r
3037        REPEAT GEN_TAC\r
3038        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3039        THEN REWRITE_TAC[lemma_edge_walkup]\r
3040        THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
3041        THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps)\r
3042        THEN MP_TAC (SPEC `x:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT2((SPEC `H:(A)hypermap` node_map_and_darts)))))\r
3043        THEN ASM_REWRITE_TAC[IN_DELETE]);;\r
3044 \r
3045 let lemma_face_map_walkup_in_dart = prove(`!H:(A)hypermap x:A. x IN dart H /\ ~(face_map H x = x) ==> (face_map H x IN dart (edge_walkup H x)) /\ (inverse (face_map H) x IN dart (edge_walkup H x))`,\r
3046        REPEAT GEN_TAC\r
3047        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3048        THEN REWRITE_TAC[lemma_edge_walkup]\r
3049        THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
3050        THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps)\r
3051        THEN MP_TAC (SPEC `x:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))))\r
3052        THEN ASM_REWRITE_TAC[IN_DELETE]);;\r
3053 \r
3054 let lemma_walkup_support_edges = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_nondegenerate H x  ==> edge H x UNION edge H (node_map H x) = {x} UNION (edge (edge_walkup H x) (node_map H x) UNION edge (edge_walkup H x) (inverse (edge_map H) x))`,\r
3055  REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3056    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
3057    THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP lemma_complement_two_edges (CONJ th th1)]))\r
3058    THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[dart_nondegenerate])\r
3059    THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> MP_TAC(CONJUNCT2(MATCH_MP lemma_edge_map_walkup_in_dart (CONJ th th1)))))\r
3060    THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[dart_nondegenerate])\r
3061    THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> MP_TAC(CONJUNCT1(MATCH_MP lemma_node_map_walkup_in_dart (CONJ th th1)))))\r
3062    THEN REWRITE_TAC[IMP_IMP]\r
3063    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_complement_two_edges th])\r
3064    THEN USE_THEN "F1" (SUBST1_TAC o SYM o MATCH_MP lemma_walkup_edges)\r
3065    THEN REWRITE_TAC[lemma_edge_walkup]\r
3066    THEN ABBREV_TAC `t = UNIONS (edge_set (H:(A)hypermap) DIFF {edge H (x:A), edge H (node_map H x)})`\r
3067    THEN SUBGOAL_THEN `~(x:A IN t:A->bool)` ASSUME_TAC\r
3068    THENL[EXPAND_TAC "t"\r
3069        THEN REWRITE_TAC[IN_UNIONS; DIFF; IN_ELIM_THM; NOT_EXISTS_THM; DE_MORGAN_THM; GSYM DISJ_ASSOC]\r
3070        THEN GEN_TAC\r
3071        THEN ASM_CASES_TAC `t':A->bool IN edge_set (H:(A)hypermap)`\r
3072        THENL[DISJ2_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_edge_representation)\r
3073            THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G1") SUBST1_TAC))\r
3074            THEN ASM_CASES_TAC `x:A IN edge (H:(A)hypermap) (y:A)`\r
3075            THENL[DISJ1_TAC\r
3076                THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th])\r
3077                THEN SET_TAC[]; ALL_TAC]\r
3078            THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
3079        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
3080    THEN REWRITE_TAC[SET_RULE `{u} UNION v = u INSERT v`]\r
3081    THEN MP_TAC(SPECL[`dart (H:(A)hypermap) DELETE (x:A)`; `t:A->bool`; `x:A`] INSERT_DIFF)\r
3082    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
3083    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP INSERT_DELETE th]));;\r
3084 \r
3085 let lemma_in_edge = prove(`!(H:(A)hypermap) (x:A) (y:A). y IN edge H x <=> (?j:num. y = ((edge_map H) POWER j) x)`,\r
3086    REPEAT GEN_TAC THEN REWRITE_TAC[edge; orbit_map; IN_ELIM_THM] THEN REWRITE_TAC[ARITH_RULE `(n:num) >= 0`]);;\r
3087 \r
3088 let lemma_in_edge2 = prove(`!H:(A)hypermap x:A n:num. (edge_map H POWER n) x IN edge H x`, MESON_TAC[lemma_in_edge]);;\r
3089 \r
3090 let lemma_edge_cycle = prove(`!(H:(A)hypermap) (x:A). ((edge_map H) POWER (CARD (edge H x))) x = x`, \r
3091    REWRITE_TAC[edge] THEN MESON_TAC[hypermap_lemma; lemma_cycle_orbit]);;\r
3092 \r
3093 (* SPLITTING CASE FOR EDGES *)\r
3094 \r
3095 let lemma_edge_split = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_edge_split H x \r
3096    ==> (~((inverse(face_map H)) x IN edge (edge_walkup H x) (node_map H x))) /\\r
3097  (edge H x = {x} UNION (edge (edge_walkup H x) (node_map H x)) UNION (edge (edge_walkup H x) ((inverse (face_map H)) x)))`,\r
3098    REPEAT GEN_TAC THEN  REWRITE_TAC[is_edge_split]\r
3099    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
3100    THEN STRIP_TAC\r
3101    THENL[USE_THEN "F3" MP_TAC THEN REWRITE_TAC[edge]\r
3102        THEN MP_TAC (SPEC `H:(A)hypermap` edge_map_and_darts)\r
3103        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
3104        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_index_on_orbit)\r
3105        THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1" o REWRITE_RULE[GSYM edge]) (LABEL_TAC "G2")))\r
3106        THEN USE_THEN "G2" (MP_TAC o REWRITE_RULE[] o AP_TERM `edge_map (H:(A)hypermap)`)\r
3107        THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
3108        THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [GSYM (ISPECL[`edge_map (H:(A)hypermap)`; `node_map (H:(A)hypermap)`] o_THM)]\r
3109        THEN REWRITE_TAC[GSYM inverse_hypermap_maps]\r
3110        THEN DISCH_THEN (LABEL_TAC "G3")\r
3111        THEN ASM_CASES_TAC `SUC n = CARD (edge (H:(A)hypermap) (x:A))`\r
3112        THENL[POP_ASSUM (fun th-> USE_THEN "G3" (MP_TAC o REWRITE_RULE[th; lemma_edge_cycle]))\r
3113            THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th]); ALL_TAC]\r
3114        THEN USE_THEN "G1" (MP_TAC o REWRITE_RULE[GSYM LE_SUC_LT])\r
3115        THEN ONCE_REWRITE_TAC[LE_LT]\r
3116        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
3117        THEN DISCH_THEN (LABEL_TAC "G4")\r
3118        THEN ASM_CASES_TAC `~(0 < n:num)`\r
3119        THENL[USE_THEN "G2" MP_TAC\r
3120            THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[LT_NZ] th; POWER_0; I_THM])\r
3121            THEN USE_THEN "F2" (fun th-> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th]); ALL_TAC]\r
3122        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS; CONJUNCT1 ADD])\r
3123        THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
3124        THEN SUBGOAL_THEN `!i:num. i<=d ==>(edge_map (edge_walkup (H:(A)hypermap) (x:A)) POWER i) (edge_map H x)=(edge_map H POWER i) (edge_map H x)` (LABEL_TAC "G5")\r
3125        THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC]\r
3126            THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION]\r
3127            THEN POP_ASSUM (LABEL_TAC "G5") THEN DISCH_THEN (LABEL_TAC "G6")\r
3128            THEN USE_THEN "G5" MP_TAC\r
3129            THEN USE_THEN "G6" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)])\r
3130            THEN DISCH_THEN SUBST1_TAC\r
3131            THEN ABBREV_TAC `y = (edge_map (H:(A)hypermap) POWER (i:num)) (edge_map H x)`\r
3132            THEN SUBGOAL_THEN `~(y:A = node_map (H:(A)hypermap) (x:A))` MP_TAC\r
3133            THENL[USE_THEN "G2" SUBST1_TAC THEN EXPAND_TAC "y"\r
3134               THEN REWRITE_TAC[POWER_FUNCTION]\r
3135               THEN MP_TAC (SPECL[`x:A`; `SUC d`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts)))\r
3136               THEN REWRITE_TAC[GSYM edge]\r
3137               THEN USE_THEN "G4" (fun th-> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ (SPEC `SUC d` LT_PLUS) th)])\r
3138               THEN DISCH_THEN (MP_TAC o SPECL[`SUC d`; `SUC i`] o  REWRITE_RULE[lemma_def_inj_orbit])\r
3139               THEN USE_THEN "G6" (fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LT_SUC_LE] th; LE_REFL])\r
3140               THEN SIMP_TAC[]; ALL_TAC]\r
3141            THEN SUBGOAL_THEN `~(y:A = inverse (edge_map (H:(A)hypermap)) (x:A))` MP_TAC\r
3142            THENL[EXPAND_TAC "y" THEN REWRITE_TAC[GSYM edge_map_inverse_representation]\r
3143               THEN REWRITE_TAC[POWER_FUNCTION] THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
3144               THEN MP_TAC (SPECL[`x:A`; `SUC(SUC i)`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts)))\r
3145               THEN REWRITE_TAC[GSYM edge] THEN USE_THEN "G6" (MP_TAC o REWRITE_RULE[GSYM LT_SUC_LE])\r
3146               THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LT_SUC]\r
3147               THEN USE_THEN "G4" (fun th-> DISCH_THEN (fun  th1-> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ th1 th)]))\r
3148               THEN DISCH_THEN (MP_TAC o SPECL[`SUC(SUC i)`; `0`] o  REWRITE_RULE[lemma_def_inj_orbit])\r
3149               THEN REWRITE_TAC[LT_0; LE_REFL; POWER_0; I_THM] THEN SIMP_TAC[]; ALL_TAC]\r
3150            THEN SUBGOAL_THEN `~(y:A = (x:A))` MP_TAC\r
3151            THENL[EXPAND_TAC "y" THEN REWRITE_TAC[POWER_FUNCTION]\r
3152               THEN MP_TAC (SPECL[`x:A`; `SUC i`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts)))\r
3153               THEN REWRITE_TAC[GSYM edge] THEN USE_THEN "G6" (MP_TAC o REWRITE_RULE[GSYM LT_SUC_LE])\r
3154               THEN DISCH_THEN (fun th-> (MP_TAC (MATCH_MP LT_TRANS (CONJ th (SPEC `SUC d` LT_PLUS)))))\r
3155               THEN USE_THEN "G4" (fun th-> (DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ th1 th)])))\r
3156               THEN DISCH_THEN (MP_TAC o SPECL[`SUC i`; `0`] o  REWRITE_RULE[lemma_def_inj_orbit])\r
3157               THEN REWRITE_TAC[LT_0; LE_REFL; POWER_0; I_THM]; ALL_TAC]\r
3158            THEN REWRITE_TAC[IMP_IMP]\r
3159            THEN DISCH_THEN (fun th-> MP_TAC(REWRITE_RULE[th] (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup))))))\r
3160            THEN SIMP_TAC[]; ALL_TAC]\r
3161        THEN USE_THEN "G5" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `d:num`)\r
3162        THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [POWER_FUNCTION]\r
3163        THEN USE_THEN "G2" (SUBST1_TAC o SYM)\r
3164        THEN DISCH_THEN (MP_TAC o AP_TERM `edge_map (edge_walkup (H:(A)hypermap) (x:A))`)\r
3165        THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
3166        THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup)))\r
3167        THEN USE_THEN "F2" (fun th-> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th])\r
3168        THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN REWRITE_TAC[GSYM edge]\r
3169        THEN DISCH_THEN (fun th -> SUBST1_TAC th THEN ASSUME_TAC th)\r
3170        THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`G:(A)hypermap`; `node_map (H:(A)hypermap) (x:A)`; `1`] lemma_in_edge2))\r
3171        THEN POP_ASSUM SUBST1_TAC\r
3172        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th])\r
3173        THEN DISCH_THEN (fun th-> (MP_TAC (MATCH_MP orbit_cyclic (CONJ (SPEC `d:num` NON_ZERO) th))))\r
3174        THEN REWRITE_TAC[GSYM edge]\r
3175        THEN DISCH_THEN SUBST1_TAC\r
3176        THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM; DE_MORGAN_THM]\r
3177        THEN GEN_TAC\r
3178        THEN ASM_CASES_TAC `~(k:num < SUC d)` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
3179        THEN POP_ASSUM (LABEL_TAC "G7" o REWRITE_RULE[LT_SUC_LE])\r
3180        THEN DISJ2_TAC\r
3181        THEN USE_THEN "G7" (fun th-> USE_THEN "G5" (fun th1-> REWRITE_TAC[MATCH_MP th1 th]))\r
3182        THEN USE_THEN "G3" SUBST1_TAC\r
3183        THEN REWRITE_TAC[POWER_FUNCTION]\r
3184        THEN MP_TAC (SPECL[`x:A`; `SUC(SUC d)`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts)))\r
3185        THEN REWRITE_TAC[GSYM edge]\r
3186        THEN USE_THEN "G4" (fun  th -> REWRITE_TAC[th])\r
3187        THEN DISCH_THEN (MP_TAC o SPECL[`SUC(SUC d)`; `SUC k`] o  REWRITE_RULE[lemma_def_inj_orbit])\r
3188        THEN USE_THEN "G7" (MP_TAC o REWRITE_RULE[GSYM LT_SUC_LE])\r
3189        THEN DISCH_THEN (fun th-> REWRITE_TAC[LE_REFL; ONCE_REWRITE_RULE[GSYM LT_SUC] th]); ALL_TAC]\r
3190    THEN MP_TAC(CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup))))\r
3191    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th])\r
3192    THEN DISCH_TAC\r
3193    THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `inverse (edge_map (H:(A)hypermap)) (x:A)`; `1`] lemma_in_edge2))\r
3194    THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (SUBST1_TAC o  SYM o MATCH_MP lemma_edge_identity)\r
3195    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[SYM(MATCH_MP lemma_walkup_support_edges (CONJ th th1))]))\r
3196    THEN POP_ASSUM (SUBST1_TAC o SYM o MATCH_MP lemma_edge_identity)\r
3197    THEN SET_TAC[]);;\r
3198 \r
3199 (* MERGE CASE - FOR EDGES  *)\r
3200 \r
3201 let lemma_edge_merge = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_edge_merge H x \r
3202    ==> {x} UNION (edge (edge_walkup H x) (node_map H x)) = (edge H x) UNION (edge H (node_map H x))`,\r
3203    REPEAT GEN_TAC THEN  REWRITE_TAC[is_edge_merge]\r
3204    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
3205    THEN MP_TAC (SPEC `x:A` (MATCH_MP lemma_inverse_in_orbit (SPEC `H:(A)hypermap` edge_map_and_darts)))\r
3206    THEN MP_TAC (SPEC `H:(A)hypermap` edge_map_and_darts)\r
3207    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
3208    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_index_on_orbit)\r
3209    THEN REWRITE_TAC[GSYM edge]\r
3210    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
3211    THEN ASM_CASES_TAC `~(0 < n:num)`\r
3212    THENL[USE_THEN "F5" MP_TAC\r
3213        THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[LT_NZ] th; POWER_0; I_THM])\r
3214        THEN USE_THEN "F2" (fun th-> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th])\r
3215        THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th]); ALL_TAC]\r
3216    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS; CONJUNCT1 ADD])\r
3217    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
3218    THEN SUBGOAL_THEN `!i:num. i<=d ==>(edge_map (edge_walkup (H:(A)hypermap) (x:A)) POWER i) (edge_map H x)=(edge_map H POWER i) (edge_map H x)` (LABEL_TAC "F6")\r
3219    THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC]\r
3220        THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN POP_ASSUM (LABEL_TAC "G1")\r
3221        THEN DISCH_THEN (LABEL_TAC "G2") THEN USE_THEN "G1" MP_TAC\r
3222        THEN USE_THEN "G2" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)])\r
3223        THEN DISCH_THEN SUBST1_TAC\r
3224        THEN ABBREV_TAC `y = (edge_map (H:(A)hypermap) POWER (i:num)) (edge_map H x)`\r
3225        THEN SUBGOAL_THEN `~(y:A = node_map (H:(A)hypermap) (x:A))` MP_TAC\r
3226        THENL[EXPAND_TAC "y" THEN USE_THEN "F3" MP_TAC\r
3227            THEN REWRITE_TAC[CONTRAPOS_THM; POWER_FUNCTION] THEN DISCH_TAC\r
3228            THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `(x:A)`; `SUC i`] lemma_in_edge2))\r
3229            THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
3230        THEN SUBGOAL_THEN `~(y:A = inverse (edge_map (H:(A)hypermap)) (x:A))` MP_TAC\r
3231        THENL[EXPAND_TAC "y" THEN USE_THEN "F5" SUBST1_TAC\r
3232            THEN REWRITE_TAC[POWER_FUNCTION] THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
3233            THEN MP_TAC (SPECL[`x:A`; `SUC d`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts)))\r
3234            THEN USE_THEN "F4" (fun th-> REWRITE_TAC[GSYM edge; th])\r
3235            THEN DISCH_THEN (MP_TAC o SPECL[`SUC d`; `SUC i`] o  REWRITE_RULE[lemma_def_inj_orbit])\r
3236            THEN USE_THEN "G2" (fun th-> REWRITE_TAC[LE_REFL; REWRITE_RULE[GSYM LT_SUC_LE] th])\r
3237            THEN SIMP_TAC[]; ALL_TAC]\r
3238        THEN SUBGOAL_THEN `~(y:A = (x:A))` MP_TAC\r
3239        THENL[EXPAND_TAC "y" THEN REWRITE_TAC[POWER_FUNCTION]\r
3240            THEN MP_TAC (SPECL[`x:A`; `SUC i`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts)))\r
3241            THEN REWRITE_TAC[GSYM edge]\r
3242            THEN USE_THEN "G2" (fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ (REWRITE_RULE[GSYM LT_SUC_LE] th) th1)]))\r
3243            THEN DISCH_THEN (MP_TAC o SPECL[`SUC i`; `0`] o  REWRITE_RULE[lemma_def_inj_orbit])\r
3244            THEN REWRITE_TAC[LT_0; LE_REFL; POWER_0; I_THM]; ALL_TAC]\r
3245        THEN REWRITE_TAC[IMP_IMP]\r
3246        THEN DISCH_THEN (fun th-> MP_TAC(REWRITE_RULE[th] (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup))))))\r
3247        THEN SIMP_TAC[]; ALL_TAC]\r
3248    THEN USE_THEN "F6" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `d:num`)\r
3249    THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [POWER_FUNCTION]\r
3250    THEN USE_THEN "F5" (SUBST1_TAC o SYM) THEN DISCH_TAC\r
3251    THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup)))\r
3252    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th])\r
3253    THEN DISCH_THEN (MP_TAC o AP_TERM `(edge_map (edge_walkup (H:(A)hypermap) (x:A))) POWER (d:num)`)\r
3254    THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_FUNCTION] THEN DISCH_TAC\r
3255    THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `node_map (H:(A)hypermap) (x:A)`; `SUC d`] lemma_in_edge2))\r
3256    THEN POP_ASSUM SUBST1_TAC\r
3257    THEN DISCH_THEN (LABEL_TAC "G7" o MATCH_MP lemma_edge_identity)\r
3258    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP lemma_walkup_support_edges (CONJ th th1)]))\r
3259    THEN POP_ASSUM (SUBST1_TAC o SYM) THEN SET_TAC[]);;\r
3260 \r
3261 (* Node *)\r
3262 \r
3263 let lemma_shift_non_degenerate = prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x <=>  dart_nondegenerate (shift H) x`,\r
3264     REPEAT GEN_TAC THEN REWRITE_TAC[dart_nondegenerate]\r
3265     THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma))\r
3266     THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);;\r
3267 \r
3268 let lemma_change_node_walkup = prove(`!(H:(A)hypermap) (x:A). (is_node_merge H x ==> is_edge_merge (shift H) x) /\ (is_node_split H x ==> is_edge_split (shift H) x)`,\r
3269 REPEAT GEN_TAC\r
3270   THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma))\r
3271   THEN ASM_REWRITE_TAC[is_node_merge; is_edge_merge; is_node_split; is_edge_split; edge; node]\r
3272   THEN STRIP_TAC\r
3273   THENL[STRIP_TAC\r
3274           THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_shift_non_degenerate]\r
3275           THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
3276   THEN STRIP_TAC\r
3277   THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_shift_non_degenerate]\r
3278   THEN ASM_REWRITE_TAC[]);;\r
3279 \r
3280 let lemma_node_merge = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_node_merge H x \r
3281    ==> {x} UNION (node (node_walkup H x) (face_map H x)) = (node H x) UNION (node H (face_map H x))`,\r
3282   REPEAT GEN_TAC\r
3283   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC))\r
3284   THEN REWRITE_TAC[node_walkup] \r
3285   THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_node_walkup))\r
3286   THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3287   THEN DISCH_THEN (LABEL_TAC "F2")\r
3288   THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma))\r
3289   THEN REMOVE_THEN "F1" MP_TAC\r
3290   THEN USE_THEN "G1" (SUBST1_TAC o SYM)\r
3291   THEN DISCH_THEN (LABEL_TAC "F3")\r
3292   THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] lemma_edge_merge)\r
3293   THEN ASM_REWRITE_TAC[node; edge]\r
3294   THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(H:(A)hypermap)) (x:A)` double_shift_lemma))\r
3295   THEN ASM_REWRITE_TAC[]);;\r
3296 \r
3297 let lemma_node_split = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_node_split H x \r
3298    ==> (~((inverse(edge_map H)) x IN node (node_walkup H x) (face_map H x))) /\\r
3299  (node H x = {x} UNION (node (node_walkup H x) (face_map H x)) UNION (node (node_walkup H x) ((inverse (edge_map H)) x)))`,\r
3300   \r
3301   REPEAT GEN_TAC\r
3302   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC))\r
3303   THEN REWRITE_TAC[node_walkup] \r
3304   THEN MP_TAC (CONJUNCT2 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_node_walkup))\r
3305   THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3306   THEN DISCH_THEN (LABEL_TAC "F2")\r
3307   THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma))\r
3308   THEN REMOVE_THEN "F1" MP_TAC\r
3309   THEN USE_THEN "G1" (SUBST1_TAC o SYM)\r
3310   THEN DISCH_THEN (LABEL_TAC "F3")\r
3311   THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] lemma_edge_split)\r
3312   THEN ASM_REWRITE_TAC[node; edge]\r
3313   THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(H:(A)hypermap)) (x:A)` double_shift_lemma))\r
3314   THEN ASM_REWRITE_TAC[]);;\r
3315 \r
3316 (* face *)\r
3317 \r
3318 let lemma_double_shift_non_degenerate = prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x <=>  dart_nondegenerate (shift(shift H)) x`,\r
3319     REPEAT GEN_TAC THEN REWRITE_TAC[dart_nondegenerate]\r
3320     THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma))\r
3321     THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);;\r
3322 \r
3323 \r
3324 let lemma_change_face_walkup = prove(`!(H:(A)hypermap) (x:A). (is_face_merge H x ==> is_edge_merge (shift(shift H)) x) /\ (is_face_split H x ==> is_edge_split (shift (shift H)) x)`,\r
3325 REPEAT GEN_TAC\r
3326   THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma))\r
3327   THEN ASM_REWRITE_TAC[is_face_merge; is_edge_merge; is_face_split; is_edge_split; edge; face]\r
3328   THEN STRIP_TAC\r
3329   THENL[STRIP_TAC\r
3330           THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_double_shift_non_degenerate]\r
3331           THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
3332   THEN STRIP_TAC\r
3333   THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_double_shift_non_degenerate]\r
3334   THEN ASM_REWRITE_TAC[]);;\r
3335 \r
3336 let lemma_face_merge = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_face_merge H x \r
3337    ==> {x} UNION (face (face_walkup H x) (edge_map H x)) = (face H x) UNION (face H (edge_map H x))`,\r
3338   REPEAT GEN_TAC\r
3339   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC))\r
3340   THEN REWRITE_TAC[face_walkup] \r
3341   THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_face_walkup))\r
3342   THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3343   THEN DISCH_THEN (LABEL_TAC "F2")\r
3344   THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma))\r
3345   THEN REMOVE_THEN "F1" MP_TAC\r
3346   THEN USE_THEN "G1" (SUBST1_TAC o SYM)\r
3347   THEN DISCH_THEN (LABEL_TAC "F3")\r
3348   THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] lemma_edge_merge)\r
3349   THEN ASM_REWRITE_TAC[face; edge]\r
3350   THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(shift(H:(A)hypermap))) (x:A)` shift_lemma))\r
3351   THEN ASM_REWRITE_TAC[]);;\r
3352 \r
3353 let lemma_face_split = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_face_split H x \r
3354    ==> (~((inverse(node_map H)) x IN face (face_walkup H x) (edge_map H x))) /\\r
3355  (face H x = {x} UNION (face (face_walkup H x) (edge_map H x)) UNION (face (face_walkup H x) ((inverse (node_map H)) x)))`,\r
3356   \r
3357   REPEAT GEN_TAC\r
3358   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC))\r
3359   THEN REWRITE_TAC[face_walkup] \r
3360   THEN MP_TAC (CONJUNCT2 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_face_walkup))\r
3361   THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3362   THEN DISCH_THEN (LABEL_TAC "F2")\r
3363   THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma))\r
3364   THEN REMOVE_THEN "F1" MP_TAC\r
3365   THEN USE_THEN "G1" (SUBST1_TAC o SYM)\r
3366   THEN DISCH_THEN (LABEL_TAC "F3")\r
3367   THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] lemma_edge_split)\r
3368   THEN ASM_REWRITE_TAC[face; edge]\r
3369   THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(shift(H:(A)hypermap))) (x:A)` shift_lemma))\r
3370   THEN ASM_REWRITE_TAC[]);;\r
3371 \r
3372 \r
3373 (* A SOME FACTS ON COMPONETS *)\r
3374 \r
3375 let lemma_powers_in_component = prove(`!(H:(A)hypermap) (x:A) (j:num). (((edge_map H) POWER j) x IN comb_component H x) /\ (((node_map H) POWER j) x IN comb_component H x) /\ (((face_map H) POWER j) x IN comb_component H x)`, \r
3376    REWRITE_TAC[comb_component; is_in_component; IN_ELIM_THM]\r
3377    THEN REPEAT GEN_TAC\r
3378    THEN STRIP_TAC\r
3379    THENL[EXISTS_TAC `edge_path (H:(A)hypermap) (x:A)` \r
3380        THEN EXISTS_TAC `j:num`\r
3381        THEN REWRITE_TAC[edge_path; lemma_edge_path; POWER_0; I_THM]; ALL_TAC]\r
3382    THEN STRIP_TAC\r
3383    THENL[EXISTS_TAC `node_path (H:(A)hypermap) (x:A)`\r
3384        THEN EXISTS_TAC `j:num`\r
3385        THEN REWRITE_TAC[node_path; lemma_node_path; POWER_0; I_THM]; ALL_TAC]\r
3386    THEN EXISTS_TAC `face_path (H:(A)hypermap) (x:A)`\r
3387    THEN EXISTS_TAC `j:num`\r
3388    THEN REWRITE_TAC[face_path; lemma_face_path; POWER_0; I_THM]);;\r
3389 \r
3390 let lemma_inverses_in_component = prove(`!(H:(A)hypermap) (x:A) (j:num). (inverse(edge_map H) x IN comb_component H x) /\ (inverse(node_map H) x IN comb_component H x) /\ (inverse(face_map H) x IN comb_component H x)`,\r
3391 REPEAT GEN_TAC\r
3392   THEN label_hypermap_TAC `H:(A)hypermap`\r
3393   THEN REPEAT STRIP_TAC\r
3394   THENL[USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (MP_TAC (SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))))\r
3395           THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
3396           THEN REWRITE_TAC[ lemma_powers_in_component];\r
3397           USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (MP_TAC (SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))))\r
3398           THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
3399           THEN REWRITE_TAC[ lemma_powers_in_component];\r
3400           USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))))\r
3401           THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
3402           THEN REWRITE_TAC[ lemma_powers_in_component]]);;\r
3403 \r
3404 let lemma_edge_subset_component = prove(`!(H:(A)hypermap) (x:A). edge H x SUBSET comb_component H x`,\r
3405     REPEAT GEN_TAC\r
3406     THEN REWRITE_TAC[SUBSET; edge; orbit_map; IN_ELIM_THM]\r
3407     THEN REPEAT STRIP_TAC\r
3408     THEN POP_ASSUM SUBST1_TAC\r
3409     THEN REWRITE_TAC[lemma_powers_in_component]);;\r
3410 \r
3411 let lemma_node_subset_component = prove(`!(H:(A)hypermap) (x:A). node H x SUBSET comb_component H x`,\r
3412     REPEAT GEN_TAC\r
3413     THEN REWRITE_TAC[SUBSET; node; orbit_map; IN_ELIM_THM]\r
3414     THEN REPEAT STRIP_TAC\r
3415     THEN POP_ASSUM SUBST1_TAC\r
3416     THEN REWRITE_TAC[lemma_powers_in_component]);;\r
3417 \r
3418 let lemma_face_subset_component = prove(`!(H:(A)hypermap) (x:A). face H x SUBSET comb_component H x`,\r
3419     REPEAT GEN_TAC\r
3420     THEN REWRITE_TAC[SUBSET; face; orbit_map; IN_ELIM_THM]\r
3421     THEN REPEAT STRIP_TAC\r
3422     THEN POP_ASSUM SUBST1_TAC\r
3423     THEN REWRITE_TAC[lemma_powers_in_component]);;\r
3424 \r
3425 let lemma_component_identity = prove(`!(H:(A)hypermap) x:A y:A. y IN comb_component H x ==>  comb_component H x =  comb_component H y`,\r
3426      REPEAT STRIP_TAC\r
3427      THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `y:A`] partition_components)\r
3428      THEN SUBGOAL_THEN `?z:A. z IN comb_component (H:(A)hypermap) (x:A) INTER  comb_component (H:(A)hypermap) (y:A)` MP_TAC\r
3429      THENL[ASSUME_TAC (SPECL[`H:(A)hypermap`; `y:A`] lemma_component_reflect)\r
3430              THEN  EXISTS_TAC `y:A`\r
3431              THEN  ASM_REWRITE_TAC[IN_INTER]; ALL_TAC]\r
3432      THEN  REWRITE_TAC[MEMBER_NOT_EMPTY]\r
3433      THEN DISCH_THEN (fun th -> REWRITE_TAC[th]));;\r
3434 \r
3435 \r
3436 let lemma_walkup_first_component_eq = prove(`!(H:(A)hypermap) (x:A) (y:A).x IN dart H /\ ~(x IN comb_component H y)  ==> comb_component H y = comb_component (edge_walkup H x) y /\ ~(node_map H x IN comb_component H y) /\ ~((inverse (edge_map H)) x IN comb_component H y)`,\r
3437    REPEAT GEN_TAC\r
3438    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3439    THEN label_hypermap_TAC `H:(A)hypermap`\r
3440    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
3441    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
3442    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
3443    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
3444    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
3445    THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))`\r
3446    THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))`\r
3447    THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))`\r
3448    THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (x:A))` (LABEL_TAC "F3")\r
3449    THENL[ GEN_TAC THEN STRIP_TAC\r
3450      THEN REMOVE_THEN "F2" MP_TAC\r
3451      THEN REWRITE_TAC[CONTRAPOS_THM]\r
3452      THEN DISCH_THEN SUBST_ALL_TAC\r
3453      THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
3454    THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (e:A->A) (x:A))` (LABEL_TAC "F4")\r
3455    THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3456         THEN REMOVE_THEN "F2" MP_TAC\r
3457         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3458         THEN STRIP_TAC\r
3459         THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`; `1`]  lemma_powers_in_component))\r
3460         THEN ASM_REWRITE_TAC[POWER_1]\r
3461         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3462         THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry)\r
3463         THEN POP_ASSUM MP_TAC\r
3464         THEN MESON_TAC[lemma_component_trans]; ALL_TAC]\r
3465    THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (n:A->A) (x:A))` (LABEL_TAC "F5")\r
3466    THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3467         THEN REMOVE_THEN "F2" MP_TAC\r
3468         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3469         THEN STRIP_TAC\r
3470         THEN MP_TAC (CONJUNCT1(CONJUNCT2((SPECL[`H:(A)hypermap`; `x:A`; `1`]  lemma_powers_in_component))))\r
3471         THEN ASM_REWRITE_TAC[POWER_1]\r
3472         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3473         THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry)\r
3474         THEN POP_ASSUM MP_TAC\r
3475         THEN ASM_MESON_TAC[lemma_component_trans]; ALL_TAC]\r
3476    THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (f:A->A) (x:A))` (LABEL_TAC "F6")\r
3477    THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3478         THEN REMOVE_THEN "F2" MP_TAC\r
3479         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3480         THEN STRIP_TAC\r
3481         THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `1`]  lemma_powers_in_component)))\r
3482         THEN ASM_REWRITE_TAC[POWER_1]\r
3483         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3484         THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry)\r
3485         THEN POP_ASSUM MP_TAC\r
3486         THEN ASM_MESON_TAC[lemma_component_trans]; ALL_TAC]\r
3487    THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (inverse(e:A->A)) (x:A))` (LABEL_TAC "F7")\r
3488    THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3489         THEN REMOVE_THEN "F2" MP_TAC\r
3490         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3491         THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (MP_TAC (SPEC`x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))))\r
3492         THEN ASM_REWRITE_TAC[]    \r
3493         THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
3494         THEN STRIP_TAC\r
3495         THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`; `j:num`]  lemma_powers_in_component))\r
3496         THEN ASM_REWRITE_TAC[]\r
3497         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3498         THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry)\r
3499         THEN POP_ASSUM MP_TAC\r
3500         THEN MESON_TAC[lemma_component_trans]; ALL_TAC]\r
3501    THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (inverse(n:A->A)) (x:A))` (LABEL_TAC "F8")\r
3502    THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3503         THEN REMOVE_THEN "F2" MP_TAC\r
3504         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3505         THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (MP_TAC (SPEC`x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))))\r
3506         THEN ASM_REWRITE_TAC[]    \r
3507         THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
3508         THEN STRIP_TAC\r
3509         THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `j:num`]  lemma_powers_in_component)))\r
3510         THEN ASM_REWRITE_TAC[]\r
3511         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3512         THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry)\r
3513         THEN POP_ASSUM MP_TAC\r
3514         THEN MESON_TAC[lemma_component_trans]; ALL_TAC]\r
3515    THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (inverse(f:A->A)) (x:A))` (LABEL_TAC "F8f")\r
3516    THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3517         THEN REMOVE_THEN "F2" MP_TAC\r
3518         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3519         THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPEC`x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))))\r
3520         THEN ASM_REWRITE_TAC[]    \r
3521         THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
3522         THEN STRIP_TAC\r
3523         THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `j:num`]  lemma_powers_in_component)))\r
3524         THEN ASM_REWRITE_TAC[]\r
3525         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3526         THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry)\r
3527         THEN POP_ASSUM MP_TAC\r
3528         THEN MESON_TAC[lemma_component_trans]; ALL_TAC]\r
3529    THEN SUBGOAL_THEN `~((n:A->A) (x:A) IN comb_component (H:(A)hypermap) (y:A))` ASSUME_TAC\r
3530    THENL[USE_THEN "F2" MP_TAC\r
3531         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3532         THEN STRIP_TAC\r
3533         THEN USE_THEN "F5" (MP_TAC o SPEC `(n:A->A) (x:A)`)\r
3534         THEN POP_ASSUM(fun th -> REWRITE_TAC[th]); ALL_TAC]\r
3535    THEN POP_ASSUM(fun th -> REWRITE_TAC[th])\r
3536    THEN SUBGOAL_THEN `~((inverse(e:A->A)) (x:A) IN comb_component (H:(A)hypermap) (y:A))` ASSUME_TAC\r
3537    THENL[USE_THEN "F2" MP_TAC\r
3538         THEN REWRITE_TAC[CONTRAPOS_THM]\r
3539         THEN STRIP_TAC\r
3540         THEN USE_THEN "F7" (MP_TAC o SPEC `(inverse(e:A->A)) (x:A)`)\r
3541         THEN POP_ASSUM(fun th -> REWRITE_TAC[th]); ALL_TAC]\r
3542    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3543    THEN REWRITE_TAC[comb_component; is_in_component; EXTENSION; IN_ELIM_THM]\r
3544    THEN GEN_TAC\r
3545    THEN EQ_TAC\r
3546    THENL[DISCH_THEN (X_CHOOSE_THEN `p:num->A` (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 (LABEL_TAC "F10") (LABEL_TAC "F11")))))\r
3547          THEN EXISTS_TAC `p:num->A`\r
3548          THEN EXISTS_TAC `m:num`\r
3549          THEN ASM_REWRITE_TAC[]\r
3550          THEN REWRITE_TAC[lemma_def_path]\r
3551          THEN GEN_TAC\r
3552          THEN DISCH_THEN (LABEL_TAC "F12")\r
3553          THEN USE_THEN "F11" MP_TAC\r
3554          THEN REWRITE_TAC[lemma_def_path]\r
3555          THEN DISCH_THEN (MP_TAC o SPEC `i:num`)\r
3556          THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
3557          THEN USE_THEN "F11" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_subpath)\r
3558          THEN USE_THEN "F12" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th]))\r
3559          THEN DISCH_TAC\r
3560          THEN SUBGOAL_THEN `(p:num->A) (i:num) IN comb_component (H:(A)hypermap) (y:A)` (LABEL_TAC "F14")\r
3561          THENL[REWRITE_TAC[comb_component; IN_ELIM_THM]\r
3562                  THEN REWRITE_TAC[is_in_component]\r
3563                  THEN EXISTS_TAC `p:num->A`\r
3564                 THEN EXISTS_TAC `i:num`\r
3565                 THEN ASM_SIMP_TAC[]; ALL_TAC]\r
3566          THEN REPLICATE_TAC 7 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (i:num)`) o check(is_forall o concl)))\r
3567          THEN ASM_REWRITE_TAC[]\r
3568          THEN REPLICATE_TAC 7 STRIP_TAC\r
3569          THEN REWRITE_TAC[go_one_step]\r
3570          THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] edge_map_walkup))))\r
3571          THEN ASM_REWRITE_TAC[]\r
3572          THEN DISCH_THEN SUBST1_TAC\r
3573          THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] node_map_walkup)))\r
3574          THEN ASM_REWRITE_TAC[]\r
3575          THEN DISCH_THEN SUBST1_TAC\r
3576          THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] face_map_walkup)))\r
3577          THEN ASM_REWRITE_TAC[]\r
3578          THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
3579    THEN DISCH_THEN (X_CHOOSE_THEN `p:num->A` (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 (LABEL_TAC "F10") (LABEL_TAC "F11")))))\r
3580    THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `m:num`\r
3581    THEN ASM_REWRITE_TAC[]\r
3582    THEN SUBGOAL_THEN `!k:num. k <= m ==> is_path (H:(A)hypermap) (p:num->A) k` ASSUME_TAC\r
3583    THENL[INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC]\r
3584            THEN POP_ASSUM (LABEL_TAC "F12")\r
3585            THEN DISCH_THEN (LABEL_TAC "F14")\r
3586            THEN REMOVE_THEN "F12" MP_TAC\r
3587            THEN USE_THEN "F14" (fun th-> (REWRITE_TAC[MP (ARITH_RULE `SUC (k:num) <= m:num ==> k <= m`) th]))\r
3588            THEN REWRITE_TAC[is_path]\r
3589            THEN DISCH_THEN (LABEL_TAC "F15")\r
3590            THEN REWRITE_TAC[is_path]\r
3591            THEN USE_THEN "F15" (fun th -> REWRITE_TAC[th])\r
3592            THEN USE_THEN "F11" (MP_TAC o SPEC `SUC (k:num)` o MATCH_MP lemma_subpath)\r
3593            THEN USE_THEN "F14" (fun th -> (REWRITE_TAC[th]))\r
3594            THEN REWRITE_TAC[is_path]\r
3595            THEN DISCH_THEN (MP_TAC o CONJUNCT2)\r
3596            THEN SUBGOAL_THEN `(p:num->A) (k:num) IN comb_component (H:(A)hypermap) (y:A)` (LABEL_TAC "F16")\r
3597            THENL[REWRITE_TAC[comb_component; IN_ELIM_THM]\r
3598                   THEN REWRITE_TAC[is_in_component]\r
3599                   THEN EXISTS_TAC `p:num->A`\r
3600                   THEN EXISTS_TAC `k:num`\r
3601                   THEN ASM_SIMP_TAC[]; ALL_TAC]\r
3602            THEN REPLICATE_TAC 7 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (k:num)`) o check(is_forall o concl)))\r
3603            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3604            THEN REPLICATE_TAC 7 STRIP_TAC\r
3605            THEN REWRITE_TAC[go_one_step]\r
3606            THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] edge_map_walkup))))\r
3607            THEN ASM_REWRITE_TAC[]\r
3608            THEN DISCH_THEN SUBST1_TAC\r
3609            THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] node_map_walkup)))\r
3610            THEN ASM_REWRITE_TAC[]\r
3611            THEN DISCH_THEN SUBST1_TAC\r
3612            THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] face_map_walkup)))\r
3613            THEN ASM_REWRITE_TAC[]\r
3614            THEN DISCH_THEN SUBST1_TAC\r
3615            THEN SIMP_TAC[]; ALL_TAC]\r
3616    THEN POP_ASSUM (MP_TAC o SPEC `m:num`) THEN REWRITE_TAC[LE_REFL]);;\r
3617 \r
3618 let lemma_walkup_second_component_eq = prove(`!(H:(A)hypermap) (x:A) (y:A).x IN dart H /\ y IN dart H /\ ~(y = x) /\ ~((inverse (edge_map H)) x IN comb_component (edge_walkup H x) y) /\  ~(node_map H x IN comb_component (edge_walkup H x) y) ==> comb_component H y = comb_component (edge_walkup H x) y /\ ~(y IN comb_component H x)`,\r
3619    REPEAT GEN_TAC\r
3620    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))))\r
3621    THEN label_hypermap_TAC `H:(A)hypermap`\r
3622    THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
3623    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` \r
3624    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
3625    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
3626    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
3627    THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))`\r
3628    THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))`\r
3629    THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))`\r
3630    THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)`\r
3631    THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
3632    THEN ASM_REWRITE_TAC[]\r
3633    THEN DISCH_THEN (LABEL_TAC "F6")\r
3634    THEN MP_TAC (SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma)\r
3635    THEN ASM_REWRITE_TAC[]\r
3636    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "W1") (CONJUNCTS_THEN2 (LABEL_TAC "W2") (CONJUNCTS_THEN2 (LABEL_TAC "W3") (LABEL_TAC "W4" o CONJUNCT1))))\r
3637    THEN SUBGOAL_THEN `(y:A) IN ((D:A->bool) DELETE (x:A))` (LABEL_TAC "F7")\r
3638    THENL[ASM_ASM_SET_TAC; ALL_TAC]\r
3639    THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (x:A))` (LABEL_TAC "F8")\r
3640    THENL[GEN_TAC THEN STRIP_TAC\r
3641            THEN  MP_TAC (SPECL[`G:(A)hypermap`; `y:A`] lemma_component_subset)\r
3642            THEN  ASM_REWRITE_TAC[] \r
3643            THEN REWRITE_TAC[SUBSET]\r
3644            THEN DISCH_THEN (MP_TAC o SPEC `z:A`)\r
3645            THEN POP_ASSUM (fun th -> REWRITE_TAC[th; IN_DELETE])\r
3646            THEN SIMP_TAC[]; ALL_TAC]\r
3647    THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (n:A->A) (x:A))` (LABEL_TAC "F9")\r
3648    THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3649            THEN REMOVE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
3650            THEN DISCH_THEN (SUBST1_TAC o SYM)\r
3651            THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
3652    THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (inverse(e:A->A)) (x:A))` (LABEL_TAC "F10")\r
3653    THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3654            THEN REMOVE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
3655            THEN DISCH_THEN (SUBST1_TAC o SYM)\r
3656            THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
3657    THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (inverse(n:A->A)) (x:A))` (LABEL_TAC "F11")\r
3658    THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3659              THEN  REMOVE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
3660              THEN  DISCH_THEN (MP_TAC o AP_TERM `node_map (edge_walkup (H:(A)hypermap) (x:A))`)\r
3661              THEN  EXPAND_TAC "n"\r
3662              THEN  REWRITE_TAC[node_map_walkup]\r
3663              THEN  ASM_REWRITE_TAC[]\r
3664              THEN  DISCH_TAC\r
3665              THEN  MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`G:(A)hypermap`; `z:A`; `1`]  lemma_powers_in_component)))\r
3666              THEN  ASM_REWRITE_TAC[POWER_1]\r
3667              THEN  POP_ASSUM (SUBST1_TAC o SYM)\r
3668              THEN  POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_component_identity th]); ALL_TAC]\r
3669    THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (inverse(f:A->A)) (x:A))` (LABEL_TAC "F12")\r
3670    THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
3671             THEN REMOVE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
3672             THEN ASM_CASES_TAC `(inverse(f:A->A)) (x:A) = x`\r
3673             THENL[POP_ASSUM SUBST1_TAC\r
3674                     THEN USE_THEN "F8" (MP_TAC o SPEC `z:A`)\r
3675                     THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3676                     THEN SIMP_TAC[]; ALL_TAC]\r
3677             THEN ASM_CASES_TAC `inverse(e:A->A) (x:A) = x`\r
3678             THENL[USE_THEN "H2" (MP_TAC o SPEC `x:A` o  MATCH_MP fixed_point_lemma)\r
3679                     THEN POP_ASSUM (fun th ->  REWRITE_TAC[th])\r
3680                     THEN EXPAND_TAC "e"\r
3681                     THEN REWRITE_TAC[lemma_edge_degenerate]\r
3682                     THEN ASM_REWRITE_TAC[]\r
3683                     THEN DISCH_THEN ASSUME_TAC\r
3684                     THEN DISCH_THEN (MP_TAC o AP_TERM `f':A->A`)\r
3685                     THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`]  face_map_walkup)))\r
3686                     THEN ASM_REWRITE_TAC[]\r
3687                     THEN DISCH_THEN SUBST1_TAC\r
3688                     THEN DISCH_TAC\r
3689                     THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`G:(A)hypermap`; `z:A`; `1`] lemma_powers_in_component)))\r
3690                     THEN ASM_REWRITE_TAC[POWER_1]\r
3691                     THEN USE_THEN "G1" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_component_trans (CONJ th1 th2))))))\r
3692                     THEN DISCH_TAC\r
3693                     THEN USE_THEN "F11" (MP_TAC o SPEC `(inverse (n:A->A)) (x:A)`)\r
3694                     THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
3695             THEN MP_TAC (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`]  edge_map_walkup))))\r
3696             THEN ASM_REWRITE_TAC[]\r
3697             THEN DISCH_THEN (SUBST1_TAC o SYM)\r
3698             THEN DISCH_THEN (fun th1 -> (USE_THEN "W2" (fun th2 -> (MP_TAC (MATCH_MP inverse_function (CONJ th2 (SYM th1)))))))\r
3699             THEN DISCH_THEN SUBST1_TAC\r
3700             THEN MP_TAC(CONJUNCT1(SPECL[`G:(A)hypermap`; `z:A`; `1`] lemma_inverses_in_component))\r
3701             THEN ASM_REWRITE_TAC[]\r
3702             THEN USE_THEN "G1" MP_TAC\r
3703             THEN MESON_TAC[lemma_component_trans]; ALL_TAC]\r
3704   THEN SUBGOAL_THEN `comb_component (H:(A)hypermap) (y:A) = comb_component (G:(A)hypermap) (y:A)` (LABEL_TAC "FF")\r
3705   THENL[REWRITE_TAC[comb_component; is_in_component; EXTENSION; IN_ELIM_THM]\r
3706    THEN GEN_TAC THEN EQ_TAC\r
3707    THENL[DISCH_THEN (X_CHOOSE_THEN `p:num->A` (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F14") (CONJUNCTS_THEN2 (LABEL_TAC "F15") (LABEL_TAC "F16")))))\r
3708           THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `m:num`\r
3709           THEN ASM_REWRITE_TAC[]\r
3710           THEN SUBGOAL_THEN `!k:num. k <= m:num ==> is_path (G:(A)hypermap) (p:num->A) k` ASSUME_TAC\r
3711           THENL[INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC]\r
3712                   THEN POP_ASSUM (LABEL_TAC "G4")\r
3713                   THEN DISCH_THEN (LABEL_TAC "G5")\r
3714                   THEN REMOVE_THEN "G4" MP_TAC\r
3715                   THEN USE_THEN "G5" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `SUC (k:num) <= m ==> k <= m`) th]))\r
3716                   THEN DISCH_THEN (LABEL_TAC "G6")\r
3717                   THEN USE_THEN "F16" (MP_TAC o SPEC `SUC (k:num)` o MATCH_MP lemma_subpath)\r
3718                   THEN ASM_REWRITE_TAC[is_path]\r
3719                   THEN DISCH_THEN (MP_TAC o CONJUNCT2)\r
3720                   THEN ABBREV_TAC `z:A = (p:num->A) (k:num)`\r
3721                   THEN SUBGOAL_THEN `(z:A) IN comb_component (G:(A)hypermap) (y:A)` (LABEL_TAC "G7")\r
3722                   THENL[REWRITE_TAC[comb_component;IN_ELIM_THM] (*NOTE*)\r
3723                           THEN REWRITE_TAC[is_in_component]\r
3724                           THEN EXISTS_TAC `p:num->A`\r
3725                          THEN EXISTS_TAC `k:num`\r
3726                          THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
3727                   THEN REPLICATE_TAC 5 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (k:num)`) o check(is_forall o concl)))\r
3728                   THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 5 STRIP_TAC\r
3729                   THEN REWRITE_TAC[go_one_step]\r
3730                   THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] edge_map_walkup))))\r
3731                   THEN ASM_REWRITE_TAC[]\r
3732                   THEN DISCH_THEN SUBST1_TAC\r
3733                   THEN  MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] node_map_walkup)))\r
3734                   THEN  ASM_REWRITE_TAC[]\r
3735                   THEN  DISCH_THEN SUBST1_TAC\r
3736                   THEN  MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] face_map_walkup)))\r
3737                   THEN  ASM_REWRITE_TAC[]\r
3738                   THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
3739           THEN POP_ASSUM (MP_TAC o SPEC `m:num`)\r
3740           THEN SIMP_TAC[LE_REFL]; ALL_TAC]\r
3741    THEN DISCH_THEN (X_CHOOSE_THEN `p:num->A` (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F14") (CONJUNCTS_THEN2 (LABEL_TAC "F15") (LABEL_TAC "F16")))))\r
3742    THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `m:num`\r
3743    THEN ASM_REWRITE_TAC[]\r
3744    THEN SUBGOAL_THEN `!k:num. k <= m ==> is_path (H:(A)hypermap) (p:num->A) k` ASSUME_TAC\r
3745    THENL[INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC]\r
3746             THEN POP_ASSUM (LABEL_TAC "F17")\r
3747             THEN DISCH_THEN (LABEL_TAC "F18")\r
3748             THEN REMOVE_THEN "F17" MP_TAC\r
3749             THEN USE_THEN "F18" (fun th-> (REWRITE_TAC[MP (ARITH_RULE `SUC (k:num) <= m:num ==> k <= m`) th]))\r
3750             THEN REWRITE_TAC[is_path]\r
3751             THEN DISCH_THEN (LABEL_TAC "F19")\r
3752             THEN USE_THEN "F19" (fun th-> REWRITE_TAC[th])\r
3753             THEN USE_THEN "F16" (MP_TAC o SPEC `SUC (k:num)` o MATCH_MP lemma_subpath)\r
3754             THEN ASM_REWRITE_TAC[is_path]\r
3755             THEN DISCH_THEN (fun th -> (LABEL_TAC "F20" (CONJUNCT1 th) THEN (MP_TAC(CONJUNCT2 th))))\r
3756             THEN SUBGOAL_THEN `(p:num->A) (k:num) IN comb_component (G:(A)hypermap) (y:A)` (LABEL_TAC "F21")\r
3757             THENL[REWRITE_TAC[comb_component; IN_ELIM_THM]\r
3758                     THEN REWRITE_TAC[is_in_component]\r
3759                     THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[]; ALL_TAC]\r
3760             THEN REPLICATE_TAC 5 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (k:num)`) o check(is_forall o concl)))\r
3761             THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3762             THEN REPLICATE_TAC 5 STRIP_TAC\r
3763             THEN REWRITE_TAC[go_one_step]\r
3764             THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] edge_map_walkup))))\r
3765             THEN ASM_REWRITE_TAC[]\r
3766             THEN DISCH_THEN SUBST1_TAC\r
3767             THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] node_map_walkup)))\r
3768             THEN ASM_REWRITE_TAC[]\r
3769             THEN DISCH_THEN SUBST1_TAC\r
3770             THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] face_map_walkup)))\r
3771             THEN ASM_REWRITE_TAC[]\r
3772             THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
3773   THEN POP_ASSUM (MP_TAC o SPEC `m:num`) THEN REWRITE_TAC[LE_REFL]; ALL_TAC]\r
3774   THEN USE_THEN "FF" (fun th -> REWRITE_TAC[th])\r
3775   THEN ONCE_REWRITE_TAC[TAUT `~pp <=> (pp ==> F)`]\r
3776   THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_component_symmetry)\r
3777   THEN USE_THEN "F8" (MP_TAC o SPEC `x:A`)\r
3778   THEN USE_THEN "FF" (SUBST1_TAC o SYM)\r
3779   THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
3780 \r
3781 let lemma_walkup_components = prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> set_of_components H DELETE comb_component H x = set_of_components (edge_walkup H x) DIFF {comb_component (edge_walkup H x) (node_map H x),  comb_component (edge_walkup H x) ((inverse (edge_map H)) x)}`,\r
3782    REPEAT GEN_TAC\r
3783    THEN REWRITE_TAC[set_of_components]\r
3784    THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
3785    THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))`\r
3786    THEN REWRITE_TAC[set_part_components]\r
3787    THEN DISCH_THEN (LABEL_TAC "F1")\r
3788    THEN REWRITE_TAC[SET_RULE `s DIFF {a, b} = (s DELETE a) DELETE b`]\r
3789    THEN REWRITE_TAC[EXTENSION]\r
3790    THEN GEN_TAC\r
3791    THEN EQ_TAC\r
3792    THENL[REWRITE_TAC[IN_DELETE; IN_ELIM_THM]\r
3793       THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) (LABEL_TAC "F4"))\r
3794       THEN REMOVE_THEN "F3" SUBST_ALL_TAC\r
3795       THEN SUBGOAL_THEN `~(x:A IN comb_component (H:(A)hypermap) (y:A))` (LABEL_TAC "F5")\r
3796       THENL[POP_ASSUM MP_TAC\r
3797            THEN REWRITE_TAC[CONTRAPOS_THM]\r
3798            THEN MESON_TAC[lemma_component_identity]; ALL_TAC]\r
3799       THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_first_component_eq)\r
3800       THEN ASM_REWRITE_TAC[]\r
3801       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")))\r
3802       THEN SUBGOAL_THEN `~(comb_component (H:(A)hypermap) (y:A) = comb_component (edge_walkup H (x:A)) (inverse (edge_map H) x))` ASSUME_TAC\r
3803       THENL[POP_ASSUM MP_TAC\r
3804            THEN REWRITE_TAC[CONTRAPOS_THM]\r
3805            THEN DISCH_TAC\r
3806            THEN MP_TAC(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `(inverse (edge_map (H:(A)hypermap))) (x:A)`] lemma_component_reflect)\r
3807            THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3808            THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
3809       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3810       THEN STRIP_TAC\r
3811       THENL[EXISTS_TAC `y:A`\r
3812            THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
3813            THEN ASM_REWRITE_TAC[]\r
3814            THEN DISCH_THEN SUBST1_TAC\r
3815            THEN ASM_ASM_SET_TAC; ALL_TAC]\r
3816       THEN USE_THEN "F7" MP_TAC\r
3817       THEN REWRITE_TAC[CONTRAPOS_THM]\r
3818       THEN DISCH_TAC\r
3819       THEN MP_TAC(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `node_map (H:(A)hypermap) (x:A)`] lemma_component_reflect)\r
3820       THEN POP_ASSUM (SUBST1_TAC o SYM)\r
3821       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
3822    THEN REWRITE_TAC[IN_DELETE; IN_ELIM_THM]\r
3823    THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) (LABEL_TAC "F4")) (LABEL_TAC "F5"))\r
3824    THEN REMOVE_THEN "F3" SUBST_ALL_TAC\r
3825    THEN SUBGOAL_THEN `~((node_map (H:(A)hypermap)) (x:A) IN comb_component (edge_walkup (H:(A)hypermap) (x:A)) (y:A))` (LABEL_TAC "F6")\r
3826    THENL[USE_THEN "F4" MP_TAC\r
3827            THEN REWRITE_TAC[CONTRAPOS_THM]\r
3828            THEN MESON_TAC[lemma_component_identity]; ALL_TAC]\r
3829    THEN SUBGOAL_THEN `~((inverse (edge_map (H:(A)hypermap))) (x:A) IN comb_component (edge_walkup (H:(A)hypermap) (x:A)) (y:A))` (LABEL_TAC "F7")\r
3830    THENL[USE_THEN "F5" MP_TAC\r
3831            THEN REWRITE_TAC[CONTRAPOS_THM]\r
3832            THEN MESON_TAC[lemma_component_identity]; ALL_TAC]\r
3833    THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
3834    THEN ASM_REWRITE_TAC[]\r
3835    THEN DISCH_THEN SUBST_ALL_TAC\r
3836    THEN USE_THEN "F2" MP_TAC\r
3837    THEN REWRITE_TAC[IN_DELETE]\r
3838    THEN STRIP_TAC\r
3839    THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_second_component_eq)\r
3840    THEN ASM_REWRITE_TAC[]\r
3841    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9"))\r
3842    THEN STRIP_TAC\r
3843    THENL[EXISTS_TAC `y:A`\r
3844            THEN USE_THEN "F8" (SUBST1_TAC o SYM)\r
3845            THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
3846    THEN USE_THEN "F8" (SUBST1_TAC o SYM)\r
3847    THEN POP_ASSUM MP_TAC\r
3848    THEN REWRITE_TAC[CONTRAPOS_THM]\r
3849    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
3850    THEN REWRITE_TAC[lemma_component_reflect]);;\r
3851 \r
3852 \r
3853 (* walkup at an edge-degenerate point *)\r
3854 \r
3855 let edge_degenerate_walkup_edge_map = prove(`!(H:(A)hypermap) x:A y:A. x IN dart H /\ edge_map H x = x ==> edge_map (edge_walkup H x) y = edge_map H y`,\r
3856    REPEAT GEN_TAC\r
3857    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))   \r
3858    THEN ASM_CASES_TAC `y:A = x:A`\r
3859    THENL[ASM_REWRITE_TAC[edge_map_walkup]; ALL_TAC]\r
3860    THEN label_hypermap4_TAC `edge_walkup (H:(A)hypermap) (x:A)`\r
3861    THEN ASM_CASES_TAC `y:A = (node_map (H:(A)hypermap)) (x:A)`\r
3862    THENL[POP_ASSUM SUBST1_TAC\r
3863            THEN REWRITE_TAC[CONJUNCT1(SPEC `edge_walkup (H:(A)hypermap) (x:A)` inverse2_hypermap_maps); o_THM]\r
3864            THEN GEN_REWRITE_TAC (RAND_CONV  o DEPTH_CONV) [GSYM o_THM]\r
3865            THEN REWRITE_TAC[GSYM inverse_hypermap_maps]\r
3866            THEN USE_THEN "H3" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPECL[`node_map (H:(A)hypermap) (x:A)`; `(inverse(face_map (H:(A)hypermap))) (x:A)`] (MATCH_MP aux_permutes_conversion (CONJ th2 th1)))))))\r
3867            THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
3868            THEN REWRITE_TAC[face_map_walkup]\r
3869            THEN USE_THEN "F2" MP_TAC\r
3870            THEN REWRITE_TAC[lemma_edge_degenerate]\r
3871            THEN DISCH_THEN SUBST1_TAC\r
3872            THEN REWRITE_TAC[node_map_walkup]; ALL_TAC]\r
3873    THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`]  fixed_point_lemma)\r
3874    THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]\r
3875    THEN DISCH_THEN (MP_TAC o SPEC `x:A`)\r
3876    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
3877    THEN DISCH_TAC\r
3878    THEN MP_TAC(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup))))\r
3879    THEN ASM_REWRITE_TAC[]);;\r
3880 \r
3881 (* walkup at a node-degenerate point *)\r
3882 \r
3883 let node_degenerate_walkup_node_map = prove(`!(H:(A)hypermap) x:A y:A. x IN dart H /\ node_map H x = x ==> node_map (edge_walkup H x) y = node_map H y`,\r
3884    REPEAT GEN_TAC\r
3885    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3886    THEN ASM_CASES_TAC `y:A = x:A`\r
3887    THENL[ASM_REWRITE_TAC[node_map_walkup]; ALL_TAC]\r
3888    THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`]  fixed_point_lemma)\r
3889    THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]\r
3890    THEN DISCH_THEN (MP_TAC o SPEC `x:A`)   \r
3891    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
3892    THEN DISCH_TAC\r
3893    THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] node_map_walkup)))\r
3894    THEN ASM_REWRITE_TAC[]);;\r
3895 \r
3896 let node_degenerate_walkup_edge_map = prove(`!(H:(A)hypermap) x:A. x IN dart H /\ node_map H x = x ==> (edge_map (edge_walkup H x) x = x) /\ (edge_map (edge_walkup H x) ((inverse (edge_map H)) x) = edge_map H x) /\ (!y:A. ~(y = x) /\ ~(y = (inverse (edge_map H)) x) ==> edge_map (edge_walkup H x) y = edge_map H y)`,\r
3897    REPEAT GEN_TAC\r
3898    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3899    THEN REWRITE_TAC[edge_map_walkup]\r
3900    THEN STRIP_TAC\r
3901    THENL[label_hypermap4_TAC `edge_walkup (H:(A)hypermap) (x:A)`\r
3902       THEN USE_THEN "F2" MP_TAC\r
3903       THEN REWRITE_TAC[lemma_node_degenerate]\r
3904       THEN DISCH_THEN SUBST1_TAC\r
3905       THEN REWRITE_TAC[CONJUNCT1(SPEC `edge_walkup (H:(A)hypermap) (x:A)` inverse2_hypermap_maps); o_THM]\r
3906       THEN USE_THEN "H3" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPECL[`inverse(edge_map (H:(A)hypermap)) (x:A)`; `(inverse(face_map (H:(A)hypermap))) (x:A)`] (MATCH_MP aux_permutes_conversion (CONJ th2 th1)))))))  \r
3907       THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
3908       THEN REWRITE_TAC[face_map_walkup]\r
3909       THEN ASM_CASES_TAC `face_map (H:(A)hypermap) (x:A) = x`\r
3910       THENL[MP_TAC(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps))\r
3911            THEN DISCH_THEN (fun th -> (MP_TAC (AP_THM th `x:A`)))\r
3912            THEN ASM_REWRITE_TAC[o_THM]\r
3913            THEN DISCH_THEN SUBST1_TAC\r
3914            THEN REWRITE_TAC[node_map_walkup]; ALL_TAC]\r
3915       THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`]  fixed_point_lemma)\r
3916       THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]\r
3917       THEN DISCH_THEN (MP_TAC o SPEC `x:A`)\r
3918       THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
3919       THEN DISCH_TAC\r
3920       THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `face_map (H:(A)hypermap) (x:A)`] node_map_walkup)))\r
3921       THEN ASM_REWRITE_TAC[]\r
3922       THEN DISCH_THEN SUBST1_TAC\r
3923       THEN GEN_REWRITE_TAC(LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM]\r
3924       THEN REWRITE_TAC[inverse_hypermap_maps]; ALL_TAC]\r
3925    THEN REPEAT STRIP_TAC\r
3926    THEN MP_TAC(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup))))\r
3927    THEN ASM_REWRITE_TAC[]);;\r
3928 \r
3929 (* walkup at a face-degenerate point *)\r
3930 \r
3931 let face_degenerate_walkup_face_map = prove(`!(H:(A)hypermap) x:A y:A. x IN dart H /\ face_map H x = x ==> face_map (edge_walkup H x) y = face_map H y`,\r
3932    REPEAT GEN_TAC\r
3933    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3934    THEN ASM_CASES_TAC `y:A = x:A`\r
3935    THENL[ASM_REWRITE_TAC[face_map_walkup]; ALL_TAC]\r
3936    THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `face_map (H:(A)hypermap)`]  fixed_point_lemma)\r
3937    THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]\r
3938    THEN DISCH_THEN (MP_TAC o SPEC `x:A`)   \r
3939    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
3940    THEN DISCH_TAC\r
3941    THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] face_map_walkup)))\r
3942    THEN ASM_REWRITE_TAC[]);;\r
3943 \r
3944 \r
3945 let face_degenerate_walkup_edge_map = prove(`!(H:(A)hypermap) x:A. x IN dart H /\ face_map H x = x ==> (edge_map (edge_walkup H x) x = x) /\ (edge_map (edge_walkup H x) ((inverse (edge_map H)) x) = edge_map H x) /\ (!y:A. ~(y = x) /\ ~(y = (inverse (edge_map H)) x) ==> edge_map (edge_walkup H x) y = edge_map H y)`,\r
3946    REPEAT GEN_TAC\r
3947    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
3948    THEN REWRITE_TAC[edge_map_walkup]\r
3949    THEN USE_THEN "F2" MP_TAC\r
3950    THEN REWRITE_TAC[lemma_face_degenerate]\r
3951    THEN DISCH_THEN (LABEL_TAC "FG")   \r
3952    THEN STRIP_TAC\r
3953    THENL[label_hypermap4_TAC `edge_walkup (H:(A)hypermap) (x:A)`\r
3954       THEN USE_THEN "FG" (SUBST1_TAC o SYM)\r
3955       THEN USE_THEN "F2" MP_TAC\r
3956       THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `face_map (H:(A)hypermap)`]  fixed_point_lemma)\r
3957       THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]\r
3958       THEN DISCH_THEN (MP_TAC o SPEC `x:A`)\r
3959       THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
3960       THEN DISCH_THEN (LABEL_TAC "F3")\r
3961       THEN ASM_CASES_TAC `node_map (H:(A)hypermap) (x:A) = x`\r
3962       THENL[USE_THEN "FG" (MP_TAC o SYM)\r
3963            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3964            THEN DISCH_TAC\r
3965            THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`]  fixed_point_lemma)\r
3966            THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]\r
3967            THEN DISCH_THEN (MP_TAC o SPEC `x:A`)\r
3968            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3969            THEN DISCH_THEN SUBST1_TAC\r
3970            THEN REWRITE_TAC[edge_map_walkup]; ALL_TAC]   \r
3971       THEN REWRITE_TAC[CONJUNCT1(SPEC `edge_walkup (H:(A)hypermap) (x:A)` inverse2_hypermap_maps); o_THM]\r
3972       THEN USE_THEN "H3" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPECL[`node_map (H:(A)hypermap) (x:A)`; `(edge_map (H:(A)hypermap)) (x:A)`] (MATCH_MP aux_permutes_conversion (CONJ th2 th1)))))))\r
3973       THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
3974       THEN SUBGOAL_THEN `~(edge_map (H:(A)hypermap) (x:A) = x)` ASSUME_TAC\r
3975       THENL[POP_ASSUM MP_TAC\r
3976           THEN REWRITE_TAC[CONTRAPOS_THM]\r
3977           THEN DISCH_THEN ASSUME_TAC\r
3978           THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`]  fixed_point_lemma)\r
3979           THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]\r
3980           THEN DISCH_THEN (MP_TAC o SPEC `x:A`)\r
3981           THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
3982           THEN USE_THEN "FG" (fun th -> REWRITE_TAC[SYM th])\r
3983           THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
3984       THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `edge_map (H:(A)hypermap) (x:A)`] face_map_walkup)))\r
3985       THEN ASM_REWRITE_TAC[]\r
3986       THEN DISCH_THEN  SUBST1_TAC\r
3987       THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [GSYM o_THM]\r
3988       THEN REWRITE_TAC[GSYM inverse_hypermap_maps]\r
3989       THEN ASM_REWRITE_TAC[node_map_walkup]; ALL_TAC]\r
3990    THEN REPEAT STRIP_TAC\r
3991    THEN MP_TAC(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup))))\r
3992    THEN ASM_REWRITE_TAC[]);;\r
3993 \r
3994 \r
3995 (* WALKUP AT A DEGENERATE DART: THREE WALKUPS ARE EQUAL *)\r
3996 \r
3997 \r
3998 let edge_degenerate_walkup_first_eq =  prove(`!(H:(A)hypermap) x:A.x IN dart H /\  edge_map H x = x  ==> node_walkup H x = edge_walkup H x`,\r
3999      REPEAT GEN_TAC\r
4000      THEN label_4Gs_TAC (SPEC `H:(A)hypermap` shift_lemma)\r
4001      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
4002      THEN USE_THEN "F1" MP_TAC\r
4003      THEN USE_THEN "G1" SUBST1_TAC\r
4004      THEN DISCH_THEN (LABEL_TAC "F3")\r
4005      THEN USE_THEN "F2" MP_TAC\r
4006      THEN USE_THEN "G2" SUBST1_TAC\r
4007      THEN DISCH_THEN (LABEL_TAC "F4")\r
4008      THEN ONCE_REWRITE_TAC[lemma_hypermap_eq]\r
4009      THEN REWRITE_TAC[node_walkup]\r
4010      THEN ONCE_REWRITE_TAC[GSYM double_shift_lemma]\r
4011      THEN STRIP_TAC \r
4012      THENL[REWRITE_TAC[lemma_edge_walkup]\r
4013         THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
4014      THEN STRIP_TAC\r
4015      THENL[ REWRITE_TAC[FUN_EQ_THM]\r
4016         THEN STRIP_TAC\r
4017         THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x':A`] edge_degenerate_walkup_edge_map)\r
4018         THEN ASM_REWRITE_TAC[]\r
4019         THEN DISCH_THEN SUBST1_TAC\r
4020         THEN MP_TAC (SPECL[`shift (H:(A)hypermap)`; `x:A`; `x':A`] face_degenerate_walkup_face_map)\r
4021         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4022      THEN STRIP_TAC\r
4023      THENL[REWRITE_TAC[FUN_EQ_THM]\r
4024        THEN STRIP_TAC\r
4025        THEN ASM_CASES_TAC `x':A = (inverse (node_map (H:(A)hypermap))) (x:A)`\r
4026        THENL[ POP_ASSUM (LABEL_TAC "G1")\r
4027          THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]))\r
4028          THEN REWRITE_TAC[node_map_walkup]\r
4029          THEN POP_ASSUM MP_TAC\r
4030          THEN USE_THEN "G3"  SUBST1_TAC\r
4031          THEN DISCH_THEN SUBST1_TAC\r
4032          THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F4" (fun th2 -> (MP_TAC ( CONJUNCT1(CONJUNCT2(MATCH_MP face_degenerate_walkup_edge_map (CONJ th1 th2))))))))\r
4033          THEN DISCH_THEN SUBST1_TAC\r
4034          THEN SIMP_TAC[]; ALL_TAC]\r
4035        THEN ASM_CASES_TAC `x':A = x:A`\r
4036        THENL[ POP_ASSUM SUBST1_TAC\r
4037          THEN REWRITE_TAC[edge_map_walkup; node_map_walkup]; ALL_TAC]\r
4038        THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] node_map_walkup)))\r
4039        THEN ASM_REWRITE_TAC[]\r
4040        THEN DISCH_THEN SUBST1_TAC\r
4041        THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F4" (fun th2 -> (MP_TAC ( CONJUNCT2(CONJUNCT2(MATCH_MP face_degenerate_walkup_edge_map (CONJ th1 th2))))))))\r
4042        THEN DISCH_THEN (MP_TAC o SPEC `x':A`)\r
4043        THEN USE_THEN "G3" (SUBST1_TAC o SYM)\r
4044        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4045    THEN REWRITE_TAC[FUN_EQ_THM]\r
4046    THEN STRIP_TAC\r
4047    THEN ASM_CASES_TAC `x':A = (inverse (face_map (H:(A)hypermap))) (x:A)`\r
4048    THENL[POP_ASSUM (LABEL_TAC "G1")\r
4049            THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]))\r
4050            THEN REWRITE_TAC[face_map_walkup]\r
4051            THEN POP_ASSUM MP_TAC\r
4052            THEN USE_THEN "G4"  SUBST1_TAC\r
4053            THEN DISCH_THEN SUBST1_TAC\r
4054            THEN REWRITE_TAC[node_map_walkup]; ALL_TAC]\r
4055    THEN ASM_CASES_TAC `x':A = x:A`\r
4056    THENL[POP_ASSUM SUBST1_TAC\r
4057            THEN REWRITE_TAC[face_map_walkup; node_map_walkup]; ALL_TAC]\r
4058    THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] face_map_walkup)))\r
4059    THEN ASM_REWRITE_TAC[]\r
4060    THEN DISCH_THEN SUBST1_TAC\r
4061    THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`shift (H:(A)hypermap)`; `x:A`; `x':A`] node_map_walkup)))\r
4062    THEN USE_THEN "G4" (fun th -> REWRITE_TAC[SYM th])\r
4063    THEN ASM_REWRITE_TAC[]);;\r
4064 \r
4065 \r
4066 let edge_degenerate_walkup_second_eq =  prove(`!(H:(A)hypermap) x:A.x IN dart H /\  edge_map H x = x  ==> face_walkup H x = edge_walkup H x`,\r
4067    REPEAT GEN_TAC\r
4068    THEN label_4Gs_TAC (SPEC `H:(A)hypermap` double_shift_lemma)\r
4069    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
4070    THEN USE_THEN "F1" MP_TAC\r
4071    THEN USE_THEN "G1" SUBST1_TAC\r
4072    THEN DISCH_THEN (LABEL_TAC "F3")\r
4073    THEN USE_THEN "F2" MP_TAC\r
4074    THEN USE_THEN "G2" SUBST1_TAC\r
4075    THEN DISCH_THEN (LABEL_TAC "F4")\r
4076    THEN ONCE_REWRITE_TAC[lemma_hypermap_eq]\r
4077    THEN REWRITE_TAC[face_walkup]\r
4078    THEN ONCE_REWRITE_TAC[GSYM shift_lemma]\r
4079    THEN STRIP_TAC\r
4080    THENL[REWRITE_TAC[lemma_edge_walkup]\r
4081            THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
4082    THEN STRIP_TAC\r
4083    THENL[REWRITE_TAC[FUN_EQ_THM]\r
4084       THEN STRIP_TAC\r
4085       THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x':A`] edge_degenerate_walkup_edge_map)\r
4086       THEN ASM_REWRITE_TAC[]\r
4087       THEN DISCH_THEN SUBST1_TAC\r
4088       THEN MP_TAC (SPECL[`shift(shift (H:(A)hypermap))`; `x:A`; `x':A`] node_degenerate_walkup_node_map)\r
4089       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4090    THEN STRIP_TAC\r
4091    THENL[REWRITE_TAC[FUN_EQ_THM]\r
4092       THEN STRIP_TAC\r
4093       THEN ASM_CASES_TAC `x':A = (inverse (node_map (H:(A)hypermap))) (x:A)`\r
4094       THENL[POP_ASSUM (LABEL_TAC "G1")\r
4095               THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]))\r
4096               THEN REWRITE_TAC[node_map_walkup]\r
4097               THEN POP_ASSUM MP_TAC\r
4098               THEN USE_THEN "G3"  SUBST1_TAC\r
4099               THEN DISCH_THEN SUBST1_TAC\r
4100               THEN REWRITE_TAC[face_map_walkup]; ALL_TAC]\r
4101       THEN ASM_CASES_TAC `x':A = x:A`\r
4102       THENL[POP_ASSUM SUBST1_TAC\r
4103               THEN REWRITE_TAC[face_map_walkup; node_map_walkup]; ALL_TAC]\r
4104       THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] node_map_walkup)))\r
4105       THEN ASM_REWRITE_TAC[]\r
4106       THEN DISCH_THEN SUBST1_TAC\r
4107       THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`shift(shift(H:(A)hypermap))`; `x:A`; `x':A`] face_map_walkup)))\r
4108       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4109       THEN REMOVE_THEN "G3" (SUBST1_TAC o SYM)\r
4110       THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
4111    THEN REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC\r
4112    THEN ASM_CASES_TAC `x':A = x:A`\r
4113    THENL[POP_ASSUM SUBST1_TAC\r
4114            THEN REWRITE_TAC[face_map_walkup; edge_map_walkup]; ALL_TAC]\r
4115    THEN ASM_CASES_TAC `x':A = (inverse (face_map (H:(A)hypermap))) (x:A)`\r
4116    THENL[POP_ASSUM (LABEL_TAC "G1")\r
4117       THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]))\r
4118       THEN REWRITE_TAC[face_map_walkup]\r
4119       THEN POP_ASSUM MP_TAC\r
4120       THEN USE_THEN "G4"  SUBST1_TAC\r
4121       THEN DISCH_THEN SUBST1_TAC\r
4122       THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F4" (fun th2 -> (MP_TAC (CONJUNCT1(CONJUNCT2(MATCH_MP node_degenerate_walkup_edge_map (CONJ th1 th2))))))))\r
4123       THEN SIMP_TAC[]; ALL_TAC]\r
4124    THEN POP_ASSUM MP_TAC\r
4125    THEN USE_THEN "G4" SUBST1_TAC\r
4126    THEN DISCH_TAC\r
4127    THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F4" (fun th2 -> (MP_TAC (CONJUNCT2(CONJUNCT2(MATCH_MP node_degenerate_walkup_edge_map (CONJ th1 th2))))))))\r
4128    THEN DISCH_THEN (MP_TAC o SPEC `x':A`)\r
4129    THEN ASM_REWRITE_TAC[]\r
4130    THEN DISCH_THEN SUBST1_TAC\r
4131    THEN USE_THEN "G4" (SUBST1_TAC o SYM)\r
4132    THEN POP_ASSUM MP_TAC\r
4133    THEN USE_THEN "G4" (SUBST1_TAC o SYM)\r
4134    THEN DISCH_TAC\r
4135    THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] face_map_walkup)))\r
4136    THEN ASM_REWRITE_TAC[]\r
4137    THEN DISCH_THEN SUBST1_TAC\r
4138    THEN SIMP_TAC[]);;\r
4139 \r
4140 \r
4141 let edge_degenerate_walkup_third_eq = prove(`!(H:(A)hypermap) x:A.x IN dart H /\  edge_map H x = x  ==> node_walkup H x = face_walkup H x`,\r
4142    REPEAT GEN_TAC\r
4143    THEN  DISCH_THEN (LABEL_TAC "F1")\r
4144    THEN USE_THEN "F1" (MP_TAC o MATCH_MP edge_degenerate_walkup_first_eq)\r
4145    THEN DISCH_THEN SUBST1_TAC\r
4146    THEN CONV_TAC SYM_CONV\r
4147    THEN MATCH_MP_TAC edge_degenerate_walkup_second_eq\r
4148    THEN ASM_REWRITE_TAC[]);;\r
4149 \r
4150 let lemma_shift_cycle = prove(`!(H:(A)hypermap). shift (shift (shift H)) = H`,\r
4151    GEN_TAC\r
4152    THEN ONCE_REWRITE_TAC[lemma_hypermap_eq]\r
4153    THEN REWRITE_TAC[GSYM shift_lemma]);;\r
4154 \r
4155 let lemma_eq_iff_shift_eq = prove(`!(H:(A)hypermap) (H':(A)hypermap). H = H' <=> shift H = shift H'`,\r
4156    REPEAT GEN_TAC\r
4157    THEN EQ_TAC\r
4158    THENL[DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
4159    THEN REWRITE_TAC[lemma_hypermap_eq; GSYM shift_lemma]\r
4160    THEN MESON_TAC[]);;\r
4161 \r
4162 let lemma_degenerate_walkup_first_eq = prove(`!(H:(A)hypermap) x:A. x IN dart H /\ dart_degenerate H x ==> node_walkup H x = edge_walkup H x`,\r
4163    REPEAT GEN_TAC\r
4164    THEN REWRITE_TAC[dart_degenerate]\r
4165    THEN STRIP_TAC\r
4166    THENL[MATCH_MP_TAC edge_degenerate_walkup_first_eq\r
4167       THEN ASM_REWRITE_TAC[]; \r
4168       label_4Gs_TAC (SPEC `H:(A)hypermap` shift_lemma)\r
4169       THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)`\r
4170       THEN UNDISCH_TAC `node_map (H:(A)hypermap) (x:A) = x`\r
4171       THEN ASM_REWRITE_TAC[]\r
4172       THEN DISCH_THEN (LABEL_TAC "F1")\r
4173       THEN DISCH_THEN (LABEL_TAC "F2")\r
4174       THEN REWRITE_TAC[node_walkup]\r
4175       THEN ONCE_REWRITE_TAC[lemma_eq_iff_shift_eq]\r
4176       THEN REWRITE_TAC[lemma_shift_cycle]\r
4177       THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] edge_degenerate_walkup_second_eq)\r
4178       THEN ASM_REWRITE_TAC[]\r
4179       THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4180       THEN REWRITE_TAC[face_walkup]\r
4181       THEN REWRITE_TAC[lemma_shift_cycle]; ALL_TAC]\r
4182    THEN label_4Gs_TAC (SPEC `H:(A)hypermap` double_shift_lemma)\r
4183    THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)`\r
4184    THEN UNDISCH_TAC `face_map (H:(A)hypermap) (x:A) = x`\r
4185    THEN ASM_REWRITE_TAC[]\r
4186    THEN DISCH_THEN (LABEL_TAC "F1")\r
4187    THEN DISCH_THEN (LABEL_TAC "F2")\r
4188    THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] edge_degenerate_walkup_third_eq)\r
4189    THEN ASM_REWRITE_TAC[]\r
4190    THEN ASM_REWRITE_TAC[face_walkup; node_walkup]\r
4191    THEN REWRITE_TAC[lemma_shift_cycle]\r
4192    THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `shift:((A)hypermap) -> ((A)hypermap)`)\r
4193    THEN REWRITE_TAC[lemma_shift_cycle]);;\r
4194 \r
4195 let lemma_degenerate_walkup_second_eq = prove(`!(H:(A)hypermap) x:A. x IN dart H /\ dart_degenerate H x ==> face_walkup H x = edge_walkup H x`,\r
4196    REPEAT GEN_TAC\r
4197    THEN REWRITE_TAC[dart_degenerate]\r
4198    THEN STRIP_TAC\r
4199    THENL[MATCH_MP_TAC edge_degenerate_walkup_second_eq\r
4200          THEN ASM_REWRITE_TAC[];\r
4201          label_4Gs_TAC (SPEC `H:(A)hypermap` shift_lemma)\r
4202          THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)`\r
4203          THEN UNDISCH_TAC `node_map (H:(A)hypermap) (x:A) = x`\r
4204          THEN ASM_REWRITE_TAC[]\r
4205          THEN DISCH_THEN (LABEL_TAC "F1")\r
4206          THEN DISCH_THEN (LABEL_TAC "F2")\r
4207          THEN REWRITE_TAC[face_walkup]\r
4208          THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] edge_degenerate_walkup_third_eq)\r
4209          THEN ASM_REWRITE_TAC[]\r
4210          THEN REWRITE_TAC[node_walkup; face_walkup]\r
4211          THEN REWRITE_TAC[GSYM lemma_eq_iff_shift_eq; lemma_shift_cycle]; ALL_TAC]\r
4212    THEN label_4Gs_TAC (SPEC `H:(A)hypermap` double_shift_lemma)\r
4213    THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)`\r
4214    THEN UNDISCH_TAC `face_map (H:(A)hypermap) (x:A) = x`\r
4215    THEN ASM_REWRITE_TAC[]\r
4216    THEN DISCH_THEN (LABEL_TAC "F1")\r
4217    THEN DISCH_THEN (LABEL_TAC "F2")\r
4218    THEN REWRITE_TAC[face_walkup]\r
4219    THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] edge_degenerate_walkup_first_eq)\r
4220    THEN ASM_REWRITE_TAC[node_walkup; lemma_shift_cycle]\r
4221    THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `shift:((A)hypermap) -> ((A)hypermap)`)\r
4222    THEN REWRITE_TAC[lemma_shift_cycle]);;\r
4223 \r
4224 let lemma_degenerate_walkup_third_eq = prove(`!(H:(A)hypermap) x:A.x IN dart H /\ dart_degenerate H x ==> node_walkup H x = face_walkup H x`,\r
4225    REPEAT GEN_TAC\r
4226    THEN  DISCH_THEN (LABEL_TAC "F1")\r
4227    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_degenerate_walkup_first_eq)\r
4228    THEN DISCH_THEN SUBST1_TAC\r
4229    THEN CONV_TAC SYM_CONV\r
4230    THEN MATCH_MP_TAC lemma_degenerate_walkup_second_eq\r
4231    THEN ASM_REWRITE_TAC[]);;\r
4232 \r
4233 (* I prove that walkup at a degenerate dart do not change the plannar indices *)\r
4234 \r
4235 \r
4236 let component_at_isolated_dart = prove(`!(H:(A)hypermap) x:A. isolated_dart H x ==> comb_component H x = {x}`,\r
4237    REPEAT GEN_TAC\r
4238    THEN REWRITE_TAC[isolated_dart]\r
4239    THEN REPEAT STRIP_TAC\r
4240    THEN REWRITE_TAC[comb_component; EXTENSION; IN_ELIM_THM; IN_SING; is_in_component]\r
4241    THEN GEN_TAC\r
4242    THEN REWRITE_TAC[lemma_def_path]\r
4243    THEN EQ_TAC\r
4244    THENL[STRIP_TAC\r
4245         THEN SUBGOAL_THEN `!j:num. j <= n:num ==> (p:num->A) j = x:A` (LABEL_TAC "F1")\r
4246         THENL[INDUCT_TAC THENL[ASM_REWRITE_TAC[]; ALL_TAC]\r
4247            THEN DISCH_THEN (LABEL_TAC "F1")\r
4248            THEN FIRST_ASSUM (MP_TAC o SPEC `j:num` o  check (is_forall o concl))\r
4249            THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (j:num) <= n:num ==> j < n`) th])\r
4250            THEN REWRITE_TAC[go_one_step]\r
4251            THEN FIRST_ASSUM (MP_TAC o check (is_imp o concl))\r
4252            THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (j:num) <= n:num ==> j <= n`) th])\r
4253            THEN DISCH_THEN SUBST1_TAC\r
4254            THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4255         THEN POP_ASSUM (MP_TAC o SPEC `n:num`)\r
4256         THEN REWRITE_TAC[LE_REFL]\r
4257         THEN FIRST_ASSUM SUBST1_TAC\r
4258         THEN DISCH_THEN SUBST1_TAC\r
4259         THEN SIMP_TAC[]; ALL_TAC]\r
4260    THEN STRIP_TAC\r
4261    THEN EXISTS_TAC `(\k:num. x:A)`\r
4262    THEN EXISTS_TAC `0`\r
4263    THEN ASM_REWRITE_TAC[]\r
4264    THEN ARITH_TAC);;\r
4265 \r
4266 let LEMMA_CARD_DIFF = prove(`!(s:A->bool) (t:A->bool). FINITE s /\ t SUBSET s ==> CARD s = CARD (s DIFF t) + CARD t`,\r
4267    REPEAT STRIP_TAC\r
4268    THEN CONV_TAC SYM_CONV\r
4269    THEN MATCH_MP_TAC CARD_UNION_EQ\r
4270    THEN ASM_SIMP_TAC[] THEN ASM_ASM_SET_TAC);;\r
4271 \r
4272 let CARD_MINUS_ONE = prove(`!(s:B -> bool) (x:B). FINITE s /\ x IN s ==> CARD s = CARD (s DELETE x) + 1`,\r
4273    REPEAT STRIP_TAC\r
4274    THEN ASSUME_TAC (ISPECL[`x:B`; `s:B->bool`] DELETE_SUBSET)\r
4275    THEN MP_TAC (ISPECL[`(s:B->bool) DELETE (x:B)`; `s:B->bool`] FINITE_SUBSET)\r
4276    THEN ASM_REWRITE_TAC[]\r
4277    THEN DISCH_TAC\r
4278    THEN MP_TAC(ISPECL[`x:B`; `(s:B->bool) DELETE (x:B)`] (CONJUNCT2 CARD_CLAUSES))\r
4279    THEN ASM_REWRITE_TAC[IN_DELETE]\r
4280    THEN MP_TAC(ISPECL[`x:B`; `s:B->bool`] INSERT_DELETE)\r
4281    THEN ASM_REWRITE_TAC[]\r
4282    THEN DISCH_THEN SUBST1_TAC\r
4283    THEN ARITH_TAC);;\r
4284 \r
4285 let CARD_MINUS_DIFF_TWO_SET = prove(`!(s:B -> bool) (x:B) (y:B). FINITE s /\ x IN s /\ y IN s ==> CARD s = CARD (s DIFF {x, y}) + CARD {x,y}`,\r
4286    REPEAT STRIP_TAC\r
4287    THEN MATCH_MP_TAC LEMMA_CARD_DIFF\r
4288    THEN ASM_ASM_SET_TAC);;\r
4289 \r
4290 let EDGE_FINITE = prove(`!(H:(A)hypermap) (x:A). FINITE (edge H x)`,\r
4291    REPEAT GEN_TAC\r
4292    THEN REWRITE_TAC[edge]\r
4293    THEN MATCH_MP_TAC lemma_orbit_finite\r
4294    THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
4295    THEN REWRITE_TAC[hypermap_lemma]);;\r
4296 \r
4297 let EDGE_NOT_EMPTY = prove(`!(H:(A)hypermap) (x:A). 1 <= CARD (edge H x)`,\r
4298    REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_ATLEAST_1\r
4299    THEN EXISTS_TAC `x:A`\r
4300    THEN REWRITE_TAC[EDGE_FINITE; edge]\r
4301    THEN REWRITE_TAC[orbit_reflect]);;\r
4302 \r
4303 let NODE_FINITE = prove(`!(H:(A)hypermap) (x:A). FINITE (node H x)`,\r
4304    REPEAT GEN_TAC\r
4305    THEN REWRITE_TAC[node]\r
4306    THEN MATCH_MP_TAC lemma_orbit_finite\r
4307    THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
4308    THEN REWRITE_TAC[hypermap_lemma]);;\r
4309 \r
4310 let NODE_NOT_EMPTY = prove(`!(H:(A)hypermap) (x:A). 1 <= CARD (node H x)`,\r
4311    REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_ATLEAST_1\r
4312    THEN EXISTS_TAC `x:A`\r
4313    THEN REWRITE_TAC[NODE_FINITE; node]\r
4314    THEN REWRITE_TAC[orbit_reflect]);;\r
4315 \r
4316 let FACE_FINITE = prove(`!(H:(A)hypermap) (x:A). FINITE (face H x)`,\r
4317    REPEAT GEN_TAC\r
4318    THEN REWRITE_TAC[face]\r
4319    THEN MATCH_MP_TAC lemma_orbit_finite\r
4320    THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
4321    THEN REWRITE_TAC[hypermap_lemma]);;\r
4322 \r
4323 let FACE_NOT_EMPTY = prove(`!(H:(A)hypermap) (x:A). 1 <= CARD (face H x)`,\r
4324    REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_ATLEAST_1\r
4325    THEN EXISTS_TAC `x:A`\r
4326    THEN REWRITE_TAC[FACE_FINITE; face]\r
4327    THEN REWRITE_TAC[orbit_reflect]);;\r
4328 \r
4329 let FINITE_HYPERMAP_ORBITS = prove(`!(H:(A)hypermap). FINITE (edge_set H) /\ FINITE (node_set H) /\ FINITE (face_set H)`,\r
4330    GEN_TAC THEN REWRITE_TAC[edge_set; node_set; face_set] THEN REPEAT STRIP_TAC\r
4331    THENL[MATCH_MP_TAC finite_orbits_lemma THEN REWRITE_TAC[hypermap_lemma];\r
4332      MATCH_MP_TAC finite_orbits_lemma THEN REWRITE_TAC[hypermap_lemma];\r
4333      MATCH_MP_TAC finite_orbits_lemma THEN REWRITE_TAC[hypermap_lemma]]);;\r
4334 \r
4335 let FINITE_HYPERMAP_COMPONENTS = prove(`!H:(A)hypermap. FINITE (set_of_components H)`,\r
4336    GEN_TAC THEN REWRITE_TAC[set_of_components] THEN label_hypermap4_TAC `H:(A)hypermap`\r
4337    THEN ABBREV_TAC `D = dart (H:(A)hypermap)`  \r
4338    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`  \r
4339    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
4340    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
4341    THEN SUBGOAL_THEN `IMAGE (\x:A. comb_component (H:(A)hypermap) (x:A)) (D:A->bool) = set_part_components H D` ASSUME_TAC\r
4342    THENL[REWRITE_TAC[EXTENSION] THEN STRIP_TAC THEN EQ_TAC\r
4343        THENL[REWRITE_TAC[set_part_components;IMAGE;IN;IN_ELIM_THM]; \r
4344            REWRITE_TAC[set_part_components;IMAGE;IN;IN_ELIM_THM]]; ALL_TAC]\r
4345    THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th])\r
4346    THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[]);;\r
4347 \r
4348 let WALKUP_EXCEPTION_COMPONENT = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> comb_component (edge_walkup H x) x = {x}`,\r
4349    REPEAT STRIP_TAC\r
4350    THEN ASSUME_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup))\r
4351    THEN ASSUME_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] node_map_walkup))\r
4352    THEN ASSUME_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] face_map_walkup))\r
4353    THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)`\r
4354    THEN MP_TAC(SPECL[`G:(A)hypermap`; `x:A`] isolated_dart)\r
4355    THEN ASM_REWRITE_TAC[]\r
4356    THEN DISCH_THEN (MP_TAC o MATCH_MP component_at_isolated_dart)\r
4357    THEN SIMP_TAC[]);;\r
4358 \r
4359 \r
4360 (* SOME TRIVIAL LEMMAS ON INCIDENT RELATIONSHIPS *)\r
4361    \r
4362 let lemma_in_components = prove(`!(H:(A)hypermap) x:A. x IN dart H <=> comb_component H x IN set_of_components H`,\r
4363    REPEAT GEN_TAC THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
4364    THEN ASM_REWRITE_TAC[set_of_components]\r
4365    THEN REWRITE_TAC[set_part_components]\r
4366    THEN EQ_TAC\r
4367    THENL[STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM]\r
4368            THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4369    THEN REWRITE_TAC[IN_ELIM_THM]\r
4370    THEN STRIP_TAC\r
4371    THEN MP_TAC (SPECL[`H:(A)hypermap`; `x':A`] lemma_component_subset)\r
4372    THEN ASM_REWRITE_TAC[]\r
4373    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
4374    THEN MESON_TAC[lemma_component_reflect; SUBSET]);;  \r
4375 \r
4376 let lemma_card_eq_reflect = prove(`!s t. s = t ==> CARD s = CARD t`,MESON_TAC[]);;\r
4377 \r
4378 let lemma_different_edges = prove(`!(H:(A)hypermap) (x:A) (y:A). ~(x IN edge H y) ==> ~(edge H x = edge H y)`,\r
4379    REPEAT GEN_TAC\r
4380      THEN REWRITE_TAC[edge]\r
4381      THEN ASSUME_TAC(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))\r
4382      THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
4383      THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`\r
4384      THEN REWRITE_TAC[CONTRAPOS_THM]\r
4385      THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4386      THEN REWRITE_TAC[orbit_reflect]);;\r
4387 \r
4388 let lemma_different_nodes = prove(`!(H:(A)hypermap) (x:A) (y:A). ~(x IN node H y) ==> ~(node H x = node H y)`,\r
4389    REPEAT GEN_TAC\r
4390      THEN REWRITE_TAC[node]\r
4391      THEN ASSUME_TAC(CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))\r
4392      THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
4393      THEN ABBREV_TAC `e = node_map (H:(A)hypermap)`\r
4394      THEN REWRITE_TAC[CONTRAPOS_THM]\r
4395      THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4396      THEN REWRITE_TAC[orbit_reflect]);;\r
4397 \r
4398 let lemma_different_faces = prove(`!(H:(A)hypermap) (x:A) (y:A). ~(x IN face H y) ==> ~(face H x = face H y)`,\r
4399    REPEAT GEN_TAC\r
4400      THEN REWRITE_TAC[face]\r
4401      THEN ASSUME_TAC(CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))\r
4402      THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
4403      THEN ABBREV_TAC `e = face_map (H:(A)hypermap)`\r
4404      THEN REWRITE_TAC[CONTRAPOS_THM]\r
4405      THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4406      THEN REWRITE_TAC[orbit_reflect]);;\r
4407 \r
4408 \r
4409 (* WALKUP AT AN ISOLATED DART *)\r
4410 \r
4411 \r
4412 let lemma_planar_index_on_walkup_at_isolated_dart = prove(`!(H:(A)hypermap) x:A. x IN dart H /\ isolated_dart H x ==> planar_ind H = planar_ind (edge_walkup H x)`,\r
4413   REPEAT GEN_TAC\r
4414   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
4415   THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[isolated_dart]\r
4416   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
4417   THEN LABEL_TAC "F6" (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
4418   THEN label_hypermap_TAC `H:(A)hypermap`\r
4419   THEN label_hypermapG_TAC `edge_walkup (H:(A)hypermap) (x:A)`\r
4420   THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
4421   THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`  \r
4422   THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
4423   THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
4424   THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` \r
4425   THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))`  \r
4426   THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))` \r
4427   THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))`\r
4428   THEN SUBGOAL_THEN `number_of_edges (H:(A)hypermap) = number_of_edges (edge_walkup H (x:A)) + 1` (LABEL_TAC "X1")\r
4429   THENL[REWRITE_TAC[number_of_edges] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges)\r
4430    THEN REWRITE_TAC[edge] THEN ASM_REWRITE_TAC[]\r
4431    THEN USE_THEN "F3" MP_TAC\r
4432    THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`e:A->A`; `x:A`] orbit_one_point]\r
4433    THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4434    THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o  MATCH_MP fixed_point_lemma)\r
4435    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th])\r
4436    THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4437    THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup))\r
4438    THEN ASM_REWRITE_TAC[]\r
4439    THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`e':A->A`; `x:A`] orbit_one_point]\r
4440    THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4441    THEN REWRITE_TAC[SET_RULE `{x, x} = {x}`]\r
4442    THEN SUBGOAL_THEN `{x:A} IN edge_set (H:(A)hypermap)` ASSUME_TAC\r
4443    THENL[REWRITE_TAC[edge_set] THEN ASM_REWRITE_TAC[]\r
4444       THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
4445       THEN EXISTS_TAC `x:A`\r
4446       THEN USE_THEN "F3" MP_TAC\r
4447       THEN GEN_REWRITE_TAC (LAND_CONV) [orbit_one_point]\r
4448       THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
4449       THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
4450    THEN SUBGOAL_THEN `~({x:A} IN edge_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC\r
4451    THENL[REWRITE_TAC[edge_set] THEN ASM_REWRITE_TAC[]\r
4452       THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
4453       THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM]\r
4454       THEN REWRITE_TAC[IN_DELETE]\r
4455       THEN REPEAT STRIP_TAC\r
4456       THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))\r
4457       THEN REWRITE_TAC[]\r
4458       THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th)))\r
4459       THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma)\r
4460       THEN SIMP_TAC[]; ALL_TAC]\r
4461    THEN REWRITE_TAC[SET_RULE `((edge_set (H:(A)hypermap)):((A->bool)->bool)) DIFF {{x:A}} = (edge_set (H:(A)hypermap)) DELETE {x:A}`]\r
4462    THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT]\r
4463    THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
4464    THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
4465    THEN MP_TAC(ISPECL[`edge_set (H:(A)hypermap)`; `{x:A}`] CARD_MINUS_ONE)\r
4466    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4467    THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC]\r
4468   THEN SUBGOAL_THEN `number_of_nodes (H:(A)hypermap) = number_of_nodes (edge_walkup H (x:A)) + 1` (LABEL_TAC "X2")\r
4469    THENL[REWRITE_TAC[number_of_nodes] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_nodes)\r
4470       THEN REWRITE_TAC[node] THEN ASM_REWRITE_TAC[]\r
4471       THEN USE_THEN "F4" MP_TAC THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`n:A->A`; `x:A`] orbit_one_point]\r
4472       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4473       THEN USE_THEN "H3" (MP_TAC o SPEC `x:A` o  MATCH_MP fixed_point_lemma)\r
4474       THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th])\r
4475       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4476       THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] node_map_walkup))\r
4477       THEN ASM_REWRITE_TAC[]\r
4478       THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`n':A->A`; `x:A`] orbit_one_point]\r
4479       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4480       THEN SUBGOAL_THEN `{x:A} IN node_set (H:(A)hypermap)` ASSUME_TAC\r
4481       THENL[REWRITE_TAC[node_set] THEN ASM_REWRITE_TAC[]\r
4482         THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
4483         THEN EXISTS_TAC `x:A` THEN USE_THEN "F4" MP_TAC\r
4484         THEN GEN_REWRITE_TAC (LAND_CONV) [orbit_one_point]\r
4485         THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
4486         THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
4487       THEN SUBGOAL_THEN `~({x:A} IN node_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC\r
4488       THENL[REWRITE_TAC[node_set] THEN ASM_REWRITE_TAC[]\r
4489         THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
4490         THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM]\r
4491         THEN REWRITE_TAC[IN_DELETE] THEN REPEAT STRIP_TAC\r
4492         THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))\r
4493         THEN REWRITE_TAC[]\r
4494         THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th)))\r
4495         THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma)\r
4496         THEN SIMP_TAC[]; ALL_TAC]\r
4497       THEN POP_ASSUM MP_TAC\r
4498       THEN REWRITE_TAC[DELETE_NON_ELEMENT]\r
4499       THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
4500       THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
4501       THEN MP_TAC(ISPECL[`node_set (H:(A)hypermap)`; `{x:A}`] CARD_MINUS_ONE)\r
4502       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4503       THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC]\r
4504    THEN SUBGOAL_THEN `number_of_faces (H:(A)hypermap) = number_of_faces (edge_walkup H (x:A)) + 1` (LABEL_TAC "X3")\r
4505    THENL[REWRITE_TAC[number_of_faces] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_faces)\r
4506       THEN REWRITE_TAC[face] THEN ASM_REWRITE_TAC[]\r
4507       THEN USE_THEN "F5" MP_TAC THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`n:A->A`; `x:A`] orbit_one_point]\r
4508       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4509       THEN USE_THEN "H4" (MP_TAC o SPEC `x:A` o  MATCH_MP fixed_point_lemma)\r
4510       THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
4511       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4512       THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] face_map_walkup))\r
4513       THEN ASM_REWRITE_TAC[]\r
4514       THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`f':A->A`; `x:A`] orbit_one_point]\r
4515       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4516       THEN SUBGOAL_THEN `{x:A} IN face_set (H:(A)hypermap)` ASSUME_TAC\r
4517       THENL[REWRITE_TAC[face_set] THEN ASM_REWRITE_TAC[]\r
4518         THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
4519         THEN EXISTS_TAC `x:A` THEN USE_THEN "F5" MP_TAC\r
4520         THEN GEN_REWRITE_TAC (LAND_CONV) [orbit_one_point]\r
4521         THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
4522         THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
4523       THEN SUBGOAL_THEN `~({x:A} IN face_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC\r
4524       THENL[REWRITE_TAC[face_set] THEN ASM_REWRITE_TAC[]\r
4525         THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
4526         THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM]\r
4527         THEN REWRITE_TAC[IN_DELETE] THEN REPEAT STRIP_TAC\r
4528         THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))\r
4529         THEN REWRITE_TAC[]\r
4530         THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th)))\r
4531         THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma)\r
4532         THEN SIMP_TAC[]; ALL_TAC]\r
4533       THEN POP_ASSUM MP_TAC\r
4534       THEN REWRITE_TAC[DELETE_NON_ELEMENT]\r
4535       THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
4536       THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
4537       THEN MP_TAC(ISPECL[`face_set (H:(A)hypermap)`; `{x:A}`] CARD_MINUS_ONE)\r
4538       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4539       THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC]\r
4540    THEN SUBGOAL_THEN `number_of_components (H:(A)hypermap) = number_of_components (edge_walkup H (x:A)) + 1` (LABEL_TAC "X4")\r
4541    THENL[REWRITE_TAC[number_of_components]\r
4542      THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_components)\r
4543      THEN ASM_REWRITE_TAC[]\r
4544      THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o  MATCH_MP fixed_point_lemma)\r
4545      THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th])\r
4546      THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4547      THEN REWRITE_TAC[SET_RULE `{x, x} = {x}`]\r
4548      THEN REWRITE_TAC[SET_RULE `set_of_components (edge_walkup (H:(A)hypermap) (x:A)) DIFF {comb_component (edge_walkup H x) x} = set_of_components (edge_walkup (H:(A)hypermap) (x:A)) DELETE (comb_component (edge_walkup H x) x )`]\r
4549      THEN SUBGOAL_THEN `comb_component (H:(A)hypermap) (x:A) IN set_of_components H` ASSUME_TAC\r
4550      THENL[REWRITE_TAC[set_of_components]\r
4551              THEN ASM_REWRITE_TAC[]\r
4552              THEN REWRITE_TAC[set_part_components; IN_ELIM_THM]\r
4553              THEN EXISTS_TAC `x:A`\r
4554              THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
4555      THEN SUBGOAL_THEN `~(comb_component (edge_walkup (H:(A)hypermap) (x:A)) x IN set_of_components (edge_walkup H x))` ASSUME_TAC\r
4556      THENL[REWRITE_TAC[set_of_components]\r
4557              THEN ASM_REWRITE_TAC[]\r
4558              THEN REWRITE_TAC[set_part_components; IN_ELIM_THM; IN_DELETE]\r
4559              THEN STRIP_TAC\r
4560              THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] WALKUP_EXCEPTION_COMPONENT)\r
4561              THEN ASM_REWRITE_TAC[]\r
4562              THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))\r
4563              THEN REWRITE_TAC[CONTRAPOS_THM]\r
4564              THEN STRIP_TAC\r
4565              THEN MP_TAC (SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `x':A`] lemma_component_reflect)\r
4566              THEN POP_ASSUM SUBST1_TAC\r
4567              THEN REWRITE_TAC[IN_SING]; ALL_TAC]\r
4568      THEN POP_ASSUM MP_TAC\r
4569      THEN REWRITE_TAC[DELETE_NON_ELEMENT]\r
4570      THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
4571      THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
4572      THEN MP_TAC(ISPECL[`set_of_components (H:(A)hypermap)`; `comb_component (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE)\r
4573      THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4574      THEN REWRITE_TAC[FINITE_HYPERMAP_COMPONENTS]; ALL_TAC]\r
4575    THEN SUBGOAL_THEN `CARD (dart (H:(A)hypermap)) = CARD(dart (edge_walkup H (x:A))) + 1` (LABEL_TAC "X5")\r
4576    THENL[MP_TAC(CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
4577      THEN DISCH_THEN SUBST1_TAC\r
4578      THEN MATCH_MP_TAC CARD_MINUS_ONE\r
4579      THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4580    THEN REWRITE_TAC[planar_ind]\r
4581    THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD]\r
4582    THEN REAL_ARITH_TAC);;\r
4583 \r
4584 \r
4585 (* Walkup at an edge-degenerate dart *)\r
4586 \r
4587 let lemma_planar_index_on_walkup_at_edge_degenerate_dart = prove(`!(H:(A)hypermap) x:A. x IN dart H /\ is_edge_degenerate H x ==> planar_ind H = planar_ind (edge_walkup H x)`,\r
4588   REPEAT GEN_TAC\r
4589   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
4590   THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[is_edge_degenerate]\r
4591   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
4592   THEN LABEL_TAC "F6" (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
4593   THEN label_hypermap_TAC `H:(A)hypermap`\r
4594   THEN label_hypermapG_TAC `edge_walkup (H:(A)hypermap) (x:A)`\r
4595   THEN ABBREV_TAC `D = dart (H:(A)hypermap)` \r
4596   THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`  \r
4597   THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` \r
4598   THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
4599   THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` \r
4600   THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))`  \r
4601   THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))` \r
4602   THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))`\r
4603   THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] lemma_in_hypermap_orbits)\r
4604   THEN ASM_REWRITE_TAC[]\r
4605   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9")))\r
4606   THEN SUBGOAL_THEN `number_of_edges (H:(A)hypermap) = number_of_edges (edge_walkup H (x:A)) + 1` (LABEL_TAC "X1")\r
4607   THENL[REWRITE_TAC[number_of_edges] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges)\r
4608           THEN ASM_REWRITE_TAC[]\r
4609           THEN LABEL_TAC "F10" (CONJUNCT1(SPEC `H:(A)hypermap`  FINITE_HYPERMAP_ORBITS))\r
4610           THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant)\r
4611           THEN ASM_REWRITE_TAC[]\r
4612           THEN DISCH_THEN (fun th -> (LABEL_TAC "F11" (CONJUNCT1 th)))\r
4613           THEN MP_TAC(SPECL[`H:(A)hypermap`; `(n:A->A) (x:A)`] lemma_in_hypermap_orbits)\r
4614           THEN ASM_REWRITE_TAC[]\r
4615           THEN DISCH_THEN ((LABEL_TAC "F11") o CONJUNCT1)\r
4616           THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_card_eq_reflect)\r
4617           THEN MP_TAC (ISPECL[`edge_set (H:(A)hypermap)`; `edge (H:(A)hypermap) (x:A)`; `edge (H:(A)hypermap) ((n:A->A) (x:A))`] CARD_MINUS_DIFF_TWO_SET)\r
4618           THEN POP_ASSUM SUBST1_TAC\r
4619           THEN ASM_REWRITE_TAC[]\r
4620           THEN DISCH_THEN SUBST1_TAC\r
4621           THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o  MATCH_MP fixed_point_lemma)\r
4622           THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
4623           THEN DISCH_THEN SUBST1_TAC\r
4624           THEN ASSUME_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`;`x:A`] edge_map_walkup))\r
4625           THEN MP_TAC(SPECL[`edge_map (edge_walkup (H:(A)hypermap) (x:A))`; `x:A`] orbit_one_point)\r
4626           THEN POP_ASSUM(fun th -> REWRITE_TAC[th])\r
4627           THEN REWRITE_TAC[GSYM edge]\r
4628           THEN DISCH_THEN SUBST1_TAC\r
4629           THEN MP_TAC(SPECL[`e:A->A`; `x:A`] orbit_one_point)\r
4630           THEN USE_THEN "F3"(fun th -> REWRITE_TAC[th])\r
4631           THEN EXPAND_TAC "e"\r
4632           THEN REWRITE_TAC[GSYM edge]\r
4633           THEN DISCH_THEN SUBST1_TAC\r
4634           THEN SUBGOAL_THEN `~({x:A} IN edge_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC\r
4635           THENL[REWRITE_TAC[edge_set] THEN ASM_REWRITE_TAC[]\r
4636                   THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
4637                   THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM]\r
4638                   THEN REWRITE_TAC[IN_DELETE]\r
4639                   THEN REPEAT STRIP_TAC\r
4640                   THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))\r
4641                   THEN REWRITE_TAC[]\r
4642                   THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th)))\r
4643                   THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma)\r
4644                   THEN SIMP_TAC[]; ALL_TAC]\r
4645           THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE b) DELETE a`]\r
4646           THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT]\r
4647           THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
4648           THEN SUBGOAL_THEN `(n:A->A) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))` MP_TAC\r
4649           THENL[ASM_REWRITE_TAC[IN_DELETE]; ALL_TAC]\r
4650           THEN REWRITE_TAC[CONJUNCT1(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `(n:A->A) (x:A)`] lemma_in_hypermap_orbits)]\r
4651           THEN DISCH_TAC\r
4652           THEN MP_TAC(ISPECL[`edge_set (edge_walkup (H:(A)hypermap) (x:A))`; `edge (edge_walkup (H:(A)hypermap) (x:A)) ((n:A->A) (x:A))`] CARD_MINUS_ONE)\r
4653           THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS]\r
4654           THEN DISCH_THEN SUBST1_TAC\r
4655           THEN REWRITE_TAC[ARITH_RULE `((l:num) + 1) + 1 = l + 2`]\r
4656           THEN REWRITE_TAC[ARITH_RULE `(k:num)+ a = k + b <=> a = b`]\r
4657           THEN ASM_CASES_TAC `~({x:A} = edge (H:(A)hypermap) ((n:A->A) (x:A)))`\r
4658           THENL[POP_ASSUM (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS) THEN SIMP_TAC[]; ALL_TAC]\r
4659           THEN POP_ASSUM MP_TAC\r
4660           THEN REWRITE_TAC[TAUT `~ ~p = p`]\r
4661           THEN REWRITE_TAC[edge]\r
4662           THEN ASM_REWRITE_TAC[]\r
4663           THEN DISCH_THEN (ASSUME_TAC o SYM)\r
4664           THEN MP_TAC (SPECL[`e:A->A`; `(n:A->A) (x:A)`] orbit_reflect)\r
4665           THEN POP_ASSUM SUBST1_TAC\r
4666           THEN ASM_REWRITE_TAC[IN_SING]; ALL_TAC]\r
4667     THEN SUBGOAL_THEN `number_of_nodes (H:(A)hypermap) = number_of_nodes (edge_walkup H (x:A))` (LABEL_TAC "X2")\r
4668     THENL[REWRITE_TAC[number_of_nodes] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_nodes)\r
4669             THEN ASM_REWRITE_TAC[]\r
4670             THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant)\r
4671             THEN ASM_REWRITE_TAC[]\r
4672             THEN DISCH_THEN (fun th -> (LABEL_TAC "G11" (CONJUNCT1 th)))\r
4673             THEN MP_TAC (ISPECL[`node_set (H:(A)hypermap)`; `node (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE)\r
4674             THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS]\r
4675             THEN DISCH_THEN SUBST1_TAC\r
4676             THEN DISCH_THEN SUBST1_TAC\r
4677             THEN CONV_TAC SYM_CONV\r
4678             THEN SUBGOAL_THEN `(inverse (n:A->A)) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))` ASSUME_TAC\r
4679             THENL[ASM_REWRITE_TAC[IN_DELETE]\r
4680                  THEN USE_THEN "H3" (MP_TAC o SPEC `x:A` o MATCH_MP non_fixed_point_lemma)\r
4681                  THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th])\r
4682                  THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4683                  THEN USE_THEN "F1" MP_TAC\r
4684                  THEN EXPAND_TAC "D"\r
4685                  THEN DISCH_THEN (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps)\r
4686                  THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4687             THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `inverse (n:A->A) (x:A)`]lemma_in_hypermap_orbits)))\r
4688             THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4689             THEN DISCH_TAC\r
4690             THEN MP_TAC (ISPECL[`node_set (edge_walkup (H:(A)hypermap) (x:A))`; `node (edge_walkup (H:(A)hypermap) (x:A)) (inverse (n:A->A) (x:A))`] CARD_MINUS_ONE)\r
4691             THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC]\r
4692     THEN SUBGOAL_THEN `number_of_faces (H:(A)hypermap) = number_of_faces (edge_walkup H (x:A))` (LABEL_TAC "X4")\r
4693     THENL[REWRITE_TAC[number_of_faces] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_faces)\r
4694          THEN ASM_REWRITE_TAC[]\r
4695          THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant)\r
4696          THEN ASM_REWRITE_TAC[]\r
4697          THEN DISCH_THEN (fun th -> (LABEL_TAC "J11" (CONJUNCT2 th)))\r
4698          THEN MP_TAC (ISPECL[`face_set (H:(A)hypermap)`; `face (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE)\r
4699          THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS]\r
4700          THEN DISCH_THEN SUBST1_TAC\r
4701          THEN DISCH_THEN SUBST1_TAC\r
4702          THEN CONV_TAC SYM_CONV\r
4703          THEN SUBGOAL_THEN `(inverse (f:A->A)) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))` ASSUME_TAC\r
4704          THENL[ASM_REWRITE_TAC[IN_DELETE]\r
4705                  THEN USE_THEN "H4" (MP_TAC o SPEC `x:A` o MATCH_MP non_fixed_point_lemma)\r
4706                  THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
4707                  THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4708                  THEN USE_THEN "F1" MP_TAC\r
4709                  THEN EXPAND_TAC "D"\r
4710                  THEN DISCH_THEN (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps)\r
4711                  THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4712          THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `inverse (f:A->A) (x:A)`]lemma_in_hypermap_orbits)))\r
4713          THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4714          THEN DISCH_TAC\r
4715          THEN MP_TAC (ISPECL[`face_set (edge_walkup (H:(A)hypermap) (x:A))`; `face (edge_walkup (H:(A)hypermap) (x:A)) (inverse (f:A->A) (x:A))`] CARD_MINUS_ONE)\r
4716          THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC]\r
4717     THEN SUBGOAL_THEN `number_of_components (H:(A)hypermap) = number_of_components (edge_walkup H (x:A))` (LABEL_TAC "X5")\r
4718     THENL[REWRITE_TAC[number_of_components] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_components)\r
4719         THEN ASM_REWRITE_TAC[] THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o  MATCH_MP fixed_point_lemma)\r
4720         THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
4721         THEN DISCH_THEN SUBST1_TAC\r
4722         THEN ASM_CASES_TAC `(comb_component (edge_walkup (H:(A)hypermap) (x:A)) x) IN set_of_components (edge_walkup H x)`\r
4723         THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM lemma_in_components]\r
4724                 THEN ASM_REWRITE_TAC[IN_DELETE]; ALL_TAC]\r
4725         THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE b) DELETE a`]\r
4726         THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT]\r
4727         THEN DISCH_THEN SUBST1_TAC\r
4728         THEN USE_THEN "F1" MP_TAC\r
4729         THEN EXPAND_TAC "D"\r
4730         THEN REWRITE_TAC[lemma_in_components]\r
4731         THEN DISCH_TAC\r
4732         THEN MP_TAC (ISPECL[`set_of_components (H:(A)hypermap)`; `comb_component (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE)\r
4733         THEN POP_ASSUM (fun th -> REWRITE_TAC[th; FINITE_HYPERMAP_COMPONENTS])\r
4734         THEN DISCH_THEN SUBST1_TAC\r
4735         THEN ASM_CASES_TAC `(n:A->A) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))`\r
4736         THENL[POP_ASSUM MP_TAC\r
4737                 THEN REWRITE_TAC[lemma_in_components]\r
4738                 THEN DISCH_TAC \r
4739                 THEN MP_TAC (ISPECL[`set_of_components (edge_walkup (H:(A)hypermap) (x:A))`; `comb_component (edge_walkup (H:(A)hypermap) (x:A)) ((n:A->A) (x:A))`] CARD_MINUS_ONE)\r
4740                 THEN POP_ASSUM (fun th -> REWRITE_TAC[th; FINITE_HYPERMAP_COMPONENTS])\r
4741                 THEN DISCH_THEN SUBST1_TAC\r
4742                 THEN SIMP_TAC[]; ALL_TAC]\r
4743         THEN POP_ASSUM MP_TAC\r
4744         THEN ASM_REWRITE_TAC[IN_DELETE]\r
4745         THEN DISCH_TAC\r
4746         THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant)\r
4747         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4748     THEN SUBGOAL_THEN `CARD (dart (H:(A)hypermap)) = CARD(dart (edge_walkup H (x:A))) + 1` (LABEL_TAC "X6")\r
4749     THENL[MP_TAC(CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
4750         THEN DISCH_THEN SUBST1_TAC\r
4751         THEN MATCH_MP_TAC CARD_MINUS_ONE\r
4752         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
4753     THEN REWRITE_TAC[planar_ind]\r
4754     THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD]\r
4755     THEN REAL_ARITH_TAC);;\r
4756 \r
4757 let lemma_planar_index_on_walkup_at_degenerate_dart = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_degenerate H x ==> planar_ind H = planar_ind (edge_walkup H x)`,\r
4758      REPEAT GEN_TAC\r
4759      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
4760      THEN USE_THEN "F2" MP_TAC\r
4761      THEN REWRITE_TAC[degenerate_lemma]\r
4762      THEN STRIP_TAC\r
4763      THENL[MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_planar_index_on_walkup_at_isolated_dart)\r
4764           THEN ASM_REWRITE_TAC[]; MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_planar_index_on_walkup_at_edge_degenerate_dart)\r
4765           THEN ASM_REWRITE_TAC[]; USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (MATCH_MP (lemma_degenerate_walkup_first_eq) (CONJ th1 th2)))))) THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4766           THEN REWRITE_TAC[node_walkup] THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift]\r
4767           THEN REWRITE_TAC[lemma_shift_cycle]\r
4768           THEN SUBGOAL_THEN `is_edge_degenerate (shift (H:(A)hypermap)) (x:A)` ASSUME_TAC\r
4769           THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[is_edge_degenerate]\r
4770                   THEN REWRITE_TAC[GSYM shift_lemma; is_node_degenerate]\r
4771                   THEN SIMP_TAC[]; ALL_TAC]\r
4772           THEN MP_TAC (SPECL[`shift(H:(A)hypermap)`; `x:A`] lemma_planar_index_on_walkup_at_edge_degenerate_dart)\r
4773           THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV ) [GSYM shift_lemma]\r
4774           THEN ASM_REWRITE_TAC[]; USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (MATCH_MP (lemma_degenerate_walkup_second_eq) (CONJ th1 th2)))))) THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4775           THEN REWRITE_TAC[face_walkup]\r
4776           THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[lemma_planar_invariant_shift])\r
4777           THEN REWRITE_TAC[lemma_shift_cycle]\r
4778           THEN SUBGOAL_THEN `is_edge_degenerate (shift(shift (H:(A)hypermap))) (x:A)` ASSUME_TAC\r
4779           THENL[POP_ASSUM MP_TAC\r
4780               THEN REWRITE_TAC[is_edge_degenerate]\r
4781               THEN REWRITE_TAC[GSYM shift_lemma; is_face_degenerate]\r
4782               THEN SIMP_TAC[]; ALL_TAC]\r
4783           THEN MP_TAC (SPECL[`shift(shift(H:(A)hypermap))`; `x:A`] lemma_planar_index_on_walkup_at_edge_degenerate_dart)\r
4784           THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV ) [GSYM double_shift_lemma]\r
4785           THEN ASM_REWRITE_TAC[]]);;\r
4786 \r
4787 (* COMPUTE the numbers on edge-walkup at a non-degerate dart *)\r
4788 \r
4789 (* Trivial for darts *)\r
4790 \r
4791 let lemma_card_walkup_dart = prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> CARD(dart H) = CARD(dart(edge_walkup H x)) + 1`,\r
4792      REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
4793      THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE\r
4794      THEN ASM_REWRITE_TAC[hypermap_lemma]);;\r
4795 \r
4796 \r
4797 (* Compute number of edges acording to then splitting cas *)\r
4798 \r
4799 let lemma_splitting_case_count_edges = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_edge_split H x ==> number_of_edges H + 1 = number_of_edges (edge_walkup H x)`,\r
4800      REPEAT GEN_TAC\r
4801      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
4802      THEN REWRITE_TAC[number_of_edges]\r
4803      THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges)\r
4804      THEN ASM_REWRITE_TAC[]\r
4805      THEN USE_THEN "F2" MP_TAC\r
4806      THEN REWRITE_TAC[is_edge_split]\r
4807      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))\r
4808      THEN USE_THEN "F4" (MP_TAC o MATCH_MP lemma_edge_identity)\r
4809      THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4810      THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`]\r
4811      THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_in_hypermap_orbits))\r
4812      THEN ASM_REWRITE_TAC[]\r
4813      THEN DISCH_THEN ASSUME_TAC\r
4814      THEN MP_TAC (ISPECL[`edge_set (H:(A)hypermap)`; `edge (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE)\r
4815      THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS])\r
4816      THEN DISCH_THEN SUBST1_TAC\r
4817      THEN DISCH_THEN SUBST1_TAC\r
4818      THEN CONV_TAC SYM_CONV\r
4819      THEN REWRITE_TAC[ARITH_RULE `((k:num)+1)+1 = k + 2`]\r
4820      THEN MP_TAC (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup))))\r
4821      THEN USE_THEN "F3" (MP_TAC o MATCH_MP  lemma_inverse_maps_at_nondegenerate_dart)\r
4822      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))\r
4823      THEN ASM_REWRITE_TAC[]\r
4824      THEN DISCH_TAC\r
4825      THEN MP_TAC (SPECL[`edge_map(edge_walkup (H:(A)hypermap) (x:A))`; `1`; `inverse(edge_map (H:(A)hypermap)) (x:A)`; `inverse(face_map (H:(A)hypermap)) (x:A)`] in_orbit_lemma)\r
4826      THEN REWRITE_TAC[POWER_1]\r
4827      THEN POP_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV)  [SYM th])\r
4828      THEN REWRITE_TAC[lemma_edge_identity; GSYM edge]\r
4829      THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_edge_identity)\r
4830      THEN DISCH_THEN SUBST1_TAC\r
4831      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_edge_split (CONJ th1 th2)))))))\r
4832      THEN DISCH_THEN (MP_TAC o GSYM o MATCH_MP lemma_different_edges)\r
4833      THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS)\r
4834      THEN DISCH_THEN (fun th -> REWRITE_TAC[GSYM th])\r
4835      THEN MATCH_MP_TAC CARD_MINUS_DIFF_TWO_SET\r
4836      THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]\r
4837      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_edge_split (CONJ th1 th2)))))))\r
4838      THEN USE_THEN "F3" MP_TAC\r
4839      THEN REWRITE_TAC[dart_nondegenerate]\r
4840      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "G3")))\r
4841      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_node_map_walkup_in_dart (CONJ th1 th2)))))))\r
4842      THEN REWRITE_TAC[lemma_in_edge_set]\r
4843      THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
4844      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_face_map_walkup_in_dart (CONJ th1 th2)))))))\r
4845      THEN REWRITE_TAC[lemma_in_edge_set]\r
4846      THEN SIMP_TAC[]);;\r
4847 \r
4848 (* Compute number of edges acording to then splitting cas *)\r
4849 \r
4850 let lemma_merge_case_count_edges = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_edge_merge H x ==> number_of_edges H = number_of_edges (edge_walkup H x) + 1`,\r
4851      REPEAT GEN_TAC\r
4852      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
4853      THEN REWRITE_TAC[number_of_edges]\r
4854      THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges)\r
4855      THEN ASM_REWRITE_TAC[]\r
4856      THEN USE_THEN "F2" MP_TAC\r
4857      THEN REWRITE_TAC[is_edge_merge]\r
4858      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))\r
4859      THEN USE_THEN "F3" MP_TAC\r
4860      THEN REWRITE_TAC[dart_nondegenerate]\r
4861      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))\r
4862        THEN USE_THEN "F4" (ASSUME_TAC o GSYM o MATCH_MP lemma_different_edges)\r
4863        THEN MP_TAC(ISPECL[`edge_set (H:(A)hypermap)`; `edge (H:(A)hypermap) (x:A)`; `edge (H:(A)hypermap) (node_map H (x:A))`] CARD_MINUS_DIFF_TWO_SET)\r
4864        THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]\r
4865        THEN USE_THEN "F1" MP_TAC\r
4866        THEN REWRITE_TAC[lemma_in_edge_set]\r
4867        THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4868        THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
4869        THEN REWRITE_TAC[lemma_in_edge_set]\r
4870        THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4871        THEN POP_ASSUM (SUBST1_TAC o MATCH_MP CARD_TWO_ELEMENTS)\r
4872        THEN DISCH_THEN SUBST1_TAC\r
4873        THEN DISCH_THEN SUBST1_TAC\r
4874        THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (LABEL_TAC "F8" (SYM(MATCH_MP lemma_edge_merge (CONJ th1 th2)))))))\r
4875        THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`; `x:A`] lemma_inverse_in_orbit)\r
4876        THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [hypermap_lemma]\r
4877        THEN REWRITE_TAC[GSYM edge]\r
4878        THEN DISCH_TAC\r
4879        THEN MP_TAC (SET_RULE `(inverse (edge_map (H:(A)hypermap)) (x:A)) IN (edge H x) ==> (inverse (edge_map H) x)  IN ((edge H x)  UNION (edge H ((node_map H) x)))`)\r
4880        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
4881        THEN POP_ASSUM SUBST1_TAC\r
4882        THEN REWRITE_TAC[IN_UNION; IN_SING]\r
4883        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th])\r
4884        THEN REWRITE_TAC[lemma_edge_identity]\r
4885        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_edge_identity)\r
4886        THEN DISCH_THEN (SUBST1_TAC o SYM)      \r
4887        THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`]\r
4888        THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F6" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_node_map_walkup_in_dart (CONJ th1 th2)))))))\r
4889        THEN REWRITE_TAC[lemma_in_edge_set]\r
4890        THEN DISCH_TAC\r
4891        THEN REWRITE_TAC[ARITH_RULE `(m:num) + 2 = (n:num) + 1 <=> m + 1 = n`]\r
4892        THEN CONV_TAC SYM_CONV\r
4893        THEN MATCH_MP_TAC CARD_MINUS_ONE\r
4894        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
4895        THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]);;\r
4896 \r
4897 (* NODES and FACES IN all cases are invariant*)\r
4898 \r
4899 let lemma_walkup_count_nodes = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_nondegenerate H x \r
4900     ==> number_of_nodes H = number_of_nodes (edge_walkup H x)`, \r
4901      REPEAT GEN_TAC\r
4902      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC))\r
4903      THEN REWRITE_TAC[dart_nondegenerate]\r
4904      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))\r
4905      THEN REWRITE_TAC[number_of_nodes]\r
4906      THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_nodes)\r
4907      THEN ASM_REWRITE_TAC[]\r
4908      THEN USE_THEN "F1" MP_TAC\r
4909      THEN REWRITE_TAC[lemma_in_node_set]\r
4910      THEN DISCH_TAC\r
4911      THEN MP_TAC (ISPECL[`node_set (H:(A)hypermap)`; `node (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE)\r
4912      THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS])\r
4913      THEN REPLICATE_TAC 2 (DISCH_THEN SUBST1_TAC)\r
4914      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F3" (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_node_map_walkup_in_dart (CONJ th1 th2)))))))\r
4915      THEN REWRITE_TAC[lemma_in_node_set]\r
4916      THEN DISCH_TAC\r
4917      THEN MP_TAC (ISPECL[`node_set (edge_walkup (H:(A)hypermap) (x:A))`; `node (edge_walkup (H:(A)hypermap) (x:A)) ((inverse (node_map H) (x:A)))`] CARD_MINUS_ONE)\r
4918      THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS])\r
4919      THEN DISCH_THEN SUBST1_TAC\r
4920      THEN SIMP_TAC[]);;\r
4921 \r
4922 let lemma_walkup_count_faces = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_nondegenerate H x \r
4923     ==> number_of_faces H = number_of_faces (edge_walkup H x)`,\r
4924        REPEAT GEN_TAC\r
4925        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC))\r
4926        THEN REWRITE_TAC[dart_nondegenerate]\r
4927        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))\r
4928        THEN REWRITE_TAC[number_of_faces]\r
4929        THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_faces)\r
4930        THEN ASM_REWRITE_TAC[]\r
4931        THEN USE_THEN "F1" MP_TAC\r
4932        THEN REWRITE_TAC[lemma_in_face_set]\r
4933        THEN DISCH_TAC\r
4934        THEN MP_TAC (ISPECL[`face_set (H:(A)hypermap)`; `face (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE)\r
4935        THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS])\r
4936        THEN REPLICATE_TAC 2 (DISCH_THEN SUBST1_TAC)\r
4937        THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F4" (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_face_map_walkup_in_dart (CONJ th1 th2)))))))\r
4938        THEN REWRITE_TAC[lemma_in_face_set]\r
4939        THEN DISCH_TAC\r
4940        THEN MP_TAC (ISPECL[`face_set (edge_walkup (H:(A)hypermap) (x:A))`; `face (edge_walkup (H:(A)hypermap) (x:A)) ((inverse (face_map H) (x:A)))`] CARD_MINUS_ONE)\r
4941        THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS])\r
4942        THEN DISCH_THEN SUBST1_TAC\r
4943        THEN SIMP_TAC[]);;\r
4944 \r
4945 (* For components, we have two cases: component splitting and not splitting *)\r
4946 \r
4947 \r
4948 let lemma_walkup_count_splitting_components = prove(`!(H:(A)hypermap) (x:A).x IN dart H /\ dart_nondegenerate H x /\ ~(comb_component (edge_walkup H x) (node_map H x) = comb_component (edge_walkup H x) (inverse (edge_map H) x)) ==> (number_of_components H) + 1 = number_of_components (edge_walkup H x)`,\r
4949 REPEAT GEN_TAC\r
4950   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
4951   THEN REWRITE_TAC[number_of_components]\r
4952   THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_components)\r
4953   THEN USE_THEN "F1" MP_TAC\r
4954   THEN REWRITE_TAC[lemma_in_components]\r
4955   THEN DISCH_TAC\r
4956   THEN POP_ASSUM (fun th -> (MP_TAC (MATCH_MP CARD_MINUS_ONE (CONJ (SPEC `H:(A)hypermap` FINITE_HYPERMAP_COMPONENTS) th))))\r
4957   THEN DISCH_THEN SUBST1_TAC\r
4958   THEN DISCH_THEN SUBST1_TAC\r
4959   THEN REWRITE_TAC[ARITH_RULE `((m:num) + 1) + 1 = m + 2`]\r
4960   THEN POP_ASSUM (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS)\r
4961   THEN DISCH_THEN (SUBST1_TAC o SYM)\r
4962   THEN CONV_TAC SYM_CONV\r
4963   THEN MATCH_MP_TAC CARD_MINUS_DIFF_TWO_SET\r
4964   THEN REWRITE_TAC[FINITE_HYPERMAP_COMPONENTS]\r
4965   THEN POP_ASSUM MP_TAC\r
4966   THEN REWRITE_TAC[dart_nondegenerate]\r
4967   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G2") (LABEL_TAC "G3" o CONJUNCT1))\r
4968   THEN USE_THEN "F1" (fun th-> (USE_THEN "G3" (fun th1 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_node_map_walkup_in_dart (CONJ th th1)))))))\r
4969   THEN REWRITE_TAC[lemma_in_components]\r
4970   THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
4971   THEN USE_THEN "F1" (fun th-> (USE_THEN "G2" (fun th1 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_edge_map_walkup_in_dart (CONJ th th1)))))))\r
4972   THEN REWRITE_TAC[lemma_in_components]);;\r
4973 \r
4974 \r
4975 let lemma_walkup_count_not_splitting_components = prove(`!(H:(A)hypermap) (x:A).x IN dart H /\ dart_nondegenerate H x /\ comb_component (edge_walkup H x) (node_map H x) = comb_component (edge_walkup H x) (inverse (edge_map H) x) ==> (number_of_components H) = number_of_components (edge_walkup H x)`,\r
4976     REPEAT GEN_TAC\r
4977     THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
4978     THEN REWRITE_TAC[number_of_components]\r
4979     THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_components)\r
4980     THEN USE_THEN "F1" MP_TAC\r
4981     THEN REWRITE_TAC[lemma_in_components]\r
4982     THEN DISCH_TAC\r
4983     THEN POP_ASSUM (fun th -> (MP_TAC (MATCH_MP CARD_MINUS_ONE (CONJ (SPEC `H:(A)hypermap` FINITE_HYPERMAP_COMPONENTS) th))))\r
4984     THEN DISCH_THEN SUBST1_TAC\r
4985     THEN DISCH_THEN SUBST1_TAC\r
4986     THEN POP_ASSUM (SUBST1_TAC o SYM)\r
4987     THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`]\r
4988     THEN CONV_TAC  SYM_CONV\r
4989     THEN MATCH_MP_TAC CARD_MINUS_ONE\r
4990     THEN REWRITE_TAC[FINITE_HYPERMAP_COMPONENTS]\r
4991     THEN POP_ASSUM MP_TAC\r
4992     THEN REWRITE_TAC[dart_nondegenerate]\r
4993     THEN DISCH_THEN (LABEL_TAC "G2" o CONJUNCT1 o CONJUNCT2)\r
4994     THEN USE_THEN "F1" (fun th-> (USE_THEN "G2" (fun th1 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_node_map_walkup_in_dart (CONJ th th1)))))))\r
4995     THEN REWRITE_TAC[lemma_in_components]);;\r
4996 \r
4997 let is_splitting_component = new_definition `is_splitting_component (H:(A)hypermap) (x:A) <=> ~(comb_component (edge_walkup H x) (node_map H x) = comb_component (edge_walkup H x) (inverse (edge_map H) x))`;;\r
4998 \r
4999 let lemma_planar_index_on_nondegenerate = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_nondegenerate H x ==>\r
5000 (is_edge_split H x /\ ~(is_splitting_component H x) ==> (planar_ind H) + &2 = planar_ind (edge_walkup H x)) /\\r
5001 (~(is_edge_split H x /\ ~(is_splitting_component H x)) ==> (planar_ind H) = planar_ind (edge_walkup H x))`,\r
5002      REPEAT GEN_TAC THEN REWRITE_TAC[is_splitting_component]\r
5003      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
5004      THEN STRIP_TAC\r
5005      THENL[DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))\r
5006              THEN REWRITE_TAC[planar_ind]\r
5007              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_nodes (CONJ th1 th2)))))))\r
5008              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_faces (CONJ th1 th2)))))))\r
5009              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "G1" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_splitting_case_count_edges (CONJ th1 th2)))))))\r
5010              THEN USE_THEN "F1" (fun th1 -> (SUBST1_TAC (MATCH_MP lemma_card_walkup_dart th1)))\r
5011              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (USE_THEN "G2" (fun th3 -> SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_not_splitting_components (CONJ th1 (CONJ th2 th3)))))))))\r
5012              THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD]\r
5013              THEN REAL_ARITH_TAC; ALL_TAC]\r
5014      THEN REWRITE_TAC[DE_MORGAN_THM]\r
5015      THEN ASM_CASES_TAC `~(is_edge_split (H:(A)hypermap) (x:A))`\r
5016      THENL[ ASM_REWRITE_TAC[] \r
5017             THEN POP_ASSUM MP_TAC\r
5018              THEN REWRITE_TAC[is_edge_split]\r
5019              THEN ASM_REWRITE_TAC[]\r
5020              THEN DISCH_THEN (LABEL_TAC "F3")\r
5021              THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] is_edge_merge)\r
5022              THEN ASM_REWRITE_TAC[]\r
5023              THEN DISCH_THEN (LABEL_TAC "F4")\r
5024              THEN SUBGOAL_THEN `comb_component (edge_walkup (H:(A)hypermap) (x:A)) (node_map H x) = comb_component (edge_walkup H x) (inverse (edge_map H) x)` (LABEL_TAC "J1")\r
5025              THENL[USE_THEN "F1" (fun th1 -> (USE_THEN "F4" (fun th2 -> (LABEL_TAC "F8" (SYM(MATCH_MP lemma_edge_merge (CONJ th1 th2)))))))\r
5026                      THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`; `x:A`] lemma_inverse_in_orbit)\r
5027                      THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [hypermap_lemma]\r
5028                      THEN REWRITE_TAC[GSYM edge]\r
5029                      THEN DISCH_TAC\r
5030                      THEN MP_TAC (SET_RULE `(inverse (edge_map (H:(A)hypermap)) (x:A)) IN (edge H x) ==> (inverse (edge_map H) x)  IN ((edge H x)  UNION (edge H ((node_map H) x)))`)\r
5031                      THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
5032                      THEN POP_ASSUM SUBST1_TAC\r
5033                      THEN REWRITE_TAC[IN_UNION; IN_SING]\r
5034                      THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP  lemma_inverse_maps_at_nondegenerate_dart th])\r
5035                      THEN REWRITE_TAC[lemma_in_edge]\r
5036                      THEN DISCH_THEN (X_CHOOSE_THEN `j:num` ASSUME_TAC)\r
5037                      THEN MP_TAC (CONJUNCT1(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `node_map (H:(A)hypermap) (x:A)`; `j:num`] lemma_powers_in_component))\r
5038                      THEN POP_ASSUM (SUBST1_TAC o SYM)\r
5039                      THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_identity)\r
5040                      THEN SIMP_TAC[]; ALL_TAC]\r
5041              THEN REWRITE_TAC[planar_ind]\r
5042              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_nodes (CONJ th1 th2)))))))\r
5043              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_faces (CONJ th1 th2)))))))\r
5044              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F4" (fun th2 -> (SUBST1_TAC (MATCH_MP lemma_merge_case_count_edges (CONJ th1 th2))))))\r
5045              THEN USE_THEN "F1" (fun th1 -> (SUBST1_TAC (MATCH_MP lemma_card_walkup_dart th1)))\r
5046              THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (USE_THEN "J1" (fun th3 -> SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_not_splitting_components (CONJ th1 (CONJ th2 th3)))))))))\r
5047              THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD]\r
5048              THEN REAL_ARITH_TAC; ALL_TAC]\r
5049      THEN POP_ASSUM MP_TAC\r
5050      THEN REWRITE_TAC[TAUT `~ ~P = P`]\r
5051      THEN DISCH_THEN (LABEL_TAC "K1")\r
5052      THEN ASM_REWRITE_TAC[]\r
5053      THEN DISCH_THEN (LABEL_TAC "K2")\r
5054      THEN REWRITE_TAC[planar_ind]\r
5055      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_nodes (CONJ th1 th2)))))))\r
5056      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_faces (CONJ th1 th2)))))))\r
5057      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "K1" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_splitting_case_count_edges (CONJ th1 th2)))))))\r
5058      THEN USE_THEN "F1" (fun th1 -> (SUBST1_TAC (MATCH_MP lemma_card_walkup_dart th1)))\r
5059      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (USE_THEN "K2" (fun th3 -> SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_splitting_components (CONJ th1 (CONJ th2 th3)))))))))\r
5060      THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD]\r
5061      THEN REAL_ARITH_TAC);;\r
5062 \r
5063 (* LEMMA IUCLZYI *)\r
5064 \r
5065 let lemmaIUCLZYI = prove(`!(H:(A)hypermap) x:A. (x IN dart H /\ dart_nondegenerate H x ==> \r
5066 (is_edge_split H x ==> number_of_edges H + 1 = number_of_edges (edge_walkup H x)) /\ (is_edge_merge H x ==> number_of_edges H = number_of_edges (edge_walkup H x) + 1) /\ (number_of_nodes H = number_of_nodes (edge_walkup H x)) /\ (number_of_faces H = number_of_faces (edge_walkup H x))\r
5067 /\ (is_splitting_component H x ==> (number_of_components H) + 1 = number_of_components (edge_walkup H x))/\ (~(is_splitting_component H x) ==> (number_of_components H)  = number_of_components (edge_walkup H x)) /\(is_edge_split H x /\ ~(is_splitting_component H x) ==> (planar_ind H) + &2 = planar_ind (edge_walkup H x)) /\ (~(is_edge_split H x /\ ~(is_splitting_component H x)) ==> (planar_ind H) = planar_ind (edge_walkup H x))) /\ (x IN dart H /\ dart_degenerate H x ==> planar_ind H = planar_ind (edge_walkup H x))`,\r
5068    SIMP_TAC[lemma_planar_index_on_walkup_at_degenerate_dart]\r
5069    THEN SIMP_TAC[lemma_planar_index_on_nondegenerate]\r
5070    THEN SIMP_TAC[lemma_walkup_count_nodes; lemma_walkup_count_faces]\r
5071    THEN SIMP_TAC[lemma_merge_case_count_edges; lemma_splitting_case_count_edges]\r
5072    THEN REWRITE_TAC[is_splitting_component]\r
5073    THEN MESON_TAC[lemma_walkup_count_not_splitting_components; lemma_walkup_count_splitting_components]);;\r
5074 \r
5075 let lemma_desc_planar_index = prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> planar_ind H <= planar_ind (edge_walkup H x)`,\r
5076   REPEAT GEN_TAC\r
5077     THEN DISCH_THEN (LABEL_TAC "F1")\r
5078     THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] lemma_category_darts)\r
5079     THEN STRIP_TAC\r
5080     THENL[POP_ASSUM (LABEL_TAC "F2")\r
5081        THEN ASM_CASES_TAC `is_edge_split (H:(A)hypermap) (x:A) /\ ~is_splitting_component H x`\r
5082        THENL[USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_planar_index_on_nondegenerate (CONJ th1 th2)))))))\r
5083            THEN ASM_REWRITE_TAC[]\r
5084            THEN REAL_ARITH_TAC; ALL_TAC]\r
5085        THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_planar_index_on_nondegenerate (CONJ th1 th2)))))))\r
5086        THEN ASM_REWRITE_TAC[]\r
5087        THEN REAL_ARITH_TAC; ALL_TAC]\r
5088     THEN POP_ASSUM (fun th1 -> (USE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP lemma_planar_index_on_walkup_at_degenerate_dart (CONJ th2 th1))))))\r
5089     THEN REAL_ARITH_TAC);;\r
5090 \r
5091 let lemmaBISHKQW = prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> planar_ind H <= planar_ind (edge_walkup H x) /\ planar_ind H <= planar_ind (node_walkup H x) /\ planar_ind H <= planar_ind (face_walkup H x)`,\r
5092      REPEAT GEN_TAC\r
5093      THEN DISCH_THEN (LABEL_TAC "F1")\r
5094      THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_desc_planar_index th])\r
5095      THEN STRIP_TAC\r
5096      THENL[REWRITE_TAC[node_walkup]\r
5097              THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift]\r
5098              THEN REWRITE_TAC[lemma_shift_cycle]\r
5099              THEN POP_ASSUM MP_TAC\r
5100              THEN ONCE_REWRITE_TAC[shift_lemma]\r
5101              THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_desc_planar_index th]); ALL_TAC]\r
5102      THEN REWRITE_TAC[face_walkup]\r
5103      THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift]\r
5104      THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift]\r
5105      THEN REWRITE_TAC[lemma_shift_cycle]\r
5106      THEN POP_ASSUM MP_TAC\r
5107      THEN ONCE_REWRITE_TAC[double_shift_lemma]\r
5108      THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_desc_planar_index th]));;\r
5109 \r
5110 \r
5111 let lemmaFOAGLPA = prove(`!(H:(A)hypermap). planar_ind H <= &0`,\r
5112    GEN_TAC\r
5113    THEN ABBREV_TAC `n = CARD(dart (H:(A)hypermap))`\r
5114    THEN POP_ASSUM (MP_TAC)\r
5115    THEN SPEC_TAC(`H:(A)hypermap`, `H:(A)hypermap`)\r
5116    THEN SPEC_TAC(`n:num`, `n:num`)\r
5117    THEN INDUCT_TAC \r
5118    THENL[REPEAT STRIP_TAC\r
5119         THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_null_hypermap_planar_index)\r
5120         THEN REAL_ARITH_TAC; ALL_TAC]\r
5121    THEN REPEAT STRIP_TAC\r
5122    THEN POP_ASSUM (LABEL_TAC "F2")\r
5123    THEN ASM_CASES_TAC `dart (H:(A)hypermap) = {}`\r
5124    THENL[POP_ASSUM (MP_TAC o MATCH_MP lemma_card_eq_reflect)\r
5125            THEN POP_ASSUM SUBST1_TAC\r
5126            THEN REWRITE_TAC[CARD_CLAUSES]\r
5127            THEN ARITH_TAC; ALL_TAC]\r
5128    THEN POP_ASSUM (MP_TAC o MATCH_MP CHOICE_DEF)\r
5129    THEN ABBREV_TAC `(x:A) = CHOICE (dart (H:(A)hypermap))`\r
5130    THEN DISCH_THEN (LABEL_TAC "F1")\r
5131    THEN USE_THEN "F1" (ASSUME_TAC o MATCH_MP lemma_desc_planar_index)\r
5132    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_card_walkup_dart)\r
5133    THEN REMOVE_THEN "F2" SUBST1_TAC\r
5134    THEN REWRITE_TAC[GSYM ADD1; EQ_SUC]\r
5135    THEN DISCH_THEN (LABEL_TAC "F3" o SYM)\r
5136    THEN FIRST_ASSUM (MP_TAC o SPEC `edge_walkup (H:(A)hypermap) (x:A)`)\r
5137    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
5138    THEN POP_ASSUM MP_TAC\r
5139    THEN REAL_ARITH_TAC);;\r
5140 \r
5141 let lemmaSGCOSXK = prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ planar_hypermap H ==> planar_hypermap (edge_walkup H x) /\ planar_hypermap (node_walkup H x) /\ planar_hypermap (face_walkup H x)`,\r
5142    REPEAT GEN_TAC\r
5143      THEN REWRITE_TAC[lemma_planar_hypermap]\r
5144      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
5145      THEN STRIP_TAC\r
5146      THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemmaBISHKQW)\r
5147              THEN POP_ASSUM SUBST1_TAC\r
5148              THEN MP_TAC (SPEC `edge_walkup (H:(A)hypermap) (x:A)` lemmaFOAGLPA)\r
5149              THEN REAL_ARITH_TAC; ALL_TAC]\r
5150      THEN STRIP_TAC\r
5151      THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemmaBISHKQW)\r
5152              THEN POP_ASSUM SUBST1_TAC\r
5153              THEN MP_TAC (SPEC `node_walkup (H:(A)hypermap) (x:A)` lemmaFOAGLPA)\r
5154              THEN REAL_ARITH_TAC; ALL_TAC]\r
5155      THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemmaBISHKQW)\r
5156      THEN POP_ASSUM SUBST1_TAC\r
5157      THEN MP_TAC (SPEC `face_walkup (H:(A)hypermap) (x:A)` lemmaFOAGLPA)\r
5158      THEN REAL_ARITH_TAC);;\r
5159 \r
5160 (* double walkups *)\r
5161 \r
5162 \r
5163 let convolution_rep = prove(`!s:A->bool p:A->A. p permutes s ==> (p o p = I <=> p = inverse p)`,\r
5164     REPEAT STRIP_TAC\r
5165     THEN EQ_TAC\r
5166     THENL[POP_ASSUM (fun th-> (DISCH_THEN (fun th1->(MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ th th1))))))\r
5167         THEN REWRITE_TAC[I_O_ID]; ALL_TAC]\r
5168     THEN DISCH_THEN (MP_TAC o SPEC `p:A->A` o  MATCH_MP RIGHT_MULT_MAP)\r
5169     THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th]));;\r
5170 \r
5171 let convolution_inv = prove(`!s:A->bool p:A->A. p permutes s ==> (p o p = I <=> inverse p o inverse p = I)`,\r
5172   REPEAT GEN_TAC\r
5173     THEN DISCH_THEN (LABEL_TAC "F1")\r
5174     THEN EQ_TAC\r
5175     THENL[DISCH_THEN (fun th -> LABEL_TAC "F2" th THEN MP_TAC th)\r
5176        THEN USE_THEN "F1" (fun th->(DISCH_THEN (fun th1->(MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ th th1))))))\r
5177        THEN REWRITE_TAC[I_O_ID]\r
5178        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
5179        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5180     THEN DISCH_THEN (MP_TAC o SPEC `p:A->A` o  MATCH_MP RIGHT_MULT_MAP)\r
5181     THEN REWRITE_TAC[GSYM o_ASSOC]\r
5182     THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID])\r
5183     THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
5184     THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID]));;\r
5185 \r
5186 let convolution_belong = prove(`!s:A->bool p:A->A. p permutes s ==> (p o p = I <=> (!x:A. x IN s ==> p (p x) = x))`,\r
5187     REPEAT STRIP_TAC\r
5188     THEN EQ_TAC\r
5189     THENL[REPEAT STRIP_TAC\r
5190         THEN FIRST_X_ASSUM (fun th -> (MP_TAC(AP_THM th `x:A`)))\r
5191         THEN REWRITE_TAC[o_THM; I_THM]; ALL_TAC]\r
5192     THEN STRIP_TAC\r
5193     THEN REWRITE_TAC[FUN_EQ_THM]\r
5194     THEN GEN_TAC\r
5195     THEN REWRITE_TAC[o_THM; I_THM]\r
5196     THEN ASM_CASES_TAC `~(x:A IN s:A->bool)`\r
5197     THENL[POP_ASSUM MP_TAC\r
5198         THEN UNDISCH_TAC `p:A->A permutes s:A->bool`\r
5199         THEN REWRITE_TAC[permutes]\r
5200         THEN DISCH_THEN (MP_TAC o CONJUNCT1)\r
5201         THEN MESON_TAC[]; ALL_TAC]\r
5202     THEN ASM_MESON_TAC[]);;\r
5203 \r
5204 let edge_convolution = prove(`!(H:(A)hypermap). plain_hypermap H <=> !x:A. x IN dart H ==> node_map H (face_map H (node_map H (face_map H x))) = x`,\r
5205     REPEAT GEN_TAC\r
5206     THEN REWRITE_TAC[plain_hypermap]\r
5207     THEN REWRITE_TAC[MATCH_MP convolution_inv (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts))]\r
5208     THEN ASSUME_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` edge_map_and_darts)))\r
5209     THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP convolution_belong th])\r
5210     THEN ONCE_REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)]\r
5211     THEN REWRITE_TAC[inverse_hypermap_maps; o_THM]);;\r
5212 \r
5213 let edge_map_convolution = prove(`!(H:(A)hypermap). plain_hypermap H <=> edge_map H = node_map H o face_map H`,\r
5214     REPEAT GEN_TAC\r
5215     THEN REWRITE_TAC[plain_hypermap]\r
5216     THEN REWRITE_TAC[MATCH_MP convolution_rep (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts))]\r
5217     THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)]\r
5218     THEN SIMP_TAC[]);;\r
5219 \r
5220 let lemma_convolution_evaluation = prove(`!s:A->bool p:A->A x:A. FINITE s /\ p permutes s ==> ((p (p x)) = x <=> CARD (orbit_map p x) <= 2)`,\r
5221    REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC\r
5222    THENL[STRIP_TAC THEN MP_TAC (SPECL[`p:A->A`; `2`; `x:A`] card_orbit_le)\r
5223         THEN REWRITE_TAC[POWER_2; o_THM;  ARITH_RULE `~(2 = 0)`]\r
5224         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5225    THEN ASM_CASES_TAC `(p:A->A) (x:A) = x` THENL[REWRITE_TAC[POWER_2; o_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5226    THEN ASM_CASES_TAC `(p:A->A) (p (x:A)) = x` THENL[ASM_REWRITE_TAC[]; ALL_TAC]\r
5227    THEN DISCH_TAC\r
5228    THEN FIRST_ASSUM (MP_TAC o SPEC `x:A` o MATCH_MP lemma_cycle_orbit)\r
5229    THEN ASM_REWRITE_TAC[]\r
5230    THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect)\r
5231    THEN FIRST_ASSUM (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite)\r
5232    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP CARD_ATLEAST_1)\r
5233    THEN ABBREV_TAC `n = CARD(orbit_map (p:A->A) (x:A))` THEN MP_TAC (SPEC `n:num` SEGMENT_TO_TWO)\r
5234    THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) (`n:num <= 2`)\r
5235    THEN FIND_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[LT1_NZ; LT_NZ] th]) (`1 <= n:num`)\r
5236    THEN STRIP_TAC THENL[POP_ASSUM (fun th-> ASM_REWRITE_TAC[th; POWER_1]); ALL_TAC]\r
5237    THEN POP_ASSUM (fun th-> ASM_REWRITE_TAC[th; POWER_2; o_THM]));;\r
5238 \r
5239 \r
5240 let lemma_convolution_map = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> (p o p = I <=> !x:A. x IN s ==> CARD (orbit_map p x) <= 2)`,\r
5241    REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC\r
5242    THENL[DISCH_THEN (LABEL_TAC "F1") THEN REPEAT STRIP_TAC\r
5243       THEN REMOVE_THEN "F1" (fun th -> (MP_TAC (AP_THM th `x:A`)))\r
5244       THEN REWRITE_TAC[GSYM POWER_2; I_THM]\r
5245       THEN MP_TAC (SPECL[`p:A->A`; `2`; `x:A`] card_orbit_le)\r
5246       THEN REWRITE_TAC[ARITH_RULE `~(2 = 0)`]; ALL_TAC]\r
5247    THEN STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]\r
5248    THEN GEN_TAC THEN ASM_CASES_TAC `x:A IN (s:A->bool)`\r
5249    THENL[FIRST_ASSUM (MP_TAC o SPEC `x:A` o  check (is_forall o concl)) \r
5250       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
5251       THEN ASM_REWRITE_TAC[]\r
5252       THEN FIRST_ASSUM (MP_TAC o MATCH_MP  lemma_convolution_evaluation)\r
5253       THEN MESON_TAC[]; ALL_TAC]\r
5254    THEN FIND_ASSUM (MP_TAC o CONJUNCT2) `FINITE (s:A->bool) /\ (p:A->A) permutes s`\r
5255    THEN REWRITE_TAC[permutes]\r
5256    THEN DISCH_THEN (MP_TAC o SPEC `x:A` o CONJUNCT1)\r
5257    THEN ASM_REWRITE_TAC[]\r
5258    THEN DISCH_THEN ASSUME_TAC\r
5259    THEN ASM_REWRITE_TAC[]);;\r
5260 \r
5261 let lemma_orbit_of_size_2 = prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> (CARD (orbit_map p x) = 2 <=> ~(p x = x) /\ (p (p x) = x))`,\r
5262      REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC\r
5263      THENL[DISCH_THEN (LABEL_TAC "F2")\r
5264              THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_convolution_evaluation)\r
5265              THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num = 2 ==> m <= 2`) th])\r
5266              THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5267              THEN ONCE_REWRITE_TAC[orbit_one_point]\r
5268              THEN POP_ASSUM MP_TAC\r
5269              THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
5270              THEN REWRITE_TAC[]\r
5271              THEN DISCH_THEN SUBST1_TAC\r
5272              THEN REWRITE_TAC[CARD_SINGLETON]\r
5273              THEN ARITH_TAC; ALL_TAC]\r
5274      THEN STRIP_TAC\r
5275      THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_convolution_evaluation)\r
5276      THEN ASM_REWRITE_TAC[]\r
5277      THEN ASSUME_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect)\r
5278      THEN MP_TAC (SPECL[`p:A->A`; `1`; `x:A`] lemma_in_orbit)\r
5279      THEN REWRITE_TAC[POWER_1]\r
5280      THEN USE_THEN "F1" (ASSUME_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite)\r
5281      THEN REPEAT STRIP_TAC\r
5282      THEN MP_TAC (SPECL[`orbit_map (p:A->A) (x:A)`; `x:A`; `(p:A->A) (x:A)`] CARD_ATLEAST_2)\r
5283      THEN ASM_REWRITE_TAC[]\r
5284      THEN POP_ASSUM MP_TAC\r
5285      THEN ARITH_TAC);;\r
5286 \r
5287 let EDGE_OF_SIZE_2 = prove(`!(H:(A)hypermap) x:A. (CARD(edge H x) = 2 <=> ~(edge_map H x = x) /\ (edge_map H (edge_map H x) = x))`,\r
5288      REPEAT STRIP_TAC THEN REWRITE_TAC[edge] THEN MATCH_MP_TAC lemma_orbit_of_size_2\r
5289      THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]);;\r
5290 \r
5291 let NODE_OF_SIZE_2 = prove(`!(H:(A)hypermap) x:A. (CARD(node H x) = 2 <=> ~(node_map H x = x) /\ (node_map H (node_map H x) = x))`,\r
5292      REPEAT STRIP_TAC THEN REWRITE_TAC[node] THEN MATCH_MP_TAC lemma_orbit_of_size_2\r
5293      THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]);;\r
5294 \r
5295 let FACE_OF_SIZE_2 = prove(`!(H:(A)hypermap) x:A. (CARD(face H x) = 2 <=> ~(face_map H x = x) /\ (face_map H (face_map H x) = x))`,\r
5296      REPEAT STRIP_TAC THEN REWRITE_TAC[face] THEN MATCH_MP_TAC lemma_orbit_of_size_2\r
5297      THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]);;\r
5298 \r
5299 let lemma_sub_unions_diff = prove(`!s:(A->bool)->bool t:(A->bool)->bool. t SUBSET s ==> UNIONS s = (UNIONS (s DIFF t)) UNION  (UNIONS t)`,\r
5300     REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS; UNION; DIFF]\r
5301     THEN REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN GEN_TAC\r
5302     THEN EQ_TAC THENL[STRIP_TAC \r
5303        THEN ASM_CASES_TAC `(u:A->bool) IN (t:(A->bool)->bool)`\r
5304        THENL[DISJ2_TAC THEN EXISTS_TAC `u:A->bool`\r
5305              THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5306        THEN DISJ1_TAC\r
5307        THEN EXISTS_TAC `u:A->bool`\r
5308        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5309     THEN STRIP_TAC \r
5310     THENL[EXISTS_TAC `u:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5311     THEN UNDISCH_TAC `t:(A->bool)->bool SUBSET s:(A->bool)->bool`\r
5312     THEN REWRITE_TAC[SUBSET]\r
5313     THEN DISCH_THEN (MP_TAC o SPEC `u:A->bool`)\r
5314     THEN ASM_REWRITE_TAC[]\r
5315     THEN DISCH_TAC\r
5316     THEN EXISTS_TAC `u:A->bool`\r
5317     THEN ASM_REWRITE_TAC[]);;\r
5318 \r
5319 let lemma_card_unions_diff = prove(`!s:(A->bool)->bool t:(A->bool)->bool. t SUBSET s /\ FINITE (UNIONS s) /\ (!a:A->bool b:A->bool. a IN s /\ b IN s ==> a = b \/ a INTER b = {}) ==> CARD (UNIONS s) = CARD (UNIONS (s DIFF t)) + CARD (UNIONS t)`,\r
5320      REPEAT GEN_TAC\r
5321      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
5322      THEN USE_THEN "F1" (LABEL_TAC "F4" o MATCH_MP lemma_sub_unions_diff)\r
5323      THEN USE_THEN "F4" (fun th2-> (MP_TAC(MATCH_MP (SET_RULE `u = v UNION w ==> v SUBSET u /\ w SUBSET u`) th2 )))\r
5324      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))\r
5325      THEN USE_THEN "F2" (fun th1 -> (USE_THEN "F5" (fun th2 -> (MP_TAC (MATCH_MP FINITE_SUBSET (CONJ th1 th2))))))\r
5326      THEN DISCH_THEN (LABEL_TAC "F7")\r
5327      THEN USE_THEN "F2" (fun th1 -> (USE_THEN "F6" (fun th2 -> (MP_TAC (MATCH_MP FINITE_SUBSET (CONJ th1 th2))))))\r
5328      THEN DISCH_THEN (LABEL_TAC "F8")\r
5329      THEN ASM_CASES_TAC `~(((UNIONS ((s:(A->bool)->bool) DIFF (t:(A->bool)->bool))) INTER (UNIONS t)) = {})`\r
5330      THENL[POP_ASSUM MP_TAC\r
5331              THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]\r
5332              THEN DISCH_THEN (X_CHOOSE_THEN `el:A` MP_TAC)\r
5333              THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [UNIONS; DIFF; IN_INTER]\r
5334              THEN REWRITE_TAC[IN_ELIM_THM]\r
5335              THEN STRIP_TAC\r
5336              THEN USE_THEN "F1" MP_TAC\r
5337              THEN REWRITE_TAC[SUBSET]\r
5338              THEN DISCH_THEN (MP_TAC o (SPEC `u':A->bool`))\r
5339              THEN ASM_REWRITE_TAC[]\r
5340              THEN DISCH_TAC\r
5341              THEN MP_TAC (SPECL[`u:A->bool`; `u':A->bool`; `el:A`] IN_INTER)\r
5342              THEN ASM_REWRITE_TAC[]\r
5343              THEN DISCH_THEN (MP_TAC o SIMPLE_EXISTS `el:A`)\r
5344              THEN REWRITE_TAC[MEMBER_NOT_EMPTY]\r
5345              THEN STRIP_TAC\r
5346              THEN REMOVE_THEN "F3" (MP_TAC o SPECL[`u:A->bool`; `u':A->bool`])\r
5347              THEN ASM_REWRITE_TAC[]\r
5348              THEN DISCH_TAC\r
5349              THEN UNDISCH_TAC `u':A->bool IN (t:(A->bool)->bool)`\r
5350             THEN POP_ASSUM (SUBST1_TAC o SYM)\r
5351             THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5352      THEN POP_ASSUM MP_TAC\r
5353      THEN REWRITE_TAC[]\r
5354      THEN DISCH_TAC\r
5355      THEN USE_THEN "F4" SUBST1_TAC\r
5356      THEN MATCH_MP_TAC CARD_UNION\r
5357      THEN ASM_REWRITE_TAC[]);;\r
5358 \r
5359 \r
5360 let lemma_card_partion2_unions = prove(`!(H:(A)hypermap) (x:A) (y:A). x IN dart H /\ y IN dart H ==> CARD (dart H) = CARD(UNIONS (edge_set H DIFF {edge H x, edge H y})) + CARD(UNIONS {edge H x, edge H y})`,\r
5361      REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
5362      THEN SUBGOAL_THEN `dart (H:(A)hypermap) = UNIONS (edge_set H)` (LABEL_TAC "F3")\r
5363      THENL[REWRITE_TAC[edge_set]\r
5364              THEN MATCH_MP_TAC lemma_partition\r
5365              THEN REWRITE_TAC[hypermap_lemma]; ALL_TAC]\r
5366      THEN SUBGOAL_THEN `FINITE (UNIONS (edge_set (H:(A)hypermap)))` ASSUME_TAC\r
5367      THENL[USE_THEN "F3" (SUBST1_TAC o SYM) THEN REWRITE_TAC[hypermap_lemma]; ALL_TAC]\r
5368      THEN REMOVE_THEN "F3" (SUBST1_TAC)\r
5369      THEN MATCH_MP_TAC lemma_card_unions_diff\r
5370      THEN ASM_REWRITE_TAC[]\r
5371      THEN REWRITE_TAC[SET_RULE `{u, v} SUBSET w <=> u IN w /\ v IN w`]\r
5372      THEN REWRITE_TAC[GSYM lemma_in_edge_set]\r
5373      THEN ASM_REWRITE_TAC[]\r
5374      THEN REWRITE_TAC[edge_set; IN_ELIM_THM]\r
5375      THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
5376      THEN REPEAT GEN_TAC\r
5377      THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
5378      THEN STRIP_TAC\r
5379      THEN ASM_REWRITE_TAC[]\r
5380      THEN MP_TAC (MATCH_MP partition_orbit  (CONJ (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_lemma)) (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))\r
5381      THEN MESON_TAC[]);;\r
5382 \r
5383 let CARD_UNION_EDGES_LE = prove(`!(H:(A)hypermap) (x:A) (y:A). CARD (edge H x UNION edge H y) <= CARD (edge H x) + CARD (edge H y)`,\r
5384    REPEAT GEN_TAC\r
5385    THEN MATCH_MP_TAC CARD_UNION_LE\r
5386    THEN REWRITE_TAC[EDGE_FINITE]);;\r
5387 \r
5388 let lemma_card_partion2_unions_approx = prove(`!(H:(A)hypermap) (x:A) (y:A). x IN dart H /\ y IN dart H ==> CARD (dart H) <= CARD(UNIONS (edge_set H DIFF {edge H x, edge H y})) + CARD(edge H x) + CARD(edge H y)`,\r
5389      REPEAT GEN_TAC\r
5390      THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_card_partion2_unions)\r
5391      THEN REWRITE_TAC[UNIONS_2]\r
5392      THEN DISCH_THEN SUBST1_TAC\r
5393      THEN REWRITE_TAC[ARITH_RULE `(m:num) + a <= m + b +c  <=> a <= b + c`]\r
5394      THEN MATCH_MP_TAC CARD_UNION_LE\r
5395      THEN REWRITE_TAC[edge]\r
5396      THEN label_hypermap4_TAC `H:(A)hypermap`\r
5397      THEN STRIP_TAC\r
5398      THENL[MATCH_MP_TAC lemma_orbit_finite\r
5399           THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
5400           THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5401      THEN MATCH_MP_TAC lemma_orbit_finite\r
5402      THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
5403      THEN ASM_REWRITE_TAC[]);;\r
5404 \r
5405 let lemma_card_partion2_unions_eq = prove(`!(H:(A)hypermap) (x:A) (y:A). x IN dart H /\ y IN dart H /\ ~(edge H x = edge H y) ==> CARD (dart H) = CARD(UNIONS (edge_set H DIFF {edge H x, edge H y})) + CARD(edge H x) + CARD(edge H y)`,\r
5406    REPEAT GEN_TAC\r
5407    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
5408    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (MATCH_MP lemma_card_partion2_unions (CONJ th1 th2))))))\r
5409    THEN REWRITE_TAC[UNIONS_2]\r
5410    THEN DISCH_THEN SUBST1_TAC\r
5411    THEN REWRITE_TAC[ARITH_RULE `(m:num) + a = m + b +c  <=> a = b + c`]\r
5412    THEN CONV_TAC  SYM_CONV\r
5413    THEN MATCH_MP_TAC CARD_UNION_EQ\r
5414    THEN REWRITE_TAC[FINITE_UNION]\r
5415    THEN REWRITE_TAC[edge]\r
5416    THEN label_hypermap4_TAC `H:(A)hypermap`\r
5417    THEN STRIP_TAC\r
5418    THENL[STRIP_TAC\r
5419        THENL[MATCH_MP_TAC lemma_orbit_finite\r
5420            THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
5421            THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5422        THEN MATCH_MP_TAC lemma_orbit_finite\r
5423        THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
5424        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
5425    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (MP_TAC (SPECL[`x:A`; `y:A`] (MATCH_MP partition_orbit (CONJ th1 th2)))))))\r
5426    THEN REWRITE_TAC[GSYM edge]\r
5427    THEN USE_THEN "F3" MP_TAC\r
5428    THEN MESON_TAC[]);;\r
5429 \r
5430 let lemma_card_partion1_unions_eq =  prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> CARD (dart H) = CARD(UNIONS (edge_set H DELETE (edge H x))) + CARD(edge H x)`,\r
5431    REPEAT STRIP_TAC\r
5432    THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] lemma_card_partion2_unions)\r
5433    THEN ASM_REWRITE_TAC[SET_RULE `{a,a} = {a} /\ (s DIFF {a} = s DELETE a)`; UNIONS_1]);;\r
5434 \r
5435 let lemma_permutes_exception = prove(`!s:A->bool p:A->A x:A. p permutes s /\ ~(x IN s) ==> p x = x`, \r
5436      REWRITE_TAC[permutes] THEN MESON_TAC[]);;\r
5437 \r
5438 let map_permutes_outside_domain = prove(`!s:A->bool p:A->A. p permutes s ==> (!x:A. ~(x IN s) ==> p x = x)`,\r
5439      REWRITE_TAC[permutes] THEN MESON_TAC[]);;\r
5440 \r
5441 let power_permutation_outside_domain = prove(`!s:A->bool p:A->A x:A n:num. p permutes s /\ ~(x IN s) ==> (p POWER n) x = x`, \r
5442     REPEAT STRIP_TAC\r
5443     THEN SPEC_TAC(`n:num`, `n:num`)\r
5444     THEN INDUCT_TAC\r
5445     THENL[REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
5446     THEN REWRITE_TAC[COM_POWER; o_THM]\r
5447     THEN POP_ASSUM SUBST1_TAC\r
5448     THEN POP_ASSUM MP_TAC\r
5449     THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP map_permutes_outside_domain th]));;\r
5450 \r
5451 let lemma_edge_exception = prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> edge H x = {x}`,\r
5452      REPEAT STRIP_TAC\r
5453      THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` edge_map_and_darts))))\r
5454      THEN ASM_REWRITE_TAC[edge]\r
5455      THEN MESON_TAC[orbit_one_point]);;\r
5456 \r
5457 let lemma_node_exception = prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> node H x = {x}`,\r
5458      REPEAT STRIP_TAC\r
5459      THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))))\r
5460      THEN ASM_REWRITE_TAC[node]\r
5461      THEN MESON_TAC[orbit_one_point]);;\r
5462 \r
5463 let lemma_face_exception = prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> face H x = {x}`,\r
5464      REPEAT STRIP_TAC\r
5465      THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))))\r
5466      THEN ASM_REWRITE_TAC[face]\r
5467      THEN MESON_TAC[orbit_one_point]);;\r
5468 \r
5469 let lemma_simple_hypermap = prove(`simple_hypermap (H:(A)hypermap) ==> !x:A. (node H x) INTER (face H x) = {x}`,\r
5470  REPEAT STRIP_TAC\r
5471    THEN ASM_CASES_TAC `x:A IN dart (H:(A)hypermap)`\r
5472    THENL[POP_ASSUM MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[simple_hypermap] th]); ALL_TAC]\r
5473    THEN POP_ASSUM (LABEL_TAC "F1")\r
5474    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_node_exception th] THEN ASSUME_TAC th)\r
5475    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_face_exception th])\r
5476    THEN SET_TAC[]);;\r
5477 \r
5478 (* DOUBLE EDGE WALKUP ALONG A NODE OF SIZE 2 CARRING A PLAIN HYPERMAP TO A PLAIN ONE *)\r
5479 \r
5480 let double_edge_walkup_plain_hypermap = prove(`!(H:(A)hypermap) (x:A).x IN dart H /\ plain_hypermap H /\ CARD (node H x) = 2 ==> plain_hypermap (double_edge_walkup H x (node_map H x))`,\r
5481    REPEAT GEN_TAC\r
5482      THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [plain_hypermap]\r
5483      THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] lemma_convolution_map)\r
5484      THEN REWRITE_TAC[hypermap_lemma]\r
5485      THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5486      THEN REWRITE_TAC[NODE_OF_SIZE_2]\r
5487      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
5488      THEN ABBREV_TAC `y = node_map (H:(A)hypermap) (x:A)`\r
5489      THEN POP_ASSUM (LABEL_TAC "F5")\r
5490      THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`; `x:A`; `y:A`] inverse_function)\r
5491      THEN ASM_REWRITE_TAC[hypermap_lemma]\r
5492      THEN USE_THEN "F4" (SUBST1_TAC o SYM)\r
5493      THEN DISCH_THEN (LABEL_TAC "F6" o SYM)\r
5494      THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`; `y:A`; `x:A`] inverse_function)\r
5495      THEN ASM_REWRITE_TAC[hypermap_lemma]\r
5496      THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th])\r
5497      THEN DISCH_THEN (LABEL_TAC "F7" o SYM)\r
5498      THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_edges)\r
5499      THEN ASM_REWRITE_TAC[]\r
5500      THEN DISCH_THEN (LABEL_TAC "F8")\r
5501      THEN ABBREV_TAC `G = edge_walkup  (H:(A)hypermap) (x:A)`\r
5502      THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_node_map_walkup_in_dart)\r
5503      THEN ASM_REWRITE_TAC[]\r
5504      THEN DISCH_THEN (LABEL_TAC "F9")\r
5505      THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] node_map_walkup)))\r
5506      THEN ASM_REWRITE_TAC[]\r
5507      THEN DISCH_THEN (LABEL_TAC "F10")\r
5508      THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_walkup_edges)\r
5509      THEN ASM_REWRITE_TAC[SET_RULE `{a,a} = {a} /\ s DIFF {a} = s DELETE a`]\r
5510      THEN ABBREV_TAC `W = edge_walkup (G:(A)hypermap) (y:A)`\r
5511      THEN DISCH_THEN (LABEL_TAC "F11")\r
5512      THEN SUBGOAL_THEN `~(edge (W:(A)hypermap) (y:A) IN edge_set W)` (LABEL_TAC "F12")\r
5513      THENL[REWRITE_TAC[GSYM lemma_in_edge_set]\r
5514              THEN EXPAND_TAC "W"\r
5515              THEN MP_TAC (CONJUNCT1(SPECL[`G:(A)hypermap`; `y:A`] lemma_edge_walkup))\r
5516              THEN DISCH_THEN SUBST1_TAC\r
5517              THEN REWRITE_TAC[IN_DELETE]; ALL_TAC]\r
5518      THEN REMOVE_THEN "F11" MP_TAC\r
5519      THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE a) DELETE b`]\r
5520      THEN USE_THEN "F12" (MP_TAC o MATCH_MP (SET_RULE `~(a IN s) ==> s DELETE a = s`))\r
5521      THEN DISCH_THEN SUBST1_TAC\r
5522      THEN DISCH_THEN (LABEL_TAC "F14")\r
5523      THEN MP_TAC (CONJUNCT1 (SPECL[`G:(A)hypermap`; `y:A`] lemma_edge_walkup))\r
5524      THEN FIND_ASSUM (fun th -> REWRITE_TAC[th]) `edge_walkup (G:(A)hypermap) (y:A) = W`\r
5525      THEN DISCH_THEN (LABEL_TAC "F15")\r
5526      THEN SUBGOAL_THEN `~(y:A IN dart (W:(A)hypermap))` (LABEL_TAC "F16")\r
5527      THEN USE_THEN "F15" SUBST1_TAC\r
5528      THEN REWRITE_TAC[IN_DELETE]\r
5529      THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
5530      THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
5531      THEN DISCH_THEN (LABEL_TAC "F17")\r
5532      THEN ASM_CASES_TAC `(inverse (edge_map (H:(A)hypermap)) (x:A)) = x \/ edge (G:(A)hypermap) (y:A) = edge G (inverse (edge_map H) x)`\r
5533     THENL[SUBGOAL_THEN `edge_set (G:(A)hypermap) DIFF {edge G (y:A), edge G (inverse (edge_map (H:(A)hypermap)) (x:A))} = edge_set G DELETE (edge G y)` ASSUME_TAC\r
5534         THENL[POP_ASSUM MP_TAC THEN STRIP_TAC\r
5535                 THENL[REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE b) DELETE a`]\r
5536                         THEN POP_ASSUM SUBST1_TAC\r
5537                         THEN MP_TAC (ISPECL[`edge (G:(A)hypermap) (x:A)`; `edge_set (G:(A)hypermap)`] DELETE_NON_ELEMENT)\r
5538                         THEN REWRITE_TAC[GSYM lemma_in_edge_set]\r
5539                         THEN REWRITE_TAC[lemma_edge_walkup]\r
5540                         THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup))\r
5541                         THEN FIND_ASSUM SUBST1_TAC `edge_walkup (H:(A)hypermap) (x:A) = G`\r
5542                         THEN DISCH_THEN SUBST1_TAC\r
5543                         THEN REWRITE_TAC[IN_DELETE]\r
5544                         THEN DISCH_THEN SUBST1_TAC\r
5545                         THEN SIMP_TAC[]; ALL_TAC]\r
5546                 THEN POP_ASSUM (SUBST1_TAC o SYM)\r
5547                 THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`]; ALL_TAC]\r
5548         THEN REMOVE_THEN "F8" MP_TAC\r
5549         THEN POP_ASSUM  SUBST1_TAC\r
5550         THEN DISCH_THEN (LABEL_TAC "K1")        \r
5551         THEN SUBGOAL_THEN `CARD (edge (G:(A)hypermap) (y:A)) <= 3` (LABEL_TAC "K2")\r
5552         THENL[USE_THEN "F1" (fun th1 -> (USE_THEN "F17" (fun th2 -> (MP_TAC (MATCH_MP lemma_card_partion2_unions (CONJ th1 th2))))))\r
5553                 THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_card_walkup_dart)\r
5554                 THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (H:(A)hypermap) (x:A) = G`\r
5555                 THEN DISCH_THEN  SUBST1_TAC\r
5556                 THEN USE_THEN "K1" SUBST1_TAC\r
5557                 THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq)\r
5558                 THEN DISCH_THEN SUBST1_TAC\r
5559                 THEN REWRITE_TAC[ARITH_RULE `((m:num)+n) +1 = m + k <=> n+1 = k`; UNIONS_2]\r
5560                 THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP (ARITH_RULE `(a:num) = b /\ b <= c ==> a <= c`) (CONJ th (SPECL[`H:(A)hypermap`; `x:A`; `y:A`] CARD_UNION_EDGES_LE)))))\r
5561                 THEN USE_THEN "F2" (MP_TAC o SPEC `x:A`)\r
5562                 THEN USE_THEN "F2" (MP_TAC o SPEC `y:A`)\r
5563                 THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th])\r
5564                 THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th])\r
5565                 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
5566                 THEN REWRITE_TAC[GSYM edge]\r
5567                 THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `(a:num) <= 2 /\ (b:num) <= 2 /\ (c:num) + 1 <= b + a ==> c <= 3`))\r
5568                 THEN SIMP_TAC[]; ALL_TAC]\r
5569         THEN SUBGOAL_THEN `CARD (edge (W:(A)hypermap) (inverse (edge_map (G:(A)hypermap)) (y:A))) <= 2` (LABEL_TAC "K3")\r
5570         THENL[ASM_CASES_TAC `inverse (edge_map (G:(A)hypermap)) (y:A) = y`\r
5571             THENL[POP_ASSUM SUBST1_TAC\r
5572                     THEN USE_THEN "F16" (MP_TAC o MATCH_MP lemma_edge_exception)\r
5573                     THEN DISCH_THEN SUBST1_TAC\r
5574                     THEN REWRITE_TAC[CARD_SINGLETON]\r
5575                     THEN ARITH_TAC; ALL_TAC]\r
5576             THEN MP_TAC (SPEC `y:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT1(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma)))))\r
5577             THEN POP_ASSUM (fun th -> ((LABEL_TAC "K4" th) THEN REWRITE_TAC[th]))\r
5578             THEN USE_THEN "F9" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_edge_map_walkup_in_dart (CONJ th1 th2)))))))\r
5579             THEN FIND_ASSUM SUBST1_TAC `edge_walkup (G:(A)hypermap) (y:A) = W`\r
5580             THEN DISCH_THEN (LABEL_TAC "K5")\r
5581             THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq)\r
5582             THEN USE_THEN "F14" SUBST1_TAC\r
5583             THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_walkup_dart)\r
5584             THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (G:(A)hypermap) (y:A) = W`\r
5585             THEN DISCH_THEN  SUBST1_TAC\r
5586             THEN USE_THEN "K5" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq)\r
5587             THEN DISCH_THEN SUBST1_TAC\r
5588             THEN REWRITE_TAC[ARITH_RULE `((m:num)+n) +1 = m + k <=> n+1 = k`]\r
5589             THEN USE_THEN "K2" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP (ARITH_RULE `((a:num) <= 3 /\ (b:num) + 1 = a) ==> b <=2`) (CONJ th1 th2))))))\r
5590             THEN SIMP_TAC[]; ALL_TAC]\r
5591         THEN ASM_REWRITE_TAC[plain_hypermap; double_edge_walkup]\r
5592         THEN MP_TAC (SPECL[`dart (W:(A)hypermap)`; `edge_map (W:(A)hypermap)`] lemma_convolution_map)\r
5593         THEN REWRITE_TAC[hypermap_lemma]\r
5594         THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5595         THEN REWRITE_TAC[GSYM edge]\r
5596         THEN GEN_TAC\r
5597         THEN ASM_CASES_TAC `edge (W:(A)hypermap) (x':A) = edge W (inverse (edge_map (G:(A)hypermap)) (y:A))`\r
5598         THENL[POP_ASSUM SUBST1_TAC\r
5599                 THEN USE_THEN "K3" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
5600 \r
5601         THEN POP_ASSUM (LABEL_TAC "K10")\r
5602         THEN DISCH_THEN (fun th -> (LABEL_TAC "K11" th  THEN MP_TAC th))\r
5603         THEN REWRITE_TAC[lemma_in_edge_set]\r
5604         THEN DISCH_THEN (LABEL_TAC "K12")\r
5605         THEN MP_TAC (ISPECL[`edge_set (W:(A)hypermap)`; `edge (W:(A)hypermap) (x':A)`; `edge (W:(A)hypermap) (inverse (edge_map (G:(A)hypermap)) (y:A))` ] IN_DELETE)\r
5606         THEN USE_THEN "K12" (fun th -> REWRITE_TAC[th])\r
5607         THEN USE_THEN "K10" (fun th -> REWRITE_TAC[th])\r
5608         THEN USE_THEN "F14" (SUBST1_TAC o SYM)\r
5609         THEN USE_THEN "K1" (SUBST1_TAC o SYM)\r
5610         THEN ABBREV_TAC `E = edge (W:(A)hypermap) (x':A)`\r
5611         THEN REWRITE_TAC[IN_DIFF]\r
5612         THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_edge_representation (CONJUNCT1 th))))\r
5613         THEN STRIP_TAC\r
5614         THEN USE_THEN "F2" (MP_TAC o SPEC `x'':A`)\r
5615         THEN REWRITE_TAC[GSYM edge]\r
5616         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
5617         THEN POP_ASSUM (fun th -> REWRITE_TAC[th]);ALL_TAC]\r
5618     THEN POP_ASSUM MP_TAC\r
5619      THEN REWRITE_TAC[DE_MORGAN_THM]\r
5620      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J1") (LABEL_TAC "J2"))\r
5621      THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_dart_inveriant_under_inverse_maps)\r
5622      THEN USE_THEN "F1" (fun th1 -> USE_THEN "J1" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_in_walkup_dart (CONJ th1 (CONJ th3 th2))))))))\r
5623      THEN FIND_ASSUM SUBST1_TAC `edge_walkup (H:(A)hypermap) (x:A) = G`\r
5624      THEN DISCH_THEN (fun th -> (MP_TAC th THEN (LABEL_TAC "J3" th)))\r
5625      THEN REWRITE_TAC[lemma_in_edge_set]\r
5626      THEN DISCH_THEN (LABEL_TAC "J4")\r
5627      THEN ABBREV_TAC `u = inverse (edge_map (H:(A)hypermap)) (x:A)`\r
5628      THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F17" (fun th2 -> (MP_TAC (MATCH_MP lemma_card_partion2_unions_approx (CONJ th1 th2))))))\r
5629      THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_card_walkup_dart)\r
5630      THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (H:(A)hypermap) (x:A) = G`\r
5631      THEN DISCH_THEN  SUBST1_TAC\r
5632      THEN USE_THEN "F9" (fun th1 -> (USE_THEN "J3" (fun th2 -> (USE_THEN "J2" (fun th3 -> (MP_TAC (MATCH_MP lemma_card_partion2_unions_eq (CONJ th1 (CONJ th2 th3)))))))))\r
5633      THEN DISCH_THEN SUBST1_TAC\r
5634      THEN USE_THEN "F8" (SUBST1_TAC)\r
5635      THEN REWRITE_TAC[ARITH_RULE  `((m:num)+n+k) + 1 <= m + a + b <=> n+k+1 <= a+b`]\r
5636      THEN USE_THEN "F2" (MP_TAC o SPEC `x:A`)\r
5637      THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th])\r
5638      THEN USE_THEN "F2" (MP_TAC o SPEC `y:A`)\r
5639      THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th])\r
5640      THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
5641      THEN REWRITE_TAC[GSYM edge]\r
5642      THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP (ARITH_RULE `b:num <= 2 /\ a:num <= 2 /\ (m:num) + (n:num) + 1 <=a + b ==> m +n <= 3`) th)))\r
5643      THEN MP_TAC (SPECL[`G:(A)hypermap`; `y:A`] EDGE_NOT_EMPTY)\r
5644      THEN MP_TAC (SPECL[`G:(A)hypermap`; `u:A`] EDGE_NOT_EMPTY)\r
5645      THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
5646      THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `1 <= n:num /\ 1 <= m:num /\ m + n <= 3 ==> m <=2 /\ n <=2`))\r
5647      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J5") (LABEL_TAC "J6"))\r
5648      THEN SUBGOAL_THEN `CARD (edge (W:(A)hypermap) (inverse (edge_map (G:(A)hypermap)) (y:A))) <= 2` (LABEL_TAC "J6a")\r
5649      THENL[ASM_CASES_TAC `inverse (edge_map (G:(A)hypermap)) (y:A) = y`\r
5650          THENL[POP_ASSUM SUBST1_TAC \r
5651                  THEN MP_TAC (CONJUNCT1(SPECL[`G:(A)hypermap`; `y:A`; `y:A`] edge_map_walkup))\r
5652                  THEN FIND_ASSUM SUBST1_TAC `edge_walkup (G:(A)hypermap) (y:A) = W`\r
5653              THEN MP_TAC (SPECL[`edge_map (W:(A)hypermap)`; `y:A`] orbit_one_point)\r
5654              THEN REWRITE_TAC[GSYM edge]\r
5655              THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5656              THEN DISCH_THEN SUBST1_TAC\r
5657              THEN REWRITE_TAC[CARD_SINGLETON]\r
5658              THEN ARITH_TAC; ALL_TAC]\r
5659          THEN POP_ASSUM (LABEL_TAC "J7")\r
5660          THEN MP_TAC (SPEC `y:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT1(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma)))))\r
5661          THEN USE_THEN "J7" (fun th -> REWRITE_TAC[th])\r
5662          THEN USE_THEN "F9" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_edge_map_walkup_in_dart (CONJ th1 th2)))))))\r
5663          THEN FIND_ASSUM SUBST1_TAC `edge_walkup (G:(A)hypermap) (y:A) = W`\r
5664          THEN DISCH_THEN (LABEL_TAC "J8")\r
5665          THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq)\r
5666          THEN (USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_walkup_dart))\r
5667          THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (G:(A)hypermap) (y:A) = W`\r
5668          THEN DISCH_THEN  SUBST1_TAC\r
5669          THEN USE_THEN "F14" SUBST1_TAC\r
5670          THEN USE_THEN "J8" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq)\r
5671          THEN DISCH_THEN SUBST1_TAC\r
5672          THEN REWRITE_TAC[ARITH_RULE `((m:num)+n) +1 = m + k <=> n+1 = k`]\r
5673          THEN USE_THEN "J5" MP_TAC\r
5674          THEN REWRITE_TAC[IMP_IMP]\r
5675          THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `a:num <= 2 /\ (m:num) + 1 = a ==> m <= 2`))\r
5676          THEN SIMP_TAC[]; ALL_TAC]\r
5677      THEN ABBREV_TAC `v = inverse (edge_map (G:(A)hypermap)) (y:A)`\r
5678     THEN ASM_REWRITE_TAC[plain_hypermap; double_edge_walkup]\r
5679     THEN  MP_TAC (SPECL[`dart (W:(A)hypermap)`; `edge_map (W:(A)hypermap)`] lemma_convolution_map)\r
5680     THEN  REWRITE_TAC[hypermap_lemma]\r
5681     THEN  DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5682     THEN  REWRITE_TAC[GSYM edge]\r
5683     THEN  GEN_TAC\r
5684     THEN  ASM_CASES_TAC `edge (W:(A)hypermap) (x':A) = edge W (v:A)`\r
5685     THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "J6a" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
5686     THEN  POP_ASSUM (LABEL_TAC "J16")\r
5687     THEN  DISCH_THEN (fun th -> (LABEL_TAC "J17" th  THEN MP_TAC th))\r
5688     THEN  REWRITE_TAC[lemma_in_edge_set]\r
5689     THEN  DISCH_THEN (LABEL_TAC "J18")\r
5690     THEN  MP_TAC (ISPECL[`edge_set (W:(A)hypermap)`; `edge (W:(A)hypermap) (x':A)`; `edge (W:(A)hypermap) (v:A)` ] IN_DELETE)\r
5691     THEN  USE_THEN "J18" (fun th -> REWRITE_TAC[th])\r
5692     THEN  USE_THEN "J16" (fun th -> REWRITE_TAC[th])\r
5693     THEN  USE_THEN "F14" (SUBST1_TAC o SYM)\r
5694     THEN  ASM_CASES_TAC `edge (W:(A)hypermap) (x':A) = edge (G:(A)hypermap) (u:A)`\r
5695     THENL[POP_ASSUM SUBST1_TAC\r
5696         THEN USE_THEN "J6" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
5697     THEN DISCH_THEN (fun th -> (POP_ASSUM (fun th2 -> (MP_TAC (MATCH_MP (SET_RULE `~(a = b) /\ a IN (s DELETE c) ==> a IN (s DIFF {c, b})`) (CONJ th2 th))))))\r
5698     THEN  USE_THEN "F8" (SUBST1_TAC o SYM)\r
5699     THEN  ABBREV_TAC `ED = edge (W:(A)hypermap) (x':A)`\r
5700     THEN REWRITE_TAC[IN_DIFF]\r
5701     THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_edge_representation (CONJUNCT1 th))))\r
5702     THEN STRIP_TAC\r
5703     THEN USE_THEN "F2" (MP_TAC o SPEC `x'':A`)\r
5704     THEN REWRITE_TAC[GSYM edge]\r
5705     THEN POP_ASSUM (SUBST1_TAC o SYM)\r
5706     THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
5707 \r
5708 let lemma_representaion_Wn = prove(`!(H:(A)hypermap) (x:A) (y:A). double_node_walkup H x y = shift(shift(double_edge_walkup (shift H) x y))`,\r
5709     REPEAT GEN_TAC THEN REWRITE_TAC[double_node_walkup; node_walkup; double_edge_walkup]\r
5710     THEN REWRITE_TAC[lemma_shift_cycle]);;\r
5711 \r
5712 let lemma_representaion_Wf = prove(`!(H:(A)hypermap) (x:A) (y:A). double_face_walkup H x y = shift(double_edge_walkup (shift(shift H)) x y)`,\r
5713     REPEAT GEN_TAC THEN REWRITE_TAC[double_face_walkup; face_walkup; double_edge_walkup]\r
5714     THEN REWRITE_TAC[lemma_shift_cycle]);;\r
5715 \r
5716 \r
5717 let double_node_walkup_plain_hypermap = prove(`!(H:(A)hypermap) (x:A).x IN dart H /\ plain_hypermap H /\ CARD (edge H x) = 2 ==> plain_hypermap (double_node_walkup H x (edge_map H x))`,\r
5718    REPEAT GEN_TAC\r
5719    THEN REWRITE_TAC[lemma_representaion_Wn]\r
5720    THEN REWRITE_TAC[plain_hypermap]\r
5721    THEN ABBREV_TAC `G = shift (H:(A)hypermap)`\r
5722    THEN REWRITE_TAC[GSYM shift_lemma]\r
5723    THEN MP_TAC (CONJUNCT1(SPEC `H:(A)hypermap` shift_lemma))\r
5724    THEN DISCH_THEN SUBST1_TAC\r
5725    THEN REWRITE_TAC[edge]\r
5726    THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` shift_lemma)))\r
5727    THEN DISCH_THEN SUBST1_TAC\r
5728    THEN ASM_REWRITE_TAC[]\r
5729    THEN REWRITE_TAC[GSYM face]\r
5730    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
5731    THEN MP_TAC (SPECL[`dart (G:(A)hypermap)`; `face_map (G:(A)hypermap)`] lemma_convolution_map)\r
5732    THEN ASM_REWRITE_TAC[hypermap_lemma; GSYM face]\r
5733    THEN DISCH_THEN (LABEL_TAC "F4")\r
5734    THEN REMOVE_THEN "F3" MP_TAC\r
5735    THEN REWRITE_TAC[FACE_OF_SIZE_2]\r
5736    THEN ABBREV_TAC `y = face_map (G:(A)hypermap) (x:A)`\r
5737    THEN POP_ASSUM (LABEL_TAC "J0")\r
5738    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))\r
5739    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_faces)\r
5740    THEN ABBREV_TAC `J = edge_walkup (G:(A)hypermap) (x:A)`\r
5741    THEN POP_ASSUM (LABEL_TAC "J1")\r
5742    THEN USE_THEN "F6" (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma))))) th))))\r
5743    THEN DISCH_THEN (fun th -> (LABEL_TAC "J2" (SYM th) THEN (SUBST1_TAC (SYM th))))\r
5744    THEN DISCH_THEN (LABEL_TAC "F7")\r
5745    THEN USE_THEN "F5" MP_TAC\r
5746    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
5747    THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
5748    THEN USE_THEN "J0" (fun th -> REWRITE_TAC[th])\r
5749    THEN DISCH_THEN (LABEL_TAC "F8")\r
5750    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F8" (fun th2 -> (USE_THEN "F5" (fun th3 -> (MP_TAC (MATCH_MP lemma_in_walkup_dart (CONJ th1 (CONJ th2 th3)))))))))\r
5751    THEN USE_THEN "J1" (fun th->REWRITE_TAC[th])\r
5752    THEN DISCH_THEN (LABEL_TAC "F9")\r
5753    THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_walkup_faces)\r
5754    THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`G:(A)hypermap`; `x:A`; `x:A`] face_map_walkup)))\r
5755    THEN ASM_REWRITE_TAC[]\r
5756    THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `J:(A)hypermap` hypermap_lemma))))) th))))\r
5757    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
5758    THEN ABBREV_TAC `W = edge_walkup (J:(A)hypermap) (y:A)`\r
5759    THEN SUBGOAL_THEN `~(face (W:(A)hypermap) (y:A) IN face_set W)` ASSUME_TAC\r
5760    THENL[REWRITE_TAC[GSYM lemma_in_face_set]\r
5761            THEN EXPAND_TAC "W"\r
5762            THEN REWRITE_TAC[lemma_edge_walkup]\r
5763            THEN REWRITE_TAC[IN_DELETE]; ALL_TAC]\r
5764   THEN POP_ASSUM (MP_TAC o MATCH_MP (SET_RULE `~(a IN s) ==> (s DELETE a = s)`))\r
5765   THEN DISCH_THEN SUBST1_TAC\r
5766   THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM)\r
5767   THEN DISCH_THEN (LABEL_TAC "F10" o SYM)\r
5768   THEN REWRITE_TAC[double_edge_walkup]\r
5769   THEN USE_THEN "J1" (fun th -> REWRITE_TAC[th])\r
5770   THEN FIND_ASSUM (fun th -> REWRITE_TAC[th]) `edge_walkup (J:(A)hypermap) (y:A) = W`\r
5771   THEN MP_TAC (SPECL[`dart (W:(A)hypermap)`; `face_map (W:(A)hypermap)`] lemma_convolution_map)\r
5772   THEN REWRITE_TAC[hypermap_lemma]\r
5773   THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5774   THEN REWRITE_TAC[GSYM face]\r
5775   THEN GEN_TAC\r
5776   THEN REWRITE_TAC[lemma_in_face_set]\r
5777   THEN POP_ASSUM SUBST1_TAC\r
5778   THEN REWRITE_TAC[IN_DELETE]\r
5779   THEN ABBREV_TAC `FF = face (W:(A)hypermap) (x':A)`\r
5780   THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_face_representation (CONJUNCT1 th))))\r
5781   THEN REPEAT STRIP_TAC\r
5782   THEN REMOVE_THEN "F4" (MP_TAC o SPEC `x'':A`)\r
5783   THEN ASM_REWRITE_TAC[]);;\r
5784 \r
5785 let double_face_walkup_plain_hypermap = prove(`!(H:(A)hypermap) (x:A).x IN dart H /\ plain_hypermap H /\ CARD (edge H x) = 2 ==> plain_hypermap (double_face_walkup H x (edge_map H x))`,\r
5786    REPEAT GEN_TAC\r
5787    THEN REWRITE_TAC[lemma_representaion_Wf]\r
5788    THEN REWRITE_TAC[plain_hypermap]\r
5789    THEN ABBREV_TAC `G = shift(shift (H:(A)hypermap))`\r
5790    THEN REWRITE_TAC[GSYM shift_lemma]\r
5791    THEN MP_TAC (CONJUNCT1(SPEC `H:(A)hypermap` double_shift_lemma))\r
5792    THEN DISCH_THEN SUBST1_TAC\r
5793    THEN REWRITE_TAC[edge]\r
5794    THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` double_shift_lemma)))\r
5795    THEN DISCH_THEN SUBST1_TAC\r
5796    THEN ASM_REWRITE_TAC[]\r
5797    THEN REWRITE_TAC[GSYM node]\r
5798    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
5799    THEN MP_TAC (SPECL[`dart (G:(A)hypermap)`; `node_map (G:(A)hypermap)`] lemma_convolution_map)\r
5800    THEN ASM_REWRITE_TAC[hypermap_lemma; GSYM node]\r
5801    THEN DISCH_THEN (LABEL_TAC "F4")\r
5802    THEN REMOVE_THEN "F3" MP_TAC\r
5803    THEN REWRITE_TAC[NODE_OF_SIZE_2]\r
5804    THEN ABBREV_TAC `y = node_map (G:(A)hypermap) (x:A)`\r
5805    THEN POP_ASSUM (LABEL_TAC "J0")\r
5806    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))\r
5807    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_nodes)\r
5808    THEN ABBREV_TAC `J = edge_walkup (G:(A)hypermap) (x:A)`\r
5809    THEN POP_ASSUM (LABEL_TAC "J1")\r
5810    THEN USE_THEN "F6" (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma)))) th))))\r
5811    THEN DISCH_THEN (fun th -> (LABEL_TAC "J2" (SYM th) THEN (SUBST1_TAC (SYM th))))\r
5812    THEN DISCH_THEN (LABEL_TAC "F7")\r
5813    THEN USE_THEN "F5" MP_TAC\r
5814    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
5815    THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
5816    THEN USE_THEN "J0" (fun th -> REWRITE_TAC[th])\r
5817    THEN DISCH_THEN (LABEL_TAC "F8")\r
5818   THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F8" (fun th2 -> (USE_THEN "F5" (fun th3 -> (MP_TAC (MATCH_MP lemma_in_walkup_dart (CONJ th1 (CONJ th2 th3)))))))))\r
5819    THEN USE_THEN "J1" (fun th->REWRITE_TAC[th])\r
5820    THEN DISCH_THEN (LABEL_TAC "F9")\r
5821    THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_walkup_nodes)\r
5822    THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`G:(A)hypermap`; `x:A`; `x:A`] node_map_walkup)))\r
5823    THEN ASM_REWRITE_TAC[]\r
5824    THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `J:(A)hypermap` hypermap_lemma)))) th))))\r
5825    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
5826    THEN ABBREV_TAC `W = edge_walkup (J:(A)hypermap) (y:A)`\r
5827    THEN SUBGOAL_THEN `~(node (W:(A)hypermap) (y:A) IN node_set W)` ASSUME_TAC\r
5828    THENL[REWRITE_TAC[GSYM lemma_in_node_set]\r
5829            THEN EXPAND_TAC "W"\r
5830            THEN REWRITE_TAC[lemma_edge_walkup]\r
5831            THEN REWRITE_TAC[IN_DELETE]; ALL_TAC]\r
5832   THEN POP_ASSUM (MP_TAC o MATCH_MP (SET_RULE `~(a IN s) ==> (s DELETE a = s)`))\r
5833   THEN DISCH_THEN SUBST1_TAC\r
5834   THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM)\r
5835   THEN DISCH_THEN (LABEL_TAC "F10" o SYM)\r
5836   THEN REWRITE_TAC[double_edge_walkup]\r
5837   THEN USE_THEN "J1" (fun th -> REWRITE_TAC[th])\r
5838   THEN FIND_ASSUM (fun th -> REWRITE_TAC[th]) `edge_walkup (J:(A)hypermap) (y:A) = W`\r
5839   THEN MP_TAC (SPECL[`dart (W:(A)hypermap)`; `node_map (W:(A)hypermap)`] lemma_convolution_map)\r
5840   THEN REWRITE_TAC[hypermap_lemma]\r
5841   THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5842   THEN REWRITE_TAC[GSYM node]\r
5843   THEN GEN_TAC\r
5844   THEN REWRITE_TAC[lemma_in_node_set]\r
5845   THEN POP_ASSUM SUBST1_TAC\r
5846   THEN REWRITE_TAC[IN_DELETE]\r
5847   THEN ABBREV_TAC `NN = node (W:(A)hypermap) (x':A)`\r
5848   THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_node_representation (CONJUNCT1 th))))\r
5849   THEN REPEAT STRIP_TAC\r
5850   THEN REMOVE_THEN "F4" (MP_TAC o SPEC `x'':A`)\r
5851   THEN ASM_REWRITE_TAC[]);;\r
5852 \r
5853 let lemmaHOZKXVW = prove(`!(H:(A)hypermap) (x:A).x IN dart H /\ plain_hypermap H ==> (CARD (edge H x) = 2 ==> plain_hypermap (double_face_walkup H x (edge_map H x)) /\ plain_hypermap (double_node_walkup H x (edge_map H x))) /\ (CARD (node H x) = 2 ==> plain_hypermap (double_edge_walkup H x (node_map H x)))`,\r
5854   REPEAT STRIP_TAC\r
5855   THENL[ASM_MESON_TAC[double_face_walkup_plain_hypermap];\r
5856         ASM_MESON_TAC[double_node_walkup_plain_hypermap];\r
5857         ASM_MESON_TAC[double_edge_walkup_plain_hypermap]]);;\r
5858 \r
5859 (* WE DEFINE THE MOEBIUS CONTOUR HERE *)\r
5860 \r
5861 let is_Moebius_contour = new_definition `is_Moebius_contour (H:(A)hypermap) (p:num->A) (k:num) <=> (is_inj_contour H p k /\ (?i:num j:num. 0 < i /\ i <=j /\ j < k /\ (p j = node_map H (p 0)) /\ (p k = node_map H (p i))))`;;\r
5862 \r
5863 let lemma_contour_in_dart = prove(`!(H:(A)hypermap) (p:num->A) (n:num). p 0 IN dart H /\ is_contour H p n ==> p n IN dart H`,\r
5864    REPLICATE_TAC 2 GEN_TAC\r
5865    THEN INDUCT_TAC\r
5866    THENL[SIMP_TAC[]; ALL_TAC]\r
5867    THEN POP_ASSUM (LABEL_TAC "F1")\r
5868    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (MP_TAC))\r
5869    THEN REWRITE_TAC[is_contour]\r
5870    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))\r
5871    THEN REMOVE_THEN "F1" MP_TAC\r
5872    THEN ASM_REWRITE_TAC[]\r
5873    THEN DISCH_THEN (LABEL_TAC "F5")\r
5874    THEN REMOVE_THEN "F4" MP_TAC\r
5875    THEN REWRITE_TAC[one_step_contour]\r
5876    THEN STRIP_TAC\r
5877    THENL[USE_THEN "F5" (fun th -> (MP_TAC(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_dart_invariant th)))))\r
5878            THEN POP_ASSUM (SUBST1_TAC o SYM)\r
5879            THEN SIMP_TAC[]; ALL_TAC]\r
5880    THEN USE_THEN "F5" (fun th -> (MP_TAC(CONJUNCT1(CONJUNCT2(MATCH_MP lemma_dart_inveriant_under_inverse_maps th)))))\r
5881    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
5882    THEN SIMP_TAC[]);;\r
5883 \r
5884 let lemma_darts_in_contour = prove(`!(H:(A)hypermap) (p:num->A) (n:num). p 0 IN dart H /\ is_contour H p n ==> {p (i:num) | i <= n} SUBSET dart H`,\r
5885      REPEAT GEN_TAC\r
5886      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
5887      THEN REWRITE_TAC[SUBSET; EXTENSION; IN_ELIM_THM]\r
5888      THEN REPEAT STRIP_TAC\r
5889      THEN USE_THEN "F2" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_subcontour)\r
5890      THEN POP_ASSUM SUBST1_TAC\r
5891      THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
5892      THEN USE_THEN "F1" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_contour_in_dart (CONJ th1 th2))))))\r
5893      THEN SIMP_TAC[]);;\r
5894 \r
5895 let lemma_first_dart_on_inj_contour = prove(`!(H:(A)hypermap) (p:num->A) (n:num). 0 < n /\ is_inj_contour H p n ==> p 0 IN dart H`,\r
5896  REPEAT GEN_TAC\r
5897    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
5898    THEN ASM_CASES_TAC `~(((p:num->A) 0) IN dart (H:(A)hypermap))`\r
5899    THENL[SUBGOAL_THEN `!m:num. m <= n ==> (p:num->A) m = p 0` ASSUME_TAC\r
5900        THENL[INDUCT_TAC THENL[ ARITH_TAC; ALL_TAC]\r
5901            THEN  POP_ASSUM (LABEL_TAC "J0")\r
5902            THEN DISCH_THEN (LABEL_TAC "J1")\r
5903            THEN REMOVE_THEN "J0" MP_TAC\r
5904            THEN USE_THEN "J1" (ASSUME_TAC o REWRITE_RULE[LE_SUC_LT])\r
5905            THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
5906            THEN DISCH_TAC\r
5907            THEN ABBREV_TAC `x = (p:num->A) 0`\r
5908            THEN USE_THEN "F2" (MP_TAC o SPEC `m:num` o CONJUNCT1 o  REWRITE_RULE[lemma_def_inj_contour; lemma_def_contour])\r
5909            THEN REWRITE_TAC[GSYM LE_SUC_LT]\r
5910            THEN REMOVE_THEN "J1" (fun th -> REWRITE_TAC[th])\r
5911            THEN REWRITE_TAC[one_step_contour]\r
5912            THEN ASM_REWRITE_TAC[]\r
5913            THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))))\r
5914            THEN ASM_REWRITE_TAC[]\r
5915            THEN DISCH_THEN SUBST1_TAC\r
5916            THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))))\r
5917            THEN ASM_REWRITE_TAC[]\r
5918            THEN DISCH_THEN (SUBST1_TAC o SYM o ONCE_REWRITE_RULE[node_map_inverse_representation] o SYM)\r
5919            THEN SIMP_TAC[]; ALL_TAC]\r
5920        THEN USE_THEN "F2" (MP_TAC o SPECL[`n:num`; `0`] o CONJUNCT2 o REWRITE_RULE[lemma_def_inj_contour])\r
5921        THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th; LE_REFL])\r
5922        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`)\r
5923        THEN MESON_TAC[]; ALL_TAC]\r
5924    THEN POP_ASSUM (fun th -> MESON_TAC[th]));;\r
5925 \r
5926 let lemma_darts_on_Moebius_contour = prove(`!(H:(A)hypermap) (p:num->A) (k:num). is_Moebius_contour H p k ==> (2 <= k) /\ (p:num->A) 0 IN dart H /\ SUC k <= CARD(dart H)`,\r
5927    REPEAT GEN_TAC  THEN REWRITE_TAC[is_Moebius_contour]\r
5928    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FJ") (STRIP_ASSUME_TAC))\r
5929    THEN MP_TAC (ARITH_RULE `0 < i:num /\ i <= j:num /\ j < k:num ==> 2 <= k`)\r
5930    THEN ASM_REWRITE_TAC[]\r
5931    THEN DISCH_THEN (fun th -> (ASSUME_TAC th  THEN REWRITE_TAC[th]))\r
5932    THEN MP_TAC (SPECL[`H:(A)hypermap`; `p:num->A`;  `k:num`] lemma_first_dart_on_inj_contour)\r
5933    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE`2 <= k:num ==> 0 < k`) th])\r
5934    THEN USE_THEN "FJ" (fun th -> REWRITE_TAC[th])\r
5935    THEN DISCH_THEN (LABEL_TAC "F1")\r
5936    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th])\r
5937    THEN USE_THEN "FJ" (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_def_inj_contour])\r
5938    THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [GSYM LT_SUC_LE]\r
5939    THEN REWRITE_TAC[MESON[] `~(a = b) <=> ~(b=a)`]\r
5940    THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_FINITE_SERIES_EQ)\r
5941    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
5942    THEN USE_THEN "FJ" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour])\r
5943    THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th -> (MP_TAC(MATCH_MP lemma_darts_in_contour (CONJ th th1))))))\r
5944    THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [GSYM LT_SUC_LE]\r
5945    THEN DISCH_TAC\r
5946    THEN MATCH_MP_TAC CARD_SUBSET\r
5947    THEN POP_ASSUM (fun th -> REWRITE_TAC[th; hypermap_lemma]));; \r
5948 \r
5949 let lemma_Moebius_contour_points_subset_darts = prove(`!(H:(A)hypermap) (p:num -> A) (k:num). is_Moebius_contour H p k ==> {p (i:num) | i <= k} SUBSET dart H /\ CARD ({p (i:num) | i <= k}) = SUC k`,\r
5950    REPEAT GEN_TAC\r
5951      THEN DISCH_THEN (LABEL_TAC "F1")\r
5952      THEN USE_THEN "F1" (LABEL_TAC "F2" o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_darts_on_Moebius_contour)\r
5953      THEN USE_THEN "F1" MP_TAC\r
5954      THEN REWRITE_TAC[is_Moebius_contour]\r
5955      THEN DISCH_THEN (MP_TAC o CONJUNCT1)\r
5956      THEN REWRITE_TAC[lemma_def_inj_contour]\r
5957      THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "F3"))\r
5958      THEN REMOVE_THEN "F2" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_darts_in_contour (CONJ th1 th2))))))\r
5959      THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
5960      THEN MP_TAC (GSYM (SPECL[`SUC (k:num)`; `p:num->A`] CARD_FINITE_SERIES_EQ))\r
5961      THEN REWRITE_TAC[LT_SUC_LE]\r
5962      THEN ASM_REWRITE_TAC[]\r
5963      THEN REWRITE_TAC[EQ_SYM]);;\r
5964 \r
5965 let lemma_darts_is_Moebius_contour = prove(`!(H:(A)hypermap) (p:num->A) (k:num). is_Moebius_contour H p k /\ SUC k = CARD(dart H) ==> dart H = {p (i:num) | i <= k}`,\r
5966      REPEAT STRIP_TAC\r
5967      THEN CONV_TAC SYM_CONV\r
5968      THEN FIRST_X_ASSUM (MP_TAC o MATCH_MP  lemma_Moebius_contour_points_subset_darts)\r
5969      THEN POP_ASSUM SUBST1_TAC\r
5970      THEN MP_TAC (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_lemma))\r
5971      THEN REWRITE_TAC[IMP_IMP; CARD_SUBSET_EQ]);;\r
5972 \r
5973 let lemma_point_in_list = prove(`!(p:num->A) k:num x:A. (x IN {p (i:num) | i <= k} <=> ?j:num. j <= k /\ x = p j)`, REWRITE_TAC[IN_ELIM_THM]);;\r
5974 \r
5975 let lemma_point_not_in_list = prove(`!(p:num->A) k:num x:A. ~(x IN {p (i:num) | i <= k}) <=> !j:num. j <= k ==> ~(x = p j)`,\r
5976    REPEAT GEN_TAC\r
5977    THEN REWRITE_TAC[lemma_point_in_list]\r
5978    THEN MESON_TAC[]);;\r
5979 \r
5980 let lemma_eliminate_dart_ouside_Moebius_contour = prove(`!(H:(A)hypermap) (p:num->A) (k:num) (x:A). is_Moebius_contour H p k /\ ~(x IN {p (i:num) | i <= k}) ==> is_Moebius_contour (edge_walkup H x) p k`,\r
5981    REPEAT GEN_TAC\r
5982     THEN REWRITE_TAC[lemma_point_not_in_list]\r
5983     THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
5984     THEN label_hypermap4_TAC `H:(A)hypermap`\r
5985     THEN (LABEL_TAC "G1" (CONJUNCT1(CONJUNCT2(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma))))\r
5986     THEN (LABEL_TAC "G2" (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma)))))\r
5987     THEN (LABEL_TAC "G3" (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma))))))\r
5988     THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)`\r
5989     THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
5990     THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`\r
5991     THEN ABBREV_TAC `n = node_map (H:(A)hypermap)`\r
5992     THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
5993     THEN ABBREV_TAC `D' = dart (G:(A)hypermap)`\r
5994     THEN ABBREV_TAC `e' = edge_map (G:(A)hypermap)`\r
5995     THEN ABBREV_TAC `n' = node_map (G:(A)hypermap)`\r
5996     THEN ABBREV_TAC `f' = face_map (G:(A)hypermap)`\r
5997     THEN SUBGOAL_THEN `!i:num j:num. i <= k /\ j <= k /\ (n:A->A) ((p:num->A) i) = p j ==> (n':A->A) (p i) = p j` (LABEL_TAC "F3")\r
5998     THENL[REPEAT GEN_TAC\r
5999       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "E3") (CONJUNCTS_THEN2 (LABEL_TAC "E4") (LABEL_TAC "E5")))\r
6000       THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `i:num`)\r
6001       THEN USE_THEN "E3" (fun th -> REWRITE_TAC[th])\r
6002       THEN DISCH_THEN (LABEL_TAC "E6")\r
6003       THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `j:num`)\r
6004       THEN USE_THEN "E4" (fun th -> REWRITE_TAC[th])\r
6005       THEN DISCH_THEN (LABEL_TAC "E7")\r
6006       THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (n:A->A) (x:A))` (LABEL_TAC "E8")\r
6007       THENL[POP_ASSUM MP_TAC\r
6008               THEN REWRITE_TAC[CONTRAPOS_THM]\r
6009               THEN DISCH_THEN (MP_TAC o AP_TERM `n:A->A`)\r
6010               THEN USE_THEN "E5" SUBST1_TAC\r
6011               THEN USE_THEN "H3" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]); ALL_TAC]\r
6012       THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] node_map_walkup)))\r
6013       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
6014    THEN SUBGOAL_THEN `!i:num j:num. i <= k /\ j <= k /\ inverse (n:A->A) ((p:num->A) i) = p j ==> inverse (n':A->A) (p i) = p j` (LABEL_TAC "F4")\r
6015    THENL[USE_THEN "H3" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th])\r
6016         THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th])\r
6017         THEN POP_ASSUM (fun th -> MESON_TAC[th]); ALL_TAC]\r
6018    THEN SUBGOAL_THEN `!i:num j:num. i <= k /\ j <= k /\ (f:A->A) ((p:num->A) i) = p j ==> (f':A->A) (p i) = p j` (LABEL_TAC "F5")\r
6019    THENL[ REPEAT GEN_TAC\r
6020        THEN  DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FE3") (CONJUNCTS_THEN2 (LABEL_TAC "FE4") (LABEL_TAC "FE5")))\r
6021        THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `i:num`)\r
6022        THEN USE_THEN "FE3" (fun th -> REWRITE_TAC[th])\r
6023        THEN DISCH_THEN (LABEL_TAC "FE6")\r
6024        THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `j:num`)\r
6025        THEN USE_THEN "FE4" (fun th -> REWRITE_TAC[th])\r
6026        THEN DISCH_THEN (LABEL_TAC "FE7")\r
6027        THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (f:A->A) (x:A))` (LABEL_TAC "FE8")\r
6028        THENL[POP_ASSUM MP_TAC\r
6029                THEN REWRITE_TAC[CONTRAPOS_THM]\r
6030                THEN DISCH_THEN (MP_TAC o AP_TERM `f:A->A`)\r
6031                THEN USE_THEN "FE5" SUBST1_TAC\r
6032                THEN USE_THEN "H4" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]); ALL_TAC]\r
6033        THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] face_map_walkup)))\r
6034        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
6035      THEN SUBGOAL_THEN `!i:num. i <= k:num /\is_inj_contour (H:(A)hypermap) (p:num->A) i ==> is_inj_contour (G:(A)hypermap) (p:num->A) i` ASSUME_TAC\r
6036      THENL[INDUCT_TAC\r
6037            THENL[REWRITE_TAC[is_inj_contour]; ALL_TAC]\r
6038            THEN REWRITE_TAC[is_inj_contour]\r
6039            THEN POP_ASSUM (LABEL_TAC "J1")\r
6040            THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J2") (CONJUNCTS_THEN2 (LABEL_TAC "J3") (CONJUNCTS_THEN2 (LABEL_TAC "J4") (LABEL_TAC "J10"))))\r
6041            THEN USE_THEN "J2" (LABEL_TAC "J5" o MATCH_MP (ARITH_RULE `SUC (i:num) <= (k:num) ==> i <= k`))\r
6042            THEN REMOVE_THEN "J1" MP_TAC\r
6043            THEN USE_THEN "J5" (fun th -> REWRITE_TAC[th])\r
6044            THEN USE_THEN "J3" (fun th -> REWRITE_TAC[th])\r
6045            THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
6046            THEN USE_THEN "J10" (fun th -> REWRITE_TAC[th])\r
6047            THEN REMOVE_THEN "J4" MP_TAC\r
6048            THEN REWRITE_TAC[one_step_contour]\r
6049            THEN ASM_REWRITE_TAC[]\r
6050            THEN STRIP_TAC\r
6051            THENL[DISJ1_TAC\r
6052                 THEN USE_THEN "F5" (MP_TAC o SPECL[`i:num`; `SUC (i:num)`])\r
6053                 THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th])\r
6054                 THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6055                 THEN USE_THEN "J2" (fun th -> REWRITE_TAC[th])\r
6056                 THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6057            THEN DISJ2_TAC\r
6058            THEN USE_THEN "F4" (MP_TAC o SPECL[`i:num`; `SUC i`])\r
6059            THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th])\r
6060            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6061            THEN USE_THEN "J2" (fun th -> REWRITE_TAC[th])\r
6062            THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6063      THEN POP_ASSUM (MP_TAC o SPEC `k:num`)\r
6064    THEN REWRITE_TAC[LE_REFL]\r
6065    THEN DISCH_THEN (LABEL_TAC "F6")\r
6066    THEN REMOVE_THEN "F1" (MP_TAC)\r
6067    THEN REWRITE_TAC[is_Moebius_contour]\r
6068    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))\r
6069    THEN REMOVE_THEN "F6" MP_TAC\r
6070    THEN USE_THEN "F7" (fun th -> REWRITE_TAC[th])\r
6071    THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
6072    THEN POP_ASSUM (X_CHOOSE_THEN `i:num` (X_CHOOSE_THEN `j:num` MP_TAC))\r
6073    THEN FIND_ASSUM SUBST1_TAC `node_map (H:(A)hypermap) = n`\r
6074     THEN FIND_ASSUM SUBST1_TAC `node_map (G:(A)hypermap) = n'`\r
6075     THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 (LABEL_TAC "F10") (CONJUNCTS_THEN2 (LABEL_TAC "F11") (CONJUNCTS_THEN2 (LABEL_TAC "F12") (LABEL_TAC "F13")))))\r
6076     THEN EXISTS_TAC `i:num`\r
6077     THEN EXISTS_TAC `j:num`\r
6078     THEN USE_THEN "F9" (fun th -> REWRITE_TAC[th])\r
6079     THEN USE_THEN "F10" (fun th -> REWRITE_TAC[th])\r
6080     THEN USE_THEN "F11" (fun th -> REWRITE_TAC[th])\r
6081     THEN USE_THEN "F11" (LABEL_TAC "F15" o MATCH_MP (ARITH_RULE `j:num < k:num ==> j <= k`))\r
6082     THEN USE_THEN "F10" (fun th1 -> (USE_THEN "F15" (fun th2-> (LABEL_TAC "F16" (MATCH_MP LE_TRANS (CONJ th1 th2))))))\r
6083     THEN USE_THEN "F3" (MP_TAC o SPECL[`0`; `j:num`])\r
6084     THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th; LE_0])\r
6085     THEN USE_THEN "F15" (fun th -> REWRITE_TAC[th])\r
6086     THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
6087     THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
6088     THEN USE_THEN "F3" (MP_TAC o SPECL[`i:num`; `k:num`])\r
6089     THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th; LE_REFL])\r
6090     THEN USE_THEN "F13" (fun th -> REWRITE_TAC[th])\r
6091     THEN REWRITE_TAC[EQ_SYM]);;\r
6092 \r
6093 let shift_path = new_definition `shift_path (p:num->A) (l:num) = \i:num. p (l + i)`;;\r
6094 \r
6095 let lemma_shift_path_evaluation = prove(`!p:num->A l:num i:num. shift_path p l i = p (l+i)`, REWRITE_TAC[shift_path]);;\r
6096 \r
6097 let lemma_shift_path = prove(`!(H:(A)hypermap) (p:num->A) (n:num) (l:num). is_path H p n /\ l <= n ==> is_path H (shift_path p l) (n-l)`,\r
6098    REPEAT GEN_TAC\r
6099    THEN REWRITE_TAC[lemma_def_path]\r
6100    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
6101    THEN GEN_TAC\r
6102    THEN DISCH_THEN (LABEL_TAC "F3")\r
6103    THEN REWRITE_TAC[go_one_step]\r
6104    THEN REWRITE_TAC[lemma_shift_path_evaluation; ADD_SUC]\r
6105    THEN USE_THEN "F3" (ASSUME_TAC o MATCH_MP (ARITH_RULE `i:num < (n:num) - (l:num) ==> l +i < n`))\r
6106    THEN REWRITE_TAC[GSYM go_one_step]\r
6107    THEN USE_THEN "F1" (MP_TAC o SPEC `(l:num) + (i:num)`)\r
6108    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
6109 \r
6110   \r
6111 let lemma_shift_contour = prove(`!(H:(A)hypermap) (p:num->A) (n:num) (l:num). is_contour H p n /\ l <= n ==> is_contour H (shift_path p l) (n-l)`,\r
6112    REPEAT GEN_TAC\r
6113    THEN REWRITE_TAC[lemma_def_contour]\r
6114    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
6115    THEN GEN_TAC\r
6116    THEN DISCH_THEN (LABEL_TAC "F3")\r
6117    THEN REWRITE_TAC[one_step_contour]\r
6118    THEN REWRITE_TAC[lemma_shift_path_evaluation; ADD_SUC]\r
6119    THEN USE_THEN "F3" (ASSUME_TAC o MATCH_MP (ARITH_RULE `i:num < (n:num) - (l:num) ==> l +i < n`))\r
6120    THEN REWRITE_TAC[GSYM one_step_contour]\r
6121    THEN USE_THEN "F1" (MP_TAC o SPEC `(l:num) + (i:num)`)\r
6122    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
6123 \r
6124 let lemma_shift_inj_contour = prove(`!(H:(A)hypermap) (p:num->A) (n:num) (l:num). is_inj_contour H p n /\ l <= n \r
6125   ==> is_inj_contour H (shift_path p l) (n-l)`,\r
6126   REPEAT GEN_TAC\r
6127   THEN REWRITE_TAC[lemma_def_inj_contour]\r
6128   THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
6129   THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) (LABEL_TAC "F3"))\r
6130   THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F3" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_shift_contour (CONJ th1 th2)])))\r
6131   THEN REPEAT GEN_TAC\r
6132   THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `i:num <= (n:num) -(l:num) /\ j:num < i ==>  l + i <= n /\ l + j < l + i`))\r
6133   THEN DISCH_TAC\r
6134   THEN USE_THEN "F2" (MP_TAC o SPECL[`(l:num) + (i:num)`; `(l:num) + (j:num)`])\r
6135   THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
6136 \r
6137 let lemma_join_contours = prove(`!(H:(A)hypermap) p:num->A q:num->A n:num m:num. is_contour H p n /\ is_contour H q m /\ one_step_contour H (p n) (q 0)\r
6138    ==> is_contour H (join p q n) (n + m + 1)`, \r
6139    REPEAT GEN_TAC\r
6140    THEN REWRITE_TAC[lemma_def_contour]\r
6141    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
6142    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4")\r
6143    THEN ASM_CASES_TAC `i:num < n:num`\r
6144    THENL[POP_ASSUM (LABEL_TAC "F5")\r
6145        THEN USE_THEN "F5" (fun th -> (MP_TAC (MATCH_MP LT_IMP_LE th)) THEN ASSUME_TAC (REWRITE_RULE[GSYM LE_SUC_LT] th))\r
6146        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th])\r
6147        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th])\r
6148        THEN POP_ASSUM (fun th-> USE_THEN "F1" (fun thm -> REWRITE_TAC[MATCH_MP thm th])); ALL_TAC]\r
6149    THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[NOT_LT])\r
6150    THEN ASM_CASES_TAC `i = n:num`\r
6151    THENL[POP_ASSUM (SUBST_ALL_TAC)\r
6152        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th])\r
6153        THEN ONCE_REWRITE_TAC[ADD1] THEN REWRITE_TAC[ONE]\r
6154        THEN REWRITE_TAC[second_join_evaluation]\r
6155        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
6156    THEN POP_ASSUM (fun th-> POP_ASSUM (fun th1 -> ASSUME_TAC (REWRITE_RULE[GSYM LT_LE] (CONJ th1 (GSYM th)))))\r
6157    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS])\r
6158    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC)\r
6159    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
6160    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2(GSYM ADD)]\r
6161    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
6162    THEN REWRITE_TAC[second_join_evaluation]\r
6163    THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[GSYM ADD1; LT_ADD_LCANCEL; LT_SUC])\r
6164    THEN DISCH_THEN(fun th-> USE_THEN "F2" (fun thm -> REWRITE_TAC[MATCH_MP thm th])));; \r
6165 \r
6166 let lemma_inj_contour_via_list = prove(`!(H:(A)hypermap) p:num->A n:num. is_inj_contour H p n \r
6167     <=> is_contour H p n /\ is_inj_list p n`,\r
6168    REWRITE_TAC[lemma_inj_list; lemma_def_inj_contour]);;\r
6169 \r
6170 let lemma_join_inj_contours = prove(`!(H:(A)hypermap) p:num->A q:num->A n:num m:num. is_inj_contour H p n /\ is_inj_contour H q m /\ one_step_contour H (p n) (q 0) /\ is_disjoint p q n m   ==> is_inj_contour H (join p q n) (n + m + 1)`,\r
6171  REPEAT GEN_TAC\r
6172    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F3"))))\r
6173    THEN REWRITE_TAC[lemma_inj_contour_via_list]\r
6174    THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_inj_contour_via_list])\r
6175    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_inj_contour_via_list])\r
6176    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
6177    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_join_contours th])\r
6178    THEN POP_ASSUM MP_TAC\r
6179    THEN REPLICATE_TAC 2 (POP_ASSUM (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list]))\r
6180    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_join_inj_lists th]));;\r
6181 \r
6182 let lemma_glue_inj_contours = prove(`!(H:(A)hypermap) (p:num->A) (q:num->A) n:num m:num. is_inj_contour H p n /\ is_inj_contour H q m /\ is_glueing p q n m ==> is_inj_contour H (glue p q n) (n+m)`,\r
6183  REPEAT GEN_TAC\r
6184    THEN REWRITE_TAC[lemma_inj_contour_via_list; GSYM LT1_NZ; GSYM lemma_not_in_list]\r
6185    THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) (CONJUNCTS_THEN2(CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))(LABEL_TAC "F5")))\r
6186    THEN USE_THEN "F2" (fun th-> USE_THEN "F4" (fun th1-> USE_THEN "F5" (fun th2-> REWRITE_TAC[MATCH_MP lemma_glue_inj_lists (CONJ th (CONJ th1 th2))])))\r
6187    THEN USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT1 o REWRITE_RULE[is_glueing])\r
6188    THEN USE_THEN "F1" (fun th-> USE_THEN "F3" (fun th1-> USE_THEN "F6" (fun th2-> REWRITE_TAC[MATCH_MP lemma_glue_contours (CONJ th (CONJ th1 th2))]))));;\r
6189 \r
6190 let concatenate_two_contours = prove(`!(H:(A)hypermap) (p:num->A) (q:num->A) n:num m:num. is_inj_contour H p n /\ is_inj_contour H q m /\ p n = q 0  /\ (!j:num. 0 < j /\ j <= m ==> (!i:num. i <= n ==> ~(q j = p i))) ==> ?g:num->A. g 0 = p 0 /\ g (n+m) = q m /\ is_inj_contour H g (n+m) /\ (!i:num. i <= n ==> g i = p i) /\ (!i:num. i <= m ==> g (n+i) = q i)`,\r
6191    REPEAT GEN_TAC\r
6192    THEN REWRITE_TAC[GSYM LT1_NZ; GSYM lemma_not_in_list; GSYM is_glueing]\r
6193    THEN DISCH_THEN (LABEL_TAC "F1") THEN EXISTS_TAC `glue (p:num->A) (q:num->A) (n:num)`\r
6194    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_glue_inj_contours th])\r
6195    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[is_glueing] o CONJUNCT2 o CONJUNCT2)\r
6196    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
6197    THEN REWRITE_TAC[first_glue_evaluation] THEN REWRITE_TAC[glue; LE_0]);;\r
6198 \r
6199 let concatenate_two_disjoint_contours = prove(`!(H:(A)hypermap) (p:num->A) (q:num->A) n:num m:num. is_inj_contour H p n /\ is_inj_contour H q m /\ one_step_contour H (p n) (q 0) /\(!i:num j:num. i <= n /\ j <= m ==> ~(q j = p i)) ==> ?g:num->A. g 0 = p 0 /\ g (n+m+1) = q m /\ is_inj_contour H g (n+m+1) /\ (!i:num. i <= n ==> g i = p i) /\ (!i:num. i <= m ==> g (n+i+1) = q i)`,\r
6200    REPEAT GEN_TAC\r
6201    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MESON[] `~(A = B) <=> ~(B = A)`]\r
6202    THEN REWRITE_TAC[GSYM lemma_list_disjoint]\r
6203    THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_join_inj_contours)\r
6204    THEN EXISTS_TAC `join (p:num->A) (q:num->A) (n:num)`\r
6205    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
6206    THEN REWRITE_TAC[first_join_evaluation]\r
6207    THEN REWRITE_TAC[GSYM ADD1; second_join_evaluation]\r
6208    THEN REWRITE_TAC[join; LE_0]);;\r
6209 \r
6210 (* Lemma on reducing darts from a contour to make an injective contour *)\r
6211 \r
6212 let lemmaQZTPGJV = prove(`!(H:(A)hypermap) p:num->A n:num. is_contour H p n ==> ?q:num->A m:num. m <= n /\q 0 = p 0 /\ q m = p n /\ is_inj_contour H q m /\ (!i:num. (i < m)==>(?j:num. i <= j /\ j < n /\ q i = p j /\ q (SUC i) = p (SUC j)))`,\r
6213    REPLICATE_TAC 2 GEN_TAC\r
6214    THEN INDUCT_TAC \r
6215    THENL[STRIP_TAC THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[is_inj_contour] THEN  ARITH_TAC; ALL_TAC]\r
6216    THEN REWRITE_TAC[is_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
6217    THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl))\r
6218    THEN ASM_REWRITE_TAC[]\r
6219    THEN DISCH_THEN (X_CHOOSE_THEN `q:num->A` (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))))))\r
6220    THEN ASM_CASES_TAC `?k:num. k <= m:num /\ (q:num->A) k = p (SUC n:num)`\r
6221    THENL[POP_ASSUM (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")))\r
6222        THEN EXISTS_TAC `q:num->A`\r
6223        THEN EXISTS_TAC `k:num`\r
6224        THEN ASM_REWRITE_TAC[]  \r
6225        THEN USE_THEN "G1" (fun th1 -> (USE_THEN "F3" (fun th2 -> MP_TAC(MATCH_MP LE_TRANS (CONJ th1 th2)))))\r
6226        THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `k:num <= n:num ==> k <= SUC n`) th])\r
6227        THEN USE_THEN "F6" (MP_TAC o (SPEC `k:num`) o MATCH_MP lemma_sub_inj_contour)\r
6228        THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th])\r
6229        THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
6230        THEN REPEAT STRIP_TAC\r
6231        THEN USE_THEN "F7" (MP_TAC o SPEC `i:num`)\r
6232        THEN POP_ASSUM (fun th -> (USE_THEN "G1" (fun th1 -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ th th1)])))\r
6233        THEN MESON_TAC[LT_RIGHT_SUC]; ALL_TAC]\r
6234    THEN POP_ASSUM MP_TAC\r
6235    THEN STRIP_TAC\r
6236    THEN ABBREV_TAC `g = (\i:num. (p:num->A) (SUC n))`\r
6237    THEN SUBGOAL_THEN `is_inj_contour (H:(A)hypermap) (g:num->A) 0` ASSUME_TAC\r
6238    THENL[REWRITE_TAC[is_inj_contour]; ALL_TAC]\r
6239    THEN SUBGOAL_THEN `one_step_contour (H:(A)hypermap) ((q:num->A) (m:num)) ((g:num->A) 0)` ASSUME_TAC\r
6240    THENL[USE_THEN "F5" SUBST1_TAC\r
6241       THEN EXPAND_TAC "g"\r
6242       THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
6243    THEN SUBGOAL_THEN `!i:num j:num. i <= m:num /\ j <= 0 ==> ~((g:num->A) j = (q:num->A) i)` ASSUME_TAC\r
6244    THENL[REPEAT GEN_TAC\r
6245        THEN REWRITE_TAC[LE]\r
6246        THEN STRIP_TAC\r
6247        THEN POP_ASSUM SUBST1_TAC\r
6248        THEN EXPAND_TAC "g"\r
6249        THEN FIRST_ASSUM (MP_TAC o check (is_neg o  concl))\r
6250        THEN REWRITE_TAC[CONTRAPOS_THM]\r
6251        THEN DISCH_THEN SUBST1_TAC\r
6252        THEN EXISTS_TAC `i:num`\r
6253        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
6254    THEN USE_THEN "F6" (fun th1 -> (POP_ASSUM (fun th4 -> (POP_ASSUM (fun th3 -> (POP_ASSUM (fun th2 -> (MP_TAC (MATCH_MP concatenate_two_disjoint_contours (CONJ th1 (CONJ th2 (CONJ th3 th4))))))))))))\r
6255    THEN EXPAND_TAC "g"\r
6256    THEN REWRITE_TAC[ADD;GSYM ADD1; ADD_SUC]\r
6257    THEN DISCH_THEN (X_CHOOSE_THEN `w:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2 (LABEL_TAC "H2") (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4" o CONJUNCT1)))))\r
6258    THEN EXISTS_TAC `w:num->A`\r
6259    THEN EXISTS_TAC `SUC m`\r
6260    THEN REWRITE_TAC[LE_SUC]   \r
6261    THEN ASM_REWRITE_TAC[]\r
6262    THEN REPEAT STRIP_TAC\r
6263    THEN POP_ASSUM MP_TAC\r
6264    THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [LT_SUC_LE; LE_LT]\r
6265    THEN STRIP_TAC\r
6266    THENL[POP_ASSUM (LABEL_TAC "H5")\r
6267        THEN USE_THEN "F7" (MP_TAC o SPEC `i:num`)\r
6268        THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th])\r
6269        THEN USE_THEN "H4" (MP_TAC o SPEC `i:num`)\r
6270        THEN USE_THEN "H5" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6271        THEN DISCH_THEN  SUBST1_TAC\r
6272        THEN USE_THEN "H4" (MP_TAC o SPEC `SUC i`)\r
6273        THEN REWRITE_TAC[LE_SUC_LT]\r
6274        THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th])\r
6275        THEN DISCH_THEN  SUBST1_TAC\r
6276        THEN MESON_TAC[ARITH_RULE `j:num < n:num ==> j < SUC n`]; ALL_TAC] \r
6277    THEN EXISTS_TAC `n:num`\r
6278    THEN REWRITE_TAC[LT_PLUS]\r
6279    THEN POP_ASSUM SUBST1_TAC\r
6280    THEN USE_THEN "H2" SUBST1_TAC\r
6281    THEN USE_THEN "H4" (MP_TAC o SPEC `m:num`)\r
6282    THEN REWRITE_TAC[LE_REFL; EQ_SYM]\r
6283    THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
6284    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]));;\r
6285     \r
6286 let lemma_one_step_contour = prove(`!(H:(A)hypermap) (x:A) (y:A). one_step_contour H x y <=> y = face_map H x \/ x = node_map H y`,\r
6287    REPEAT GEN_TAC\r
6288    THEN REWRITE_TAC[one_step_contour]\r
6289    THEN REWRITE_TAC[]\r
6290    THEN MP_TAC(SPECL[`y:A`; `x:A`] (MATCH_MP PERMUTES_INVERSE_EQ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))))\r
6291    THEN MESON_TAC[]);;\r
6292 \r
6293 let lemma_only_one_orbit = prove(`!s:A->bool p:A->A x:A. FINITE s /\ p permutes s /\ orbit_map p x = s ==> set_of_orbits s p = {orbit_map p x}`,\r
6294      REPEAT GEN_TAC\r
6295      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
6296      THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect)\r
6297      THEN USE_THEN "F3" (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th])\r
6298      THEN DISCH_THEN (LABEL_TAC "F4")\r
6299      THEN MATCH_MP_TAC SUBSET_ANTISYM\r
6300      THEN STRIP_TAC\r
6301      THENL[REWRITE_TAC[SUBSET; IN_SING]\r
6302          THEN GEN_TAC\r
6303          THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
6304          THEN STRIP_TAC\r
6305          THEN POP_ASSUM SUBST1_TAC\r
6306          THEN POP_ASSUM MP_TAC\r
6307          THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
6308          THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
6309          THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6310      THEN REWRITE_TAC[set_of_orbits; SUBSET; IN_SING; IN_ELIM_THM]\r
6311      THEN GEN_TAC\r
6312      THEN DISCH_TAC\r
6313      THEN EXISTS_TAC `x:A`\r
6314      THEN ASM_REWRITE_TAC[]);;\r
6315 \r
6316 let lemma_atmost_two_orbits = prove(`!s:A->bool p:A->A x:A y:A. FINITE s /\ p permutes s /\ s SUBSET (orbit_map p x UNION orbit_map p y) \r
6317    ==> number_of_orbits s p <=2`,\r
6318    REPEAT GEN_TAC\r
6319    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
6320    THEN SUBGOAL_THEN `set_of_orbits (s:A->bool) (p:A->A) SUBSET {orbit_map p (x:A), orbit_map p (y:A)}` ASSUME_TAC\r
6321    THENL[ REWRITE_TAC[set_of_orbits; SUBSET; IN_ELIM_THM]\r
6322        THEN REPEAT STRIP_TAC\r
6323        THEN POP_ASSUM SUBST1_TAC\r
6324        THEN USE_THEN "F3" MP_TAC\r
6325        THEN REWRITE_TAC[SUBSET]\r
6326        THEN DISCH_THEN (MP_TAC o SPEC `x'':A`)\r
6327        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6328        THEN REWRITE_TAC[IN_UNION]\r
6329        THEN STRIP_TAC\r
6330        THENL[USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (POP_ASSUM  (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
6331                THEN DISCH_THEN (SUBST1_TAC o SYM)\r
6332                THEN SET_TAC[]; ALL_TAC]\r
6333        THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (POP_ASSUM  (fun th3 -> (MP_TAC (MATCH_MP lemma_orbit_identity (CONJ th1 (CONJ th2 th3)))))))))\r
6334        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
6335        THEN SET_TAC[]; ALL_TAC]\r
6336    THEN MP_TAC (ISPECL[`orbit_map (p:A->A) (x:A)`; `orbit_map (p:A->A) (y:A)`] FINITE_TWO_ELEMENTS)\r
6337    THEN POP_ASSUM (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP CARD_SUBSET (CONJ th1 th2))))))\r
6338    THEN REWRITE_TAC[number_of_orbits]\r
6339    THEN ASM_CASES_TAC `orbit_map (p:A->A) (x:A) = orbit_map p (y:A)`\r
6340    THENL[POP_ASSUM SUBST1_TAC\r
6341         THEN REWRITE_TAC[SET_RULE `{a,a} = {a}`; CARD_SINGLETON]\r
6342         THEN ARITH_TAC; ALL_TAC]\r
6343    THEN POP_ASSUM (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS)\r
6344    THEN DISCH_THEN (fun th -> REWRITE_TAC[th]));;\r
6345 \r
6346 let lemma_only_one_component = prove(`!(H:(A)hypermap) (x:A). comb_component H x = dart H ==> set_of_components H = {comb_component H x}`,\r
6347   REPEAT GEN_TAC\r
6348     THEN  DISCH_THEN (LABEL_TAC "F1")\r
6349     THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_component_reflect)\r
6350     THEN DISCH_THEN (LABEL_TAC "F2")\r
6351     THEN MATCH_MP_TAC SUBSET_ANTISYM\r
6352     THEN STRIP_TAC\r
6353     THENL[REWRITE_TAC[SUBSET; IN_SING]\r
6354        THEN GEN_TAC\r
6355        THEN REWRITE_TAC[set_of_components; set_part_components;IN_ELIM_THM]\r
6356        THEN STRIP_TAC\r
6357        THEN POP_ASSUM SUBST1_TAC\r
6358        THEN POP_ASSUM MP_TAC\r
6359        THEN USE_THEN "F1" (SUBST1_TAC o SYM)\r
6360        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_identity)\r
6361        THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6362     THEN REWRITE_TAC[set_of_components; SUBSET; IN_SING; IN_ELIM_THM; set_part_components]\r
6363     THEN GEN_TAC\r
6364     THEN DISCH_TAC\r
6365     THEN EXISTS_TAC `x:A`\r
6366     THEN REMOVE_THEN "F1" (SUBST1_TAC o SYM)\r
6367     THEN ASM_REWRITE_TAC[]);;\r
6368 \r
6369 \r
6370 (* THE MINIMUM HYPERMAP WHICH HAS A MOEBIUS CONTOUR - THE HYPERMAP OF ORDER 3 *)\r
6371 \r
6372 let lemma_minimum_Moebius_hypermap = prove(`!(H:(A)hypermap). CARD(dart H) = 3 /\ (?p:num->A k:num. is_Moebius_contour H p k) ==> ~(planar_hypermap H)`,\r
6373   GEN_TAC\r
6374    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (X_CHOOSE_THEN `p:num->A` (X_CHOOSE_THEN `k:num` (LABEL_TAC "F2"))))\r
6375    THEN USE_THEN "F2" (MP_TAC o MATCH_MP lemma_darts_on_Moebius_contour)\r
6376    THEN ASM_REWRITE_TAC[]\r
6377    THEN DISCH_THEN ASSUME_TAC\r
6378    THEN MP_TAC (ARITH_RULE `2 <= k:num /\ SUC k <= 3 ==> k = 2`)\r
6379    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6380    THEN DISCH_THEN SUBST_ALL_TAC\r
6381    THEN USE_THEN "F1" MP_TAC\r
6382    THEN REWRITE_TAC[ARITH_RULE `3 = SUC 2`]\r
6383    THEN USE_THEN "F2" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC(MATCH_MP lemma_darts_is_Moebius_contour (CONJ th1 (SYM th2)))))))\r
6384    THEN DISCH_THEN (LABEL_TAC "F3")\r
6385    THEN USE_THEN "F2" MP_TAC\r
6386    THEN REWRITE_TAC[is_Moebius_contour]\r
6387    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (X_CHOOSE_THEN `i:num` (X_CHOOSE_THEN `j:num` MP_TAC)))\r
6388    THEN USE_THEN "F3" SUBST1_TAC\r
6389    THEN DISCH_THEN (LABEL_TAC "C1")\r
6390    THEN MP_TAC (ARITH_RULE `0 < i:num /\ i <= j:num /\ j < 2 ==> (i = 1) /\ (j = 1)`)\r
6391    THEN USE_THEN "C1" (fun th -> REWRITE_TAC[th])\r
6392    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))\r
6393    THEN REMOVE_THEN "C1" MP_TAC\r
6394    THEN ASM_REWRITE_TAC[]\r
6395    THEN REWRITE_TAC[ARITH_RULE `0 < 1 /\ 1 <= 1 /\ 1 < 2`]\r
6396    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))\r
6397    THEN USE_THEN "F4" MP_TAC\r
6398    THEN REWRITE_TAC[lemma_def_inj_contour]\r
6399    THEN DISCH_THEN (LABEL_TAC "C2" o CONJUNCT2)\r
6400    THEN USE_THEN "C2" (MP_TAC o SPECL[`1`; `0`])\r
6401    THEN REWRITE_TAC[ARITH_RULE `1 <= 2 /\ 0 < 1`]\r
6402    THEN DISCH_THEN (LABEL_TAC "F9")\r
6403    THEN USE_THEN "C2" (MP_TAC o SPECL[`2`; `1`])\r
6404    THEN REWRITE_TAC[LE_REFL; ARITH_RULE `1 < 2`]\r
6405    THEN DISCH_THEN (LABEL_TAC "F10")\r
6406    THEN REMOVE_THEN "C2" (MP_TAC o SPECL[`2`; `0`])\r
6407    THEN REWRITE_TAC[LE_REFL; ARITH_RULE `0 < 2`]\r
6408    THEN DISCH_THEN (LABEL_TAC "F11")\r
6409    THEN USE_THEN "F4" MP_TAC\r
6410    THEN REWRITE_TAC[lemma_def_inj_contour]\r
6411    THEN DISCH_THEN (MP_TAC o CONJUNCT1)\r
6412    THEN REWRITE_TAC[lemma_def_contour]\r
6413    THEN DISCH_THEN (LABEL_TAC "C2")\r
6414    THEN USE_THEN "C2" (MP_TAC o SPEC `0`)\r
6415    THEN REWRITE_TAC[ARITH_RULE `0 < 2`; GSYM ONE; one_step_contour]\r
6416    THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM DISJ_SYM]\r
6417    THEN STRIP_TAC\r
6418    THENL[POP_ASSUM MP_TAC\r
6419       THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6420       THEN USE_THEN "F8" (SUBST1_TAC o SYM)\r
6421       THEN USE_THEN "F11" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC]\r
6422    THEN POP_ASSUM (LABEL_TAC "F12")\r
6423    THEN REMOVE_THEN "C2" (MP_TAC o SPEC `1`)\r
6424    THEN REWRITE_TAC[ARITH_RULE `1 < 2`; GSYM TWO; one_step_contour]\r
6425    THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM DISJ_SYM]\r
6426    THEN STRIP_TAC\r
6427    THENL[POP_ASSUM MP_TAC\r
6428        THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6429        THEN USE_THEN "F7" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ (SYM th1) th2))))))\r
6430        THEN REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))]\r
6431        THEN USE_THEN "F11" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
6432    THEN POP_ASSUM (LABEL_TAC "F14")\r
6433    THEN SUBGOAL_THEN `!x:A. x IN {(p:num->A) (i:num) | i <= 2} <=> x = p 0 \/ x = p 1 \/ x = p 2` MP_TAC\r
6434    THENL[GEN_TAC\r
6435       THEN REWRITE_TAC[SPEC `i:num` SEGMENT_TO_TWO]\r
6436       THEN REWRITE_TAC[IN_ELIM_THM]\r
6437       THEN MESON_TAC[]; ALL_TAC]\r
6438    THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
6439    THEN DISCH_THEN (LABEL_TAC "F15")\r
6440    THEN ABBREV_TAC `a = (p:num->A) 0`\r
6441    THEN ABBREV_TAC `b = (p:num->A) 1`\r
6442    THEN ABBREV_TAC `c = (p:num->A) 2`\r
6443    THEN label_hypermap_TAC `H:(A)hypermap`\r
6444    THEN ABBREV_TAC `D = dart (H:(A)hypermap)`\r
6445    THEN POP_ASSUM (LABEL_TAC "AB1")\r
6446    THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)`\r
6447    THEN POP_ASSUM (LABEL_TAC "AB2")\r
6448    THEN ABBREV_TAC `n = node_map (H:(A)hypermap)`\r
6449    THEN POP_ASSUM (LABEL_TAC "AB3")\r
6450    THEN ABBREV_TAC `f = face_map (H:(A)hypermap)`\r
6451    THEN POP_ASSUM (LABEL_TAC "AB4")\r
6452    THEN USE_THEN "F15" (MP_TAC o SPEC `c:A`)\r
6453    THEN REWRITE_TAC[]\r
6454    THEN DISCH_THEN (LABEL_TAC "F16")\r
6455    THEN SUBGOAL_THEN `(f:A->A) (c:A) = a:A` (LABEL_TAC "F17")\r
6456    THENL[USE_THEN "F16" MP_TAC\r
6457        THEN EXPAND_TAC "D"\r
6458        THEN DISCH_THEN (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
6459        THEN USE_THEN "AB4" (fun th -> REWRITE_TAC[th])\r
6460        THEN USE_THEN "AB1" (fun th -> REWRITE_TAC[th])\r
6461        THEN DISCH_TAC\r
6462        THEN USE_THEN "F15" (MP_TAC o SPEC `(f:A->A) (c:A)`)\r
6463        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6464        THEN STRIP_TAC\r
6465        THENL[POP_ASSUM (fun th1 -> (USE_THEN "F12" (fun th2 -> MP_TAC(MATCH_MP EQ_TRANS (CONJ th1 th2)))))\r
6466            THEN USE_THEN "H4"(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE th])\r
6467            THEN USE_THEN "F11" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC]\r
6468        THEN POP_ASSUM (fun th1 -> (USE_THEN "F14" (fun th2 -> MP_TAC(MATCH_MP EQ_TRANS (CONJ th1 th2)))))\r
6469        THEN USE_THEN "H4"(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE th])\r
6470        THEN USE_THEN "F10" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC]\r
6471    THEN USE_THEN "F15" (MP_TAC o SPEC `a:A`)\r
6472    THEN REWRITE_TAC[]\r
6473    THEN DISCH_THEN (LABEL_TAC "F18")\r
6474    THEN USE_THEN "F15" (MP_TAC o SPEC `b:A`)\r
6475    THEN REWRITE_TAC[]\r
6476    THEN DISCH_THEN (LABEL_TAC "F19")\r
6477    THEN SUBGOAL_THEN `orbit_map (f:A->A) (a:A) = D:A->bool` (LABEL_TAC "F20")\r
6478    THENL[MATCH_MP_TAC SUBSET_ANTISYM\r
6479        THEN USE_THEN "H4" (MP_TAC o SPEC `a:A` o MATCH_MP orbit_subset)\r
6480        THEN USE_THEN "F18" (fun th -> REWRITE_TAC[th])\r
6481        THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
6482        THEN REWRITE_TAC[SUBSET]\r
6483        THEN GEN_TAC\r
6484        THEN DISCH_TAC\r
6485        THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`)\r
6486        THEN POP_ASSUM(fun th -> REWRITE_TAC[th])\r
6487        THEN STRIP_TAC\r
6488        THENL[POP_ASSUM SUBST1_TAC\r
6489            THEN REWRITE_TAC[orbit_reflect];\r
6490          POP_ASSUM SUBST1_TAC\r
6491            THEN MP_TAC (SPECL[`f:A->A`; `1`; `a:A`] lemma_in_orbit)\r
6492            THEN REWRITE_TAC[POWER_1]\r
6493            THEN USE_THEN "F12" (SUBST1_TAC o SYM)\r
6494            THEN SIMP_TAC[];\r
6495          POP_ASSUM SUBST1_TAC\r
6496            THEN MP_TAC (SPECL[`f:A->A`; `2`; `a:A`] lemma_in_orbit)\r
6497            THEN REWRITE_TAC[POWER_2; o_THM]\r
6498            THEN USE_THEN "F12" (SUBST1_TAC o SYM)\r
6499            THEN USE_THEN "F14" (SUBST1_TAC o SYM)\r
6500            THEN SIMP_TAC[]]; ALL_TAC]\r
6501    THEN SUBGOAL_THEN `orbit_map (n:A->A) (a:A) = D:A->bool` (LABEL_TAC "F21")\r
6502    THENL[MATCH_MP_TAC SUBSET_ANTISYM\r
6503        THEN USE_THEN "H3" (MP_TAC o SPEC `a:A` o MATCH_MP orbit_subset)\r
6504        THEN USE_THEN "F18" (fun th -> REWRITE_TAC[th])\r
6505        THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
6506        THEN REWRITE_TAC[SUBSET]\r
6507        THEN GEN_TAC\r
6508        THEN DISCH_TAC\r
6509        THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`)\r
6510        THEN POP_ASSUM(fun th -> REWRITE_TAC[th])\r
6511        THEN STRIP_TAC\r
6512        THENL[POP_ASSUM SUBST1_TAC\r
6513            THEN REWRITE_TAC[orbit_reflect];\r
6514          POP_ASSUM SUBST1_TAC\r
6515            THEN MP_TAC (SPECL[`n:A->A`; `1`; `a:A`] lemma_in_orbit)\r
6516            THEN REWRITE_TAC[POWER_1]\r
6517            THEN USE_THEN "F7" (SUBST1_TAC o SYM)\r
6518            THEN SIMP_TAC[];\r
6519          POP_ASSUM SUBST1_TAC\r
6520            THEN MP_TAC (SPECL[`n:A->A`; `2`; `a:A`] lemma_in_orbit)\r
6521            THEN REWRITE_TAC[POWER_2; o_THM]\r
6522            THEN USE_THEN "F7" (SUBST1_TAC o SYM)\r
6523            THEN USE_THEN "F8" (SUBST1_TAC o SYM)\r
6524            THEN SIMP_TAC[]]; ALL_TAC]\r
6525    THEN SUBGOAL_THEN `orbit_map (e:A->A) (b:A) = D:A->bool` (LABEL_TAC "F22")\r
6526    THENL[USE_THEN "H5" (fun th -> (MP_TAC (AP_THM th `c:A`)))\r
6527        THEN REWRITE_TAC[o_THM; I_THM]\r
6528        THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th])\r
6529        THEN USE_THEN "F7" (fun th -> REWRITE_TAC[SYM th])\r
6530        THEN DISCH_THEN (LABEL_TAC "EE1")\r
6531        THEN USE_THEN "H5" (fun th -> (MP_TAC (AP_THM th `a:A`)))\r
6532        THEN REWRITE_TAC[o_THM; I_THM]\r
6533        THEN USE_THEN "F12" (fun th -> REWRITE_TAC[SYM th])\r
6534        THEN USE_THEN "F8" (fun th -> REWRITE_TAC[SYM th])\r
6535        THEN DISCH_THEN (LABEL_TAC "EE2")       \r
6536        THEN MATCH_MP_TAC SUBSET_ANTISYM\r
6537        THEN USE_THEN "H2" (MP_TAC o SPEC `b:A` o MATCH_MP orbit_subset)\r
6538        THEN USE_THEN "F19" (fun th -> REWRITE_TAC[th])\r
6539        THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
6540        THEN REWRITE_TAC[SUBSET]\r
6541        THEN GEN_TAC\r
6542        THEN DISCH_TAC\r
6543        THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`)\r
6544        THEN POP_ASSUM(fun th -> REWRITE_TAC[th])\r
6545        THEN STRIP_TAC\r
6546        THENL[POP_ASSUM SUBST1_TAC\r
6547            THEN MP_TAC (SPECL[`e:A->A`; `2`; `b:A`] lemma_in_orbit)\r
6548            THEN REWRITE_TAC[POWER_2; o_THM]\r
6549            THEN USE_THEN "EE1" SUBST1_TAC\r
6550            THEN USE_THEN "EE2" SUBST1_TAC\r
6551            THEN SIMP_TAC[];        \r
6552          POP_ASSUM SUBST1_TAC\r
6553            THEN REWRITE_TAC[orbit_reflect];\r
6554          POP_ASSUM SUBST1_TAC\r
6555            THEN MP_TAC (SPECL[`e:A->A`; `1`; `b:A`] lemma_in_orbit)\r
6556            THEN REWRITE_TAC[POWER_1]\r
6557            THEN USE_THEN "EE1" SUBST1_TAC\r
6558            THEN SIMP_TAC[]]; ALL_TAC]\r
6559    THEN SUBGOAL_THEN `comb_component (H:(A)hypermap) (a:A) = dart (H:(A)hypermap)` (LABEL_TAC "F23")\r
6560    THENL[MATCH_MP_TAC SUBSET_ANTISYM\r
6561       THEN USE_THEN "F18" MP_TAC\r
6562       THEN USE_THEN "AB1" (SUBST1_TAC o SYM)\r
6563       THEN DISCH_THEN (fun th -> (REWRITE_TAC[MATCH_MP lemma_component_subset th]))\r
6564       THEN USE_THEN "AB1" (SUBST1_TAC)\r
6565       THEN USE_THEN "F21" (SUBST1_TAC o SYM)\r
6566       THEN EXPAND_TAC "n"\r
6567       THEN REWRITE_TAC[GSYM node]\r
6568       THEN REWRITE_TAC[lemma_node_subset_component]; ALL_TAC]\r
6569    THEN  REWRITE_TAC[planar_hypermap; number_of_components]\r
6570    THEN POP_ASSUM (fun th -> (REWRITE_TAC[MATCH_MP lemma_only_one_component th]))\r
6571    THEN REWRITE_TAC[number_of_nodes; number_of_edges; number_of_faces; node_set; edge_set; face_set]\r
6572    THEN USE_THEN "AB1" SUBST1_TAC\r
6573    THEN USE_THEN "F1" SUBST1_TAC\r
6574    THEN USE_THEN "AB2" SUBST1_TAC\r
6575    THEN USE_THEN "AB3" SUBST1_TAC\r
6576    THEN USE_THEN "AB4" SUBST1_TAC\r
6577    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (USE_THEN "F20" (fun th3 -> (MP_TAC(MATCH_MP lemma_only_one_orbit (CONJ th1 (CONJ th2 th3)))))))))\r
6578    THEN DISCH_THEN SUBST1_TAC\r
6579    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (USE_THEN "F21" (fun th3 -> (MP_TAC(MATCH_MP lemma_only_one_orbit (CONJ th1 (CONJ th2 th3)))))))))\r
6580    THEN DISCH_THEN SUBST1_TAC\r
6581    THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (USE_THEN "F22" (fun th3 -> (MP_TAC(MATCH_MP lemma_only_one_orbit (CONJ th1 (CONJ th2 th3)))))))))\r
6582    THEN DISCH_THEN SUBST1_TAC\r
6583    THEN REWRITE_TAC[CARD_SINGLETON]\r
6584    THEN CONV_TAC NUM_REDUCE_CONV);;\r
6585    \r
6586 (* FACE_WALKUP *)\r
6587 \r
6588 let dart_face_walkup = prove(`!(H:(A)hypermap) (x:A). dart (face_walkup H x) = (dart H) DELETE x`,\r
6589     REPEAT STRIP_TAC\r
6590     THEN REWRITE_TAC[face_walkup]\r
6591     THEN REWRITE_TAC[GSYM shift_lemma]\r
6592     THEN REWRITE_TAC[lemma_edge_walkup]\r
6593     THEN REWRITE_TAC[GSYM double_shift_lemma]);;\r
6594 \r
6595 let lemma_card_face_walkup_dart = prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> CARD(dart H) = CARD(dart(face_walkup H x)) + 1`,\r
6596      REPEAT STRIP_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] dart_face_walkup)\r
6597      THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE\r
6598      THEN ASM_REWRITE_TAC[hypermap_lemma]);;\r
6599 \r
6600 let face_map_face_walkup = prove(`!(H:(A)hypermap) (x:A) (y:A). face_map (face_walkup H x) x = x\r
6601 /\ (~(edge_map H x = x) /\ ~(face_map H x = x) ==> face_map (face_walkup H x) (edge_map H x) = face_map H x)\r
6602 /\ (~(inverse (node_map H) x = x) /\ ~(inverse (face_map H) x = x) ==> face_map (face_walkup H x) (inverse (face_map H) x) = inverse (node_map H) x)\r
6603 /\ (~(y = x) /\ ~(y = inverse (face_map H) x) /\ ~(y = edge_map H x) ==> face_map (face_walkup H x) y = face_map H y)`,\r
6604    REPEAT GEN_TAC\r
6605    THEN REWRITE_TAC[face_walkup]\r
6606    THEN ONCE_REWRITE_TAC[double_shift_lemma]\r
6607    THEN REWRITE_TAC[lemma_shift_cycle]\r
6608    THEN ABBREV_TAC `G = shift (shift (H:(A)hypermap))`\r
6609    THEN REWRITE_TAC[edge_map_walkup]);;\r
6610 \r
6611 let node_map_face_walkup = prove(`!(H:(A)hypermap) (x:A) (y:A). node_map (face_walkup H x) x = x /\ node_map (face_walkup H x) (inverse (node_map H) x) = node_map H x /\ (~(y = x) /\ ~(y = inverse (node_map H) x) ==> node_map (face_walkup H x) y = node_map H y)`,\r
6612    REPEAT GEN_TAC\r
6613    THEN REWRITE_TAC[face_walkup]\r
6614    THEN ONCE_REWRITE_TAC[double_shift_lemma]\r
6615    THEN REWRITE_TAC[lemma_shift_cycle]\r
6616    THEN ABBREV_TAC `G = shift (shift (H:(A)hypermap))`\r
6617    THEN REWRITE_TAC[face_map_walkup]);;\r
6618 \r
6619 (* NODE_WALKUP *)\r
6620 \r
6621 let dart_node_walkup = prove(`!(H:(A)hypermap) (x:A). dart (node_walkup H x) = (dart H) DELETE x`,\r
6622     REPEAT STRIP_TAC\r
6623     THEN REWRITE_TAC[node_walkup]\r
6624     THEN REWRITE_TAC[GSYM double_shift_lemma]\r
6625     THEN REWRITE_TAC[lemma_edge_walkup]\r
6626     THEN REWRITE_TAC[GSYM shift_lemma]);;\r
6627 \r
6628 let lemma_card_node_walkup_dart = prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> CARD(dart H) = CARD(dart(node_walkup H x)) + 1`,\r
6629      REPEAT STRIP_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] dart_node_walkup)\r
6630      THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE\r
6631      THEN ASM_REWRITE_TAC[hypermap_lemma]);;\r
6632 \r
6633 \r
6634 let node_map_node_walkup = prove(`!(H:(A)hypermap) (x:A) (y:A). node_map (node_walkup H x) x = x /\ (~(face_map H x = x) /\ ~(node_map H x = x) ==> node_map (node_walkup H x) (face_map H x) = node_map H x) /\ (~(inverse (edge_map H) x = x) /\ ~(inverse (node_map H) x = x) ==> node_map (node_walkup H x) (inverse (node_map H) x) = inverse (edge_map H) x) /\ (~(y = x) /\ ~(y = inverse (node_map H) x) /\ ~(y = face_map H x) ==> node_map (node_walkup H x) y = node_map H y)`,\r
6635    REPEAT GEN_TAC\r
6636    THEN REWRITE_TAC[node_walkup]\r
6637    THEN ONCE_REWRITE_TAC[shift_lemma]\r
6638    THEN REWRITE_TAC[lemma_shift_cycle]\r
6639    THEN ABBREV_TAC `G = shift (H:(A)hypermap)`\r
6640    THEN REWRITE_TAC[edge_map_walkup]);;\r
6641 \r
6642 let face_map_node_walkup = prove(`!(H:(A)hypermap) (x:A) (y:A). face_map (node_walkup H x) x = x /\ face_map (node_walkup H x) (inverse (face_map H) x) = face_map H x /\ (~(y = x) /\ ~(y = inverse (face_map H) x) ==> face_map (node_walkup H x) y = face_map H y)`,\r
6643    REPEAT GEN_TAC\r
6644    THEN REWRITE_TAC[node_walkup]\r
6645    THEN ONCE_REWRITE_TAC[shift_lemma]\r
6646    THEN REWRITE_TAC[lemma_shift_cycle]\r
6647    THEN ABBREV_TAC `G = shift (H:(A)hypermap)`\r
6648    THEN REWRITE_TAC[node_map_walkup]);;\r
6649 \r
6650 let lemma_face_walkup_second_segment_contour = prove(`!(H:(A)hypermap) (p:num->A) (k:num) (m:num). (is_inj_contour H p k /\ m < k /\ node_map H (p (m+1)) = p m) ==> is_inj_contour (face_walkup H (p m)) (shift_path p (m+1)) (k-(m+1))`,\r
6651    REPEAT GEN_TAC\r
6652    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
6653    THEN USE_THEN "F1" MP_TAC\r
6654    THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour]\r
6655    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J1") (LABEL_TAC "J2"))\r
6656    THEN STRIP_TAC\r
6657    THENL[GEN_TAC\r
6658       THEN REWRITE_TAC[lemma_sub_two_numbers]\r
6659       THEN DISCH_THEN (LABEL_TAC "J3")\r
6660       THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
6661       THEN REWRITE_TAC[ARITH_RULE `((m:num) + 1) + (i:num) = m + i + 1 /\ (m+1) + SUC i = SUC (m + i + 1)`]\r
6662       THEN REMOVE_THEN "J3" (fun th -> (LABEL_TAC "J4") (MATCH_MP (ARITH_RULE `i:num < (k:num) - ((m:num) + 1) ==> m + i + 1 < k`) th))\r
6663       THEN LABEL_TAC "J5" (ARITH_RULE `m:num < m + (i:num) + 1`)\r
6664       THEN ABBREV_TAC `id = (m:num) + (i:num) + 1`\r
6665       THEN USE_THEN "J1" (MP_TAC o SPEC `id:num`)\r
6666       THEN USE_THEN "J4" (fun th -> REWRITE_TAC[th])\r
6667       THEN REWRITE_TAC[one_step_contour]\r
6668       THEN STRIP_TAC\r
6669       THENL[DISJ1_TAC\r
6670          THEN POP_ASSUM (LABEL_TAC "J6")\r
6671          THEN USE_THEN "J2" (MP_TAC o SPECL[`id:num`; `m:num`])\r
6672          THEN USE_THEN "J5" (fun th -> REWRITE_TAC[th])\r
6673          THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6674          THEN DISCH_THEN (LABEL_TAC "J7" o GSYM)\r
6675          THEN SUBGOAL_THEN `~((p:num->A) (id:num) = inverse (face_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "J8")\r
6676          THENL[POP_ASSUM MP_TAC\r
6677              THEN REWRITE_TAC[CONTRAPOS_THM]\r
6678              THEN REWRITE_TAC[GSYM face_map_inverse_representation]\r
6679              THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6680              THEN USE_THEN "J2" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`])\r
6681              THEN USE_THEN "J5" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < id:num ==> m < SUC id`) th])\r
6682              THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th])\r
6683              THEN MESON_TAC[]; ALL_TAC]\r
6684          THEN SUBGOAL_THEN `~((p:num->A) (id:num) = edge_map (H:(A)hypermap) ((p:num->A) (m:num)))` (LABEL_TAC "J9")\r
6685          THENL[USE_THEN "J7" MP_TAC\r
6686              THEN REWRITE_TAC[CONTRAPOS_THM]\r
6687              THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
6688              THEN DISCH_THEN (MP_TAC o AP_TERM `face_map (H:(A)hypermap)`)\r
6689              THEN REPLICATE_TAC 2 (GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM])\r
6690              THEN REWRITE_TAC[GSYM o_ASSOC]\r
6691              THEN REWRITE_TAC[hypermap_cyclic; I_THM]\r
6692              THEN USE_THEN "J6" (SUBST1_TAC o SYM)\r
6693              THEN USE_THEN "J2" (MP_TAC o SPECL[`SUC (id:num)`; `(m:num) + 1`])\r
6694              THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th])\r
6695              THEN USE_THEN "J5" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < id:num ==> m + 1 < SUC id`) th])\r
6696              THEN MESON_TAC[]; ALL_TAC]\r
6697          THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (id:num)`] face_map_face_walkup))))\r
6698          THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
6699          THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6700          THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6701       THEN DISJ2_TAC\r
6702       THEN POP_ASSUM MP_TAC\r
6703       THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6704       THEN DISCH_THEN (LABEL_TAC "J10")\r
6705       THEN USE_THEN "J2" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`])\r
6706       THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th])\r
6707       THEN USE_THEN "J5" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < id:num ==> m < SUC id`) th])\r
6708       THEN DISCH_THEN (LABEL_TAC "J11" o GSYM)\r
6709       THEN SUBGOAL_THEN `~((p:num->A) (SUC (id:num)) = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "J12")\r
6710       THENL[POP_ASSUM MP_TAC\r
6711          THEN REWRITE_TAC[CONTRAPOS_THM]\r
6712          THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6713          THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6714          THEN USE_THEN "J2" (MP_TAC o SPECL[`id:num`; `m:num`])\r
6715          THEN USE_THEN "J5" (fun th -> REWRITE_TAC[th])\r
6716          THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6717          THEN MESON_TAC[]; ALL_TAC]\r
6718       THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (SUC (id:num))`] node_map_face_walkup)))\r
6719       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6720       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6721       THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6722       THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6723    THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
6724    THEN REPEAT GEN_TAC\r
6725    THEN REWRITE_TAC[lemma_sub_two_numbers]\r
6726    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K1") (LABEL_TAC "K2"))\r
6727    THEN USE_THEN "J2" (MP_TAC o SPECL[`((m:num) + 1) + (i:num)`; `((m:num)+1)+(j:num)`])\r
6728    THEN USE_THEN "K1" (fun th -> (USE_THEN "F2" (fun th1->  REWRITE_TAC[MP (ARITH_RULE `i:num <= (k:num) - ((m:num) + 1) /\ m < k ==> (m + 1) + i <= k`) (CONJ th th1)])))\r
6729    THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MP (ARITH_RULE `j:num < i:num ==> ((m:num) + 1) + j < (m + 1) + i`) th])\r
6730   );;\r
6731 \r
6732 \r
6733 let lemma_face_walkup_eliminate_dart_on_Moebius_contour = prove(`!(H:(A)hypermap) (p:num->A) (k:num) (m:num). (is_inj_contour H p k /\ 0 < m /\ m < k /\ node_map H (p (m+1)) = p m) ==> is_inj_contour (face_walkup H (p m)) p (m-1) /\ is_inj_contour (face_walkup H (p m)) (shift_path p (m+1)) (k-m-1)\r
6734 /\ one_step_contour (face_walkup H (p m)) (p (m-1)) (p (m+1))`,\r
6735    REPEAT GEN_TAC\r
6736    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
6737    THEN STRIP_TAC\r
6738    THENL[USE_THEN "F1" (MP_TAC o SPEC `(m:num)-1` o MATCH_MP lemma_sub_inj_contour)\r
6739        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> m - 1 <= k`) th])\r
6740        THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour]\r
6741        THEN SIMP_TAC[]\r
6742        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))\r
6743        THEN STRIP_TAC\r
6744        THEN DISCH_THEN (LABEL_TAC "G3")\r
6745        THEN USE_THEN "G1" (MP_TAC o SPEC `i:num`)\r
6746        THEN USE_THEN "G3" (fun th -> REWRITE_TAC[th])\r
6747        THEN USE_THEN "F1" MP_TAC\r
6748        THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour]\r
6749        THEN DISCH_THEN (LABEL_TAC "G4" o CONJUNCT2)\r
6750        THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `i:num`])\r
6751        THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) - 1 ==> i < m`) th])\r
6752        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6753        THEN DISCH_THEN (LABEL_TAC "G5")\r
6754        THEN REWRITE_TAC[one_step_contour]\r
6755        THEN STRIP_TAC\r
6756        THENL[DISJ1_TAC\r
6757            THEN POP_ASSUM (LABEL_TAC "G6")\r
6758            THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (face_map H) (p (m:num)))` (LABEL_TAC "G7")\r
6759            THENL[USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `SUC (i:num)`])\r
6760                THEN USE_THEN "G3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) - 1 ==> SUC i < m`) th]))\r
6761                THEN USE_THEN "F3" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th]))\r
6762                THEN REWRITE_TAC[CONTRAPOS_THM]\r
6763                THEN REWRITE_TAC[GSYM face_map_inverse_representation]\r
6764                THEN USE_THEN "G6" (SUBST1_TAC o SYM)\r
6765                THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6766            THEN SUBGOAL_THEN `~((p:num->A) (i:num) = (edge_map H) (p (m:num)))` (LABEL_TAC "G8")\r
6767            THENL[POP_ASSUM MP_TAC\r
6768                THEN REWRITE_TAC[CONTRAPOS_THM]\r
6769                THEN DISCH_TAC\r
6770                THEN REMOVE_THEN "G6" MP_TAC\r
6771                THEN POP_ASSUM SUBST1_TAC\r
6772                THEN DISCH_THEN (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`)\r
6773                THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM]\r
6774                THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM]\r
6775                THEN REWRITE_TAC[GSYM o_ASSOC]\r
6776                THEN REWRITE_TAC[hypermap_cyclic; I_THM]\r
6777                THEN USE_THEN "F4" (SUBST1_TAC o SYM)\r
6778                THEN REWRITE_TAC[node_map_injective; ADD1]\r
6779                THEN DISCH_TAC\r
6780                THEN USE_THEN "G4" (MP_TAC o SPECL[`(m:num) + 1`; `(i:num) + 1`])\r
6781                THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < k:num ==> m+ 1 <= k:num`) th])\r
6782                THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> i+ 1 < m+1`) th])\r
6783                THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
6784            THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (i:num)`] face_map_face_walkup))))\r
6785            THEN ASM_REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6786        THEN DISJ2_TAC\r
6787        THEN POP_ASSUM MP_TAC\r
6788        THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6789        THEN DISCH_THEN (LABEL_TAC "G10")\r
6790        THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `SUC (i:num)`])\r
6791        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6792        THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> SUC i < m`) th])\r
6793        THEN DISCH_THEN (LABEL_TAC"G11")\r
6794        THEN SUBGOAL_THEN `~((p:num->A) (SUC (i:num)) = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "G12")\r
6795        THENL[POP_ASSUM MP_TAC\r
6796            THEN REWRITE_TAC[CONTRAPOS_THM]\r
6797            THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6798            THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6799            THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC]\r
6800        THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (SUC (i:num))`] node_map_face_walkup)))\r
6801        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6802        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6803        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6804        THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6805    THEN REWRITE_TAC[lemma_sub_two_numbers]\r
6806    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F3" (fun th2 -> (USE_THEN "F4" (fun th3 -> (REWRITE_TAC[MATCH_MP lemma_face_walkup_second_segment_contour (CONJ th1 (CONJ th2 th3))]))))))\r
6807    THEN USE_THEN "F1" MP_TAC\r
6808    THEN REWRITE_TAC[lemma_def_inj_contour]\r
6809    THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "FF"))\r
6810    THEN REWRITE_TAC[lemma_def_contour]\r
6811    THEN DISCH_THEN (MP_TAC o SPEC `(m:num) - 1`)\r
6812    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m - 1 < k`) th])\r
6813    THEN REWRITE_TAC[lemma_one_step_contour]\r
6814    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> SUC (m-1) = m`) th])\r
6815    THEN STRIP_TAC\r
6816    THENL[DISJ1_TAC\r
6817        THEN POP_ASSUM MP_TAC\r
6818        THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [face_map_inverse_representation]\r
6819        THEN DISCH_THEN (LABEL_TAC "L1")\r
6820        THEN USE_THEN "F4" (MP_TAC o SYM)\r
6821        THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [node_map_inverse_representation]\r
6822        THEN DISCH_THEN (LABEL_TAC "L2")\r
6823        THEN USE_THEN "FF" (MP_TAC o SPECL[`m:num`; `(m:num)-1`])\r
6824        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6825        THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> m - 1 < m`) th])\r
6826        THEN USE_THEN "L1" SUBST1_TAC\r
6827        THEN DISCH_THEN (LABEL_TAC "L3")\r
6828        THEN USE_THEN "FF" (MP_TAC o GSYM o  SPECL[`(m:num)+1`; `(m:num)`])\r
6829        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m + 1 <= k`) th])\r
6830        THEN REWRITE_TAC[ARITH_RULE ` m:num < m + 1`]\r
6831        THEN USE_THEN "L2" SUBST1_TAC\r
6832        THEN DISCH_THEN (LABEL_TAC "L4")\r
6833        THEN MP_TAC (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (m:num)`] face_map_face_walkup))))\r
6834        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6835        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6836        THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6837    THEN DISJ2_TAC\r
6838    THEN POP_ASSUM SUBST1_TAC\r
6839    THEN USE_THEN "F4" (MP_TAC o SYM)\r
6840    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [node_map_inverse_representation]\r
6841    THEN DISCH_THEN SUBST1_TAC\r
6842    THEN REWRITE_TAC[node_map_face_walkup]\r
6843 );;\r
6844 \r
6845 (* FORMULATE THIS LEMMA FOR f STEP *)\r
6846 \r
6847 let lemma_node_walkup_second_segment_contour = prove(`!(H:(A)hypermap) (p:num->A) (k:num) (m:num). is_inj_contour H p k /\ m < k /\ p (m+1) = face_map H (p m) ==> is_inj_contour (node_walkup H (p m)) (shift_path p (m+1)) (k-(m+1))`,\r
6848    REPEAT GEN_TAC\r
6849    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
6850    THEN REWRITE_TAC[lemma_sub_two_numbers]\r
6851    THEN ASM_CASES_TAC `k:num = ((m:num) + 1)`\r
6852    THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[SUB_REFL; is_inj_contour]; ALL_TAC]\r
6853   THEN POP_ASSUM (fun th -> (USE_THEN "F2"(fun th2 -> (LABEL_TAC "F4" (MATCH_MP (ARITH_RULE `m:num < k:num /\ ~(k = m+1) ==> m + 1 < k`) (CONJ th2 th))))))\r
6854    THEN USE_THEN "F1" MP_TAC\r
6855    THEN REWRITE_TAC[lemma_def_inj_contour]\r
6856    THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "F5"))\r
6857    THEN REWRITE_TAC[lemma_def_contour]\r
6858    THEN DISCH_THEN (LABEL_TAC "F6")\r
6859    THEN STRIP_TAC\r
6860    THENL[GEN_TAC\r
6861        THEN DISCH_THEN (LABEL_TAC "F7")\r
6862        THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
6863        THEN USE_THEN "F6" (MP_TAC o SPEC `((m:num)+1) + (i:num)`)\r
6864        THEN USE_THEN "F7" (fun th1 -> (USE_THEN "F4" (fun th2 -> (LABEL_TAC "F8" (MATCH_MP (ARITH_RULE `i:num < (k:num) - ((m:num) + 1) /\ m + 1 < k ==> (m+1)+ i < k`) (CONJ th1 th2))))))\r
6865        THEN ABBREV_TAC `id = ((m:num) + 1) + (i:num)`\r
6866        THEN POP_ASSUM (LABEL_TAC "F9")\r
6867        THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th])\r
6868        THEN REWRITE_TAC[ADD_SUC]\r
6869        THEN USE_THEN "F9" (SUBST1_TAC)\r
6870        THEN REWRITE_TAC[lemma_one_step_contour]\r
6871        THEN CONV_TAC (ONCE_REWRITE_CONV[DISJ_SYM])\r
6872        THEN STRIP_TAC\r
6873        THENL[DISJ1_TAC\r
6874           THEN POP_ASSUM (LABEL_TAC "F10")\r
6875           THEN USE_THEN "F5" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`])\r
6876           THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th])\r
6877           THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m < SUC id`) th])\r
6878           THEN DISCH_THEN (LABEL_TAC "F11" o GSYM)\r
6879           THEN SUBGOAL_THEN `~((p:num->A) (SUC (id:num)) = face_map (H:(A)hypermap) ((p:num->A) (m:num)))` (LABEL_TAC "F12")\r
6880           THENL[USE_THEN "F11" MP_TAC\r
6881               THEN REWRITE_TAC[CONTRAPOS_THM]\r
6882               THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
6883               THEN USE_THEN "F5" (MP_TAC o SPECL[`SUC (id:num)`; `(m:num) + 1`])\r
6884               THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th])\r
6885               THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m + 1 < SUC id`) th])\r
6886               THEN MESON_TAC[]; ALL_TAC]\r
6887           THEN SUBGOAL_THEN `~((p:num->A) (SUC (id:num)) = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "F14")\r
6888           THENL[USE_THEN "F12" MP_TAC\r
6889               THEN REWRITE_TAC[CONTRAPOS_THM]\r
6890               THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6891               THEN USE_THEN "F10" (SUBST1_TAC o SYM)\r
6892               THEN USE_THEN "F5" (MP_TAC o SPECL[`(id:num)`; `(m:num)`])\r
6893               THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6894               THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m < id`) th])\r
6895               THEN MESON_TAC[]; ALL_TAC]\r
6896           THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (SUC (id:num))`] node_map_node_walkup))))\r
6897           THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
6898           THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6899           THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6900        THEN DISJ2_TAC\r
6901        THEN POP_ASSUM (LABEL_TAC "F10")\r
6902        THEN USE_THEN "F5" (MP_TAC o SPECL[`id:num`; `m:num`])\r
6903        THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6904        THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m < id`) th])\r
6905        THEN DISCH_TAC\r
6906        THEN SUBGOAL_THEN  `~((p:num->A) (id:num) = inverse (face_map (H:(A)hypermap)) ((p:num->A) (m:num)))` ASSUME_TAC\r
6907        THENL[POP_ASSUM MP_TAC\r
6908            THEN REWRITE_TAC[CONTRAPOS_THM]\r
6909            THEN REWRITE_TAC[GSYM face_map_inverse_representation]\r
6910            THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6911            THEN USE_THEN "F5" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`])\r
6912            THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th])\r
6913            THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m  < SUC  id`) th])\r
6914            THEN MESON_TAC[]; ALL_TAC]\r
6915        THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (id:num)`] face_map_node_walkup)))\r
6916        THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
6917        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6918        THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6919    THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
6920    THEN REPEAT GEN_TAC\r
6921    THEN REWRITE_TAC[lemma_sub_two_numbers]\r
6922    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K1") (LABEL_TAC "K2"))\r
6923    THEN USE_THEN "F5" (MP_TAC o SPECL[`((m:num) + 1) + (i:num)`; `((m:num)+1)+(j:num)`])\r
6924    THEN USE_THEN "K1" (fun th -> (USE_THEN "F2" (fun th1->  REWRITE_TAC[MP (ARITH_RULE `i:num <= (k:num) - ((m:num) + 1) /\ m < k ==> (m + 1) + i <= k`) (CONJ th th1)])))\r
6925    THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MP (ARITH_RULE `j:num < i:num ==> ((m:num) + 1) + j < (m + 1) + i`) th])\r
6926   );;\r
6927 \r
6928 let lemma_node_walkup_eliminate_dart_on_Moebius_contour = prove(`!(H:(A)hypermap) (p:num->A) (k:num) (m:num). is_inj_contour H p k /\ 0 < m /\ m < k /\ p (m+1) = face_map H (p m) ==> is_inj_contour (node_walkup H (p m)) p (m-1) /\ is_inj_contour (node_walkup H (p m)) (shift_path p (m+1)) (k-m-1)\r
6929 /\ one_step_contour (node_walkup H (p m)) (p (m-1)) (p (m+1))`,\r
6930    REPEAT GEN_TAC\r
6931    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
6932    THEN STRIP_TAC\r
6933    THENL[USE_THEN "F1" (MP_TAC o SPEC `(m:num)-1` o MATCH_MP lemma_sub_inj_contour)\r
6934        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> m - 1 <= k`) th])\r
6935        THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour]\r
6936        THEN SIMP_TAC[]\r
6937        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))\r
6938        THEN STRIP_TAC\r
6939        THEN DISCH_THEN (LABEL_TAC "G3")\r
6940        THEN USE_THEN "G1" (MP_TAC o SPEC `i:num`)\r
6941        THEN USE_THEN "G3" (fun th -> REWRITE_TAC[th])\r
6942        THEN USE_THEN "F1" MP_TAC\r
6943        THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour]\r
6944        THEN DISCH_THEN (LABEL_TAC "G4" o CONJUNCT2)\r
6945        THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `SUC (i:num)`])\r
6946        THEN USE_THEN "G3" (fun th -> (USE_THEN "F2"(fun th2 ->  REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) - 1 /\ 0 < m ==> SUC i < m`) (CONJ th th2)])))\r
6947        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6948        THEN DISCH_THEN (LABEL_TAC "G5")\r
6949        THEN REWRITE_TAC[one_step_contour]\r
6950        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [DISJ_SYM]\r
6951        THEN STRIP_TAC\r
6952        THENL[DISJ2_TAC\r
6953            THEN POP_ASSUM (LABEL_TAC "G6")\r
6954            THEN SUBGOAL_THEN `~((p:num->A) (SUC (i:num)) = inverse (node_map H) (p (m:num)))` (LABEL_TAC "G7")\r
6955            THENL[USE_THEN "G5" MP_TAC\r
6956                THEN REWRITE_TAC[CONTRAPOS_THM]\r
6957                THEN POP_ASSUM MP_TAC\r
6958                THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
6959                THEN DISCH_THEN (SUBST1_TAC o SYM)\r
6960                THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `i:num`])\r
6961                THEN USE_THEN "G3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) - 1 ==> i < m`) th]))\r
6962                THEN USE_THEN "F3" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th]))\r
6963                THEN MESON_TAC[]; ALL_TAC]\r
6964            THEN SUBGOAL_THEN `~((p:num->A) (SUC(i:num)) = (face_map H) (p (m:num)))` (LABEL_TAC "G8")\r
6965            THENL[POP_ASSUM MP_TAC\r
6966                THEN REWRITE_TAC[CONTRAPOS_THM]\r
6967                THEN USE_THEN "F4" (SUBST1_TAC o SYM)\r
6968                THEN DISCH_TAC\r
6969                THEN USE_THEN "G4" (MP_TAC o SPECL[`(m:num) + 1`; `SUC (i:num)`])\r
6970                THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < k:num ==> m+ 1 <= k:num`) th])\r
6971                THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> SUC i < m+1`) th])\r
6972                THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
6973            THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (SUC (i:num))`] node_map_node_walkup))))\r
6974            THEN REPLICATE_TAC 2(POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
6975            THEN USE_THEN "G5" (fun th -> REWRITE_TAC[th])\r
6976            THEN POP_ASSUM MP_TAC\r
6977            THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [GSYM node_map_inverse_representation]\r
6978            THEN ASM_REWRITE_TAC[EQ_SYM]\r
6979            THEN DISCH_THEN (SUBST1_TAC o SYM)\r
6980            THEN REWRITE_TAC[GSYM node_map_inverse_representation; EQ_SYM]; ALL_TAC]\r
6981        THEN DISJ1_TAC\r
6982        THEN POP_ASSUM (LABEL_TAC "G10")\r
6983        THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `(i:num)`])\r
6984        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
6985        THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> i < m`) th])\r
6986        THEN DISCH_THEN (LABEL_TAC"G11")\r
6987        THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (face_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "G12")\r
6988        THENL[POP_ASSUM MP_TAC\r
6989            THEN REWRITE_TAC[CONTRAPOS_THM]\r
6990            THEN REWRITE_TAC[GSYM face_map_inverse_representation]\r
6991            THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6992            THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC]\r
6993        THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (i:num)`] face_map_node_walkup)))\r
6994        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6995        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
6996        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
6997        THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
6998    THEN REWRITE_TAC[lemma_sub_two_numbers]\r
6999    THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F3" (fun th2 -> (USE_THEN "F4" (fun th3 -> (REWRITE_TAC[MATCH_MP lemma_node_walkup_second_segment_contour (CONJ th1 (CONJ th2 th3))]))))))\r
7000    THEN USE_THEN "F1" MP_TAC\r
7001    THEN REWRITE_TAC[lemma_def_inj_contour]\r
7002    THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "FF"))\r
7003    THEN REWRITE_TAC[lemma_def_contour]\r
7004    THEN DISCH_THEN (MP_TAC o SPEC `(m:num) - 1`)\r
7005    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m - 1 < k`) th])\r
7006    THEN REWRITE_TAC[lemma_one_step_contour]\r
7007    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> SUC (m-1) = m`) th])\r
7008    THEN CONV_TAC (ONCE_REWRITE_CONV[DISJ_SYM])\r
7009    THEN STRIP_TAC\r
7010    THENL[DISJ1_TAC\r
7011        THEN POP_ASSUM MP_TAC\r
7012        THEN DISCH_THEN (LABEL_TAC "L1")\r
7013        THEN USE_THEN "FF" (MP_TAC o SPECL[`m:num`; `(m:num)-1`])\r
7014        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
7015        THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> m - 1 < m`) th])\r
7016        THEN USE_THEN "L1" SUBST1_TAC\r
7017        THEN DISCH_THEN (LABEL_TAC "L3")\r
7018        THEN USE_THEN "FF" (MP_TAC o GSYM o  SPECL[`(m:num)+1`; `(m:num)`])\r
7019        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m + 1 <= k`) th])\r
7020        THEN REWRITE_TAC[ARITH_RULE ` m:num < m + 1`]\r
7021        THEN USE_THEN "F4" SUBST1_TAC\r
7022        THEN DISCH_THEN (LABEL_TAC "L4")\r
7023        THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (m:num)`] node_map_node_walkup)))\r
7024        THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7025        THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7026    THEN DISJ2_TAC\r
7027    THEN POP_ASSUM  MP_TAC\r
7028    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [face_map_inverse_representation]\r
7029    THEN DISCH_THEN SUBST1_TAC\r
7030    THEN USE_THEN "F4" SUBST1_TAC\r
7031    THEN REWRITE_TAC[face_map_node_walkup]\r
7032   );;\r
7033 \r
7034 (* THE COMBINATORIAL JORDAN CURVE THEOREM *)\r
7035 \r
7036 let lemmaLIPYTUI = prove(`!(H:(A)hypermap). planar_hypermap H ==> ~(?(p:num->A) k:num. is_Moebius_contour H p k)`,\r
7037    GEN_TAC\r
7038    THEN ABBREV_TAC `n = CARD (dart (H:(A)hypermap))`\r
7039    THEN POP_ASSUM MP_TAC\r
7040    THEN REWRITE_TAC[IMP_IMP]\r
7041    THEN SPEC_TAC (`H:(A)hypermap`, `H:(A)hypermap`)\r
7042    THEN SPEC_TAC (`n:num`, `n:num`)\r
7043    THEN INDUCT_TAC\r
7044    THENL[REPEAT STRIP_TAC\r
7045       THEN POP_ASSUM (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_darts_on_Moebius_contour)\r
7046       THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `SUC (k:num) <= l:num ==> ~(l = 0)`))\r
7047       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
7048    THEN POP_ASSUM (LABEL_TAC "FI")   \r
7049    THEN GEN_TAC\r
7050      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
7051      THEN STRIP_TAC\r
7052      THEN POP_ASSUM (LABEL_TAC "F3")\r
7053      THEN USE_THEN "F3" (MP_TAC o MATCH_MP lemma_Moebius_contour_points_subset_darts)\r
7054      THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))\r
7055      THEN LABEL_TAC "F6" (CONJUNCT1(SPEC `H:(A)hypermap` hypermap_lemma))\r
7056    THEN ASM_CASES_TAC `~({(p:num->A) (i:num) | i <= (k:num)} = dart (H:(A)hypermap))`\r
7057    THENL[POP_ASSUM MP_TAC\r
7058        THEN USE_THEN "F4" MP_TAC\r
7059        THEN REWRITE_TAC[IMP_IMP; GSYM PSUBSET]\r
7060        THEN REWRITE_TAC[PSUBSET_MEMBER]\r
7061        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th])\r
7062        THEN STRIP_TAC\r
7063        THEN POP_ASSUM (fun th1 -> (USE_THEN "F3" (fun th2 -> (MP_TAC (MATCH_MP lemma_eliminate_dart_ouside_Moebius_contour (CONJ th2 th1))))))\r
7064        THEN FIRST_ASSUM  (MP_TAC o (SPEC `edge_walkup (H:(A)hypermap) (y:A)`))\r
7065        THEN REWRITE_TAC[]\r
7066        THEN POP_ASSUM (fun th -> (MP_TAC (MATCH_MP lemma_card_walkup_dart th) THEN ASSUME_TAC th))\r
7067        THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th; GSYM ADD1; EQ_SUC])\r
7068        THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
7069        THEN POP_ASSUM (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)])))\r
7070        THEN REWRITE_TAC[CONTRAPOS_THM]\r
7071        THEN STRIP_TAC\r
7072        THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num`\r
7073        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7074    THEN POP_ASSUM MP_TAC\r
7075    THEN REWRITE_TAC[]\r
7076    THEN USE_THEN "F3" MP_TAC\r
7077    THEN REWRITE_TAC[is_Moebius_contour]\r
7078    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))\r
7079    THEN USE_THEN "F7" MP_TAC\r
7080    THEN REWRITE_TAC[lemma_def_inj_contour]\r
7081    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10"))\r
7082    THEN DISCH_THEN (LABEL_TAC "F11")\r
7083    THEN REMOVE_THEN "F8" (X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `t:num` (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (CONJUNCTS_THEN2 (LABEL_TAC "F15") (CONJUNCTS_THEN2 (LABEL_TAC "F16") (LABEL_TAC "F16k")))))))\r
7084    THEN USE_THEN "F9" MP_TAC\r
7085    THEN REWRITE_TAC[lemma_def_contour]\r
7086    THEN DISCH_THEN (LABEL_TAC "F17")\r
7087    THEN ASM_CASES_TAC `m:num < t:num`\r
7088    THENL[POP_ASSUM (fun th -> (LABEL_TAC "G1" (MATCH_MP (ARITH_RULE `m:num < t:num ==> SUC m <= t`) th)))\r
7089         THEN USE_THEN "F17" (MP_TAC o SPEC `m:num`)\r
7090         THEN USE_THEN "F14" (fun th1 -> (USE_THEN "F15" (fun th2 -> (LABEL_TAC "G2" (MP (ARITH_RULE `m:num <= t:num /\ t < k:num ==> m < k`) (CONJ th1 th2))))))\r
7091         THEN USE_THEN "G2" (fun th -> REWRITE_TAC[th])\r
7092         THEN REWRITE_TAC[one_step_contour]\r
7093         THEN STRIP_TAC\r
7094         THENL[POP_ASSUM (fun th -> (LABEL_TAC "G3" th THEN MP_TAC th))\r
7095             THEN REWRITE_TAC[ADD1]\r
7096             THEN USE_THEN "F7"(fun th1 -> (USE_THEN "F12" (fun th2 -> (USE_THEN "G2" (fun th3 -> (DISCH_THEN (fun th4 -> (MP_TAC (MATCH_MP lemma_node_walkup_eliminate_dart_on_Moebius_contour (CONJ th1 (CONJ th2 (CONJ th3 th4))))))))))))\r
7097             THEN REWRITE_TAC[lemma_sub_two_numbers]\r
7098             THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 (LABEL_TAC "G5") (LABEL_TAC "G6")))\r
7099             THEN ABBREV_TAC `G = node_walkup (H:(A)hypermap) ((p:num->A) (m:num))`\r
7100             THEN POP_ASSUM (LABEL_TAC "G7")\r
7101             THEN SUBGOAL_THEN `one_step_contour G ((p:num->A) ((m:num)-1)) ((shift_path (p:num->A) ((m:num)+1)) 0)` ASSUME_TAC\r
7102             THENL[REWRITE_TAC[lemma_shift_path_evaluation]\r
7103                 THEN REWRITE_TAC[ADD_0]\r
7104                 THEN REMOVE_THEN "G6" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7105             THEN SUBGOAL_THEN `(!i:num j:num. i <= (m:num-1) /\ j <= (k:num) - (m+1) ==> ~(shift_path (p:num->A) (m+1) j = p i))` ASSUME_TAC\r
7106             THENL[REPEAT GEN_TAC\r
7107                 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G8") (LABEL_TAC "G9"))\r
7108                 THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC]\r
7109                 THEN USE_THEN "F10" (MP_TAC o SPECL[`(m:num) + 1 + (j:num)`; `i:num`])\r
7110                 THEN USE_THEN "G8" (fun th1 -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= (m:num) - 1 ==> i < m + 1 + (j:num)`) th1]))\r
7111                 THEN USE_THEN "G9" (fun th1 -> (USE_THEN "G2" (fun th2 -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `j:num <= (k:num) - ((m:num) + 1) /\ m < k:num ==> m + 1 + j <= k`) (CONJ th1 th2)]))))\r
7112                 THEN REWRITE_TAC[CONTRAPOS_THM; EQ_SYM]; ALL_TAC]\r
7113             THEN REMOVE_THEN "G4" (fun th1 -> (REMOVE_THEN "G5" (fun th2 -> (POP_ASSUM (fun th4-> (POP_ASSUM (fun th3 -> MP_TAC (MATCH_MP concatenate_two_disjoint_contours (CONJ th1 (CONJ th2 (CONJ th3 th4)))))))))))\r
7114             THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
7115             THEN USE_THEN "F12" (fun th1 -> (USE_THEN "G2" (fun th2 ->  REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < (m:num) /\ m < (k:num) ==> m - 1 + k - (m+1) + 1 = k -1`) (CONJ th1 th2)])))\r
7116             THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < (k:num) ==> (m + 1) + k - (m+1) = k`) th])\r
7117             THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < (m:num) ==> m - 1 + (i:num) + 1 = m + i`) th])\r
7118             THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "G10") (CONJUNCTS_THEN2 (LABEL_TAC "G11") (CONJUNCTS_THEN2 (LABEL_TAC "G12") (CONJUNCTS_THEN2 (LABEL_TAC "G14") (LABEL_TAC "G15"))))))\r
7119             THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "G16")\r
7120             THENL[REWRITE_TAC[is_Moebius_contour]\r
7121                 THEN USE_THEN "G12" (fun th -> REWRITE_TAC[th])\r
7122                 THEN EXISTS_TAC `m:num`\r
7123                 THEN EXISTS_TAC `(t:num) - 1`\r
7124                 THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
7125                 THEN USE_THEN "G1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (m:num) <= t:num ==> m <= t - 1`) th])\r
7126                 THEN USE_THEN "G1" (fun th1 -> (USE_THEN "F15" (fun th2 -> REWRITE_TAC[MP (ARITH_RULE `SUC (m:num) <= t:num /\ t < k:num ==> t - 1 < k - 1`) (CONJ th1 th2)])))\r
7127                 THEN USE_THEN "G10" (SUBST1_TAC)\r
7128                 THEN USE_THEN "G11" (SUBST1_TAC)\r
7129                 THEN USE_THEN "G15" (MP_TAC o SPEC `0`)\r
7130                 THEN REWRITE_TAC[LE_0; ADD_0]\r
7131                 THEN DISCH_THEN SUBST1_TAC\r
7132                 THEN USE_THEN "G1" MP_TAC\r
7133                 THEN REWRITE_TAC[LE_EXISTS; ADD1]\r
7134                 THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "G16"))\r
7135                 THEN USE_THEN "F15" (fun th1 -> (USE_THEN "G16" (fun th2 -> (ASSUME_TAC (MATCH_MP (ARITH_RULE `t:num < k:num /\ t = ((m:num) + 1) + (d:num) ==> d <= k - (m+1)`) (CONJ th1 th2))))))\r
7136                 THEN USE_THEN "G15" (MP_TAC o SPEC `d:num`)\r
7137                 THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
7138                 THEN USE_THEN "G16" (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [SYM th])\r
7139                 THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `t:num = ((m:num)+1) + (d:num) ==> m + d = t - 1`) th])\r
7140                 THEN DISCH_THEN SUBST1_TAC\r
7141                 THEN EXPAND_TAC "G"\r
7142                 THEN STRIP_TAC\r
7143                 THENL[USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`])\r
7144                     THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
7145                     THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
7146                     THEN DISCH_THEN (LABEL_TAC "G21")\r
7147                     THEN SUBGOAL_THEN `~((p:num->A) 0 = face_map (H:(A)hypermap) ((p:num->A) (m:num)))` (LABEL_TAC "G22")\r
7148                     THENL[USE_THEN "G21" MP_TAC\r
7149                         THEN REWRITE_TAC[CONTRAPOS_THM]\r
7150                         THEN USE_THEN "G3" (SUBST1_TAC o SYM)\r
7151                         THEN USE_THEN "F10" (MP_TAC o SPECL[`SUC (m:num)`; `0`])\r
7152                         THEN USE_THEN "G2" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> SUC m <= k`) th]))\r
7153                         THEN REWRITE_TAC[LT_0]\r
7154                         THEN MESON_TAC[]; ALL_TAC]\r
7155                     THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "G23")\r
7156                     THENL[ REWRITE_TAC[GSYM node_map_inverse_representation]\r
7157                         THEN USE_THEN "G21" MP_TAC\r
7158                         THEN REWRITE_TAC[CONTRAPOS_THM]\r
7159                         THEN USE_THEN "F16" (SUBST1_TAC o SYM)\r
7160                         THEN USE_THEN "F10" (MP_TAC o SPECL[`t:num`; `m:num`])\r
7161                         THEN USE_THEN "F15" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th]))\r
7162                         THEN USE_THEN "G1" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `SUC (m:num) <= t:num ==> m < t`) th]))\r
7163                         THEN MESON_TAC[]; ALL_TAC]\r
7164                     THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) 0`] node_map_node_walkup))))\r
7165                     THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7166                     THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th])\r
7167                     THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7168                 THEN USE_THEN "F10" (MP_TAC o SPECL[`(m:num) + 1`; `m:num`])\r
7169                 THEN USE_THEN "F12" (fun th -> REWRITE_TAC[ARITH_RULE `m:num < m + 1`])\r
7170                 THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> m+1 <= k`) th])\r
7171                 THEN USE_THEN "G3" MP_TAC\r
7172                 THEN REWRITE_TAC[ADD1]\r
7173                 THEN DISCH_THEN SUBST1_TAC\r
7174                 THEN DISCH_THEN (LABEL_TAC "G3" o GSYM)\r
7175                 THEN SUBGOAL_THEN `~(node_map (H:(A)hypermap) ((p:num->A) (m:num)) = p m)` (LABEL_TAC "G25")\r
7176                 THENL[USE_THEN "F16k" (SUBST1_TAC o SYM)\r
7177                     THEN USE_THEN "F10" (MP_TAC o SPECL[`k:num`; `m:num`])\r
7178                     THEN USE_THEN "G2" (fun th -> REWRITE_TAC[LE_REFL; th])\r
7179                     THEN MESON_TAC[]; ALL_TAC]\r
7180                 THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (m:num)`] node_map_node_walkup)))\r
7181                 THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7182                 THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th])\r
7183                 THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7184             THEN SUBGOAL_THEN `(p:num->A) (m:num) IN dart (H:(A)hypermap)` (LABEL_TAC "G26")\r
7185             THENL[USE_THEN "F11" (SUBST1_TAC o SYM)\r
7186                 THEN REWRITE_TAC[IN_ELIM_THM; LE_0]\r
7187                 THEN EXISTS_TAC `m:num`\r
7188                 THEN USE_THEN "G2" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])); ALL_TAC]\r
7189             THEN USE_THEN "G26" (MP_TAC o MATCH_MP lemma_card_node_walkup_dart)\r
7190             THEN USE_THEN "G7" SUBST1_TAC\r
7191             THEN USE_THEN "F1" SUBST1_TAC\r
7192             THEN REWRITE_TAC[GSYM ADD1; EQ_SUC]\r
7193             THEN DISCH_THEN (LABEL_TAC "G21")\r
7194             THEN USE_THEN "FI" (MP_TAC o SPEC `node_walkup (H:(A)hypermap) ((p:num->A) (m:num))`)\r
7195             THEN USE_THEN "G26" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)])))\r
7196             THEN USE_THEN "G7" SUBST1_TAC\r
7197             THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
7198             THEN EXISTS_TAC `g:num->A`\r
7199             THEN EXISTS_TAC `(k:num) - 1`\r
7200             THEN USE_THEN "G16" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7201         THEN POP_ASSUM MP_TAC\r
7202         THEN REWRITE_TAC[ADD1]\r
7203         THEN DISCH_THEN (fun th -> (LABEL_TAC "K3A" th THEN MP_TAC th))\r
7204         THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
7205         THEN DISCH_THEN (LABEL_TAC "K3B")\r
7206         THEN USE_THEN "F7"(fun th1 -> (USE_THEN "F12" (fun th2 -> (USE_THEN "G2" (fun th3 -> (USE_THEN "K3B" (fun th4 -> (MP_TAC (MATCH_MP lemma_face_walkup_eliminate_dart_on_Moebius_contour (CONJ th1 (CONJ th2 (CONJ th3 (SYM th4)))))))))))))\r
7207         THEN REWRITE_TAC[lemma_sub_two_numbers]\r
7208         THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K4") (CONJUNCTS_THEN2 (LABEL_TAC "K5") (LABEL_TAC "K6")))\r
7209         THEN ABBREV_TAC `G = face_walkup (H:(A)hypermap) ((p:num->A) (m:num))`\r
7210         THEN POP_ASSUM (LABEL_TAC "K7")\r
7211         THEN SUBGOAL_THEN `one_step_contour G ((p:num->A) ((m:num)-1)) ((shift_path (p:num->A) ((m:num)+1)) 0)` ASSUME_TAC\r
7212         THENL[REWRITE_TAC[lemma_shift_path_evaluation]\r
7213             THEN REWRITE_TAC[ADD_0]\r
7214             THEN REMOVE_THEN "K6" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7215         THEN SUBGOAL_THEN `(!i:num j:num. i <= (m:num-1) /\ j <= (k:num) - (m+1) ==> ~(shift_path (p:num->A) (m+1) j = p i))` ASSUME_TAC\r
7216         THENL[REPEAT GEN_TAC\r
7217             THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K8") (LABEL_TAC "K9"))\r
7218             THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC]\r
7219             THEN USE_THEN "F10" (MP_TAC o SPECL[`(m:num) + 1 + (j:num)`; `i:num`])\r
7220             THEN USE_THEN "K8" (fun th1 -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= (m:num) - 1 ==> i < m + 1 + (j:num)`) th1]))\r
7221             THEN USE_THEN "K9" (fun th1 -> (USE_THEN "G2" (fun th2 -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `j:num <= (k:num) - ((m:num) + 1) /\ m < k:num ==> m + 1 + j <= k`) (CONJ th1 th2)]))))\r
7222             THEN REWRITE_TAC[CONTRAPOS_THM; EQ_SYM]; ALL_TAC]\r
7223         THEN REMOVE_THEN "K4" (fun th1 -> (REMOVE_THEN "K5" (fun th2 -> (POP_ASSUM (fun th4-> (POP_ASSUM (fun th3 -> MP_TAC (MATCH_MP concatenate_two_disjoint_contours (CONJ th1 (CONJ th2 (CONJ th3 th4)))))))))))\r
7224         THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
7225         THEN USE_THEN "F12" (fun th1 -> (USE_THEN "G2" (fun th2 ->  REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < (m:num) /\ m < (k:num) ==> m - 1 + k - (m+1) + 1 = k -1`) (CONJ th1 th2)])))\r
7226         THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < (k:num) ==> (m + 1) + k - (m+1) = k`) th])\r
7227         THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < (m:num) ==> m - 1 + (i:num) + 1 = m + i`) th])\r
7228         THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "K10") (CONJUNCTS_THEN2 (LABEL_TAC "K11") (CONJUNCTS_THEN2 (LABEL_TAC "K12") (CONJUNCTS_THEN2 (LABEL_TAC "K14") (LABEL_TAC "K15"))))))\r
7229         THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "K16")\r
7230         THENL[REWRITE_TAC[is_Moebius_contour]\r
7231             THEN USE_THEN "K12" (fun th -> REWRITE_TAC[th])\r
7232             THEN EXISTS_TAC `m:num`\r
7233             THEN EXISTS_TAC `(t:num) - 1`\r
7234             THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
7235             THEN USE_THEN "G1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (m:num) <= t:num ==> m <= t - 1`) th])\r
7236             THEN USE_THEN "G1" (fun th1 -> (USE_THEN "F15" (fun th2 -> REWRITE_TAC[MP (ARITH_RULE `SUC (m:num) <= t:num /\ t < k:num ==> t - 1 < k - 1`) (CONJ th1 th2)])))\r
7237             THEN USE_THEN "K10" (SUBST1_TAC)\r
7238             THEN USE_THEN "K11" (SUBST1_TAC)\r
7239             THEN USE_THEN "K15" (MP_TAC o SPEC `0`)\r
7240             THEN REWRITE_TAC[LE_0; ADD_0]\r
7241             THEN DISCH_THEN SUBST1_TAC\r
7242             THEN USE_THEN "G1" MP_TAC\r
7243             THEN REWRITE_TAC[LE_EXISTS; ADD1]\r
7244             THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "K16"))\r
7245             THEN USE_THEN "F15" (fun th1 -> (USE_THEN "K16" (fun th2 -> (ASSUME_TAC (MATCH_MP (ARITH_RULE `t:num < k:num /\ t = ((m:num) + 1) + (d:num) ==> d <= k - (m+1)`) (CONJ th1 th2))))))\r
7246             THEN USE_THEN "K15" (MP_TAC o SPEC `d:num`)\r
7247             THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
7248             THEN USE_THEN "K16" (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [SYM th])\r
7249             THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `t:num = ((m:num)+1) + (d:num) ==> m + d = t - 1`) th])\r
7250             THEN DISCH_THEN SUBST1_TAC\r
7251             THEN EXPAND_TAC "G"\r
7252             THEN STRIP_TAC\r
7253             THENL[USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`])\r
7254                 THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
7255                 THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
7256                 THEN DISCH_THEN (LABEL_TAC "K21")\r
7257                 THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "K23")\r
7258                 THENL[ REWRITE_TAC[GSYM node_map_inverse_representation]\r
7259                     THEN USE_THEN "K21" MP_TAC\r
7260                     THEN REWRITE_TAC[CONTRAPOS_THM]\r
7261                     THEN USE_THEN "F16" (SUBST1_TAC o SYM)\r
7262                     THEN USE_THEN "F10" (MP_TAC o SPECL[`t:num`; `m:num`])\r
7263                     THEN USE_THEN "F15" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th]))\r
7264                     THEN USE_THEN "G1" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `SUC (m:num) <= t:num ==> m < t`) th]))\r
7265                     THEN MESON_TAC[]; ALL_TAC]\r
7266                 THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) 0`] node_map_face_walkup)))\r
7267                 THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7268                 THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th])\r
7269                 THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7270             THEN USE_THEN "K3A" SUBST1_TAC\r
7271             THEN REWRITE_TAC[node_map_face_walkup]\r
7272             THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7273         THEN SUBGOAL_THEN `(p:num->A) (m:num) IN dart (H:(A)hypermap)` (LABEL_TAC "K17")\r
7274         THENL[USE_THEN "F11" (SUBST1_TAC o SYM)\r
7275             THEN REWRITE_TAC[IN_ELIM_THM; LE_0]\r
7276             THEN EXISTS_TAC `m:num`\r
7277             THEN USE_THEN "G2" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])); ALL_TAC]\r
7278         THEN USE_THEN "K17" (MP_TAC o MATCH_MP lemma_card_face_walkup_dart)\r
7279         THEN USE_THEN "K7" SUBST1_TAC\r
7280         THEN USE_THEN "F1" SUBST1_TAC\r
7281         THEN REWRITE_TAC[GSYM ADD1; EQ_SUC]\r
7282         THEN DISCH_THEN (LABEL_TAC "K18")\r
7283         THEN USE_THEN "FI" (MP_TAC o SPEC `face_walkup (H:(A)hypermap) ((p:num->A) (m:num))`)\r
7284         THEN USE_THEN "K17" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)])))\r
7285         THEN USE_THEN "K7" SUBST1_TAC\r
7286         THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
7287         THEN EXISTS_TAC `g:num->A`\r
7288         THEN EXISTS_TAC `(k:num) - 1`\r
7289         THEN USE_THEN "K16" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7290     THEN POP_ASSUM (fun th1 -> (REMOVE_THEN "F14" (fun th2 -> (MP_TAC (MATCH_MP (ARITH_RULE `m:num <= t:num /\ ~(m < t) ==> t = m`) (CONJ th2 th1))))))\r
7291     THEN DISCH_THEN SUBST_ALL_TAC\r
7292     THEN ASM_CASES_TAC `1 < m:num`\r
7293     THENL[ POP_ASSUM (fun th -> (LABEL_TAC "B1" th THEN LABEL_TAC "B2" (MATCH_MP (ARITH_RULE `1 < m:num ==> 2 <= m`) th)))\r
7294       THEN USE_THEN "F17" (MP_TAC o SPEC `0:num`)\r
7295       THEN USE_THEN "B2" (fun th1 -> (USE_THEN "F15" (fun th2 -> (LABEL_TAC "B3" (MP (ARITH_RULE `2 <= m:num /\ m < k:num ==> 2 < k`) (CONJ th1 th2))))))\r
7296       THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> 0 < k`) th])\r
7297       THEN REWRITE_TAC[one_step_contour]\r
7298       THEN STRIP_TAC\r
7299       THENL[POP_ASSUM MP_TAC\r
7300           THEN REWRITE_TAC[ADD1]\r
7301           THEN DISCH_THEN (LABEL_TAC "B4")\r
7302           THEN USE_THEN "F15" (fun th -> MP_TAC (MATCH_MP (ARITH_RULE `m:num < k:num ==> 0 < k`) th))\r
7303           THEN USE_THEN "F7" (fun th1 -> (DISCH_THEN (fun th2 -> (USE_THEN "B4" (fun th3 -> (MP_TAC (MATCH_MP lemma_node_walkup_second_segment_contour (CONJ th1 (CONJ th2 th3)))))))))\r
7304           THEN REWRITE_TAC[ADD]\r
7305           THEN DISCH_THEN (LABEL_TAC "B5")\r
7306           THEN ABBREV_TAC `G = node_walkup (H:(A)hypermap) ((p:num->A) 0)`\r
7307           THEN POP_ASSUM (LABEL_TAC "B6")\r
7308           THEN ABBREV_TAC `g = shift_path (p:num->A) 1`\r
7309           THEN POP_ASSUM (LABEL_TAC "B7")\r
7310           THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "B8")\r
7311           THENL[REWRITE_TAC[is_Moebius_contour]\r
7312               THEN USE_THEN "B5" (fun th -> REWRITE_TAC[th])\r
7313               THEN EXISTS_TAC `(m:num) - 1`\r
7314               THEN EXISTS_TAC `(m:num) - 1`\r
7315               THEN USE_THEN "B2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= m:num ==> 0 < m - 1`) th; LE_REFL])\r
7316               THEN USE_THEN "F12" (fun th1 -> (USE_THEN "F15" (fun th2 -> REWRITE_TAC[MP (ARITH_RULE `0 < m:num /\ m < k:num ==> m - 1 < k - 1`) (CONJ th1 th2)])))\r
7317               THEN EXPAND_TAC "g"\r
7318               THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
7319               THEN REWRITE_TAC[ADD_SYM; GSYM ADD]\r
7320               THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < m:num ==> m - 1 + 1 = m`) th])\r
7321               THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> k - 1 + 1 = k`) th])\r
7322               THEN REWRITE_TAC[ARITH_RULE `1+0 = 1`]\r
7323               THEN POP_ASSUM (LABEL_TAC "B9")\r
7324               THEN EXPAND_TAC "G"\r
7325               THEN STRIP_TAC\r
7326               THENL[USE_THEN "B4" MP_TAC\r
7327                   THEN REWRITE_TAC[ADD]\r
7328                   THEN DISCH_THEN SUBST1_TAC\r
7329                   THEN SUBGOAL_THEN `~(face_map (H:(A)hypermap) ((p:num->A) 0) = p 0)` ASSUME_TAC\r
7330                   THENL[ USE_THEN "B4" (SUBST1_TAC o SYM)\r
7331                       THEN REWRITE_TAC[ADD]\r
7332                       THEN USE_THEN "F10" (MP_TAC o SPECL[`1`; `0`])\r
7333                       THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> 1 <= k`) th])\r
7334                       THEN REWRITE_TAC[ARITH_RULE `0 < 1`]\r
7335                       THEN MESON_TAC[]; ALL_TAC]\r
7336                   THEN  SUBGOAL_THEN `~(node_map (H:(A)hypermap) ((p:num->A) 0) = p 0)` ASSUME_TAC\r
7337                   THENL[USE_THEN "F16" (SUBST1_TAC o SYM)\r
7338                       THEN USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`])\r
7339                       THEN USE_THEN "F15" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
7340                       THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
7341                       THEN MESON_TAC[]; ALL_TAC]\r
7342                   THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) 0`; `(p:num->A) 0`] node_map_node_walkup)))\r
7343                   THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7344                   THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th])\r
7345                   THEN  REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7346               THEN  USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`])\r
7347               THEN USE_THEN "F15" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE  th])\r
7348               THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
7349               THEN DISCH_TAC\r
7350               THEN SUBGOAL_THEN `~((p:num->A) (m:num) = face_map (H:(A)hypermap) ((p:num->A) 0))` ASSUME_TAC\r
7351               THENL[USE_THEN "B4" (SUBST1_TAC o SYM)\r
7352                   THEN REWRITE_TAC[ADD]\r
7353                   THEN USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `1`])\r
7354                   THEN USE_THEN "F15" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th]))\r
7355                   THEN USE_THEN "B1" (fun th -> (REWRITE_TAC[th]))\r
7356                   THEN MESON_TAC[]; ALL_TAC]\r
7357               THEN SUBGOAL_THEN `~((p:num->A) (m:num) = inverse (node_map (H:(A)hypermap)) ((p:num->A) 0))` ASSUME_TAC\r
7358               THENL[REWRITE_TAC[GSYM node_map_inverse_representation]\r
7359                   THEN USE_THEN "F16k" (SUBST1_TAC o SYM)\r
7360                   THEN USE_THEN "F10" (MP_TAC o SPECL[`k:num`; `0`])\r
7361                   THEN USE_THEN "B3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `2 < k:num ==> 0 < k`) th; LE_REFL])); ALL_TAC]\r
7362               THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) 0`; `(p:num->A) (m:num)`] node_map_node_walkup))))\r
7363               THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7364               THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM th])\r
7365               THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th])\r
7366               THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7367            THEN SUBGOAL_THEN `(p:num->A) 0 IN dart (H:(A)hypermap)` (LABEL_TAC "B10")\r
7368            THENL[USE_THEN "F11" (SUBST1_TAC o SYM)\r
7369               THEN REWRITE_TAC[IN_ELIM_THM; LE_0]\r
7370               THEN EXISTS_TAC `0`\r
7371               THEN REWRITE_TAC[LE_0]; ALL_TAC]\r
7372            THEN USE_THEN "B10" (MP_TAC o MATCH_MP lemma_card_node_walkup_dart)\r
7373            THEN USE_THEN "B6" SUBST1_TAC\r
7374            THEN USE_THEN "F1" SUBST1_TAC\r
7375            THEN REWRITE_TAC[GSYM ADD1; EQ_SUC]\r
7376            THEN DISCH_THEN (LABEL_TAC "B11")\r
7377            THEN USE_THEN "FI" (MP_TAC o SPEC `node_walkup (H:(A)hypermap) ((p:num->A) 0)`)\r
7378            THEN USE_THEN "B10" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)])))\r
7379            THEN USE_THEN "B6" SUBST1_TAC\r
7380            THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th])\r
7381            THEN EXISTS_TAC `g:num->A`\r
7382            THEN EXISTS_TAC `(k:num) - 1`\r
7383            THEN USE_THEN "B8" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7384       THEN POP_ASSUM MP_TAC\r
7385       THEN REWRITE_TAC[ADD1]\r
7386       THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
7387       THEN DISCH_THEN (LABEL_TAC "C4" o GSYM)\r
7388       THEN USE_THEN "F15" (fun th -> MP_TAC (MATCH_MP (ARITH_RULE `m:num < k:num ==> 0 < k`) th))\r
7389       THEN USE_THEN "F7" (fun th1 -> (DISCH_THEN (fun th2 -> (USE_THEN "C4" (fun th3 -> (MP_TAC (MATCH_MP lemma_face_walkup_second_segment_contour (CONJ th1 (CONJ th2 th3)))))))))\r
7390       THEN REWRITE_TAC[ADD]\r
7391       THEN DISCH_THEN (LABEL_TAC "C5")\r
7392       THEN ABBREV_TAC `G = face_walkup (H:(A)hypermap) ((p:num->A) 0)`\r
7393       THEN POP_ASSUM (LABEL_TAC "C6")\r
7394       THEN ABBREV_TAC `g = shift_path (p:num->A) 1`\r
7395       THEN POP_ASSUM (LABEL_TAC "C7")\r
7396       THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "C8")\r
7397       THENL[REWRITE_TAC[is_Moebius_contour]\r
7398          THEN USE_THEN "C5" (fun th -> REWRITE_TAC[th])\r
7399          THEN  EXISTS_TAC `(m:num) - 1`\r
7400          THEN  EXISTS_TAC `(m:num) - 1`\r
7401          THEN USE_THEN "B2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= m:num ==> 0 < m - 1`) th; LE_REFL])\r
7402          THEN USE_THEN "F12" (fun th1 -> (USE_THEN "F15" (fun th2 -> REWRITE_TAC[MP (ARITH_RULE `0 < m:num /\ m < k:num ==> m - 1 < k - 1`) (CONJ th1 th2)])))\r
7403          THEN EXPAND_TAC "g"\r
7404          THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
7405          THEN REWRITE_TAC[ADD_SYM; GSYM ADD]\r
7406          THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < m:num ==> m - 1 + 1 = m`) th])\r
7407          THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> k - 1 + 1 = k`) th])\r
7408          THEN REWRITE_TAC[ARITH_RULE `1+0 = 1`]\r
7409          THEN POP_ASSUM (LABEL_TAC "C9")\r
7410          THEN EXPAND_TAC "G"\r
7411          THEN STRIP_TAC\r
7412          THENL[USE_THEN "C4" (MP_TAC o SYM)\r
7413             THEN REWRITE_TAC[ADD]\r
7414             THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [node_map_inverse_representation]\r
7415             THEN DISCH_THEN (SUBST1_TAC)\r
7416             THEN REWRITE_TAC[node_map_face_walkup]\r
7417             THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7418          THEN USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`])\r
7419          THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th])\r
7420          THEN USE_THEN "F15" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
7421          THEN DISCH_THEN (ASSUME_TAC o GSYM)\r
7422          THEN SUBGOAL_THEN `~((p:num->A) (m:num) = inverse(node_map (H:(A)hypermap)) ((p:num->A) 0))` ASSUME_TAC\r
7423          THENL[REWRITE_TAC[GSYM node_map_inverse_representation]\r
7424             THEN USE_THEN "F16k" (SUBST1_TAC o SYM)\r
7425             THEN USE_THEN "F10" (MP_TAC o SPECL[`k:num`; `0`])\r
7426             THEN USE_THEN "B3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `2 < k:num ==> 0 < k`) th; LE_REFL])); ALL_TAC]\r
7427          THEN MP_TAC (CONJUNCT2(CONJUNCT2 (SPECL[`H:(A)hypermap`; `(p:num->A) 0`; `(p:num->A) (m:num)`] node_map_face_walkup)))\r
7428          THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7429          THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th])\r
7430          THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7431       THEN SUBGOAL_THEN `(p:num->A) 0 IN dart (H:(A)hypermap)` (LABEL_TAC "C10")\r
7432       THENL[USE_THEN "F11" (SUBST1_TAC o SYM)\r
7433          THEN REWRITE_TAC[IN_ELIM_THM; LE_0]\r
7434          THEN EXISTS_TAC `0`\r
7435          THEN REWRITE_TAC[LE_0]; ALL_TAC]\r
7436       THEN USE_THEN "C10" (MP_TAC o MATCH_MP lemma_card_face_walkup_dart)\r
7437       THEN USE_THEN "C6" SUBST1_TAC\r
7438       THEN  USE_THEN "F1" SUBST1_TAC\r
7439       THEN  REWRITE_TAC[GSYM ADD1; EQ_SUC]\r
7440       THEN  DISCH_THEN (LABEL_TAC "C11" o GSYM)\r
7441       THEN  USE_THEN "FI" (MP_TAC o SPEC `face_walkup (H:(A)hypermap) ((p:num->A) 0)`)\r
7442       THEN  USE_THEN "C10" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)])))\r
7443       THEN  USE_THEN "C6" SUBST1_TAC\r
7444       THEN  POP_ASSUM (fun th -> REWRITE_TAC[SYM th])\r
7445       THEN  EXISTS_TAC `g:num->A`\r
7446       THEN  EXISTS_TAC `(k:num) - 1`\r
7447       THEN USE_THEN "C8" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7448    THEN POP_ASSUM (fun th1 -> (REMOVE_THEN "F12" (fun th2 -> ASSUME_TAC (MATCH_MP (ARITH_RULE `0 < m:num /\ ~(1 < m) ==> m = 1`) (CONJ th2 th1)))))\r
7449    THEN POP_ASSUM SUBST_ALL_TAC\r
7450    THEN ASM_CASES_TAC `2 < k:num`\r
7451    THENL[POP_ASSUM (LABEL_TAC "F18")\r
7452        THEN USE_THEN "F15" MP_TAC\r
7453        THEN REWRITE_TAC[LT_EXISTS]\r
7454        THEN DISCH_THEN (X_CHOOSE_THEN `d:num` MP_TAC)\r
7455        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
7456        THEN ABBREV_TAC `s = SUC (d:num)`\r
7457        THEN DISCH_THEN SUBST_ALL_TAC\r
7458        THEN USE_THEN "F18" (fun th -> (LABEL_TAC "F19" (MATCH_MP (ARITH_RULE `2 < (s:num) + 1 ==> 2 <= s`) th)))\r
7459        THEN USE_THEN "F17" (MP_TAC o SPEC `s:num`)\r
7460        THEN REWRITE_TAC[ARITH_RULE `(s:num) < s + 1`]\r
7461        THEN REWRITE_TAC[ADD1]\r
7462        THEN REWRITE_TAC[one_step_contour]\r
7463        THEN STRIP_TAC\r
7464        THENL[POP_ASSUM (LABEL_TAC "X1")\r
7465            THEN MP_TAC (ARITH_RULE `s:num < s + 1`)\r
7466            THEN USE_THEN "F19" (fun th -> MP_TAC (MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th))\r
7467            THEN USE_THEN "F7" (fun th1 -> (DISCH_THEN (fun th2 -> (DISCH_THEN (fun th3 -> (USE_THEN "X1" (fun th4 -> (MP_TAC (MATCH_MP lemma_node_walkup_eliminate_dart_on_Moebius_contour (CONJ th1 (CONJ th2 (CONJ th3 th4))))))))))))\r
7468            THEN REWRITE_TAC[lemma_sub_two_numbers; SUB_REFL]\r
7469            THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "X4") (CONJUNCTS_THEN2 (LABEL_TAC "X5") (LABEL_TAC "X6")))\r
7470            THEN ABBREV_TAC `G = node_walkup (H:(A)hypermap) ((p:num->A) (s:num))`\r
7471            THEN POP_ASSUM (LABEL_TAC "X7")\r
7472            THEN SUBGOAL_THEN `one_step_contour (G:(A)hypermap) ((p:num->A) ((s:num)-1)) ((shift_path (p:num->A) ((s:num)+1)) 0)` ASSUME_TAC\r
7473            THENL[REWRITE_TAC[lemma_shift_path_evaluation]\r
7474                 THEN REWRITE_TAC[ADD_0]\r
7475                 THEN REMOVE_THEN "X6" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7476            THEN SUBGOAL_THEN `(!i:num j:num. i <= (s:num-1) /\ j <= 0 ==> ~(shift_path (p:num->A) (s+1) j = p i))` ASSUME_TAC\r
7477            THENL[REWRITE_TAC[LE]\r
7478                 THEN REPEAT GEN_TAC\r
7479                 THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) (SUBST1_TAC))\r
7480                 THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC; ADD_0]\r
7481                 THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1 `; `i:num`])\r
7482                 THEN POP_ASSUM (fun th -> REWRITE_TAC[MP (ARITH_RULE `i:num  <= (s:num) - 1 ==> i < s + 1`) th; LE_REFL])\r
7483                 THEN MESON_TAC[]; ALL_TAC]\r
7484            THEN REMOVE_THEN "X4" (fun th1 -> (REMOVE_THEN "X5" (fun th2 -> (POP_ASSUM (fun th4-> (POP_ASSUM (fun th3 -> MP_TAC (MATCH_MP concatenate_two_disjoint_contours (CONJ th1 (CONJ th2 (CONJ th3 th4)))))))))))\r
7485            THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
7486            THEN REWRITE_TAC[ADD_0]\r
7487            THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> s-1+0+1 = s`) th])\r
7488            THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "X10") (CONJUNCTS_THEN2 (LABEL_TAC "X11") (CONJUNCTS_THEN2 (LABEL_TAC "X12") (LABEL_TAC "X14" o CONJUNCT1)))))    \r
7489            THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) (s:num)` (LABEL_TAC "X15")\r
7490            THENL[REWRITE_TAC[is_Moebius_contour]\r
7491                THEN USE_THEN "X12" (fun th -> REWRITE_TAC[th])\r
7492                THEN EXISTS_TAC `1:num`\r
7493                THEN EXISTS_TAC `1:num`\r
7494                THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `0 < 1 /\ 1 <= 1`])\r
7495                THEN REMOVE_THEN "X10" SUBST1_TAC\r
7496                THEN REMOVE_THEN "X11" SUBST1_TAC\r
7497                THEN POP_ASSUM (MP_TAC o SPEC `1`)\r
7498                THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 <= s - 1`) th])\r
7499                THEN DISCH_THEN SUBST1_TAC\r
7500                THEN EXPAND_TAC "G"\r
7501                THEN STRIP_TAC\r
7502                THENL[USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `0`])\r
7503                    THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th; ARITH_RULE `s:num <= s + 1`])\r
7504                    THEN DISCH_TAC\r
7505                    THEN SUBGOAL_THEN `~((p:num->A) 0 = face_map (H:(A)hypermap) ((p:num->A) (s:num)))` ASSUME_TAC\r
7506                    THENL[USE_THEN "X1" (SUBST1_TAC o SYM)\r
7507                        THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1`; `0`])\r
7508                        THEN REWRITE_TAC[ARITH_RULE `0 < (s:num) + 1`; LE_REFL]; ALL_TAC]\r
7509                    THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC)\r
7510                    THENL[REWRITE_TAC[GSYM node_map_inverse_representation]\r
7511                        THEN USE_THEN "F16" (SUBST1_TAC o SYM)\r
7512                        THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)`; `1`])\r
7513                        THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[MP (ARITH_RULE `2 <= (s:num) ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`])\r
7514                        THEN MESON_TAC[]; ALL_TAC]\r
7515                    THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (0:num)`] node_map_node_walkup))))\r
7516                    THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7517                    THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th])\r
7518                    THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7519                THEN USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `1`])\r
7520                THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`])\r
7521                THEN DISCH_TAC\r
7522                THEN SUBGOAL_THEN `~((p:num->A) 1 = face_map (H:(A)hypermap) ((p:num->A) (s:num)))` ASSUME_TAC\r
7523                THENL[USE_THEN "X1" (SUBST1_TAC o SYM)\r
7524                    THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1`; `1`])\r
7525                    THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 1 < s + 1`) th; ARITH_RULE `0 < (s:num) + 1`; LE_REFL]); \r
7526                    ALL_TAC]\r
7527                THEN SUBGOAL_THEN `~((p:num->A) 1 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC)\r
7528                THENL[REWRITE_TAC[GSYM node_map_inverse_representation]\r
7529                    THEN USE_THEN "F16k" (SUBST1_TAC o SYM)\r
7530                    THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)+1`; `s:num`])\r
7531                    THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[ARITH_RULE `s:num < s + 1`; LE_REFL]); ALL_TAC]\r
7532                THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (1:num)`] node_map_node_walkup))))\r
7533                THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7534                THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th])\r
7535                THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]         \r
7536            THEN SUBGOAL_THEN `(p:num->A) (s:num) IN dart (H:(A)hypermap)` (LABEL_TAC "X20")\r
7537            THENL[ USE_THEN "F11" (SUBST1_TAC o SYM)\r
7538                THEN REWRITE_TAC[IN_ELIM_THM; LE_0]\r
7539                THEN EXISTS_TAC `s:num`\r
7540                THEN REWRITE_TAC[ARITH_RULE `s:num <= s + 1`]; ALL_TAC]\r
7541            THEN USE_THEN "X20" (MP_TAC o MATCH_MP lemma_card_node_walkup_dart)\r
7542            THEN USE_THEN "X7" SUBST1_TAC\r
7543            THEN USE_THEN "F1" SUBST1_TAC\r
7544            THEN REWRITE_TAC[GSYM ADD1; EQ_SUC]\r
7545            THEN DISCH_THEN (LABEL_TAC "X21")\r
7546            THEN USE_THEN "FI" (MP_TAC o SPEC `node_walkup (H:(A)hypermap) ((p:num->A) (s:num))`)\r
7547            THEN USE_THEN "X20" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)])))\r
7548            THEN USE_THEN "X7" SUBST1_TAC\r
7549            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
7550            THEN EXISTS_TAC `g:num->A`\r
7551            THEN EXISTS_TAC `s:num`      \r
7552            THEN USE_THEN "X15" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7553        THEN POP_ASSUM MP_TAC\r
7554        THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
7555        THEN DISCH_THEN (LABEL_TAC "Y1")\r
7556        THEN MP_TAC (ARITH_RULE `s:num < s + 1`)\r
7557        THEN USE_THEN "F19" (fun th -> MP_TAC (MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th))\r
7558        THEN USE_THEN "F7" (fun th1 -> (DISCH_THEN (fun th2 -> (DISCH_THEN (fun th3 -> (USE_THEN "Y1" (fun th4 -> (MP_TAC (MATCH_MP lemma_face_walkup_eliminate_dart_on_Moebius_contour (CONJ th1 (CONJ th2 (CONJ th3 (SYM th4)))))))))))))\r
7559        THEN REWRITE_TAC[lemma_sub_two_numbers; SUB_REFL]\r
7560        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "Y4") (CONJUNCTS_THEN2 (LABEL_TAC "Y5") (LABEL_TAC "Y6")))\r
7561        THEN ABBREV_TAC `G = face_walkup (H:(A)hypermap) ((p:num->A) (s:num))`\r
7562        THEN POP_ASSUM (LABEL_TAC "Y7")\r
7563        THEN SUBGOAL_THEN `one_step_contour (G:(A)hypermap) ((p:num->A) ((s:num)-1)) ((shift_path (p:num->A) ((s:num)+1)) 0)` ASSUME_TAC\r
7564        THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
7565        THEN REWRITE_TAC[ADD_0]\r
7566        THEN REMOVE_THEN "Y6" (fun th -> REWRITE_TAC[th])\r
7567        THEN SUBGOAL_THEN `(!i:num j:num. i <= (s:num-1) /\ j <= 0 ==> ~(shift_path (p:num->A) (s+1) j = p i))` ASSUME_TAC\r
7568        THENL[REWRITE_TAC[LE]\r
7569           THEN REPEAT GEN_TAC\r
7570           THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) (SUBST1_TAC))\r
7571           THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC; ADD_0]\r
7572           THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1 `; `i:num`])\r
7573           THEN POP_ASSUM (fun th -> REWRITE_TAC[MP (ARITH_RULE `i:num  <= (s:num) - 1 ==> i < s + 1`) th; LE_REFL])\r
7574           THEN MESON_TAC[]; ALL_TAC]\r
7575        THEN REMOVE_THEN "Y4" (fun th1 -> (REMOVE_THEN "Y5" (fun th2 -> (POP_ASSUM (fun th4-> (POP_ASSUM (fun th3 -> MP_TAC (MATCH_MP concatenate_two_disjoint_contours (CONJ th1 (CONJ th2 (CONJ th3 th4)))))))))))\r
7576        THEN REWRITE_TAC[lemma_shift_path_evaluation]\r
7577        THEN REWRITE_TAC[ADD_0]\r
7578        THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> s-1+0+1 = s`) th])\r
7579        THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "Y10") (CONJUNCTS_THEN2 (LABEL_TAC "Y11") (CONJUNCTS_THEN2 (LABEL_TAC "Y12") (LABEL_TAC "Y14" o CONJUNCT1)))))\r
7580        THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) (s:num)` (LABEL_TAC "Y15")\r
7581        THENL[REWRITE_TAC[is_Moebius_contour]\r
7582            THEN USE_THEN "Y12" (fun th -> REWRITE_TAC[th])\r
7583            THEN EXISTS_TAC `1:num`\r
7584            THEN EXISTS_TAC `1:num`\r
7585            THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `0 < 1 /\ 1 <= 1`])\r
7586            THEN REMOVE_THEN "Y10" SUBST1_TAC\r
7587            THEN REMOVE_THEN "Y11" SUBST1_TAC\r
7588            THEN POP_ASSUM (MP_TAC o SPEC `1`)\r
7589            THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 <= s - 1`) th])\r
7590            THEN DISCH_THEN SUBST1_TAC\r
7591            THEN EXPAND_TAC "G"\r
7592            THEN STRIP_TAC\r
7593            THENL[USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `0`])\r
7594               THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th; ARITH_RULE `s:num <= s + 1`])\r
7595               THEN DISCH_TAC\r
7596               THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC)\r
7597               THENL[REWRITE_TAC[GSYM node_map_inverse_representation]\r
7598                  THEN USE_THEN "F16" (SUBST1_TAC o SYM)\r
7599                  THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)`; `1`])\r
7600                  THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[MP (ARITH_RULE `2 <= (s:num) ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`])\r
7601                  THEN MESON_TAC[]; ALL_TAC]\r
7602               THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (0:num)`] node_map_face_walkup)))\r
7603               THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7604               THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th])\r
7605               THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7606            THEN USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `1`])\r
7607            THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`])\r
7608            THEN DISCH_TAC\r
7609            THEN SUBGOAL_THEN `~((p:num->A) 1 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC)\r
7610            THENL[REWRITE_TAC[GSYM node_map_inverse_representation]\r
7611                THEN USE_THEN "F16k" (SUBST1_TAC o SYM)\r
7612                THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)+1`; `s:num`])\r
7613                THEN USE_THEN "F19" (fun th ->  REWRITE_TAC[ARITH_RULE `s:num < s + 1`; LE_REFL]); ALL_TAC]\r
7614            THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (1:num)`] node_map_face_walkup)))\r
7615            THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
7616            THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th])\r
7617            THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
7618        THEN SUBGOAL_THEN `(p:num->A) (s:num) IN dart (H:(A)hypermap)` (LABEL_TAC "Y20")\r
7619        THENL[USE_THEN "F11" (SUBST1_TAC o SYM)\r
7620            THEN REWRITE_TAC[IN_ELIM_THM; LE_0]\r
7621            THEN EXISTS_TAC `s:num`\r
7622            THEN REWRITE_TAC[ARITH_RULE `s:num <= s + 1`]; ALL_TAC]\r
7623        THEN USE_THEN "Y20" (MP_TAC o MATCH_MP lemma_card_face_walkup_dart)\r
7624        THEN USE_THEN "Y7" SUBST1_TAC\r
7625        THEN  USE_THEN "F1" SUBST1_TAC\r
7626        THEN  REWRITE_TAC[GSYM ADD1; EQ_SUC]\r
7627        THEN  DISCH_THEN (LABEL_TAC "Y21")\r
7628        THEN  USE_THEN "FI" (MP_TAC o SPEC `face_walkup (H:(A)hypermap) ((p:num->A) (s:num))`)\r
7629        THEN  USE_THEN "Y20" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)])))\r
7630        THEN  USE_THEN "Y7" SUBST1_TAC\r
7631        THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
7632        THEN EXISTS_TAC `g:num->A`\r
7633        THEN EXISTS_TAC `s:num`\r
7634        THEN USE_THEN "Y15" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
7635    THEN POP_ASSUM (fun th1 -> (REMOVE_THEN "F15" (fun th2 -> (MP_TAC (MP (ARITH_RULE `~(2 < k:num) /\ 1 < k ==> k =2`) (CONJ th1 th2))))))\r
7636    THEN DISCH_THEN (SUBST_ALL_TAC)\r
7637    THEN REMOVE_THEN "F5" MP_TAC\r
7638    THEN USE_THEN "F11" SUBST1_TAC\r
7639    THEN REWRITE_TAC[GSYM THREE]\r
7640    THEN DISCH_TAC\r
7641    THEN MP_TAC (SPEC `H:(A)hypermap` lemma_minimum_Moebius_hypermap)\r
7642    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) \r
7643    THEN REWRITE_TAC[NOT_IMP]\r
7644    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
7645    THEN EXISTS_TAC `p:num->A`\r
7646    THEN EXISTS_TAC `2`\r
7647    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]));;\r
7648 \r
7649 (* HERE I DEFINE THE NOTION OF THE LOOP. THIS DEFINITION DOES NOT DEPEND ON THE ORDER OF ITS VERTICES *)\r
7650 \r
7651 let exist_loop = prove(`?L:(A->bool)#(A->A). FINITE (FST L) /\ SND L permutes FST L /\ ?x:A. x IN FST L /\ orbit_map (SND L) x = FST L`,\r
7652    MP_TAC(SPEC `UNIV:A->bool` MEMBER_NOT_EMPTY)\r
7653    THEN REWRITE_TAC[UNIV_NOT_EMPTY]\r
7654    THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (ASSUME_TAC))\r
7655    THEN EXISTS_TAC `({x:A}, I:A->A)`\r
7656    THEN REWRITE_TAC[FST; SND]\r
7657    THEN REWRITE_TAC[FINITE_SINGLETON; PERMUTES_I; I_O_ID]\r
7658    THEN EXISTS_TAC `x:A`\r
7659    THEN REWRITE_TAC[IN_SING; GSYM orbit_one_point; I_THM]);;\r
7660 \r
7661 let loop_tybij = new_type_definition "loop"("loop", "tuple_loop") exist_loop;;\r
7662 \r
7663 let dart_of = new_definition `!L:(A)loop. dart_of L = FST (tuple_loop L)`;;\r
7664 \r
7665 let next = new_definition `!L:(A)loop. next L = SND (tuple_loop L)`;;\r
7666 \r
7667 let back = new_definition `!L:(A)loop. back L = inverse (SND (tuple_loop L))`;;\r
7668 \r
7669 let belong = new_definition `!(L:(A)loop) x:A. x belong L <=> x IN (dart_of L)`;;\r
7670 \r
7671 let size = new_definition `size (L:(A)loop) = CARD (dart_of L)`;;\r
7672 \r
7673 let top = new_definition `top (L:(A)loop) = PRE (CARD (dart_of L))`;;\r
7674 \r
7675 let is_loop = new_definition `!(H:(A)hypermap) (L:(A)loop). is_loop H L <=> (!x:A. x belong L ==> one_step_contour H x (next L x))`;;\r
7676 \r
7677 let loop_path = new_definition `!(L:(A)loop) x:A k:num. loop_path L x k = ((next L) POWER k) x`;;\r
7678 \r
7679 let lemma_loop_path_via_list = prove(`!L:(A)loop x:A. loop_path L x = power_list (next L) x`,\r
7680    REPEAT GEN_TAC THEN REWRITE_TAC[loop_path; power_list; FUN_EQ_THM]);;\r
7681 \r
7682 let loop_lemma = prove(`!L:(A)loop. FINITE (dart_of L) /\(next L) permutes (dart_of L) /\ (?x:A. x belong L /\ orbit_map (next L) x = dart_of L)`,\r
7683    GEN_TAC THEN REWRITE_TAC[belong; loop_tybij; dart_of; next] THEN MESON_TAC[loop_tybij]);;\r
7684 \r
7685 let lemma_loop_representation = prove(`!s:A->bool p:A->A x:A. FINITE s /\ p permutes s /\ orbit_map p x = s \r
7686    ==> dart_of (loop (s, p)) = s /\ next (loop (s,p)) = p`,\r
7687    REPEAT GEN_TAC  THEN STRIP_TAC\r
7688    THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect)\r
7689    THEN ASM_REWRITE_TAC[]\r
7690    THEN POP_ASSUM MP_TAC\r
7691    THEN REWRITE_TAC[IMP_IMP]\r
7692    THEN ONCE_REWRITE_TAC[CONJ_SYM]\r
7693    THEN DISCH_THEN (ASSUME_TAC o SIMPLE_EXISTS `x:A`)\r
7694    THEN MP_TAC (SPEC `(s:A->bool, p:A->A)` (CONJUNCT2 loop_tybij))\r
7695    THEN REWRITE_TAC[FST; SND; next; dart_of]\r
7696    THEN ASM_REWRITE_TAC[]\r
7697    THEN DISCH_THEN SUBST1_TAC\r
7698    THEN REWRITE_TAC[FST; SND]);;\r
7699 \r
7700 let lemma_loop_identity = prove(`!(L:(A)loop) (L':(A)loop). L = L' <=> (dart_of L = dart_of L' /\ next L = next L')`,\r
7701  REPEAT GEN_TAC\r
7702    THEN EQ_TAC\r
7703    THENL[MESON_TAC[]; ALL_TAC]\r
7704    THEN REWRITE_TAC[dart_of; next]\r
7705    THEN STRIP_TAC\r
7706    THEN SUBGOAL_THEN `tuple_loop (L:(A)loop) = tuple_loop (L':(A)loop)` ASSUME_TAC\r
7707    THENL[SUBGOAL_THEN `tuple_loop (L:(A)loop) = FST (tuple_loop (L:(A)loop)), SND (tuple_loop (L:(A)loop))` ASSUME_TAC\r
7708        THENL[MESON_TAC[PAIR]; ALL_TAC]\r
7709        THEN SUBGOAL_THEN `tuple_loop (L':(A)loop) = FST (tuple_loop (L':(A)loop)), SND (tuple_loop (L':(A)loop))` ASSUME_TAC\r
7710        THENL[MESON_TAC[PAIR]; ALL_TAC]\r
7711        THEN REPLICATE_TAC 2 (POP_ASSUM SUBST1_TAC); ALL_TAC]\r
7712    THEN ASM_REWRITE_TAC[PAIR_EQ]\r
7713    THEN POP_ASSUM (fun th -> MESON_TAC[CONJUNCT1 loop_tybij; th]));;\r
7714 \r
7715 let lemma_permute_loop = prove(`!L:(A)loop. next L permutes dart_of L /\ back L permutes dart_of L`,\r
7716    GEN_TAC THEN REWRITE_TAC[loop_lemma]\r
7717    THEN REWRITE_TAC[back; GSYM next]\r
7718    THEN MATCH_MP_TAC PERMUTES_INVERSE\r
7719    THEN REWRITE_TAC[loop_lemma]);;\r
7720 \r
7721 let lemma_transitive_permutation = prove(`!(L:(A)loop) x:A. x belong L ==> dart_of L = orbit_map (next L) x`,\r
7722  REPEAT GEN_TAC\r
7723    THEN MP_TAC (SPEC `L:(A)loop` loop_lemma)\r
7724    THEN REWRITE_TAC[belong]\r
7725    THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `y:A`(CONJUNCTS_THEN2 ASSUME_TAC(SUBST1_TAC o SYM)))))\r
7726    THEN REPEAT STRIP_TAC   \r
7727    THEN MATCH_MP_TAC lemma_orbit_identity\r
7728    THEN EXISTS_TAC `dart_of (L:(A)loop)`\r
7729    THEN ASM_REWRITE_TAC[]);;\r
7730 \r
7731 let lemma_size = prove(`!(L:(A)loop). ~(dart_of L = {}) /\ 0 < size L /\ size L = SUC(top L)`,\r
7732     REPEAT GEN_TAC\r
7733     THEN MP_TAC (SPEC `L:(A)loop` loop_lemma)\r
7734     THEN DISCH_THEN(CONJUNCTS_THEN2(LABEL_TAC "F1")(CONJUNCTS_THEN2 (LABEL_TAC "F2")(X_CHOOSE_THEN `y:A`(ASSUME_TAC o REWRITE_RULE[belong] o CONJUNCT1))))\r
7735     THEN SUBGOAL_THEN `~(dart_of (L:(A)loop) = {})` (fun th-> REWRITE_TAC[th])\r
7736     THENL[REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]\r
7737        THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
7738     THEN SUBGOAL_THEN `0 < size (L:(A)loop)` ASSUME_TAC\r
7739     THENL[ REWRITE_TAC[size]\r
7740        THEN USE_THEN "F1"(fun th -> (POP_ASSUM(fun th1-> (MP_TAC (MATCH_MP CARD_ATLEAST_1 (CONJ th th1))))))\r
7741        THEN DISCH_THEN (fun th -> REWRITE_TAC[REWRITE_RULE[LT1_NZ] th])\r
7742        THEN REWRITE_TAC[FUN_EQ_THM; I_THM]; ALL_TAC]   \r
7743     THEN ASM_REWRITE_TAC[]\r
7744     THEN REWRITE_TAC[top; GSYM size]\r
7745     THEN MATCH_MP_TAC LT_SUC_PRE\r
7746     THEN ASM_REWRITE_TAC[]);;\r
7747 \r
7748 let lemma_order_next = prove(`!L:(A)loop. (next L) POWER (size L) = I`,\r
7749    REPEAT GEN_TAC\r
7750    THEN MP_TAC (SPEC `L:(A)loop` loop_lemma)\r
7751    THEN DISCH_THEN(CONJUNCTS_THEN2(LABEL_TAC "F1")(LABEL_TAC "F2" o CONJUNCT1))\r
7752    THEN REWRITE_TAC[FUN_EQ_THM; I_THM; size]\r
7753    THEN GEN_TAC\r
7754    THEN ASM_CASES_TAC `~((x:A) IN dart_of (L:(A)loop))`\r
7755    THENL[USE_THEN "F2" (fun th->(POP_ASSUM(fun th1->REWRITE_TAC[MATCH_MP power_permutation_outside_domain (CONJ th th1)]))); ALL_TAC]\r
7756    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM belong])\r
7757    THEN MP_TAC (SPECL[`L:(A)loop`; `x:A`] lemma_transitive_permutation)\r
7758    THEN POP_ASSUM(fun th -> REWRITE_TAC[th])\r
7759    THEN DISCH_THEN SUBST1_TAC \r
7760    THEN REMOVE_THEN "F1"(fun th -> (POP_ASSUM(fun th1-> (MESON_TAC[MATCH_MP lemma_cycle_orbit (CONJ th th1)])))));;\r
7761 \r
7762 let lemma_congruence_on_loop = prove(`!L:(A)loop x:A n:num m:num. x belong L /\ n <= top L /\ (next L POWER n) x = (next L POWER m) x \r
7763    ==> ?q:num. m = q * (size L) + n`,\r
7764  REWRITE_TAC[GSYM LT_SUC_LE; GSYM lemma_size; size]\r
7765    THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
7766    THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP lemma_transitive_permutation)\r
7767    THEN MATCH_MP_TAC lemma_congruence_on_orbit\r
7768    THEN EXISTS_TAC `dart_of (L:(A)loop)` THEN ASM_REWRITE_TAC[loop_lemma]);;\r
7769 \r
7770 let lemma_back_and_next_outside_loop = prove(`!L:(A)loop  x:A. ~(x belong L) ==> back L x = x /\ next L x = x`,\r
7771     REPEAT GEN_TAC\r
7772     THEN REWRITE_TAC[belong]\r
7773     THEN DISCH_THEN (LABEL_TAC "F1")\r
7774     THEN ASSUME_TAC ((CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` loop_lemma))))\r
7775     THEN USE_THEN "F1"(fun th->(POP_ASSUM (MP_TAC o REWRITE_RULE[th] o SPEC `x:A` o MATCH_MP map_permutes_outside_domain)))\r
7776     THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
7777     THEN ASSUME_TAC ((CONJUNCT2(SPEC `L:(A)loop` lemma_permute_loop)))\r
7778     THEN REMOVE_THEN "F1"(fun th->(POP_ASSUM (MP_TAC o REWRITE_RULE[th] o SPEC `x:A` o MATCH_MP map_permutes_outside_domain)))\r
7779     THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
7780     THEN SIMP_TAC[]);;\r
7781 \r
7782 let lemma_power_back_and_next_outside_loop = prove(`!L:(A)loop x:A m:num. ~(x belong L) ==> ((back L) POWER m) x = x /\ ((next L) POWER m) x = x`,\r
7783  REPEAT GEN_TAC\r
7784    THEN REWRITE_TAC[belong]\r
7785    THEN DISCH_THEN (LABEL_TAC "F1")\r
7786    THEN ASSUME_TAC ((CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` loop_lemma))))\r
7787    THEN USE_THEN "F1"(fun th1->(POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP power_permutation_outside_domain (CONJ th th1)])))\r
7788    THEN ASSUME_TAC ((CONJUNCT2(SPEC `L:(A)loop` lemma_permute_loop)))\r
7789    THEN REMOVE_THEN "F1"(fun th1->(POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP power_permutation_outside_domain (CONJ th th1)]))));;\r
7790 \r
7791 let lemma_inverse_on_loop = prove(`!L:(A)loop. next L = inverse (back L) /\ back L = inverse (next L)`,\r
7792     STRIP_TAC\r
7793     THEN REWRITE_TAC[ back; GSYM next]\r
7794     THEN CONV_TAC SYM_CONV\r
7795     THEN ASSUME_TAC ((CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` loop_lemma))))\r
7796     THEN POP_ASSUM(fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_INVERSE th]));;\r
7797  \r
7798 let lemma_inverse_evaluation = prove(`!L:(A)loop x:A. back L (next L x) = x /\ next L (back L x) = x`,\r
7799    REPEAT GEN_TAC\r
7800    THEN REWRITE_TAC[CONJUNCT2(SPEC `L:(A)loop` lemma_inverse_on_loop)]\r
7801    THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop))]);;\r
7802 \r
7803 let lemma_second_inverse_on_loop = prove(`!L:(A)loop m:num. next L POWER m = inverse ((back L) POWER m) /\ back L POWER m = inverse ((next L) POWER m)`,\r
7804    REPEAT GEN_TAC\r
7805    THEN (MP_TAC(CONJUNCT1(SPEC `L:(A)loop`lemma_permute_loop)))\r
7806    THEN DISCH_THEN (MP_TAC o SPEC `m:num` o MATCH_MP lemma_power_inverse)\r
7807    THEN REWRITE_TAC[GSYM lemma_inverse_on_loop]\r
7808     THEN MESON_TAC[]);;\r
7809 \r
7810 let lemma_second_inverse_evaluation = prove(`!L:(A)loop (x:A) (m:num).(next L POWER m) ((back L POWER m) x) = x /\ (back L POWER m) ((next L POWER m) x) = x`, \r
7811    REPEAT GEN_TAC\r
7812    THEN LABEL_TAC "F1" (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop))\r
7813    THEN REWRITE_TAC[CONJUNCT2(SPECL[`L:(A)loop`; `m:num`] lemma_second_inverse_on_loop)]\r
7814    THEN POP_ASSUM (MP_TAC o  SPEC `m:num` o MATCH_MP power_permutation)\r
7815    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]));;\r
7816 \r
7817 let lemma_next_power_representation = prove(`!L:(A)loop (x:A) (y:A). x belong L /\ y belong L ==> ?k:num. k <= top L /\ y = ((next L) POWER k) x`,\r
7818   REPEAT GEN_TAC\r
7819    THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o REWRITE_RULE[belong]))\r
7820    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
7821     THEN REWRITE_TAC[GSYM LT_SUC_LE]\r
7822     THEN STRIP_ASSUME_TAC(CONJUNCT2(SPEC `L:(A)loop` lemma_size))\r
7823     THEN POP_ASSUM (SUBST1_TAC o SYM)\r
7824     THEN ASSUME_TAC (SPEC `L:(A)loop` lemma_order_next)\r
7825     THEN  POP_ASSUM (fun th-> MP_TAC (REWRITE_RULE[I_THM](AP_THM th `x:A`)))\r
7826     THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_NZ])\r
7827     THEN DISCH_THEN(fun th-> DISCH_THEN(fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1)]))\r
7828     THEN REWRITE_TAC[IN_ELIM_THM]);;\r
7829 \r
7830 let lemma_loop_index = new_specification["index"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_next_power_representation);;\r
7831 \r
7832 let lemma_power_next_in_loop = prove(`!L:(A)loop x:A k:num. x belong L ==> ((next L POWER k) x) belong L`,\r
7833    REPEAT GEN_TAC\r
7834    THEN REWRITE_TAC[belong]\r
7835    THEN STRIP_TAC\r
7836    THEN MP_TAC(SPECL[`k:num`; `x:A`] (MATCH_MP iterate_orbit (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop))))\r
7837    THEN ASM_REWRITE_TAC[]);;\r
7838 \r
7839 let lemma_belong_loop = prove(`!L:(A)loop x:A. x belong L ==> (!y:A. y belong L <=> ?i:num. i <= top L /\ y = (next L POWER i) x)`,\r
7840    MESON_TAC[lemma_power_next_in_loop; lemma_next_power_representation]);;\r
7841 \r
7842 let lemma_next_in_loop = prove(`!L:(A)loop x:A. x belong L ==> next L x belong L`,\r
7843    REPEAT GEN_TAC\r
7844    THEN DISCH_THEN(fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1](SPEC `1` (MATCH_MP lemma_power_next_in_loop th))]));;\r
7845 \r
7846 let lemma_power_back_in_loop = prove(`!L:(A)loop x:A k:num. x belong L ==> ((back L POWER k) x) belong L`,\r
7847    REPEAT GEN_TAC\r
7848    THEN REWRITE_TAC[belong]\r
7849    THEN STRIP_TAC\r
7850    THEN MP_TAC(SPECL[`k:num`; `x:A`] (MATCH_MP iterate_orbit (CONJUNCT2(SPEC `L:(A)loop` lemma_permute_loop))))\r
7851    THEN ASM_REWRITE_TAC[]);;\r
7852 \r
7853 let lemma_back_in_loop = prove(`!L:(A)loop x:A. x belong L ==> back L x belong L`,\r
7854    REPEAT GEN_TAC\r
7855    THEN DISCH_THEN(fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1](SPEC `1` (MATCH_MP lemma_power_back_in_loop th))]));;\r
7856 \r
7857 let determine_loop_index = prove(`!L:(A)loop x:A y:A k:num. x belong L /\ k <= top L /\ y = (next L POWER k) x ==> index L x y = k`,\r
7858    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
7859    THEN USE_THEN "F1" (MP_TAC o SPEC `k:num` o MATCH_MP lemma_power_next_in_loop)\r
7860    THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
7861    THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1)))))\r
7862    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))\r
7863    THEN ABBREV_TAC `n = index (L:(A)loop) (x:A) (y:A)`\r
7864    THEN MP_TAC (CONJUNCT1 (REWRITE_RULE[CONJ_ASSOC] (SPEC `L:(A)loop` loop_lemma)))\r
7865    THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `top (L:(A)loop)`] o MATCH_MP lemma_segment_orbit)\r
7866    THEN USE_THEN "F1"(fun th->REWRITE_TAC[SYM(MATCH_MP lemma_transitive_permutation th)])\r
7867    THEN REWRITE_TAC[GSYM size; lemma_size; LT_PLUS]\r
7868    THEN DISCH_THEN (MP_TAC o SPECL[`n:num`; `k:num`] o REWRITE_RULE[lemma_inj_orbit_via_list; lemma_inj_list2; power_list])\r
7869    THEN USE_THEN "F5" (fun th->USE_THEN "F3" (fun th1-> USE_THEN "F4" (fun th2-> USE_THEN "F2" (fun th3-> REWRITE_TAC[SYM th; SYM th1; th2; th3])))));;\r
7870 \r
7871 let support_loop_sub_dart = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). is_loop H L /\ x IN dart H /\ x belong L ==> dart_of L SUBSET dart H`,\r
7872  REPEAT GEN_TAC\r
7873    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
7874    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
7875    THEN SUBGOAL_THEN `!j:num. ((next (L:(A)loop)) POWER j) (x:A) IN dart (H:(A)hypermap)` ASSUME_TAC\r
7876    THENL[INDUCT_TAC THENL[ASM_REWRITE_TAC[POWER_0; I_THM] THEN REWRITE_TAC[COM_POWER; o_THM]; ALL_TAC]\r
7877       THEN REWRITE_TAC[COM_POWER; o_THM]\r
7878       THEN REMOVE_THEN "F3" (fun th -> ASSUME_TAC(SPEC `j:num` (MATCH_MP lemma_power_next_in_loop th)))\r
7879       THEN ABBREV_TAC `y = (next (L:(A)loop) POWER (j:num)) (x:A)`\r
7880       THEN REMOVE_THEN "F1" (MP_TAC o SPEC `y:A` o REWRITE_RULE[is_loop])\r
7881       THEN ASM_REWRITE_TAC[]\r
7882       THEN REWRITE_TAC[one_step_contour]\r
7883       THEN STRIP_TAC\r
7884       THENL[POP_ASSUM SUBST1_TAC\r
7885          THEN UNDISCH_THEN `y:A IN dart (H:(A)hypermap)` (fun th -> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]); ALL_TAC]\r
7886       THEN POP_ASSUM SUBST1_TAC\r
7887       THEN UNDISCH_THEN `y:A IN dart (H:(A)hypermap)` (fun th -> REWRITE_TAC[MATCH_MP lemma_dart_inveriant_under_inverse_maps th]); ALL_TAC]\r
7888    THEN REWRITE_TAC[orbit_map; SUBSET; IN_ELIM_THM]\r
7889    THEN GEN_TAC\r
7890    THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (SUBST1_TAC o CONJUNCT2))\r
7891    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
7892 \r
7893 let lemma_loop_contour  = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) n:num. is_loop H L /\ x belong L ==> is_contour H (loop_path L x) n`,\r
7894    REPEAT GEN_TAC\r
7895    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
7896    THEN REWRITE_TAC[lemma_def_contour]\r
7897    THEN REPEAT STRIP_TAC\r
7898    THEN REWRITE_TAC[loop_path]\r
7899    THEN REWRITE_TAC[COM_POWER; o_THM]\r
7900    THEN USE_THEN "F2" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop)\r
7901    THEN DISCH_THEN (fun th-> USE_THEN "F1"(MP_TAC o REWRITE_RULE[th] o SPEC `(next (L:(A)loop) POWER (i:num)) (x:A)` o  REWRITE_RULE[is_loop]))\r
7902    THEN SIMP_TAC[]);;\r
7903 \r
7904 let lemma_inj_loop_path = prove(`!L:(A)loop (x:A). x belong L ==> (!n:num. n <= top L <=> is_inj_list (loop_path L x) n)`,\r
7905    REPEAT GEN_TAC\r
7906    THEN DISCH_THEN (LABEL_TAC "F1")\r
7907    THEN REWRITE_TAC[lemma_loop_path_via_list; GSYM LT_SUC_LE; GSYM lemma_size; GSYM lemma_def_inj_orbit; size; GSYM lemma_inj_orbit_via_list]\r
7908    THEN GEN_TAC\r
7909    THEN EQ_TAC\r
7910    THENL[MP_TAC(CONJUNCT1(REWRITE_RULE[CONJ_ASSOC] (SPEC `L:(A)loop` loop_lemma)))\r
7911        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
7912        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_segment_orbit th]); ALL_TAC]\r
7913    THEN ASM_CASES_TAC `n:num < CARD (dart_of (L:(A)loop))`\r
7914    THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
7915    THEN DISCH_THEN (MP_TAC o SPECL[] o SPECL[`0`; `CARD (dart_of (L:(A)loop))`] o REWRITE_RULE[lemma_inj_orbit])\r
7916    THEN POP_ASSUM (fun th-> REWRITE_TAC[LE_0; REWRITE_RULE[NOT_LT] th; POWER_0; I_THM])\r
7917    THEN MP_TAC(CONJUNCT1(REWRITE_RULE[CONJ_ASSOC] (SPEC `L:(A)loop` loop_lemma)))\r
7918    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
7919    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_cycle_orbit th])\r
7920    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_transitive_permutation th); GSYM size])\r
7921    THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` lemma_size)))\r
7922    THEN DISCH_THEN (fun th-> REWRITE_TAC[GSYM (REWRITE_RULE[LT_NZ] th)]));;\r
7923 \r
7924 let let_order_for_loop = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). is_loop H L /\ x belong L \r
7925    ==> is_inj_contour H (loop_path L x) (top L) /\ one_step_contour H (loop_path L x (top L)) (loop_path L x 0)`,\r
7926    REPEAT GEN_TAC\r
7927    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
7928    THEN STRIP_TAC\r
7929    THENL[REWRITE_TAC[lemma_inj_contour_via_list]\r
7930        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_loop_contour (CONJ th th1)]))\r
7931        THEN USE_THEN "F2" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_inj_loop_path th); LE_REFL]); ALL_TAC]\r
7932    THEN REWRITE_TAC[loop_path; POWER_0; I_THM]\r
7933    THEN USE_THEN "F1"(MP_TAC o SPEC `(next (L:(A)loop) POWER  top L) x` o  REWRITE_RULE[is_loop])\r
7934    THEN REWRITE_TAC[iterate_map_valuation; GSYM lemma_size; lemma_order_next; I_THM]\r
7935    THEN USE_THEN "F2" (MP_TAC o SPEC `top (L:(A)loop)` o MATCH_MP lemma_power_next_in_loop)\r
7936    THEN SIMP_TAC[]);;\r
7937 \r
7938 let lemma_list_next = prove(`!p:num->A n:num. ?h:A->A. (!x:A. (~(in_list p n x) ==> h x = x) /\ (in_list p n x ==> ?j:num. j <= n /\ x = p j /\ h x = p (SUC j MOD SUC n)))`,\r
7939  REPEAT GEN_TAC\r
7940    THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
7941    THEN GEN_TAC\r
7942    THEN ASM_CASES_TAC `~(in_list (p:num->A) (n:num) (x:A))`\r
7943    THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
7944    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
7945    THEN ASM_REWRITE_TAC[]\r
7946    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_list])\r
7947    THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
7948    THEN EXISTS_TAC `j:num` THEN EXISTS_TAC `(p:num->A) (SUC j MOD SUC n)`\r
7949    THEN ASM_REWRITE_TAC[]);;\r
7950 \r
7951 let lemma_samsara = new_specification["samsara"] (REWRITE_RULE[SKOLEM_THM] lemma_list_next);;\r
7952 \r
7953 let samsara_formula = prove(`!p:num->A n:num. is_inj_list p n ==> (!j:num. j <= n ==> samsara p n (p j) = p (SUC j MOD SUC n))`,\r
7954  REPEAT GEN_TAC\r
7955    THEN DISCH_THEN (LABEL_TAC "F1")\r
7956    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F2")\r
7957    THEN USE_THEN "F2" (MP_TAC o SPEC `p:num->A` o MATCH_MP lemma_element_in_list)\r
7958    THEN DISCH_THEN (fun th-> MP_TAC(MATCH_MP (CONJUNCT2 (SPECL[`p:num->A`; `n:num`; `(p:num->A) j`] lemma_samsara)) th))\r
7959    THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F3") SUBST1_TAC)))\r
7960    THEN AP_TERM_TAC\r
7961    THEN REMOVE_THEN "F1" (MP_TAC o SPECL[`i:num`; `j:num`] o REWRITE_RULE[lemma_inj_list2])\r
7962    THEN ASM_REWRITE_TAC[]\r
7963    THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;\r
7964 \r
7965 let evaluation_samsara = prove(`!p:num->A n:num. is_inj_list p n \r
7966    ==> samsara p n (p n) = p 0 /\ !j:num. j < n ==> samsara p n (p j) = p (SUC j)`,\r
7967  REPEAT GEN_TAC\r
7968    THEN DISCH_THEN (ASSUME_TAC o MATCH_MP samsara_formula)\r
7969    THEN STRIP_TAC\r
7970    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`)\r
7971        THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC\r
7972        THEN MP_TAC (SPEC `1` (MATCH_MP MOD_MULT (SPEC `n:num` NON_ZERO)))\r
7973        THEN REWRITE_TAC [ARITH_RULE `(SUC n) * 1 = SUC n`]; ALL_TAC]\r
7974    THEN REPEAT STRIP_TAC\r
7975    THEN FIRST_X_ASSUM (MP_TAC o SPEC `j:num` o check (is_forall o concl))\r
7976    THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th] THEN ASSUME_TAC th)\r
7977    THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC\r
7978    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (ONCE_REWRITE_RULE[GSYM LT_SUC] th)]));;\r
7979 \r
7980 let lemma_permutes_via_surjetive = prove(`!s:A->bool p:A->A. \r
7981    FINITE s /\ (!x:A. ~(x IN s) ==> p x = x) /\ (!x:A. x IN s ==> p x IN s) /\ (!y:A. y IN s ==> ?x:A. p x = y) ==> p permutes s`,\r
7982 REPEAT GEN_TAC\r
7983    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "G4"))))\r
7984    THEN SUBGOAL_THEN `!y:A. y IN s:A->bool ==> (?x:A. x IN s /\ p x = y)` (LABEL_TAC "F4")\r
7985    THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "G1")\r
7986        THEN REMOVE_THEN "G4" (fun th-> (USE_THEN "G1" (MP_TAC o MATCH_MP th)))\r
7987        THEN DISCH_THEN (X_CHOOSE_THEN `t:A` (SUBST_ALL_TAC o SYM))\r
7988        THEN EXISTS_TAC `t:A`\r
7989        THEN SIMP_TAC[]\r
7990        THEN ASM_CASES_TAC `~(t:A IN s:A->bool)`\r
7991        THENL[USE_THEN "F2" (fun th-> (POP_ASSUM (SUBST_ALL_TAC o MATCH_MP th)))\r
7992            THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
7993        THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[] th]); ALL_TAC]\r
7994    THEN REWRITE_TAC[permutes]\r
7995    THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th])\r
7996    THEN GEN_TAC\r
7997    THEN REWRITE_TAC[EXISTS_UNIQUE_THM]\r
7998    THEN ASM_CASES_TAC `~(y:A IN s:A->bool)`\r
7999    THENL[STRIP_TAC\r
8000       THENL[EXISTS_TAC `y:A` THEN POP_ASSUM MP_TAC\r
8001          THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
8002       THEN POP_ASSUM (LABEL_TAC "F5")\r
8003       THEN REPEAT GEN_TAC\r
8004       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))\r
8005       THEN ASM_CASES_TAC `x:A IN s:A->bool`\r
8006       THENL[USE_THEN "F3"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th)))\r
8007          THEN REMOVE_THEN "F6" (SUBST1_TAC)\r
8008          THEN REMOVE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
8009       THEN USE_THEN "F2"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th)))\r
8010       THEN REMOVE_THEN "F6" SUBST1_TAC\r
8011       THEN DISCH_THEN (SUBST1_TAC o SYM) \r
8012       THEN ASM_CASES_TAC `x':A IN s:A->bool`\r
8013       THENL[USE_THEN "F3"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th)))\r
8014          THEN REMOVE_THEN "F7" (SUBST1_TAC)\r
8015          THEN REMOVE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
8016       THEN USE_THEN "F2"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th)))\r
8017       THEN REMOVE_THEN "F7" SUBST1_TAC\r
8018       THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
8019    THEN POP_ASSUM (LABEL_TAC "F8" o REWRITE_RULE[])\r
8020    THEN STRIP_TAC\r
8021    THENL[USE_THEN "F4"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th))) \r
8022       THEN STRIP_TAC THEN EXISTS_TAC `x:A`\r
8023       THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8024    THEN REPEAT GEN_TAC\r
8025    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10"))\r
8026    THEN ASM_CASES_TAC `~(x:A IN s:A->bool)`\r
8027    THENL[POP_ASSUM (LABEL_TAC "F11")\r
8028        THEN USE_THEN "F2"(fun th-> (USE_THEN "F11" (MP_TAC o MATCH_MP th)))\r
8029        THEN REMOVE_THEN "F9" SUBST1_TAC\r
8030        THEN DISCH_THEN (fun th-> (POP_ASSUM (MP_TAC o REWRITE_RULE[SYM th])))\r
8031        THEN REMOVE_THEN "F8" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
8032    THEN POP_ASSUM (LABEL_TAC "F12" o REWRITE_RULE[])\r
8033    THEN ASM_CASES_TAC `~(x':A IN s:A->bool)`\r
8034    THENL[POP_ASSUM (LABEL_TAC "F14")\r
8035        THEN USE_THEN "F2"(fun th-> (USE_THEN "F14" (MP_TAC o MATCH_MP th)))\r
8036        THEN REMOVE_THEN "F10" SUBST1_TAC\r
8037        THEN DISCH_THEN (fun th-> (POP_ASSUM (MP_TAC o REWRITE_RULE[SYM th])))\r
8038        THEN REMOVE_THEN "F8" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
8039    THEN REMOVE_THEN "F9" MP_TAC\r
8040    THEN REMOVE_THEN "F10" (SUBST1_TAC o SYM)\r
8041    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[])\r
8042    THEN POP_ASSUM (MP_TAC)\r
8043    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
8044    THEN SUBGOAL_THEN `IMAGE (p:A->A) (s:A->bool) SUBSET s` MP_TAC\r
8045    THENL[REWRITE_TAC[IMAGE; SUBSET]\r
8046       THEN GEN_TAC\r
8047       THEN REWRITE_TAC[IN_ELIM_THM]\r
8048       THEN DISCH_THEN (X_CHOOSE_THEN `t:A` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))\r
8049       THEN USE_THEN "F3"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th)))\r
8050       THEN SIMP_TAC[]; ALL_TAC]\r
8051    THEN USE_THEN "F1" (fun th-> (DISCH_THEN (fun th1-> (MP_TAC (MATCH_MP SURJECTIVE_IFF_INJECTIVE (CONJ th th1))))))\r
8052    THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
8053    THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `x':A`])\r
8054    THEN SIMP_TAC[]);;\r
8055 \r
8056 let lemma_back_index = prove(`!n:num i:num. 0 < i /\ i <= n ==> (i + n) MOD (SUC n) = PRE i`,\r
8057    REPEAT GEN_TAC\r
8058    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
8059    THEN USE_THEN "F1" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP LT_SUC_PRE th])\r
8060    THEN REWRITE_TAC[ADD] THEN REWRITE_TAC[GSYM ADD_SUC]\r
8061    THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8062    THEN REWRITE_TAC[REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC n`; `PRE i`] MOD_MULT_ADD)]\r
8063    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (MATCH_MP (ARITH_RULE `i:num <= n:num ==> PRE i < SUC n`) th)]));;\r
8064 \r
8065 let lemma_suc_mod = prove(`!m:num n:num. ~(n = 0) ==> SUC (m MOD n) MOD n = SUC m MOD n`,\r
8066    REPEAT GEN_TAC\r
8067    THEN DISCH_THEN (LABEL_TAC "F1")\r
8068    THEN USE_THEN "F1" (MP_TAC o SPEC `m:num` o MATCH_MP DIVMOD_EXIST)\r
8069    THEN DISCH_THEN (X_CHOOSE_THEN `q:num` (X_CHOOSE_THEN `r:num` (CONJUNCTS_THEN2 (LABEL_TAC "F2") ASSUME_TAC)))\r
8070    THEN USE_THEN "F2" (fun th-> (POP_ASSUM(fun th1-> SUBST_ALL_TAC (CONJUNCT2 (MATCH_MP DIVMOD_UNIQ (CONJ th th1))))))\r
8071    THEN POP_ASSUM SUBST1_TAC\r
8072    THEN REWRITE_TAC[GSYM ADD_SUC; MOD_MULT_ADD]);;\r
8073 \r
8074 let lemma_from_index = prove(`!n:num j:num. j <= n ==> SUC ((j + n) MOD SUC n) MOD SUC n = j`,\r
8075    REPEAT GEN_TAC\r
8076    THEN DISCH_THEN (LABEL_TAC "F1")\r
8077    THEN REWRITE_TAC[MATCH_MP lemma_suc_mod (SPEC `k:num` NON_ZERO); GSYM ADD_SUC]\r
8078    THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8079    THEN REWRITE_TAC[REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC k`; `i:num`] MOD_MULT_ADD)]\r
8080    THEN POP_ASSUM(fun th-> REWRITE_TAC[MATCH_MP MOD_LT (REWRITE_RULE[GSYM LT_SUC_LE] th)]));;\r
8081 \r
8082 let lemma_from_index2 = prove(`!n:num i:num. i <= n ==> (((SUC i MOD SUC n) + n) MOD SUC n) = i`,\r
8083    REPEAT STRIP_TAC\r
8084    THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM(MATCH_MP MOD_LT (SPEC `k:num` LT_PLUS))]\r
8085    THEN REWRITE_TAC[MATCH_MP MOD_ADD_MOD (SPEC `k:num` NON_ZERO)]\r
8086    THEN REWRITE_TAC[ADD]\r
8087    THEN REWRITE_TAC[GSYM ADD_SUC]\r
8088    THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8089    THEN REWRITE_TAC[(REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC k`; `i:num`] MOD_MULT_ADD))]\r
8090    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (REWRITE_RULE[GSYM LT_SUC_LE] th)]));;\r
8091 \r
8092 let lemma_samsara_permute = prove(`!p:num->A n:num. is_inj_list p n ==> samsara p n permutes support_list p n`,\r
8093  REPEAT GEN_TAC\r
8094    THEN DISCH_THEN (LABEL_TAC "F1")\r
8095    THEN MATCH_MP_TAC lemma_permutes_via_surjetive\r
8096    THEN REWRITE_TAC[lemma_finite_list; GSYM in_list; lemma_samsara]\r
8097    THEN STRIP_TAC\r
8098    THENL[GEN_TAC\r
8099        THEN REWRITE_TAC[lemma_in_list]\r
8100        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (SUBST1_TAC)))\r
8101        THEN EXISTS_TAC `SUC j MOD SUC n`\r
8102        THEN REWRITE_TAC[LE_MOD_SUC]\r
8103        THEN USE_THEN "F1" (MP_TAC o SPEC `j:num` o MATCH_MP samsara_formula)\r
8104        THEN POP_ASSUM(fun th->REWRITE_TAC[th]); ALL_TAC]\r
8105    THEN GEN_TAC THEN REWRITE_TAC[lemma_in_list]\r
8106    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (SUBST1_TAC)))\r
8107    THEN EXISTS_TAC `(p:num->A) (((j:num) + (n:num)) MOD SUC n)`\r
8108    THEN USE_THEN "F1" (MP_TAC o SPEC `((j:num) + (n:num)) MOD SUC n` o MATCH_MP samsara_formula)\r
8109    THEN REWRITE_TAC[LE_MOD_SUC]\r
8110    THEN DISCH_THEN SUBST1_TAC\r
8111    THEN AP_TERM_TAC\r
8112    THEN POP_ASSUM(fun th-> REWRITE_TAC[MATCH_MP lemma_from_index th]));;\r
8113 \r
8114 let lemma_samsara_power = prove(`!p:num->A n:num. is_inj_list p n \r
8115    ==> ((samsara p n) POWER (SUC n)) (p 0) = p 0 /\ (!j:num. j <= n ==> ((samsara p n) POWER j) (p 0) = p j)`,\r
8116  REPEAT GEN_TAC\r
8117    THEN DISCH_THEN (LABEL_TAC "F1")\r
8118    THEN SUBGOAL_THEN `!j:num. j <= n ==> ((samsara (p:num->A) n) POWER j) (p 0) = p j` ASSUME_TAC\r
8119    THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC]\r
8120       THEN POP_ASSUM (LABEL_TAC "F2")\r
8121       THEN DISCH_THEN (LABEL_TAC "F3")\r
8122       THEN USE_THEN "F3" (fun th -> (ASSUME_TAC (MATCH_MP LT_IMP_LE (REWRITE_RULE[LE_SUC_LT] th))))\r
8123       THEN REWRITE_TAC[COM_POWER; o_THM]\r
8124       THEN POP_ASSUM (fun th-> REMOVE_THEN "F2" (fun th1 -> REWRITE_TAC[REWRITE_RULE[th] th1]))\r
8125       THEN USE_THEN "F1" (MP_TAC o SPEC `j:num` o CONJUNCT2 o MATCH_MP evaluation_samsara)\r
8126       THEN POP_ASSUM (fun th -> REWRITE_TAC[REWRITE_RULE[LE_SUC_LT] th]); ALL_TAC]\r
8127    THEN ASM_REWRITE_TAC[]\r
8128    THEN REWRITE_TAC[COM_POWER; o_THM]\r
8129    THEN POP_ASSUM (fun th -> REWRITE_TAC[REWRITE_RULE[LE_REFL] (SPEC `n:num` th)])\r
8130    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP evaluation_samsara th]));;\r
8131 \r
8132 let lemma_generate_loop = prove(`!p:num->A n:num. is_inj_list p n \r
8133   ==> dart_of (loop(support_list p n, samsara p n)) = support_list p n /\ next (loop(support_list p n, samsara p n)) = samsara p n`,\r
8134  REPEAT GEN_TAC\r
8135    THEN DISCH_THEN (LABEL_TAC "F1")\r
8136    THEN MATCH_MP_TAC lemma_loop_representation\r
8137    THEN EXISTS_TAC `(p:num->A) 0`\r
8138    THEN REWRITE_TAC[lemma_finite_list]\r
8139    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_samsara_permute th])\r
8140    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_samsara_power)\r
8141    THEN MP_TAC (SPEC `n:num` NON_ZERO)\r
8142    THEN REWRITE_TAC[IMP_IMP]\r
8143    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP orbit_cyclic th])\r
8144    THEN REWRITE_TAC[LT_SUC_LE; support_list]\r
8145    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_samsara_power)\r
8146    THEN SET_TAC[lemma_two_series_eq]);;\r
8147 \r
8148 let lemma_make_contour_loop = prove(`!(H:(A)hypermap) (p:num->A) (n:num). is_inj_contour H p n /\ one_step_contour H (p n) (p 0) \r
8149     ==> is_loop H (loop(support_list p n, samsara p n))`,\r
8150  REPEAT GEN_TAC\r
8151    THEN REWRITE_TAC[lemma_inj_contour_via_list]\r
8152    THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) (LABEL_TAC "F3"))\r
8153    THEN REWRITE_TAC[is_loop]\r
8154    THEN GEN_TAC\r
8155    THEN REWRITE_TAC[belong]\r
8156    THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_generate_loop th])\r
8157    THEN REWRITE_TAC[GSYM in_list; lemma_in_list]\r
8158    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))\r
8159    THEN ASM_CASES_TAC `j:num = n`\r
8160    THENL[POP_ASSUM SUBST1_TAC\r
8161       THEN USE_THEN "F2"(fun th-> REWRITE_TAC[MATCH_MP evaluation_samsara th])\r
8162       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
8163    THEN POP_ASSUM(fun th-> (POP_ASSUM(fun th1->(LABEL_TAC "F4" (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th))))))\r
8164    THEN USE_THEN "F4"(fun th1->(USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP (CONJUNCT2(MATCH_MP evaluation_samsara th)) th1])))\r
8165    THEN REMOVE_THEN "F1" (MP_TAC o SPEC `j:num` o REWRITE_RULE[lemma_def_contour])\r
8166    THEN ASM_REWRITE_TAC[]);;\r
8167 \r
8168 let lemma_number_darts_of_inj_contour = prove(`!(H:(A)hypermap) (p:num->A) (n:num). is_inj_contour H p n ==> CARD (support_list p n) = SUC n`,\r
8169    REPEAT GEN_TAC\r
8170    THEN REWRITE_TAC[lemma_def_inj_contour; support_list]\r
8171    THEN CONV_TAC ((LAND_CONV o ONCE_DEPTH_CONV) SYM_CONV)\r
8172    THEN REWRITE_TAC[GSYM LT_SUC_LE]\r
8173    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP CARD_FINITE_SERIES_EQ (CONJUNCT2 th)]));;\r
8174 \r
8175 let lemma_inj_contour_belong_darts = prove(`!(H:(A)hypermap) (p:num->A) (n:num). 0 < n /\ is_inj_contour H p n ==> support_list p n  SUBSET dart H`,\r
8176      REPEAT GEN_TAC\r
8177      THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_first_dart_on_inj_contour th) THEN ASSUME_TAC (CONJUNCT2 th)))\r
8178      THEN POP_ASSUM (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour])\r
8179      THEN REWRITE_TAC[IMP_IMP; CONJ_SYM]\r
8180      THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_darts_in_contour th; support_list]));;\r
8181 \r
8182 let lemma_dart_loop_via_path = prove(`!L:(A)loop x:A. x belong L ==> dart_of L = support_list (loop_path L x) (top L)`,\r
8183  REPEAT STRIP_TAC\r
8184    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
8185    THEN MP_TAC (AP_THM (SPEC `L:(A)loop` lemma_order_next) `x:A`)\r
8186    THEN REWRITE_TAC[I_THM]\r
8187    THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` lemma_size)))\r
8188    THEN REWRITE_TAC[LT_NZ; IMP_IMP; support_list; loop_path]\r
8189    THEN DISCH_THEN (MP_TAC o MATCH_MP orbit_cyclic)\r
8190    THEN REWRITE_TAC[lemma_size; GSYM LT_SUC_LE]);;\r
8191 \r
8192 let lemma_belong = prove(`!L:(A)loop x:A. x belong L ==> (!y:A. y belong L <=> in_list (loop_path L x) (top L) y)`,\r
8193    REPEAT STRIP_TAC\r
8194    THEN REWRITE_TAC[belong]\r
8195    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_dart_loop_via_path th])\r
8196    THEN REWRITE_TAC[in_list]);;\r
8197 \r
8198 (*******************************************************************************************************************************)\r
8199 \r
8200 let lemmaILTXRQD =prove(`!(H:(A)hypermap) (L:(A)loop) (p:num->A) (k:num).((is_loop H L) /\ (is_inj_contour H p k) /\ (2 <= k) /\ ((p 0) belong L) /\ (p k) belong L /\ (!i:num. 0 < i /\ i < k ==> ~((p i) belong L)) /\ (!q:num->A m:num. ~(is_Moebius_contour H q m))) ==>\r
8201 (p 1 = inverse (node_map H) (p 0) ==> ~(p k = face_map H (p (PRE k)))) /\ (p 1 = face_map H (p 0) ==>  ~(p k = inverse (node_map H) (p (PRE k))))`,\r
8202    REPEAT GEN_TAC\r
8203    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))))))\r
8204    THEN USE_THEN "F2" MP_TAC\r
8205    THEN REWRITE_TAC[lemma_def_inj_contour]\r
8206    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FC") (LABEL_TAC "F8"))\r
8207    THEN USE_THEN "F8" (MP_TAC o SPECL[`k:num`; `0`])\r
8208    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= k:num ==> 0 < k`) th; LE_REFL])\r
8209    THEN DISCH_THEN (LABEL_TAC "F9")\r
8210    THEN SUBGOAL_THEN `1 <= top (L:(A)loop)` (LABEL_TAC "F10")\r
8211    THENL[ ONCE_REWRITE_TAC[GSYM LE_SUC]\r
8212       THEN REWRITE_TAC[GSYM TWO]\r
8213       THEN REWRITE_TAC[GSYM lemma_size; size]\r
8214       THEN MATCH_MP_TAC CARD_ATLEAST_2\r
8215       THEN EXISTS_TAC `(p:num->A) 0`\r
8216       THEN EXISTS_TAC `(p:num->A) (k:num)`\r
8217       THEN REWRITE_TAC[GSYM belong]\r
8218       THEN ASM_REWRITE_TAC[loop_lemma]; ALL_TAC]\r
8219    THEN USE_THEN "F3" (MP_TAC o MATCH_MP (ARITH_RULE `2 <= k:num ==> 0 < PRE k /\ 0 < k /\ PRE k < k`))\r
8220    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K1") (CONJUNCTS_THEN2 (LABEL_TAC "K2") (LABEL_TAC "K3")))\r
8221    THEN STRIP_TAC\r
8222    THENL[REWRITE_TAC[GSYM node_map_inverse_representation]\r
8223        THEN DISCH_THEN (LABEL_TAC "G10")\r
8224        THEN DISCH_THEN (LABEL_TAC "G12")\r
8225        THEN REMOVE_THEN "F7" MP_TAC\r
8226        THEN REWRITE_TAC[NOT_FORALL_THM]\r
8227        THEN REMOVE_THEN "F4" MP_TAC\r
8228        THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong th])\r
8229        THEN DISCH_THEN (LABEL_TAC "G4")\r
8230        THEN REMOVE_THEN "F6" MP_TAC\r
8231        THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong th])\r
8232        THEN DISCH_THEN (LABEL_TAC "G6")\r
8233        THEN MP_TAC (SPECL[`L:(A)loop`; `(p:num->A) (k:num)`; `0`] loop_path)\r
8234        THEN REWRITE_TAC[POWER_0; I_THM]\r
8235        THEN DISCH_THEN (LABEL_TAC "G15")\r
8236        THEN USE_THEN "F1" (fun th-> (REMOVE_THEN "F5" (fun th1-> (MP_TAC (MATCH_MP let_order_for_loop (CONJ th th1))))))\r
8237        THEN ABBREV_TAC `ploop = loop_path (L:(A)loop) ((p:num->A) (k:num))`\r
8238        THEN ABBREV_TAC `n = top (L:(A)loop)`\r
8239        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G16") (MP_TAC))\r
8240        THEN REWRITE_TAC[one_step_contour]\r
8241        THEN USE_THEN "G15" SUBST1_TAC\r
8242        THEN STRIP_TAC\r
8243        THENL[POP_ASSUM MP_TAC\r
8244           THEN USE_THEN "G12" SUBST1_TAC\r
8245           THEN REWRITE_TAC[face_map_injective]\r
8246           THEN DISCH_THEN (fun th-> (ASSUME_TAC (MATCH_MP lemma_in_list2 (CONJ (SPEC `n:num` LE_REFL) th))))\r
8247           THEN USE_THEN "G6" (MP_TAC o SPEC `PRE k`)\r
8248           THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th])\r
8249           THEN USE_THEN "K3" (fun th -> REWRITE_TAC[th])\r
8250           THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8251       THEN POP_ASSUM MP_TAC\r
8252       THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
8253       THEN DISCH_THEN (LABEL_TAC "G17")\r
8254       THEN USE_THEN "K2" MP_TAC\r
8255       THEN REWRITE_TAC[LT0_LE1]\r
8256       THEN USE_THEN "F2" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_shift_inj_contour (CONJ th1 th2))))))\r
8257       THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < k:num ==> k-1 = PRE k`) th])\r
8258       THEN DISCH_THEN (LABEL_TAC "G18")\r
8259       THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < k:num ==> k - 1 = PRE k`) th])\r
8260       THEN MP_TAC(SPECL[`p:num->A`; `1`; `PRE k`] lemma_shift_path_evaluation)\r
8261       THEN ONCE_REWRITE_TAC[GSYM ADD_SYM]\r
8262       THEN USE_THEN "K2" (fun th -> REWRITE_TAC[SYM(MATCH_MP LT_PRE th)])\r
8263       THEN DISCH_THEN (fun th -> LABEL_TAC "G19" th THEN MP_TAC th)\r
8264       THEN USE_THEN "G15" (SUBST1_TAC o SYM)\r
8265       THEN DISCH_THEN (LABEL_TAC "G20")\r
8266       THEN SUBGOAL_THEN `!j:num. 0 < j /\ j <= n:num ==> (!i:num. i <= PRE k ==> ~((ploop:num->A) j = shift_path (p:num->A) 1 i))` ASSUME_TAC\r
8267       THENL[REWRITE_TAC[shift_path]\r
8268           THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8269           THEN GEN_TAC\r
8270           THEN REPLICATE_TAC 2 STRIP_TAC\r
8271           THEN ASM_CASES_TAC `i:num = PRE k`\r
8272           THENL[POP_ASSUM SUBST1_TAC\r
8273               THEN USE_THEN "K2" (fun th -> REWRITE_TAC[SYM(MATCH_MP LT_PRE th); LE_REFL])\r
8274               THEN USE_THEN "G15" (SUBST1_TAC o SYM)\r
8275               THEN USE_THEN "G16" MP_TAC\r
8276               THEN REWRITE_TAC[lemma_def_inj_contour]\r
8277               THEN DISCH_THEN (MP_TAC o SPECL[`j:num`; `0`] o CONJUNCT2)\r
8278               THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
8279               THEN MESON_TAC[]; ALL_TAC]\r
8280           THEN POP_ASSUM MP_TAC\r
8281           THEN REWRITE_TAC[IMP_IMP]\r
8282           THEN ONCE_REWRITE_TAC[CONJ_SYM]\r
8283           THEN REWRITE_TAC[GSYM LT_LE]\r
8284           THEN REWRITE_TAC[GSYM ADD1]\r
8285           THEN ONCE_REWRITE_TAC[GSYM LT_SUC]\r
8286           THEN USE_THEN "K2" (fun th -> REWRITE_TAC[SYM(MATCH_MP LT_SUC_PRE th)])\r
8287           THEN DISCH_TAC\r
8288           THEN DISCH_THEN (ASSUME_TAC o SYM)\r
8289           THEN MP_TAC (SPECL[`ploop:num->A`; `n:num`; `(p:num->A) (SUC i)`; `j:num`] lemma_in_list2)\r
8290           THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [th])\r
8291           THEN USE_THEN "G6" (MP_TAC o SPEC `SUC i`)\r
8292           THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
8293           THEN REWRITE_TAC[LT_0]; ALL_TAC]\r
8294       THEN REMOVE_THEN "G18" (fun th1 -> (REMOVE_THEN "G16" (fun th2 -> (REMOVE_THEN "G20" (fun th3 -> (POP_ASSUM (fun th4 -> (MP_TAC (MATCH_MP concatenate_two_contours (CONJ th1 (CONJ th2 (CONJ th3 th4))))))))))))\r
8295       THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "G21") (CONJUNCTS_THEN2 (LABEL_TAC "G22") (CONJUNCTS_THEN2 (LABEL_TAC "G23") (CONJUNCTS_THEN2 (LABEL_TAC "G24") (LABEL_TAC "G25"))))))\r
8296       THEN USE_THEN "G24" (MP_TAC o SPEC `PRE k`)\r
8297       THEN REWRITE_TAC[LE_REFL; shift_path]\r
8298       THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8299       THEN USE_THEN "K2" (fun th -> (REWRITE_TAC[SYM(MATCH_MP LT_PRE th)]))\r
8300       THEN DISCH_THEN (LABEL_TAC "G26")\r
8301       THEN REMOVE_THEN "G4" MP_TAC\r
8302       THEN REWRITE_TAC[lemma_in_list]\r
8303       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "G27") (LABEL_TAC "G28")))\r
8304       THEN SUBGOAL_THEN `j:num < n:num` (LABEL_TAC "G30")\r
8305       THENL[REWRITE_TAC[LT_LE]\r
8306           THEN USE_THEN "G27" (fun th -> REWRITE_TAC[th])\r
8307           THEN USE_THEN "F9" MP_TAC\r
8308           THEN REWRITE_TAC[CONTRAPOS_THM]\r
8309           THEN DISCH_TAC\r
8310           THEN USE_THEN "G28" MP_TAC\r
8311           THEN POP_ASSUM SUBST1_TAC\r
8312           THEN USE_THEN "G17" SUBST1_TAC\r
8313           THEN USE_THEN "G10" SUBST1_TAC\r
8314           THEN REWRITE_TAC[node_map_injective]\r
8315           THEN USE_THEN "F8" (MP_TAC o SPECL[`k:num`; `1`])\r
8316           THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <=k ==> 1 < k`) th; LE_REFL])\r
8317           THEN MESON_TAC[]; ALL_TAC]\r
8318       THEN REMOVE_THEN "G21" MP_TAC\r
8319       THEN REWRITE_TAC[shift_path]\r
8320       THEN REWRITE_TAC[ADD_0]\r
8321       THEN DISCH_THEN (LABEL_TAC "G31")\r
8322       THEN REMOVE_THEN "G25" (MP_TAC o SPEC `j:num`)\r
8323       THEN USE_THEN "G30" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
8324       THEN REMOVE_THEN "G28" (SUBST1_TAC o SYM)\r
8325       THEN DISCH_THEN (LABEL_TAC "G31")\r
8326       THEN EXISTS_TAC `g:num->A`\r
8327       THEN EXISTS_TAC `PRE k + (n:num)`\r
8328       THEN REWRITE_TAC[is_Moebius_contour]\r
8329       THEN USE_THEN "G23" (fun th -> REWRITE_TAC[th])\r
8330       THEN EXISTS_TAC `PRE k`\r
8331       THEN EXISTS_TAC `PRE k + (j:num)`\r
8332       THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th])\r
8333       THEN REWRITE_TAC[LE_ADD]\r
8334       THEN ONCE_REWRITE_TAC[LT_ADD_LCANCEL]\r
8335       THEN USE_THEN "G30" (fun th -> REWRITE_TAC[th])\r
8336       THEN REPLICATE_TAC 2 (POP_ASSUM SUBST1_TAC)\r
8337       THEN USE_THEN "G10" (fun th -> REWRITE_TAC[th])\r
8338       THEN USE_THEN "G26" SUBST1_TAC\r
8339       THEN USE_THEN "G22" SUBST1_TAC\r
8340       THEN USE_THEN "G17" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8341    THEN REMOVE_THEN "F4" (LABEL_TAC "TP" o REWRITE_RULE[POWER_1] o SPEC `1` o  MATCH_MP lemma_power_next_in_loop)\r
8342    THEN REMOVE_THEN "F1" (fun th->(USE_THEN "TP"(fun th1-> (LABEL_TAC "F1" (MATCH_MP let_order_for_loop (CONJ th th1))))))\r
8343    THEN MP_TAC (SPECL[`L:(A)loop`; `next (L:(A)loop) ((p:num->A) 0)`; `top (L:(A)loop)`] loop_path)\r
8344    THEN REWRITE_TAC[iterate_map_valuation2; GSYM lemma_size; lemma_order_next; I_THM]\r
8345    THEN DISCH_THEN (LABEL_TAC "F4" o SYM)\r
8346    THEN REMOVE_THEN "F5" MP_TAC\r
8347    THEN USE_THEN "TP" (fun th -> REWRITE_TAC[MATCH_MP lemma_belong th])\r
8348    THEN DISCH_THEN (LABEL_TAC "F5")\r
8349    THEN REMOVE_THEN "F6" MP_TAC\r
8350    THEN REMOVE_THEN "TP" (fun th -> REWRITE_TAC[MATCH_MP lemma_belong th])\r
8351    THEN DISCH_THEN (LABEL_TAC "F6")\r
8352    THEN ABBREV_TAC `ploop = loop_path (L:(A)loop) (next L ((p:num->A) 0))`\r
8353    THEN ABBREV_TAC `n = top (L:(A)loop)`\r
8354    THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
8355    THEN DISCH_THEN (LABEL_TAC "G10")\r
8356    THEN DISCH_THEN (LABEL_TAC "G12")\r
8357    THEN REMOVE_THEN "F7" MP_TAC\r
8358    THEN REWRITE_TAC[NOT_FORALL_THM]\r
8359    THEN USE_THEN "F1" (CONJUNCTS_THEN2 (LABEL_TAC "G16") (MP_TAC))\r
8360    THEN REWRITE_TAC[one_step_contour]\r
8361    THEN USE_THEN "F4" (SUBST1_TAC o SYM)\r
8362    THEN STRIP_TAC\r
8363    THENL[POP_ASSUM MP_TAC\r
8364       THEN USE_THEN "G10" (SUBST1_TAC o SYM)\r
8365       THEN DISCH_THEN (fun th-> (ASSUME_TAC (MATCH_MP lemma_in_list2 (CONJ (SPEC `n:num` LE_0) (SYM th)))))\r
8366       THEN USE_THEN "F6" (MP_TAC o SPEC `1`)\r
8367       THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= k:num ==> 1 < k`) th])\r
8368       THEN REWRITE_TAC[ARITH_RULE `0 < 1`]\r
8369       THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8370    THEN POP_ASSUM MP_TAC\r
8371    THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
8372    THEN DISCH_THEN (LABEL_TAC "G17")\r
8373    THEN REMOVE_THEN "F2" (MP_TAC o SPEC `PRE k` o  MATCH_MP lemma_sub_inj_contour)\r
8374    THEN USE_THEN "K3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
8375    THEN DISCH_THEN (LABEL_TAC "G18")\r
8376    THEN SUBGOAL_THEN `!j:num. 0 < j /\ j <= PRE k ==> (!i:num. i <= (n:num) ==> ~((p:num->A) j = (ploop:num->A) i))` ASSUME_TAC\r
8377    THENL[REPEAT STRIP_TAC\r
8378        THEN MP_TAC (SPECL[`ploop:num->A`; `n:num`; `(p:num->A) (j:num)`; `i:num`] lemma_in_list2)\r
8379        THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [th]))\r
8380        THEN REWRITE_TAC[]\r
8381        THEN USE_THEN "F6" (MP_TAC o SPEC `j:num`)\r
8382        THEN POP_ASSUM (fun th -> (USE_THEN "K2" (fun th2 -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < k:num /\ j:num <= PRE k ==> j < k`) (CONJ th2 th)])))\r
8383        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8384    THEN REMOVE_THEN "G16" (fun th1 -> (REMOVE_THEN "G18" (fun th2 -> (USE_THEN "F4" (fun th3 -> (POP_ASSUM (fun th4 -> (MP_TAC (MATCH_MP concatenate_two_contours (CONJ th1 (CONJ th2 (CONJ (SYM th3) th4))))))))))))\r
8385    THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "G21") (CONJUNCTS_THEN2 (LABEL_TAC "G22") (CONJUNCTS_THEN2 (LABEL_TAC "G23") (CONJUNCTS_THEN2 (LABEL_TAC "G24") (LABEL_TAC "G25"))))))\r
8386    THEN USE_THEN "G24" (MP_TAC o SPEC `n:num`)\r
8387    THEN REWRITE_TAC[LE_REFL]\r
8388    THEN DISCH_THEN (LABEL_TAC "G26")\r
8389    THEN REMOVE_THEN "F5" MP_TAC\r
8390    THEN REWRITE_TAC[lemma_in_list]\r
8391    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "G27") (LABEL_TAC "G28")))\r
8392    THEN SUBGOAL_THEN `~(j:num = 0)` MP_TAC\r
8393    THENL[USE_THEN "F9" MP_TAC\r
8394        THEN REWRITE_TAC[CONTRAPOS_THM]\r
8395        THEN DISCH_TAC\r
8396        THEN USE_THEN "G28" MP_TAC\r
8397        THEN POP_ASSUM SUBST1_TAC\r
8398        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM (SPEC `H:(A)hypermap` node_map_injective)]\r
8399        THEN USE_THEN "G12" (SUBST1_TAC o SYM)\r
8400        THEN USE_THEN "G17" (SUBST1_TAC o SYM)\r
8401        THEN USE_THEN "F8" (MP_TAC o SPECL[`PRE k`; `0`])\r
8402        THEN USE_THEN "K3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
8403        THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th])\r
8404        THEN MESON_TAC[]; ALL_TAC]\r
8405    THEN REWRITE_TAC[GSYM LT_NZ]\r
8406    THEN DISCH_THEN (LABEL_TAC "G29")\r
8407    THEN EXISTS_TAC `g:num->A`\r
8408    THEN EXISTS_TAC `(n:num) + PRE k`\r
8409    THEN REWRITE_TAC[is_Moebius_contour]\r
8410    THEN USE_THEN "G23" (fun th -> REWRITE_TAC[th])\r
8411    THEN EXISTS_TAC `j:num`\r
8412    THEN EXISTS_TAC `n:num`\r
8413    THEN USE_THEN "G29" (fun th -> REWRITE_TAC[th])\r
8414    THEN USE_THEN "G27" (fun th -> REWRITE_TAC[th])\r
8415    THEN ONCE_REWRITE_TAC[LT_ADD]\r
8416    THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th])\r
8417    THEN USE_THEN "G26" SUBST1_TAC\r
8418    THEN USE_THEN "G21" SUBST1_TAC\r
8419    THEN USE_THEN "G22" SUBST1_TAC\r
8420    THEN USE_THEN "G24" (MP_TAC o SPEC `j:num`)\r
8421    THEN USE_THEN "G27" (fun th -> REWRITE_TAC[th])\r
8422    THEN DISCH_THEN SUBST1_TAC\r
8423    THEN USE_THEN "G28" (SUBST1_TAC o SYM)\r
8424    THEN USE_THEN "F4" (SUBST1_TAC o SYM)\r
8425    THEN USE_THEN "G12" (fun th -> REWRITE_TAC[th])\r
8426    THEN USE_THEN "G17" (fun th -> REWRITE_TAC[th]));;\r
8427 \r
8428 \r
8429 (* Some facts about face_loop, node_loop and their injective contours *)\r
8430 \r
8431 let inj_orbit_imp_inj_face_contour = prove(`!(H:(A)hypermap) (x:A) (k:num). inj_orbit (face_map H) x k ==> is_inj_contour H (face_contour H x) k`,\r
8432    REPEAT GEN_TAC\r
8433    THEN REWRITE_TAC[lemma_def_inj_contour]\r
8434    THEN REWRITE_TAC[lemma_face_contour; face_contour]\r
8435    THEN REWRITE_TAC[lemma_def_inj_orbit]\r
8436    THEN MESON_TAC[]);;\r
8437 \r
8438 let lemma_inj_face_contour = prove(`!(H:(A)hypermap) x:A k:num. k < CARD(face H x) ==> is_inj_contour H (face_contour H x) k`,\r
8439    REWRITE_TAC[face]\r
8440    THEN REPEAT STRIP_TAC\r
8441    THEN MP_TAC(SPECL[`x:A`; `k:num`](MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` face_map_and_darts)))\r
8442    THEN ASM_REWRITE_TAC[inj_orbit_imp_inj_face_contour]);;\r
8443 \r
8444 let lemma_face_cycle = prove(`!(H:(A)hypermap) (x:A). ((face_map H) POWER (CARD (face H x))) x = x`, \r
8445    REWRITE_TAC[face] THEN MESON_TAC[face_map_and_darts; lemma_cycle_orbit]);;\r
8446 \r
8447 let lemma_orbit_inverse_map_eq = prove(`!s:A->bool p:A->A x:A. FINITE s /\ p permutes s ==> orbit_map (inverse p) x = orbit_map p x`,\r
8448  REPEAT GEN_TAC\r
8449    THEN DISCH_THEN (LABEL_TAC "F1")\r
8450    THEN REWRITE_TAC[orbit_map;GE; LE_0; EXTENSION; IN_ELIM_THM]\r
8451    THEN GEN_TAC\r
8452    THEN EQ_TAC\r
8453    THENL[STRIP_TAC\r
8454        THEN REMOVE_THEN "F1" (MP_TAC o SPEC `n:num` o MATCH_MP power_inverse_element_lemma)\r
8455        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC)\r
8456        THEN EXISTS_TAC `j:num`\r
8457        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
8458    THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_permutation_via_its_inverse)\r
8459    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` MP_TAC)\r
8460    THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
8461    THEN REWRITE_TAC[GSYM multiplication_exponents]\r
8462    THEN MESON_TAC[]);;\r
8463 \r
8464 let inj_orbit_imp_inj_node_contour = prove(\r
8465   `!(H:(A)hypermap) (x:A) (k:num). inj_orbit (inverse (node_map H)) x k ==> is_inj_contour H (node_contour H x) k`,\r
8466    REPEAT GEN_TAC\r
8467    THEN REWRITE_TAC[lemma_def_inj_contour]\r
8468    THEN REWRITE_TAC[lemma_node_contour; node_contour]\r
8469    THEN REWRITE_TAC[lemma_def_inj_orbit]\r
8470    THEN MESON_TAC[]);;\r
8471                                                                   \r
8472 let lemma_inj_node_contour = prove(`!(H:(A)hypermap) x:A k:num. k < CARD(node H x) ==> is_inj_contour H (node_contour H x) k`,\r
8473    REPEAT GEN_TAC\r
8474    THEN REWRITE_TAC[node]\r
8475    THEN MP_TAC (SPEC `H:(A)hypermap` node_map_and_darts)\r
8476    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
8477    THEN USE_THEN "F2"  (LABEL_TAC "F3" o MATCH_MP PERMUTES_INVERSE)\r
8478    THEN USE_THEN "F1" (fun th1-> (USE_THEN "F3" (fun th2 ->(MP_TAC(SPECL[`x:A`; `k:num`](MATCH_MP lemma_segment_orbit (CONJ th1 th2)))))))\r
8479    THEN USE_THEN "F1" (fun th1-> (USE_THEN "F2" (fun th2 ->(REWRITE_TAC[SYM((SPEC `x:A` (MATCH_MP lemma_orbit_inverse_map_eq (CONJ th1 th2))))]))))\r
8480    THEN MESON_TAC[inj_orbit_imp_inj_node_contour]);;\r
8481 \r
8482 let lemma_node_cycle = prove(`!(H:(A)hypermap) (x:A). ((node_map H) POWER (CARD (node H x))) x = x`, \r
8483    REWRITE_TAC[node] THEN MESON_TAC[hypermap_lemma; lemma_cycle_orbit]);;\r
8484 \r
8485 let lemma_node_inverse_cycle = prove(`!(H:(A)hypermap) (x:A). ((inverse (node_map H)) POWER (CARD (node H x))) x = x`, \r
8486    REPEAT GEN_TAC\r
8487    THEN ASSUME_TAC (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))\r
8488    THEN CONV_TAC SYM_CONV\r
8489    THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM(MATCH_MP inverse_power_function th)])\r
8490    THEN CONV_TAC SYM_CONV\r
8491    THEN REWRITE_TAC[lemma_node_cycle]);;\r
8492 \r
8493 \r
8494 let lemma_node_contour_connection = prove(`!(H:(A)hypermap) (x:A) (y:A). y IN node H x \r
8495    ==> (?k:num. k  < CARD(node H x) /\ node_contour H x 0 = x /\ node_contour H x k = y /\ is_inj_contour H (node_contour H x) k)`,\r
8496  REPEAT GEN_TAC\r
8497    THEN DISCH_THEN (LABEL_TAC "F1")\r
8498    THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_node_inverse_cycle)\r
8499    THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] NODE_NOT_EMPTY)\r
8500    THEN REWRITE_TAC[LT1_NZ; LT_NZ; IMP_IMP]\r
8501    THEN MP_TAC (SPEC`x:A` (MATCH_MP lemma_orbit_inverse_map_eq (SPEC `H:(A)hypermap` node_map_and_darts)))\r
8502    THEN REWRITE_TAC[GSYM node]\r
8503    THEN DISCH_THEN (fun th -> (ASSUME_TAC th THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[SYM th]))\r
8504    THEN DISCH_THEN (MP_TAC o MATCH_MP orbit_cyclic)\r
8505    THEN POP_ASSUM SUBST1_TAC\r
8506    THEN DISCH_TAC\r
8507    THEN REMOVE_THEN "F1" MP_TAC\r
8508    THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th])\r
8509    THEN REWRITE_TAC[IN_ELIM_THM]\r
8510    THEN REWRITE_TAC[GSYM node_contour]\r
8511    THEN STRIP_TAC\r
8512    THEN EXISTS_TAC `k:num`\r
8513    THEN ASM_REWRITE_TAC[]\r
8514    THEN FIRST_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_inj_node_contour th])\r
8515    THEN REWRITE_TAC[node_contour; POWER_0; I_THM]);;\r
8516 \r
8517 let lemma_via_inverse_node_map = prove(`!H:(A)hypermap x:A y:A. y IN node H x \r
8518    ==> ?j:num. j < CARD (node H x) /\ y = (inverse (node_map H) POWER j) x`,\r
8519    REPEAT GEN_TAC\r
8520    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[node_contour] o MATCH_MP lemma_node_contour_connection) THEN MESON_TAC[]);;\r
8521 \r
8522 \r
8523 let lemmaICJHAOQ = prove(`!(H:(A)hypermap) L:(A)loop. is_loop H L /\ (!g:num->A m:num. ~(is_Moebius_contour H g m)) \r
8524 ==> ~(?p:num->A k:num. 1 <= k /\ is_contour H p k /\ (p 0) belong L /\ (!i:num. 0 < i /\ i <= k ==> ~((p i) belong L)) /\ p 1 = face_map H (p 0) /\ ~(node H (p 0) = node H (p k)) /\ (?y:A. y IN node H (p k) /\ y belong L))`,\r
8525   REPEAT GEN_TAC   \r
8526    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") MP_TAC)\r
8527    THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
8528    THEN REWRITE_TAC[NOT_FORALL_THM]\r
8529    THEN DISCH_THEN (X_CHOOSE_THEN `p:num->A` (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")))))))))\r
8530    THEN SUBGOAL_THEN `?s:num. s <= k /\(p:num->A) s IN node (H:(A)hypermap) (p (k:num))` MP_TAC\r
8531    THENL[EXISTS_TAC `k:num` THEN REWRITE_TAC[node; orbit_reflect; LE_REFL]; ALL_TAC]\r
8532    THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP]\r
8533    THEN DISCH_THEN (X_CHOOSE_THEN `s:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) (LABEL_TAC "F11")))\r
8534    THEN REMOVE_THEN "F10" (SUBST_ALL_TAC o MATCH_MP lemma_node_identity)\r
8535    THEN SUBGOAL_THEN `~((p:num->A) 0 = p (s:num))` (LABEL_TAC "F12")\r
8536    THENL[USE_THEN "F7" MP_TAC\r
8537        THEN REWRITE_TAC[CONTRAPOS_THM]\r
8538        THEN MESON_TAC[lemma_node_identity]; ALL_TAC]\r
8539    THEN SUBGOAL_THEN `0 < s:num` (LABEL_TAC "F14")\r
8540    THENL[ASM_CASES_TAC `s:num = 0`\r
8541        THENL[USE_THEN "F12" MP_TAC\r
8542            THEN POP_ASSUM SUBST1_TAC\r
8543            THEN MESON_TAC[]; ALL_TAC]\r
8544        THEN REWRITE_TAC[LT_NZ]\r
8545        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8546    THEN REMOVE_THEN "F3" (MP_TAC o SPEC `s:num` o MATCH_MP lemma_subcontour)\r
8547    THEN USE_THEN "F9" (fun th -> REWRITE_TAC[th])\r
8548    THEN DISCH_THEN (LABEL_TAC "F16")\r
8549    THEN USE_THEN "F5" (MP_TAC o SPEC `s:num`)\r
8550    THEN USE_THEN "F14" (fun th -> REWRITE_TAC[th])\r
8551    THEN USE_THEN "F9" (fun th -> REWRITE_TAC[th])\r
8552    THEN DISCH_THEN (LABEL_TAC "F17")\r
8553    THEN SUBGOAL_THEN `?u:num. u < CARD(node (H:(A)hypermap) ((p:num->A) (s:num))) /\ (node_contour H (p s) u) belong (L:(A)loop)` MP_TAC\r
8554    THENL[USE_THEN "F8" (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (MP_TAC o MATCH_MP lemma_node_contour_connection) ASSUME_TAC))\r
8555        THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (CONJUNCTS_THEN2 (ASSUME_TAC) (ASSUME_TAC o CONJUNCT1 o CONJUNCT2)))\r
8556        THEN EXISTS_TAC `u:num`\r
8557        THEN POP_ASSUM SUBST1_TAC\r
8558        THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> (REWRITE_TAC[th]))); ALL_TAC]\r
8559    THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP]\r
8560    THEN DISCH_THEN (X_CHOOSE_THEN `t:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19")) (LABEL_TAC "F20")))\r
8561    THEN SUBGOAL_THEN `0 < t:num` (LABEL_TAC "F21")\r
8562    THENL[ASM_CASES_TAC `t:num = 0`\r
8563        THENL[USE_THEN "F19" MP_TAC\r
8564            THEN POP_ASSUM SUBST1_TAC\r
8565            THEN REWRITE_TAC[node_contour; POWER_0; I_THM]\r
8566            THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8567        THEN REWRITE_TAC[LT_NZ]\r
8568        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8569    THEN USE_THEN "F16" (MP_TAC o MATCH_MP lemmaQZTPGJV)\r
8570    THEN DISCH_THEN (X_CHOOSE_THEN `w:num->A` (X_CHOOSE_THEN `d:num` (CONJUNCTS_THEN2 (LABEL_TAC "FC") (CONJUNCTS_THEN2 (LABEL_TAC "F22") (CONJUNCTS_THEN2 (LABEL_TAC "F23") (CONJUNCTS_THEN2 (LABEL_TAC "F24") (LABEL_TAC "F25")))))))\r
8571    THEN SUBGOAL_THEN `0 < d:num` (LABEL_TAC "F26")\r
8572    THENL[ASM_CASES_TAC `d:num = 0`\r
8573        THENL[USE_THEN "F23" MP_TAC\r
8574            THEN POP_ASSUM SUBST1_TAC\r
8575            THEN USE_THEN "F22" SUBST1_TAC\r
8576            THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8577        THEN REWRITE_TAC[LT_NZ]\r
8578        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8579    THEN REMOVE_THEN "F22" (SUBST_ALL_TAC o SYM)\r
8580    THEN REMOVE_THEN "F23" (SUBST_ALL_TAC o SYM)\r
8581    THEN SUBGOAL_THEN `!i:num. 0 < i /\ i <= d:num ==> ~(((w:num->A) i) belong (L:(A)loop) )` (LABEL_TAC "F27")\r
8582    THENL[REPEAT GEN_TAC\r
8583        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G4") MP_TAC)\r
8584        THEN REWRITE_TAC[LE_LT]\r
8585        THEN STRIP_TAC\r
8586        THENL[POP_ASSUM (LABEL_TAC "G5")\r
8587            THEN USE_THEN "F25" (MP_TAC o SPEC `i:num`)\r
8588            THEN USE_THEN "G5" (fun th -> REWRITE_TAC[th])\r
8589            THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "G6") (CONJUNCTS_THEN2 (LABEL_TAC "G7") (SUBST1_TAC o CONJUNCT1))))\r
8590            THEN USE_THEN "G4" (fun th1 -> (USE_THEN "G6" (fun th2 -> (ASSUME_TAC (MATCH_MP LTE_TRANS (CONJ th1 th2))))))\r
8591            THEN USE_THEN "G7" (fun th1 -> (USE_THEN "F9" (fun th2 -> (ASSUME_TAC (MATCH_MP LTE_TRANS (CONJ th1 th2))))))\r
8592            THEN USE_THEN "F5" (MP_TAC o SPEC `j:num`)\r
8593            THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
8594            THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8595        THEN POP_ASSUM SUBST1_TAC\r
8596        THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8597    THEN SUBGOAL_THEN `(w:num->A) 1 = face_map (H:(A)hypermap) (w 0)` (LABEL_TAC "F28")\r
8598    THENL[USE_THEN "F4" (LABEL_TAC "G7" o REWRITE_RULE[POWER_1] o SPEC `1` o  MATCH_MP lemma_power_next_in_loop)\r
8599        THEN USE_THEN "F1"(MP_TAC o SPEC `(w:num->A) 0` o REWRITE_RULE[is_loop])\r
8600        THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
8601        THEN REWRITE_TAC[one_step_contour]\r
8602        THEN STRIP_TAC\r
8603        THENL[REMOVE_THEN "G7" MP_TAC\r
8604            THEN POP_ASSUM SUBST1_TAC\r
8605            THEN USE_THEN "F6" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM th])\r
8606            THEN USE_THEN "F5" (MP_TAC o SPEC `1`)\r
8607            THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th; ARITH_RULE `0 < 1`])\r
8608            THEN MESON_TAC[]; ALL_TAC]\r
8609        THEN USE_THEN "F24" (MP_TAC o SPEC `0` o  REWRITE_RULE[lemma_def_contour] o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour])\r
8610        THEN USE_THEN "F26" (fun th-> REWRITE_TAC[th; one_step_contour; GSYM ONE])\r
8611        THEN STRIP_TAC\r
8612        THEN POP_ASSUM MP_TAC\r
8613        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
8614        THEN DISCH_TAC\r
8615        THEN REMOVE_THEN "G7" MP_TAC\r
8616        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
8617        THEN POP_ASSUM (MP_TAC o SPEC `1`)\r
8618        THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT1_NZ])\r
8619        THEN POP_ASSUM (fun th-> REWRITE_TAC[ th; ARITH_RULE `0 < 1`])\r
8620        THEN MESON_TAC[]; ALL_TAC]\r
8621    THEN USE_THEN "F18" (LABEL_TAC "F29" o MATCH_MP lemma_inj_node_contour)\r
8622    THEN MP_TAC(SPECL[`H:(A)hypermap`; `(w:num->A) (d:num)`; `0`] node_contour)\r
8623    THEN REWRITE_TAC[POWER_0; I_THM]\r
8624    THEN DISCH_THEN (LABEL_TAC "F30")\r
8625    THEN SUBGOAL_THEN `!j:num. 0 < j /\ j <= t:num ==> (!i:num. i <= d ==> ~(node_contour (H:(A)hypermap) ((w:num->A) (d:num)) j = w i))` ASSUME_TAC\r
8626    THENL[GEN_TAC\r
8627       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G20") (LABEL_TAC "G21"))\r
8628       THEN GEN_TAC\r
8629       THEN DISCH_THEN (LABEL_TAC "G22")\r
8630       THEN ASM_CASES_TAC `i:num = d:num`\r
8631       THENL[POP_ASSUM SUBST1_TAC\r
8632          THEN USE_THEN "F30" (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th])\r
8633          THEN (USE_THEN "F29" (MP_TAC o SPECL[`j:num`; `0`] o CONJUNCT2 o  REWRITE_RULE[lemma_def_inj_contour; lemma_def_contour]))\r
8634          THEN USE_THEN "G20" (fun th -> REWRITE_TAC[th])\r
8635          THEN USE_THEN "G21" (fun th -> REWRITE_TAC[th])\r
8636          THEN MESON_TAC[]; ALL_TAC]\r
8637       THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC)\r
8638       THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE]\r
8639       THEN DISCH_THEN (LABEL_TAC "G25")\r
8640       THEN REWRITE_TAC[node_contour]\r
8641       THEN MP_TAC (SPEC `j:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)))\r
8642       THEN DISCH_THEN (X_CHOOSE_THEN `v:num` SUBST1_TAC)\r
8643       THEN REWRITE_TAC[GSYM node]\r
8644       THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP in_orbit_lemma (SYM th))))\r
8645       THEN USE_THEN "G25" (fun th -> REWRITE_TAC[th])\r
8646       THEN USE_THEN "F25" (MP_TAC o SPEC `i:num`)\r
8647       THEN USE_THEN "G25" (fun th -> REWRITE_TAC[th])\r
8648       THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (fun th -> (LABEL_TAC "G26" (CONJUNCT1(CONJUNCT2 th)) THEN LABEL_TAC "G27" (CONJUNCT1(CONJUNCT2(CONJUNCT2 th))))))\r
8649       THEN USE_THEN "F11" (MP_TAC o SPEC `u:num`)\r
8650       THEN USE_THEN "G26" (fun th-> REWRITE_TAC[th])\r
8651       THEN REWRITE_TAC[CONTRAPOS_THM]\r
8652       THEN USE_THEN "F9" (fun th -> (USE_THEN "G26" (fun th1 -> MP_TAC(MATCH_MP LTE_TRANS (CONJ th1 th)))))\r
8653       THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
8654       THEN REWRITE_TAC[GSYM node]     \r
8655       THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8656    THEN USE_THEN "F24" (fun th1 -> (USE_THEN "F29" (fun th2 -> (USE_THEN "F30" (fun th3 -> (POP_ASSUM (fun th4 ->MP_TAC (MATCH_MP concatenate_two_contours (CONJ th1 (CONJ th2 (CONJ (SYM th3) th4)))))))))))\r
8657    THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "M1") (CONJUNCTS_THEN2 (LABEL_TAC "M2") (CONJUNCTS_THEN2 (LABEL_TAC "M3") (CONJUNCTS_THEN2 (LABEL_TAC "M4") (LABEL_TAC "M5"))))))\r
8658    THEN SUBGOAL_THEN `!i:num. 0 < i /\ i < (d:num) + (t:num) ==> ~((g:num->A) i belong (L:(A)loop))` (LABEL_TAC "M6")\r
8659    THENL[GEN_TAC\r
8660        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G30") (LABEL_TAC "G31"))\r
8661        THEN ASM_CASES_TAC `i:num <= d:num`\r
8662        THENL[POP_ASSUM (LABEL_TAC "G32")\r
8663           THEN USE_THEN "M4" (MP_TAC o SPEC `i:num`)\r
8664           THEN USE_THEN "G32" (fun th -> REWRITE_TAC[th])\r
8665           THEN DISCH_THEN SUBST1_TAC\r
8666           THEN USE_THEN "F27" (MP_TAC o SPEC `i:num`)\r
8667           THEN USE_THEN "G30" (fun th -> REWRITE_TAC[th])\r
8668           THEN USE_THEN "G32" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8669        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE])\r
8670        THEN REWRITE_TAC[LT_EXISTS]\r
8671        THEN DISCH_THEN (X_CHOOSE_THEN `l:num` ASSUME_TAC)\r
8672        THEN USE_THEN "G31" MP_TAC\r
8673        THEN POP_ASSUM (SUBST1_TAC)\r
8674        THEN REWRITE_TAC[LT_ADD_LCANCEL]\r
8675        THEN DISCH_THEN (LABEL_TAC "G34")\r
8676        THEN USE_THEN "M5" (MP_TAC o SPEC `SUC l`)\r
8677        THEN USE_THEN "G34" (fun th-> (REWRITE_TAC[MATCH_MP LT_IMP_LE th]))\r
8678        THEN DISCH_THEN SUBST1_TAC\r
8679        THEN USE_THEN "F20" (MP_TAC o SPEC `SUC l`)\r
8680        THEN USE_THEN "G34" (fun th -> REWRITE_TAC[th; CONTRAPOS_THM])\r
8681        THEN DISCH_THEN(fun th -> SIMP_TAC[th])\r
8682        THEN USE_THEN "G34" (fun th1 -> (USE_THEN "F18" (fun th -> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ th1 th)]))); ALL_TAC]\r
8683    THEN REMOVE_THEN "F19" (MP_TAC)\r
8684    THEN USE_THEN "M2" (SUBST1_TAC o SYM)\r
8685    THEN DISCH_THEN (LABEL_TAC "F19")\r
8686    THEN REMOVE_THEN "M1" (SUBST_ALL_TAC o SYM)\r
8687    THEN REMOVE_THEN "F28" MP_TAC\r
8688    THEN USE_THEN "M4" (MP_TAC o SPEC `1`)\r
8689    THEN USE_THEN "F26" (MP_TAC o REWRITE_RULE[GSYM LT1_NZ])\r
8690    THEN DISCH_THEN(fun th -> REWRITE_TAC[th])\r
8691    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
8692    THEN DISCH_THEN (LABEL_TAC "F28")\r
8693    THEN USE_THEN "M5" (MP_TAC o SPEC `PRE t`)\r
8694    THEN REWRITE_TAC[ARITH_RULE `PRE (t:num) <= t`]\r
8695    THEN REWRITE_TAC[node_contour]\r
8696    THEN DISCH_TAC\r
8697    THEN REMOVE_THEN "M2"  MP_TAC\r
8698    THEN REWRITE_TAC[node_contour]\r
8699    THEN USE_THEN "F21" (fun th -> (GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP LT_SUC_PRE th]))\r
8700    THEN REWRITE_TAC[COM_POWER; o_THM]\r
8701    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
8702    THEN REWRITE_TAC[GSYM node_contour]\r
8703    THEN USE_THEN "F21" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < t:num ==> (d:num) + (PRE t) = PRE(d + t)`) th])\r
8704    THEN DISCH_THEN (LABEL_TAC "M2")\r
8705    THEN USE_THEN "F26"(fun th1 ->(USE_THEN "F21" (fun th2 -> (LABEL_TAC "F29" (MATCH_MP (ARITH_RULE `0 < d:num /\ 0 < t:num ==> 2 <= d + t`) (CONJ th1 th2))))))\r
8706    THEN ABBREV_TAC `m = (d:num) + (t:num)`\r
8707    THEN ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`]\r
8708    THEN DISCH_THEN ASSUME_TAC\r
8709    THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `g:num->A`;`m:num`] lemmaILTXRQD)\r
8710    THEN ASM_REWRITE_TAC[]\r
8711    THEN USE_THEN "M2" (fun th -> REWRITE_TAC[SYM th])\r
8712    THEN USE_THEN "F19" (fun th -> REWRITE_TAC[th])\r
8713    THEN REWRITE_TAC[GSYM NOT_EXISTS_THM]\r
8714    THEN POP_ASSUM(fun th -> MESON_TAC[th]));;\r
8715 \r
8716 let lemmaThreeDarts = prove(`!(H:(A)hypermap) (L:(A)loop). is_loop H L /\ (!x:A. x IN dart H ==> 3 <= CARD (face H x)) /\ (?x:A y:A. ~(node H x = node H y) /\ x belong L /\ y belong L) ==> 3 <= size L`,\r
8717  REPEAT GEN_TAC\r
8718    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (X_CHOOSE_THEN `x:A` (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))))))\r
8719    THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[lemma_in_list])\r
8720    THEN STRIP_TAC\r
8721    THEN REWRITE_TAC[THREE; lemma_size; LE_SUC]\r
8722    THEN USE_THEN "F1" (fun th-> (USE_THEN "F4" (fun th1 -> MP_TAC (MATCH_MP let_order_for_loop (CONJ th th1)))))\r
8723    THEN REWRITE_TAC[POWER_0; I_THM]\r
8724    THEN MP_TAC (SPECL[`L:(A)loop`; `x:A`; `0`]  loop_path)\r
8725    THEN REWRITE_TAC[POWER_0; I_THM]\r
8726    THEN DISCH_THEN (fun th -> (LABEL_TAC "F6" th THEN SUBST1_TAC th))\r
8727    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
8728    THEN REMOVE_THEN "F5" MP_TAC\r
8729    THEN USE_THEN "F4"(fun th -> REWRITE_TAC[MATCH_MP lemma_belong th])\r
8730    THEN DISCH_THEN (LABEL_TAC "F5")\r
8731    THEN USE_THEN "F4" MP_TAC\r
8732    THEN REMOVE_THEN "F4"(fun th -> REWRITE_TAC[MATCH_MP lemma_belong th])\r
8733    THEN DISCH_THEN (LABEL_TAC "F4")\r
8734    THEN ABBREV_TAC `ploop = loop_path (L:(A)loop) (x:A)`\r
8735    THEN ABBREV_TAC `n = top (L:(A)loop)`\r
8736    THEN SUBGOAL_THEN `~(x:A = y:A)` (LABEL_TAC "F7") \r
8737    THENL[FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN MESON_TAC[]; ALL_TAC]\r
8738    THEN MP_TAC(SPECL[`support_list (ploop:num->A) (n:num)`; `x:A`; `y:A`] CARD_ATLEAST_2)\r
8739    THEN REWRITE_TAC[GSYM in_list]\r
8740    THEN ASM_REWRITE_TAC[lemma_finite_list]\r
8741    THEN USE_THEN "H1" (fun th -> (MP_TAC (MATCH_MP lemma_number_darts_of_inj_contour th) THEN ASSUME_TAC th))\r
8742    THEN DISCH_THEN SUBST1_TAC\r
8743    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [TWO; LE_SUC; LE_LT]\r
8744    THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC]\r
8745    THEN POP_ASSUM (SUBST_ALL_TAC o SYM)\r
8746    THEN USE_THEN "F5" (MP_TAC o REWRITE_RULE[lemma_in_list])\r
8747    THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))\r
8748    THEN REWRITE_TAC[SPEC `m:num` SEGMENT_TO_ONE]\r
8749    THEN STRIP_TAC\r
8750    THENL[POP_ASSUM SUBST_ALL_TAC\r
8751       THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl))\r
8752       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
8753    THEN POP_ASSUM SUBST_ALL_TAC\r
8754    THEN POP_ASSUM SUBST_ALL_TAC\r
8755    THEN REMOVE_THEN "F6" (SUBST_ALL_TAC o SYM)\r
8756    THEN USE_THEN "H2" (MP_TAC o REWRITE_RULE[one_step_contour])\r
8757    THEN ONCE_REWRITE_TAC[DISJ_SYM]\r
8758    THEN STRIP_TAC\r
8759    THENL[POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[GSYM node_map_inverse_representation])\r
8760       THEN DISCH_TAC\r
8761       THEN MP_TAC (SPECL[`node_map (H:(A)hypermap)`; `(ploop:num->A) 0`] in_orbit_map1)\r
8762       THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM node; SYM th])\r
8763       THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity)\r
8764       THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8765   THEN POP_ASSUM (LABEL_TAC "F8")  \r
8766    THEN USE_THEN "H1" (MP_TAC o SPEC `0` o  CONJUNCT1 o  REWRITE_RULE[lemma_def_inj_contour; lemma_def_contour])\r
8767    THEN REWRITE_TAC[ZR_LT_1; GSYM ONE; one_step_contour]\r
8768    THEN ONCE_REWRITE_TAC[DISJ_SYM]\r
8769    THEN STRIP_TAC\r
8770    THENL[POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[GSYM node_map_inverse_representation])\r
8771       THEN DISCH_TAC\r
8772       THEN  MP_TAC (SPECL[`node_map (H:(A)hypermap)`; `(ploop:num->A) 1`] in_orbit_map1)\r
8773       THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM node; SYM th])\r
8774       THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP lemma_node_identity)\r
8775       THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
8776    THEN REMOVE_THEN  "F8" (MP_TAC o SYM)\r
8777    THEN POP_ASSUM SUBST1_TAC \r
8778     THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM]\r
8779    THEN REWRITE_TAC[GSYM POWER_2]\r
8780    THEN MP_TAC (ARITH_RULE `~(2 = 0)`)\r
8781    THEN REWRITE_TAC[IMP_IMP]\r
8782    THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[GSYM face] o  MATCH_MP card_orbit_le)\r
8783    THEN UNDISCH_TAC `is_inj_contour (H:(A)hypermap) (ploop:num->A) 1`\r
8784    THEN DISCH_THEN ( fun th -> (ASSUME_TAC (MATCH_MP lemma_first_dart_on_inj_contour (CONJ ZR_LT_1 th))))\r
8785    THEN USE_THEN "F2" (MP_TAC o SPEC `(ploop:num->A) 0`)\r
8786    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
8787    THEN POP_ASSUM MP_TAC\r
8788    THEN ARITH_TAC);;\r
8789 \r
8790 \r
8791 (************ GENERATION PART *****************)\r
8792 \r
8793 \r
8794 let is_node_going = new_definition `!(H:(A)hypermap) (L:(A)loop) x:A y:A. is_node_going H L x y \r
8795     <=> ?k:num. y = ((next L) POWER k) x /\ (!i:num. i <= k ==> ((next L) POWER i) x = ((inverse (node_map H)) POWER i) x)`;;\r
8796 \r
8797 let atom = new_definition `!(H:(A)hypermap) (L:(A)loop) x:A. atom H L x = {y:A | is_node_going H L x y \/ is_node_going H L y x}`;;\r
8798 \r
8799 (* Intuitively, a loop is partitioned by atoms *)\r
8800 \r
8801 let atom_reflect = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). x IN atom H L x`,\r
8802   REPEAT GEN_TAC\r
8803   THEN REWRITE_TAC[atom; IN_ELIM_THM; is_node_going]\r
8804   THEN EXISTS_TAC `0`\r
8805   THEN REWRITE_TAC[LE_0; LE; POWER_0; I_THM]\r
8806   THEN GEN_TAC\r
8807   THEN DISCH_THEN SUBST1_TAC\r
8808   THEN REWRITE_TAC[POWER_0; I_THM]);;\r
8809 \r
8810 let atom_sym = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A). y IN atom H L x ==> x IN atom H L y`,\r
8811    REWRITE_TAC[atom; IN_ELIM_THM]\r
8812    THEN MESON_TAC[]);;\r
8813 \r
8814 let lemma_transitive_going = prove(`!(H:(A)hypermap) (L: (A)loop) (x:A) (y:A) (z:A). is_node_going H L x y /\ is_node_going H L y z ==> is_node_going H L x z`,  \r
8815    REPEAT GEN_TAC\r
8816    THEN REWRITE_TAC[is_node_going]\r
8817    THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")))\r
8818 (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
8819    THEN EXISTS_TAC `(k:num) + (m:num)`\r
8820    THEN REWRITE_TAC[addition_exponents; o_THM]\r
8821    THEN USE_THEN "F1" (SUBST1_TAC o SYM)\r
8822    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th])\r
8823    THEN GEN_TAC\r
8824    THEN DISCH_THEN (LABEL_TAC "F5")\r
8825    THEN ASM_CASES_TAC `i:num <= m:num`\r
8826    THENL[POP_ASSUM (fun th -> (USE_THEN "F2" (fun thm-> REWRITE_TAC[MATCH_MP (SPEC `i:num` thm) th]))); ALL_TAC]\r
8827    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
8828    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` MP_TAC)\r
8829    THEN ABBREV_TAC `j = SUC d`\r
8830    THEN DISCH_THEN SUBST_ALL_TAC\r
8831    THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8832    THEN REWRITE_TAC[addition_exponents; o_THM]\r
8833    THEN REMOVE_THEN "F2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `m:num`)\r
8834    THEN REMOVE_THEN "F1" (SUBST1_TAC o SYM)\r
8835    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
8836    THEN REMOVE_THEN "F5" MP_TAC\r
8837    THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
8838    THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
8839    THEN DISCH_THEN (fun th -> (REMOVE_THEN "F4" (fun thm -> REWRITE_TAC[MATCH_MP (SPEC `j:num` thm) th]))));;\r
8840 \r
8841 let lemma_on_way_going = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A) (z:A). is_node_going H L x y /\ is_node_going H L x z ==> is_node_going H L y z \/ is_node_going H L z y `,\r
8842    REPEAT GEN_TAC\r
8843    THEN REWRITE_TAC[is_node_going]\r
8844    THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))) (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
8845    THEN ASM_CASES_TAC `m:num <= k:num`\r
8846    THENL[DISJ1_TAC\r
8847       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS])\r
8848       THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
8849       THEN EXISTS_TAC `d:num`\r
8850       THEN USE_THEN "F3" (MP_TAC o ONCE_REWRITE_RULE[ADD_SYM])\r
8851       THEN REWRITE_TAC[addition_exponents; o_THM]\r
8852       THEN USE_THEN "F1" (SUBST1_TAC o SYM)\r
8853       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
8854       THEN GEN_TAC\r
8855       THEN DISCH_THEN (LABEL_TAC "F5")\r
8856       THEN USE_THEN "F4" (MP_TAC o SPEC `(m:num) + (i:num)`)\r
8857       THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
8858       THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
8859       THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8860       THEN REWRITE_TAC[addition_exponents; o_THM]\r
8861       THEN USE_THEN "F2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `m:num`)\r
8862       THEN REMOVE_THEN "F1" (SUBST1_TAC o SYM)\r
8863       THEN DISCH_THEN (SUBST1_TAC o SYM)\r
8864       THEN SIMP_TAC[]; ALL_TAC]\r
8865    THEN DISJ2_TAC\r
8866    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
8867    THEN DISCH_THEN (X_CHOOSE_THEN `d1:num` SUBST_ALL_TAC)\r
8868    THEN ABBREV_TAC `d = SUC d1`\r
8869    THEN EXISTS_TAC `d:num`\r
8870    THEN USE_THEN "F1" (MP_TAC o ONCE_REWRITE_RULE[ADD_SYM])\r
8871    THEN REWRITE_TAC[addition_exponents; o_THM]\r
8872    THEN USE_THEN "F3" (SUBST1_TAC o SYM)\r
8873    THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
8874    THEN GEN_TAC\r
8875    THEN DISCH_THEN (LABEL_TAC "F5")\r
8876    THEN USE_THEN "F2" (MP_TAC o SPEC `(k:num) + (i:num)`)\r
8877    THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
8878    THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th])\r
8879    THEN ONCE_REWRITE_TAC[ADD_SYM]\r
8880    THEN REWRITE_TAC[addition_exponents; o_THM]\r
8881    THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`)\r
8882    THEN REMOVE_THEN "F3" (SUBST1_TAC o SYM)\r
8883    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
8884    THEN SIMP_TAC[]);;\r
8885 \r
8886 let lemma_second_on_way_going = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A) (z:A). is_node_going H L x z  /\ is_node_going H L y z ==> is_node_going H L x y \/ is_node_going H L y x`,\r
8887    REPEAT GEN_TAC\r
8888    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[is_node_going])\r
8889    THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))) (X_CHOOSE_THEN `k:num`(CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))))\r
8890    THEN ASM_CASES_TAC `m:num <= k:num`\r
8891    THENL[DISJ2_TAC\r
8892       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS])\r
8893       THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
8894       THEN REWRITE_TAC[is_node_going]\r
8895       THEN EXISTS_TAC `d:num`\r
8896       THEN USE_THEN "F3" (MP_TAC o SYM)\r
8897       THEN USE_THEN "F5" (SUBST1_TAC)\r
8898       THEN REWRITE_TAC[addition_exponents; o_THM]\r
8899       THEN DISCH_THEN (MP_TAC o REWRITE_RULE[o_THM; I_THM] o AP_TERM `(back (L:(A)loop)) POWER (m:num)`)\r
8900       THEN REWRITE_TAC[lemma_second_inverse_evaluation]\r
8901       THEN DISCH_THEN (fun th -> REWRITE_TAC[th])\r
8902       THEN GEN_TAC\r
8903       THEN DISCH_THEN (LABEL_TAC "F9")\r
8904       THEN USE_THEN "F6" (MP_TAC o SPEC `i:num`)\r
8905       THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= d:num ==> i <= (m:num) + d`) th]); ALL_TAC]\r
8906    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
8907    THEN DISCH_THEN (X_CHOOSE_THEN `d1:num` (SUBST_ALL_TAC))\r
8908    THEN ABBREV_TAC `d = SUC d1`\r
8909    THEN DISJ1_TAC\r
8910    THEN REWRITE_TAC[is_node_going]\r
8911    THEN EXISTS_TAC `d:num`\r
8912    THEN USE_THEN "F3" (MP_TAC o SYM)\r
8913    THEN USE_THEN "F5" (SUBST1_TAC)\r
8914    THEN REWRITE_TAC[addition_exponents; o_THM]\r
8915    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[o_THM; I_THM] o AP_TERM `(back (L:(A)loop)) POWER (k:num)`)\r
8916    THEN REWRITE_TAC[lemma_second_inverse_evaluation]\r
8917    THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th])\r
8918    THEN GEN_TAC\r
8919    THEN DISCH_THEN (LABEL_TAC "F9")\r
8920    THEN USE_THEN "F4" (MP_TAC o SPEC `i:num`)\r
8921    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= d:num ==> i <= (k:num) + d`) th]));;\r
8922 \r
8923 let atom_trans = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A) (z:A). x IN atom H L y /\ y IN atom H L z ==> x IN atom H L z`,\r
8924    REPEAT GEN_TAC\r
8925    THEN REWRITE_TAC[atom; IN_ELIM_THM]\r
8926    THEN STRIP_TAC\r
8927    THENL[POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_transitive_going (CONJ th1 th2)])));\r
8928       POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_on_way_going (CONJ th1 th2)])));\r
8929       POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_second_on_way_going (CONJ th1 th2)])));\r
8930       POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_transitive_going (CONJ th2 th1)])))]);;\r
8931 \r
8932 let lemma_atom_sub_loop = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). x belong L ==> atom H L x SUBSET dart_of L`,\r
8933    REPEAT STRIP_TAC\r
8934    THEN REWRITE_TAC[atom; SUBSET; IN_ELIM_THM; GSYM belong]\r
8935    THEN REPEAT STRIP_TAC\r
8936    THENL[POP_ASSUM ((X_CHOOSE_THEN `k:num` (SUBST1_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going])\r
8937        THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC]\r
8938    THEN POP_ASSUM ((X_CHOOSE_THEN `k:num` (MP_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going])\r
8939    THEN ASM_CASES_TAC `~((x':A) belong (L:(A)loop))`\r
8940    THENL[POP_ASSUM(fun th -> (REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th]))\r
8941        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
8942        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
8943    THEN POP_ASSUM (fun th -> MESON_TAC[th]));;\r
8944 \r
8945 let lemma_atom_out_side_loop = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). ~(x belong L) ==> atom H L x = {x}`,\r
8946    REPEAT STRIP_TAC\r
8947    THEN MATCH_MP_TAC SUBSET_ANTISYM\r
8948    THEN STRIP_TAC\r
8949    THENL[REWRITE_TAC[atom; SUBSET; IN_ELIM_THM; IN_SING]\r
8950       THEN GEN_TAC\r
8951       THEN STRIP_TAC\r
8952       THENL[POP_ASSUM ((X_CHOOSE_THEN `k:num` (SUBST1_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going])\r
8953           THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th]); ALL_TAC]\r
8954       THEN POP_ASSUM ((X_CHOOSE_THEN `k:num` (MP_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going])\r
8955       THEN DISCH_THEN (MP_TAC o REWRITE_RULE[o_THM] o AP_TERM `(back (L:(A)loop)) POWER (k:num)`)\r
8956       THEN REWRITE_TAC[lemma_second_inverse_evaluation]\r
8957       THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th])\r
8958       THEN REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
8959    THEN REWRITE_TAC[SUBSET; IN_SING]\r
8960    THEN GEN_TAC\r
8961    THEN DISCH_THEN SUBST1_TAC\r
8962    THEN REWRITE_TAC[atom_reflect]);;\r
8963 \r
8964 let lemma_atom_sub_node = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). (atom H L x) SUBSET  (node H x)`,\r
8965  REPEAT GEN_TAC\r
8966    THEN REWRITE_TAC[atom; SUBSET; IN_ELIM_THM]\r
8967    THEN GEN_TAC\r
8968    THEN STRIP_TAC\r
8969    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
8970       THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 SUBST1_TAC (LABEL_TAC "F1")))\r
8971       THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`)\r
8972       THEN MP_TAC (SPEC `k:num` (MATCH_MP  power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)))\r
8973       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
8974       THEN REWRITE_TAC[node; lemma_in_orbit]; ALL_TAC]\r
8975    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
8976    THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (ASSUME_TAC) (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`)))\r
8977    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
8978    THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)))]\r
8979    THEN DISCH_THEN SUBST1_TAC\r
8980    THEN REWRITE_TAC[node; lemma_in_orbit]);;\r
8981 \r
8982 let lemma_atom_sub_dart_set = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). x IN dart H ==> atom H L x SUBSET dart H`,\r
8983   REPEAT STRIP_TAC\r
8984     THEN MATCH_MP_TAC SUBSET_TRANS\r
8985     THEN EXISTS_TAC `node (H:(A)hypermap) (x:A)`\r
8986     THEN REWRITE_TAC[lemma_atom_sub_node; node]\r
8987     THEN MP_TAC (SPEC `x:A` (MATCH_MP orbit_subset (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))))\r
8988     THEN ASM_REWRITE_TAC[]);;\r
8989 \r
8990 let lemma_atom_finite = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). FINITE (atom H L x) /\ 1 <= CARD (atom H L x)`,\r
8991    REPEAT GEN_TAC\r
8992    THEN SUBGOAL_THEN `FINITE (atom (H:(A)hypermap) (L:(A)loop) (x:A))` ASSUME_TAC\r
8993    THENL[MATCH_MP_TAC FINITE_SUBSET\r
8994       THEN EXISTS_TAC `node (H:(A)hypermap) (x:A)`\r
8995       THEN REWRITE_TAC[NODE_FINITE; lemma_atom_sub_node]; ALL_TAC]\r
8996    THEN ASM_REWRITE_TAC[]\r
8997    THEN MATCH_MP_TAC CARD_ATLEAST_1\r
8998    THEN EXISTS_TAC `x:A`\r
8999    THEN ASM_REWRITE_TAC[atom_reflect]);;\r
9000 \r
9001 let lemma_identity_atom = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A). y IN (atom H L x) ==> atom H L x = atom H L y`,\r
9002  REPEAT STRIP_TAC\r
9003    THEN MATCH_MP_TAC SUBSET_ANTISYM\r
9004    THEN STRIP_TAC\r
9005    THENL[REWRITE_TAC[SUBSET; IN_ELIM_THM]\r
9006       THEN GEN_TAC\r
9007       THEN POP_ASSUM (MP_TAC o MATCH_MP atom_sym)\r
9008       THEN REWRITE_TAC[IMP_IMP]\r
9009       THEN ONCE_REWRITE_TAC[CONJ_SYM]\r
9010       THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP atom_trans  th]); ALL_TAC]\r
9011    THEN REWRITE_TAC[SUBSET; IN_ELIM_THM]\r
9012    THEN GEN_TAC\r
9013    THEN POP_ASSUM MP_TAC\r
9014    THEN REWRITE_TAC[IMP_IMP]\r
9015    THEN ONCE_REWRITE_TAC[CONJ_SYM]\r
9016    THEN DISCH_THEN (fun th2 -> REWRITE_TAC[MATCH_MP atom_trans th2]));;\r
9017 \r
9018 let lemma_atom_absorb_quark = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A). y IN (atom H L x) /\ next L y = inverse (node_map H) y \r
9019     ==> (next L y)  IN (atom H L x)`,\r
9020    REPEAT GEN_TAC\r
9021    THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)\r
9022    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_identity_atom th])\r
9023    THEN REWRITE_TAC[atom; IN_ELIM_THM]\r
9024    THEN DISJ1_TAC\r
9025    THEN REWRITE_TAC[is_node_going]\r
9026    THEN EXISTS_TAC `1`\r
9027    THEN REWRITE_TAC[POWER_1]\r
9028    THEN REPEAT STRIP_TAC\r
9029    THEN ASM_CASES_TAC `i:num = 1`\r
9030    THENL[POP_ASSUM SUBST1_TAC\r
9031        THEN ASM_REWRITE_TAC[POWER_1]; ALL_TAC]\r
9032    THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC)\r
9033    THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE]\r
9034    THEN REWRITE_TAC[ARITH_RULE `!i:num. i < 1 <=> i = 0`]\r
9035    THEN DISCH_THEN SUBST1_TAC\r
9036    THEN REWRITE_TAC[POWER_0]);;\r
9037  \r
9038 let lemma_second_absorb_quark = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A). y IN (atom H L x) /\ y = inverse (node_map H) (back L y)  ==> (back L y)  IN (atom H L x)`,\r
9039    REPEAT GEN_TAC\r
9040    THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)\r
9041    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_identity_atom th])\r
9042    THEN REWRITE_TAC[atom; IN_ELIM_THM]\r
9043    THEN DISJ2_TAC\r
9044    THEN REWRITE_TAC[is_node_going]\r
9045    THEN EXISTS_TAC `1`\r
9046    THEN REWRITE_TAC[POWER_1]\r
9047    THEN REWRITE_TAC[lemma_inverse_evaluation]\r
9048    THEN REPEAT STRIP_TAC\r
9049    THEN ASM_CASES_TAC `i:num = 1`\r
9050    THENL[POP_ASSUM SUBST1_TAC\r
9051        THEN REWRITE_TAC[POWER_1]\r
9052        THEN REWRITE_TAC[lemma_inverse_evaluation] \r
9053        THEN ASM_MESON_TAC[]; ALL_TAC]\r
9054    THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC)\r
9055    THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE]\r
9056    THEN REWRITE_TAC[ARITH_RULE `!i:num. i < 1 <=> i = 0`]\r
9057    THEN DISCH_THEN SUBST1_TAC\r
9058    THEN REWRITE_TAC[POWER_0] );;\r
9059 \r
9060 let next_and_loop_darts = prove(`!L:(A)loop. FINITE(dart_of L) /\ (next L permutes dart_of L)`, MESON_TAC[loop_lemma]);;\r
9061 \r
9062 let back_and_loop_darts = prove(`!L:(A)loop. FINITE(dart_of L) /\ (back L permutes dart_of L)`, MESON_TAC[loop_lemma; lemma_permute_loop]);;\r
9063 \r
9064 let lemma_border_of_atom = prove(`!(H:(A)hypermap) (L:(A)loop).(?h:A->A t:A->A.(!x:A. (x belong L /\ (?y:A z:A. y belong L /\ z belong L /\ ~(node H y = node H z))) ==> (h x) IN (atom H L x) /\ (t x) IN (atom H L x) /\ ~((next L (h x)) = (inverse (node_map H)) (h x)) /\ ~(t x = (inverse (node_map H)) (back L (t x)))))`,\r
9065    REPEAT GEN_TAC\r
9066    THEN REWRITE_TAC [GSYM SKOLEM_THM]\r
9067    THEN GEN_TAC\r
9068    THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM]\r
9069    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (X_CHOOSE_THEN `y:A` (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2(LABEL_TAC "F4") (LABEL_TAC "F5"))))))\r
9070    THEN SUBGOAL_THEN `?a:A. a IN (atom (H:(A)hypermap) (L:(A)loop) (x:A)) /\ ~(next L a = (inverse (node_map H)) a)` (LABEL_TAC "F4")\r
9071    THENL[ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`]\r
9072        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NOT_EXISTS_THM]\r
9073        THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [DE_MORGAN_THM; TAUT `~ ~A = A`; TAUT `(~A \/ B) <=> (A==>B)`]\r
9074        THEN DISCH_THEN (LABEL_TAC "G1")\r
9075        THEN REMOVE_THEN "F5" MP_TAC\r
9076        THEN REWRITE_TAC[]\r
9077        THEN SUBGOAL_THEN `dart_of (L:(A)loop) = atom (H:(A)hypermap) L (x:A)` (LABEL_TAC "G2")\r
9078        THENL[SUBGOAL_THEN `!k:num. ((next (L:(A)loop)) POWER k) (x:A) IN (atom (H:(A)hypermap) L x)` ASSUME_TAC\r
9079           THENL[INDUCT_TAC\r
9080               THENL[REWRITE_TAC[POWER_0; I_THM; node; atom_reflect]; ALL_TAC]\r
9081               THEN POP_ASSUM (LABEL_TAC "G2")\r
9082               THEN REWRITE_TAC[COM_POWER; o_THM]\r
9083               THEN USE_THEN "G2" (fun th1 -> (USE_THEN "G1" (fun th2 -> (MP_TAC(MATCH_MP th2 th1)))))\r
9084               THEN (USE_THEN "G2" (fun th2-> (DISCH_THEN (fun th3 -> (REWRITE_TAC[MATCH_MP lemma_atom_absorb_quark (CONJ th2 th3)]))))); ALL_TAC]\r
9085           THEN MATCH_MP_TAC SUBSET_ANTISYM\r
9086           THEN USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th2])\r
9087           THEN REWRITE_TAC[SUBSET; GSYM belong]\r
9088           THEN GEN_TAC\r
9089           THEN USE_THEN "F2" (fun th2-> (DISCH_THEN (fun th3-> (MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th2 th3))))))\r
9090           THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (SUBST1_TAC o CONJUNCT2))\r
9091           THEN POP_ASSUM (fun th -> REWRITE_TAC[SPEC `k:num` th]); ALL_TAC]\r
9092        THEN REMOVE_THEN "F3" (LABEL_TAC "F3" o REWRITE_RULE[belong])\r
9093        THEN REMOVE_THEN "F4" (LABEL_TAC "F4" o REWRITE_RULE[belong])\r
9094        THEN REMOVE_THEN "G2" SUBST_ALL_TAC\r
9095        THEN LABEL_TAC "G3" (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node)\r
9096        THEN USE_THEN "F3" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1))))))\r
9097        THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)])\r
9098        THEN USE_THEN "F4" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1))))))\r
9099        THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]); ALL_TAC]\r
9100    THEN POP_ASSUM (X_CHOOSE_THEN `h:A` ASSUME_TAC)\r
9101    THEN EXISTS_TAC `h:A`\r
9102    THEN POP_ASSUM (fun th -> SIMP_TAC[th])\r
9103    THEN ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`]\r
9104    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NOT_EXISTS_THM]\r
9105    THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [DE_MORGAN_THM; TAUT `~ ~A = A`; TAUT `(~A \/ B) <=> (A==>B)`]\r
9106    THEN DISCH_THEN (LABEL_TAC "G1")\r
9107    THEN REMOVE_THEN "F5" MP_TAC\r
9108    THEN REWRITE_TAC[]\r
9109    THEN SUBGOAL_THEN `dart_of (L:(A)loop) = atom (H:(A)hypermap) L (x:A)` (LABEL_TAC "G2")\r
9110    THENL[SUBGOAL_THEN `!k:num. ((back (L:(A)loop)) POWER k) (x:A) IN (atom (H:(A)hypermap) L x)` ASSUME_TAC\r
9111       THENL[INDUCT_TAC\r
9112           THENL[REWRITE_TAC[POWER_0; I_THM; node; atom_reflect]; ALL_TAC]\r
9113           THEN POP_ASSUM (LABEL_TAC "G2")\r
9114           THEN REWRITE_TAC[COM_POWER; o_THM]\r
9115           THEN USE_THEN "G2" (fun th1 -> (USE_THEN "G1" (fun th2 -> (MP_TAC(MATCH_MP th2 th1)))))\r
9116           THEN (USE_THEN "G2" (fun th2-> (DISCH_THEN (fun th3 -> (REWRITE_TAC[MATCH_MP lemma_second_absorb_quark (CONJ th2 th3)]))))); ALL_TAC]\r
9117       THEN MATCH_MP_TAC SUBSET_ANTISYM\r
9118       THEN USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th2])\r
9119       THEN REWRITE_TAC[SUBSET; GSYM belong]\r
9120       THEN GEN_TAC\r
9121       THEN USE_THEN "F2" (fun th2-> (DISCH_THEN (fun th3-> (MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th2 th3) )))))\r
9122       THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (MP_TAC o CONJUNCT2))\r
9123       THEN ONCE_REWRITE_TAC[lemma_inverse_on_loop]\r
9124       THEN MP_TAC (SPEC `k:num` (MATCH_MP power_inverse_element_lemma (SPEC `L:(A)loop` back_and_loop_darts)))\r
9125       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
9126       THEN DISCH_THEN SUBST1_TAC\r
9127       THEN POP_ASSUM (fun th -> REWRITE_TAC[SPEC `j:num` th]); ALL_TAC]\r
9128    THEN REMOVE_THEN "F3" (LABEL_TAC "F3" o REWRITE_RULE[belong])\r
9129    THEN REMOVE_THEN "F4" (LABEL_TAC "F4" o REWRITE_RULE[belong])\r
9130    THEN REMOVE_THEN "G2" SUBST_ALL_TAC\r
9131    THEN LABEL_TAC "G3" (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node)\r
9132    THEN USE_THEN "F3" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1))))))\r
9133    THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)])\r
9134    THEN USE_THEN "F4" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1))))))\r
9135    THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]));;\r
9136 \r
9137 (* The definition of quotient hypermaps *)\r
9138 \r
9139 let is_normal = new_definition `!(H:(A)hypermap) (NF:(A)loop -> bool). is_normal H NF \r
9140 <=> (!(L:(A)loop). L IN NF ==> ((is_loop H L) /\ (?x:A. x IN dart H /\ x belong L))) /\\r
9141     (!(L:(A)loop). L IN NF ==> (?y:A z:A. y belong L /\ z belong L /\ ~(node H y = node H z ))) /\\r
9142     (!(L:(A)loop) (L':(A)loop) (x:A). L IN NF /\ L' IN NF /\ x belong L /\ x belong L' ==> L = L') /\\r
9143     (!(L:(A)loop) x:A y:A. L IN NF /\ x belong L /\ y IN node H x ==> ?L':(A)loop. L' IN NF /\ y belong L') `;;\r
9144 \r
9145 let lemm_nornal_loop_sub_dart = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop). is_normal H NF /\ L IN NF ==> (dart_of L) SUBSET dart H`,\r
9146    REPEAT GEN_TAC\r
9147    THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal]) ASSUME_TAC)\r
9148    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
9149    THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `x:A` MP_TAC))\r
9150    THEN POP_ASSUM (fun th1 -> (DISCH_THEN (fun th2-> REWRITE_TAC[MATCH_MP support_loop_sub_dart (CONJ th1 th2)]))));;\r
9151 \r
9152 \r
9153 let quotient_darts = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool). quotient_darts H NF = {atom H L x | (L:(A)loop) (x:A) | L IN NF /\ x belong L}`;;\r
9154 \r
9155 let support_darts = new_definition `!(NF:(A)loop->bool). support_darts NF  = UNIONS {dart_of (L:(A)loop) | L IN NF}`;;\r
9156 \r
9157 let lemma_in_loop = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (y:A). x belong L /\ y IN atom H L x ==> y belong L`,\r
9158    REPEAT STRIP_TAC\r
9159    THEN REWRITE_TAC[belong]\r
9160    THEN MATCH_MP_TAC lemma_in_subset\r
9161    THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
9162    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
9163    THEN MATCH_MP_TAC lemma_atom_sub_loop\r
9164    THEN ASM_REWRITE_TAC[]);;\r
9165 \r
9166 let lemma_in_dart = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L ==> x IN dart H`,\r
9167  REPEAT STRIP_TAC\r
9168    THEN MATCH_MP_TAC lemma_in_subset\r
9169    THEN EXISTS_TAC `dart_of (L:(A)loop)`\r
9170    THEN POP_ASSUM (fun th-> REWRITE_TAC[GSYM belong; th])\r
9171    THEN POP_ASSUM(fun th1->(POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemm_nornal_loop_sub_dart (CONJ th th1)]))));;\r
9172 \r
9173 let lemma_support_and_atoms = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==>  support_darts NF = UNIONS (quotient_darts H NF)`,\r
9174    REPEAT GEN_TAC\r
9175    THEN DISCH_THEN (LABEL_TAC "F1")\r
9176    THEN CONV_TAC SYM_CONV\r
9177    THEN REWRITE_TAC[support_darts; quotient_darts]\r
9178    THEN MATCH_MP_TAC SUBSET_ANTISYM\r
9179    THEN STRIP_TAC\r
9180    THENL[REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM]\r
9181        THEN REPEAT STRIP_TAC\r
9182        THEN EXISTS_TAC `dart_of (L:(A)loop)`\r
9183        THEN STRIP_TAC\r
9184        THENL[EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9185        THEN UNDISCH_THEN `t:A->bool = atom (H:(A)hypermap) (L:(A)loop) (x':A)` SUBST_ALL_TAC\r
9186        THEN MATCH_MP_TAC lemma_in_subset\r
9187        THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x':A)`\r
9188        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
9189        THEN POP_ASSUM (fun th -> (REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th])); ALL_TAC]\r
9190    THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM]\r
9191    THEN REPEAT STRIP_TAC\r
9192    THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
9193    THEN STRIP_TAC\r
9194    THENL[EXISTS_TAC `L:(A)loop`\r
9195       THEN EXISTS_TAC `x:A`\r
9196       THEN POP_ASSUM MP_TAC\r
9197       THEN POP_ASSUM SUBST1_TAC\r
9198       THEN ASM_REWRITE_TAC[GSYM belong]; ALL_TAC]\r
9199    THEN REWRITE_TAC[atom_reflect]);;\r
9200 \r
9201 let lemma_finite_support = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==>  support_darts NF SUBSET dart H /\ FINITE (support_darts NF)`,\r
9202    REPEAT GEN_TAC\r
9203    THEN DISCH_THEN (LABEL_TAC "F1")\r
9204    THEN SUBGOAL_THEN `support_darts (NF:(A)loop->bool) SUBSET dart H` ASSUME_TAC\r
9205    THENL[REWRITE_TAC[support_darts; SUBSET; IN_UNIONS; IN_ELIM_THM]\r
9206        THEN REPEAT STRIP_TAC\r
9207        THEN POP_ASSUM MP_TAC\r
9208        THEN POP_ASSUM SUBST1_TAC\r
9209        THEN POP_ASSUM (fun th2 -> (POP_ASSUM (fun th1 -> MP_TAC (MATCH_MP lemm_nornal_loop_sub_dart (CONJ th1 th2)))))\r
9210        THEN REWRITE_TAC[IMP_IMP]\r
9211        THEN REWRITE_TAC[lemma_in_subset]; ALL_TAC]\r
9212    THEN ASM_REWRITE_TAC[]\r
9213    THEN MATCH_MP_TAC FINITE_SUBSET\r
9214    THEN EXISTS_TAC `dart (H:(A)hypermap)`\r
9215    THEN ASM_REWRITE_TAC[hypermap_lemma]);;\r
9216 \r
9217 let lemma_in_support2 = prove(`!(NF:(A)loop->bool) L:(A)loop (x:A). x belong L /\ L IN NF ==> x IN support_darts NF`,\r
9218    REWRITE_TAC[belong; support_darts] THEN SET_TAC[]);;\r
9219 \r
9220 let lemma_in_support = prove(`!(NF:(A)loop->bool) (x:A). x IN support_darts NF <=> ?L:(A)loop. L IN NF /\ x belong L`,\r
9221    REPEAT GEN_TAC\r
9222    THEN EQ_TAC\r
9223    THENL[REWRITE_TAC[support_darts; IN_UNIONS; IN_ELIM_THM]\r
9224       THEN REPEAT STRIP_TAC\r
9225       THEN EXISTS_TAC `L:(A)loop`\r
9226       THEN POP_ASSUM MP_TAC\r
9227       THEN POP_ASSUM SUBST1_TAC\r
9228       THEN REWRITE_TAC[GSYM belong]\r
9229       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9230    THEN MESON_TAC[lemma_in_support2]);;\r
9231 \r
9232 let lemma_node_in_support2 = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A n:num. is_normal H NF /\ x IN support_darts NF ==> ((node_map H) POWER n) x IN support_darts NF`,\r
9233    REPEAT GEN_TAC\r
9234    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") MP_TAC)\r
9235    THEN SPEC_TAC (`n:num`, `n:num`)\r
9236    THEN INDUCT_TAC\r
9237    THENL[REWRITE_TAC[POWER_0; I_THM] THEN SIMP_TAC[]; ALL_TAC]\r
9238    THEN DISCH_TAC\r
9239    THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))\r
9240    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
9241    THEN DISCH_THEN (LABEL_TAC "F2")\r
9242    THEN REWRITE_TAC[COM_POWER; o_THM]\r
9243    THEN ABBREV_TAC `y = ((node_map (H:(A)hypermap)) POWER (n:num)) (x:A)`\r
9244    THEN REMOVE_THEN "F2" (MP_TAC o REWRITE_RULE[lemma_in_support])\r
9245    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9246    THEN MP_TAC (SPECL[`node_map (H:(A)hypermap)`; `1`; `y:A`] lemma_in_orbit)\r
9247    THEN REWRITE_TAC[POWER_1; GSYM node]\r
9248    THEN DISCH_TAC\r
9249    THEN USE_THEN "F1" (MP_TAC o SPECL[`L:(A)loop`; `y:A`; `node_map (H:(A)hypermap) (y:A)`] o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o  REWRITE_RULE[is_normal])\r
9250    THEN ASM_REWRITE_TAC[]\r
9251    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (MP_TAC o ONCE_REWRITE_RULE[CONJ_SYM]))\r
9252    THEN REWRITE_TAC[lemma_in_support2]);;\r
9253 \r
9254 let lemma_loop_outside_node = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). \r
9255     is_normal H NF /\ L IN NF ==> ~(dart_of L SUBSET  node H x)`,\r
9256    REPEAT GEN_TAC\r
9257    THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_normal]) (ASSUME_TAC))\r
9258    THEN ASM_REWRITE_TAC[]\r
9259    THEN ONCE_REWRITE_TAC[TAUT `(A ==> ~B) <=> (B ==> ~A)`]\r
9260    THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(A /\ B /\ ~C) <=> (A /\ B ==> C)`]\r
9261    THEN DISCH_TAC\r
9262    THEN REPEAT GEN_TAC\r
9263    THEN REWRITE_TAC[belong]\r
9264    THEN POP_ASSUM (fun th -> (DISCH_THEN (CONJUNCTS_THEN2 (fun th1 -> (ASSUME_TAC (MATCH_MP lemma_in_subset (CONJ th th1)))) (fun th2 -> (ASSUME_TAC (MATCH_MP lemma_in_subset (CONJ th th2)))))))\r
9265    THEN REPLICATE_TAC 2 (POP_ASSUM (SUBST1_TAC o SYM o MATCH_MP lemma_node_identity))\r
9266    THEN SIMP_TAC[]);;\r
9267 \r
9268 let lemma_size_of_normal_loop = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop). is_normal H NF /\ L IN NF ==> 2 <= size L`,\r
9269  REPEAT GEN_TAC\r
9270    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
9271    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9272    THEN DISCH_THEN (LABEL_TAC "F3" o CONJUNCT1)\r
9273    THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_normal])\r
9274    THEN ASM_REWRITE_TAC[belong]\r
9275    THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC))\r
9276    THEN SUBGOAL_THEN `~(x:A = y:A)` ASSUME_TAC\r
9277    THENL[POP_ASSUM MP_TAC\r
9278        THEN REWRITE_TAC[CONTRAPOS_THM]\r
9279        THEN MESON_TAC[]; ALL_TAC]\r
9280    THEN REWRITE_TAC[size]\r
9281    THEN MATCH_MP_TAC CARD_ATLEAST_2\r
9282    THEN EXISTS_TAC `x:A` THEN EXISTS_TAC `y:A`\r
9283    THEN ASM_REWRITE_TAC[loop_lemma]);;\r
9284 \r
9285 let disjoint_loops = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (L':(A)loop) (x:A). \r
9286     is_normal H NF /\ L IN NF /\ L' IN NF /\ x belong L /\ x belong L' ==> L = L'`,\r
9287    REPEAT GEN_TAC\r
9288    THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) MP_TAC)\r
9289    THEN POP_ASSUM (fun th-> MESON_TAC[CONJUNCT1(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_normal] th)))]));;\r
9290 \r
9291 let lemma_choice_function = prove(`!(H:(A)hypermap) (NF:(A)loop->bool).  ?choice_function: A->(A->bool). !x:A. is_normal H NF ==> ((~(x IN support_darts NF) ==> choice_function x = {x}) /\ (x IN support_darts NF ==> (?L:(A)loop. L IN NF /\ x belong L /\ choice_function x = atom H L x)))`,\r
9292  REPEAT GEN_TAC\r
9293    THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
9294    THEN GEN_TAC\r
9295    THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM]\r
9296    THEN DISCH_THEN (LABEL_TAC "F1")\r
9297    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_support_and_atoms th])\r
9298    THEN ASM_CASES_TAC `~(x:A IN UNIONS (quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)))`\r
9299    THENL[EXISTS_TAC `{x:A}`\r
9300        THEN POP_ASSUM(fun th -> SIMP_TAC[th]); ALL_TAC]\r
9301    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])  \r
9302    THEN ASM_REWRITE_TAC[]\r
9303    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_UNIONS; IN_ELIM_THM])\r
9304    THEN DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F2" )))\r
9305    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) (LABEL_TAC "F5"))))\r
9306    THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
9307    THEN EXISTS_TAC `L:(A)loop`\r
9308    THEN EXISTS_TAC `t:A->bool`\r
9309    THEN POP_ASSUM SUBST_ALL_TAC\r
9310    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th])\r
9311    THEN USE_THEN "F1" (fun th -> (MP_TAC (SPEC `L:(A)loop`(CONJUNCT1 (REWRITE_RULE[is_normal] th)))))\r
9312    THEN ASM_REWRITE_TAC[]\r
9313    THEN DISCH_THEN (LABEL_TAC "F5" o CONJUNCT1)\r
9314    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP lemma_identity_atom th])\r
9315    THEN MATCH_MP_TAC lemma_in_loop\r
9316    THEN ASM_MESON_TAC[]);;\r
9317 \r
9318 let lemma_choice = new_specification ["choice"] (REWRITE_RULE[SKOLEM_THM] lemma_choice_function);;\r
9319 \r
9320 let first_unique_choice = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (!x:A. ~(x IN support_darts NF) ==> choice H NF x = {x}) \r
9321 /\ (!L:(A)loop x:A. L IN NF /\ x belong L ==> choice H NF x = atom H L x)`,\r
9322  REPEAT GEN_TAC\r
9323    THEN DISCH_THEN (LABEL_TAC "F1")\r
9324    THEN STRIP_TAC\r
9325    THENL[POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_choice th]); ALL_TAC]\r
9326    THEN REPEAT GEN_TAC\r
9327    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))\r
9328    THEN USE_THEN "F2"(fun th ->(USE_THEN "F3" (fun th1-> (ASSUME_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th))))))\r
9329    THEN USE_THEN "F1" (fun th-> MP_TAC(CONJUNCT2(SPEC `x:A` (MATCH_MP lemma_choice th))))\r
9330    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
9331    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (ASSUME_TAC) (CONJUNCTS_THEN2 (LABEL_TAC "F4") SUBST1_TAC)))\r
9332    THEN SUBGOAL_THEN `L' = L:(A)loop` SUBST_ALL_TAC\r
9333    THENL[MATCH_MP_TAC disjoint_loops THEN ASM_MESON_TAC[]; ALL_TAC]\r
9334    THEN SIMP_TAC[]);;\r
9335 \r
9336 let unique_choice = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L ==> choice H NF x = atom H L x`,\r
9337    REPEAT STRIP_TAC\r
9338    THEN UNDISCH_THEN `is_normal (H:(A)hypermap) (NF:(A)loop->bool)` (MP_TAC o SPECL[`L:(A)loop`; `x:A`] o CONJUNCT2 o MATCH_MP first_unique_choice)\r
9339    THEN ASM_REWRITE_TAC[]);;\r
9340 \r
9341 let lemma_in_quotient = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). L IN NF /\ x belong L ==> (atom H L x) IN (quotient_darts H NF)`,\r
9342  REPEAT STRIP_TAC\r
9343    THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
9344    THEN EXISTS_TAC `L:(A)loop`\r
9345    THEN EXISTS_TAC `x:A`\r
9346    THEN ASM_REWRITE_TAC[]);;\r
9347 \r
9348 let lemma_finite_quotient_darts = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> FINITE (quotient_darts H NF)`,\r
9349    REPEAT GEN_TAC\r
9350    THEN DISCH_THEN (LABEL_TAC "F1")\r
9351    THEN SUBGOAL_THEN `IMAGE (choice (H:(A)hypermap) (NF:(A)loop->bool)) (support_darts NF) = quotient_darts H NF` ASSUME_TAC\r
9352    THENL[REWRITE_TAC[IMAGE; EXTENSION; IN_ELIM_THM]\r
9353       THEN GEN_TAC\r
9354       THEN REWRITE_TAC[GSYM EXTENSION]\r
9355       THEN EQ_TAC\r
9356       THENL[DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[lemma_in_support]) (SUBST1_TAC)))\r
9357           THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (LABEL_TAC "F2"))\r
9358           THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT2 o MATCH_MP first_unique_choice)\r
9359           THEN POP_ASSUM (fun th-> (USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP th th1])))\r
9360           THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_quotient th]); ALL_TAC]\r
9361       THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
9362       THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")) (SUBST1_TAC))))\r
9363       THEN USE_THEN "G1" (fun th-> (USE_THEN "G2" (fun th1-> (MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th))))))\r
9364       THEN DISCH_TAC\r
9365       THEN EXISTS_TAC `y:A`\r
9366       THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
9367       THEN USE_THEN "F1" (MP_TAC o SPECL[`L:(A)loop`; `y:A`] o CONJUNCT2 o MATCH_MP first_unique_choice)\r
9368       THEN ASM_REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
9369    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
9370    THEN MATCH_MP_TAC FINITE_IMAGE\r
9371    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_finite_support th]));;\r
9372 \r
9373 let lemma_finite_normal_loops = prove(`!H:(A)hypermap NF:(A)loop->bool. is_normal H NF ==> FINITE NF /\ CARD NF <= CARD (dart H)`,\r
9374    REPEAT GEN_TAC\r
9375    THEN DISCH_THEN (LABEL_TAC "F1")\r
9376    THEN SUBGOAL_THEN `?f:A->(A)loop. !x:A. (x IN support_darts NF ==> ?L:(A)loop. L IN NF /\ x belong L /\ f x = L)` MP_TAC\r
9377    THENL[REWRITE_TAC[GSYM SKOLEM_THM]\r
9378       THEN GEN_TAC\r
9379       THEN REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]\r
9380       THEN REWRITE_TAC[lemma_in_support]\r
9381       THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")))\r
9382       THEN REWRITE_TAC[SWAP_EXISTS_THM]\r
9383       THEN EXISTS_TAC `L:(A)loop`\r
9384       THEN EXISTS_TAC `L:(A)loop`\r
9385       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9386    THEN DISCH_THEN (X_CHOOSE_THEN `f:A->(A)loop` (LABEL_TAC "F2"))\r
9387    THEN SUBGOAL_THEN `IMAGE (f:A->(A)loop) (support_darts (NF:(A)loop->bool)) = NF` (SUBST1_TAC o SYM)\r
9388    THENL[REWRITE_TAC[IMAGE; EXTENSION; IN_ELIM_THM]\r
9389      THEN GEN_TAC\r
9390      THEN EQ_TAC\r
9391      THENL[ DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC))\r
9392         THEN DISCH_THEN (fun th-> (USE_THEN "F2" (fun thm -> MP_TAC(MATCH_MP thm th))))\r
9393         THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o CONJUNCT2)))\r
9394         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9395      THEN DISCH_THEN (LABEL_TAC "F3")\r
9396      THEN USE_THEN "F3" (fun th -> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `x:(A)loop` o CONJUNCT1 o  REWRITE_RULE[is_normal]))\r
9397      THEN DISCH_THEN (MP_TAC o CONJUNCT2)\r
9398      THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
9399      THEN EXISTS_TAC `y:A`\r
9400      THEN USE_THEN "F3" (fun th-> (USE_THEN "F5" (fun th1-> (ASSUME_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th))))))\r
9401      THEN ASM_REWRITE_TAC[]\r
9402      THEN POP_ASSUM (fun th-> (USE_THEN "F2" (fun thm -> MP_TAC(MATCH_MP thm th))))\r
9403      THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)))\r
9404      THEN MATCH_MP_TAC disjoint_loops\r
9405      THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A`\r
9406      THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9407    THEN USE_THEN "F1" (fun th -> ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) (MATCH_MP  lemma_finite_support th)))\r
9408    THEN STRIP_TAC\r
9409    THENL[MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9410    THEN MATCH_MP_TAC LE_TRANS\r
9411    THEN EXISTS_TAC `CARD (support_darts (NF:(A)loop->bool))`\r
9412    THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP CARD_IMAGE_LE th])\r
9413    THEN MATCH_MP_TAC CARD_SUBSET\r
9414    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; hypermap_lemma]));;\r
9415 \r
9416 let lemma_border_of_atom2 = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). ?(h:A->A) (t:A->A).(!x:A. is_normal H NF ==> (~(x IN support_darts NF) ==> h x = x /\ t x = x) /\ (x IN support_darts NF ==> (?L:(A)loop. L IN NF /\ x belong L /\ (h x) IN (atom H L x) /\ ~(next L (h x) = inverse (node_map H) (h x)) /\ (t x) IN (atom H L x) /\ ~(t x = inverse (node_map H) (back L (t x))))))`,\r
9417     REPEAT GEN_TAC\r
9418     THEN ONCE_REWRITE_TAC[RIGHT_FORALL_IMP_THM]\r
9419     THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[RIGHT_EXISTS_IMP_THM])\r
9420     THEN DISCH_THEN (LABEL_TAC "F1")\r
9421     THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
9422     THEN GEN_TAC\r
9423     THEN ASM_CASES_TAC `~(x:A IN support_darts (NF:(A)loop->bool))`\r
9424     THENL[EXISTS_TAC `x:A`\r
9425         THEN EXISTS_TAC `x:A`\r
9426         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9427     THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
9428     THEN POP_ASSUM (fun th -> (REWRITE_TAC[th] THEN MP_TAC (REWRITE_RULE[lemma_in_support] th)))\r
9429     THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9430     THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`] lemma_border_of_atom)\r
9431     THEN DISCH_THEN (X_CHOOSE_THEN `h1:A->A` (X_CHOOSE_THEN `t1:A->A` (MP_TAC o SPEC `x:A`)))\r
9432     THEN ASM_REWRITE_TAC[]\r
9433     THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o  CONJUNCT1 o CONJUNCT2 o  REWRITE_RULE[is_normal])\r
9434     THEN ASM_REWRITE_TAC[]\r
9435     THEN DISCH_THEN (fun th -> SIMP_TAC[th])\r
9436     THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o  CONJUNCT1  o  REWRITE_RULE[is_normal])\r
9437     THEN ASM_REWRITE_TAC[]\r
9438     THEN DISCH_THEN (fun th -> SIMP_TAC[th])\r
9439     THEN REPEAT STRIP_TAC\r
9440     THEN EXISTS_TAC `(h1:A->A) (x:A)`\r
9441     THEN EXISTS_TAC `(t1:A->A) (x:A)`\r
9442     THEN EXISTS_TAC `L:(A)loop`\r
9443     THEN ASM_REWRITE_TAC[]);;\r
9444 \r
9445 let lemma_head_tail = new_specification ["head"; "tail"] (REWRITE_RULE[SKOLEM_THM] lemma_border_of_atom2);;\r
9446 \r
9447 let lemma_unique_head = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x /\ ~(next L y = inverse (node_map H) y) ==> head H NF x = y`,\r
9448    REPEAT GEN_TAC\r
9449    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4")\r
9450 (LABEL_TAC "F5")))))\r
9451    THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal])\r
9452    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
9453    THEN DISCH_THEN (LABEL_TAC "F6" o CONJUNCT1)\r
9454    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `x:A` o MATCH_MP lemma_head_tail)\r
9455    THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th2)])))\r
9456    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F7") (CONJUNCTS_THEN2 (LABEL_TAC "F8") (CONJUNCTS_THEN2 (LABEL_TAC "F9")\r
9457 (LABEL_TAC "F10" o CONJUNCT1)))))\r
9458    THEN USE_THEN "F1" (MP_TAC o SPECL[`L':(A)loop`; `L:(A)loop`; `x:A`] o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o  REWRITE_RULE[is_normal])\r
9459    THEN REMOVE_THEN "F8" (fun th -> REWRITE_TAC[th])\r
9460    THEN REMOVE_THEN "F7" (fun th -> REWRITE_TAC[th])\r
9461    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th])\r
9462    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
9463    THEN DISCH_THEN SUBST_ALL_TAC\r
9464    THEN ABBREV_TAC `z = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9465    THEN REMOVE_THEN "F4" (fun th2 -> (MP_TAC (MATCH_MP lemma_identity_atom th2)))\r
9466    THEN DISCH_THEN SUBST_ALL_TAC\r
9467    THEN REMOVE_THEN "F9" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM; is_node_going])\r
9468    THEN STRIP_TAC\r
9469    THENL[ASM_CASES_TAC `k:num = 0`\r
9470        THENL[UNDISCH_TAC `z:A = ((next (L:(A)loop)) POWER (k:num)) (y:A)`\r
9471            THEN POP_ASSUM SUBST1_TAC\r
9472            THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
9473        THEN FIRST_X_ASSUM (MP_TAC o SPEC `1` o check (is_forall o concl))\r
9474        THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
9475        THEN POP_ASSUM (fun th -> REWRITE_TAC[th; POWER_1])\r
9476        THEN USE_THEN "F5" (fun th -> SIMP_TAC[th]); ALL_TAC]  \r
9477    THEN ASM_CASES_TAC `k:num = 0`\r
9478    THENL[UNDISCH_TAC `y:A = ((next (L:(A)loop)) POWER (k:num)) (z:A)`\r
9479        THEN POP_ASSUM SUBST1_TAC\r
9480        THEN REWRITE_TAC[POWER_0; I_THM; EQ_SYM]; ALL_TAC]\r
9481    THEN FIRST_X_ASSUM (MP_TAC o SPEC `1` o check (is_forall o concl))\r
9482    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
9483    THEN POP_ASSUM (fun th -> REWRITE_TAC[th; POWER_1])\r
9484    THEN USE_THEN "F10" (fun th -> SIMP_TAC[th]));;\r
9485 \r
9486 let lemma_unique_tail = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x /\ ~(y = inverse (node_map H) (back L y)) ==> tail H NF x = y`,\r
9487    REPEAT GEN_TAC\r
9488    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4")\r
9489 (LABEL_TAC "F5")))))\r
9490    THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal])\r
9491    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
9492    THEN DISCH_THEN (LABEL_TAC "F6" o CONJUNCT1)\r
9493    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `x:A` o MATCH_MP lemma_head_tail)\r
9494    THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th2)])))\r
9495    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F7") (CONJUNCTS_THEN2 (LABEL_TAC "F8") (MP_TAC o CONJUNCT2 o CONJUNCT2))))\r
9496    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10"))\r
9497    THEN USE_THEN "F1" (MP_TAC o SPECL[`L':(A)loop`; `L:(A)loop`; `x:A`] o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o  REWRITE_RULE[is_normal])\r
9498    THEN REMOVE_THEN "F8" (fun th -> REWRITE_TAC[th])\r
9499    THEN REMOVE_THEN "F7" (fun th -> REWRITE_TAC[th])\r
9500    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th])\r
9501    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th])\r
9502    THEN DISCH_THEN SUBST_ALL_TAC\r
9503    THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9504    THEN REMOVE_THEN "F4" (fun th2 -> (MP_TAC (MATCH_MP lemma_identity_atom th2)))\r
9505    THEN DISCH_THEN SUBST_ALL_TAC\r
9506    THEN REMOVE_THEN "F9" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM; is_node_going])\r
9507    THEN STRIP_TAC\r
9508    THENL[ASM_CASES_TAC `k:num = 0`\r
9509        THENL[UNDISCH_TAC `z:A = ((next (L:(A)loop)) POWER (k:num)) (y:A)`\r
9510            THEN POP_ASSUM SUBST1_TAC\r
9511            THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
9512        THEN FIND_ASSUM (MP_TAC o AP_TERM `back (L:(A)loop)`) `z:A = ((next (L:(A)loop)) POWER (k:num)) (y:A)`\r
9513        THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ])\r
9514        THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP LT_SUC_PRE th] THEN ASSUME_TAC th)\r
9515        THEN REWRITE_TAC[COM_POWER; o_THM]\r
9516        THEN REWRITE_TAC[lemma_inverse_evaluation]\r
9517        THEN FIRST_ASSUM (MP_TAC o REWRITE_RULE[ARITH_RULE `PRE k <= k`] o SPEC `PRE k` o check (is_forall o concl))\r
9518        THEN DISCH_THEN (SUBST1_TAC)\r
9519        THEN DISCH_THEN (MP_TAC o AP_TERM `inverse (node_map (H:(A)hypermap))`)\r
9520        THEN REWRITE_TAC[iterate_map_valuation]\r
9521        THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[SYM(MATCH_MP LT_SUC_PRE th)])\r
9522        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`)\r
9523        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
9524        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
9525        THEN USE_THEN "F10" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC]\r
9526    THEN ASM_CASES_TAC `k:num = 0`\r
9527    THENL[UNDISCH_TAC `y:A = ((next (L:(A)loop)) POWER (k:num)) (z:A)`\r
9528        THEN POP_ASSUM SUBST1_TAC\r
9529        THEN REWRITE_TAC[POWER_0; I_THM; EQ_SYM]; ALL_TAC]\r
9530    THEN FIND_ASSUM (MP_TAC o AP_TERM `back (L:(A)loop)`) `y:A = ((next (L:(A)loop)) POWER (k:num)) (z:A)`\r
9531    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ])\r
9532    THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP LT_SUC_PRE th] THEN ASSUME_TAC th)\r
9533    THEN REWRITE_TAC[COM_POWER; o_THM]\r
9534    THEN REWRITE_TAC[lemma_inverse_evaluation]\r
9535    THEN FIRST_ASSUM (MP_TAC o REWRITE_RULE[ARITH_RULE `PRE k <= k`] o SPEC `PRE k` o check (is_forall o concl))\r
9536    THEN DISCH_THEN (SUBST1_TAC)\r
9537    THEN DISCH_THEN (MP_TAC o AP_TERM `inverse (node_map (H:(A)hypermap))`)\r
9538    THEN REWRITE_TAC[iterate_map_valuation]\r
9539    THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[SYM(MATCH_MP LT_SUC_PRE th)])\r
9540    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`)\r
9541    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
9542    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
9543    THEN USE_THEN "F5" (fun th -> REWRITE_TAC[GSYM th]));;\r
9544 \r
9545 let head_on_loop = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L \r
9546    ==> head H NF x IN atom H L x /\ ~(next L (head H NF x) = inverse (node_map H) (head H NF x))`,\r
9547  REPEAT GEN_TAC\r
9548    THEN DISCH_THEN (LABEL_TAC "FC")\r
9549    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9550    THEN USE_THEN "F2"(fun th -> (USE_THEN "F3"(fun th1-> ASSUME_TAC (MATCH_MP lemma_in_support2  (CONJ th1 th)))))\r
9551    THEN USE_THEN "F1"(fun th-> MP_TAC (CONJUNCT2(SPEC `x:A`(MATCH_MP lemma_head_tail th))))\r
9552    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
9553    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1)))))\r
9554    THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` (SUBST_ALL_TAC)\r
9555    THENL[MATCH_MP_TAC disjoint_loops \r
9556        THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A`\r
9557        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9558    THEN ASM_REWRITE_TAC[]);;\r
9559 \r
9560 let tail_on_loop = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L \r
9561    ==> tail H NF x IN atom H L x /\ ~(tail H NF x = inverse (node_map H) (back L (tail H NF x)))`,\r
9562   REPEAT GEN_TAC\r
9563    THEN DISCH_THEN (LABEL_TAC "FC")\r
9564    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9565    THEN USE_THEN "F2"(fun th -> (USE_THEN "F3"(fun th1-> ASSUME_TAC (MATCH_MP lemma_in_support2  (CONJ th1 th)))))\r
9566    THEN USE_THEN "F1"(fun th-> MP_TAC (CONJUNCT2(SPEC `x:A`(MATCH_MP lemma_head_tail th))))\r
9567    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
9568    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (MP_TAC o CONJUNCT2 o CONJUNCT2))))\r
9569    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))\r
9570    THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` (SUBST_ALL_TAC)\r
9571    THENL[MATCH_MP_TAC disjoint_loops \r
9572        THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A`\r
9573        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9574    THEN ASM_REWRITE_TAC[]);;\r
9575 \r
9576 let change_to_margin = prove( `!(H:(A)hypermap) (NF:(A)loop->bool) (x:A) (L:(A)loop). is_normal H NF /\ L IN NF /\ x belong L\r
9577                                ==> atom H L x = atom H L (tail H NF x) /\ atom H L x = atom H L (head H NF x)`,\r
9578  REPEAT GEN_TAC\r
9579    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9580    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->MP_TAC(CONJUNCT1(MATCH_MP head_on_loop (CONJ th (CONJ th1 th2)))))))))\r
9581    THEN DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_identity_atom th1))\r
9582    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->MP_TAC(CONJUNCT1(MATCH_MP tail_on_loop (CONJ th (CONJ th1 th2)))))))))\r
9583    THEN DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_identity_atom th1))\r
9584    THEN MESON_TAC[]);;\r
9585 \r
9586 let change_parameters = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x\r
9587     ==> head H NF y = head H NF x /\ tail H NF y = tail H NF x`,\r
9588    REPEAT GEN_TAC\r
9589    THEN DISCH_THEN (LABEL_TAC "FC")\r
9590    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2")(CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
9591    THEN USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3->LABEL_TAC "F6"(MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
9592    THEN USE_THEN "F4"(fun th1->(LABEL_TAC "F7"(MATCH_MP lemma_identity_atom th1)))\r
9593    THEN STRIP_TAC\r
9594    THENL[MATCH_MP_TAC lemma_unique_head\r
9595       THEN EXISTS_TAC `L:(A)loop`\r
9596       THEN ASM_REWRITE_TAC[]\r
9597       THEN POP_ASSUM (SUBST1_TAC o SYM)\r
9598       THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2-> REWRITE_TAC[MATCH_MP head_on_loop (CONJ th(CONJ th1 th2))])))))\r
9599       ; ALL_TAC]\r
9600    THEN MATCH_MP_TAC lemma_unique_tail\r
9601    THEN EXISTS_TAC `L:(A)loop`\r
9602    THEN ASM_REWRITE_TAC[]\r
9603    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
9604    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2-> REWRITE_TAC[MATCH_MP tail_on_loop (CONJ th(CONJ th1 th2))]))))));;\r
9605 \r
9606 let margin_in_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_normal H NF /\ L IN NF /\ x belong L \r
9607    ==> head H NF x belong L /\ tail H NF x belong L`,\r
9608  REPEAT GEN_TAC THEN DISCH_TAC\r
9609    THEN STRIP_TAC \r
9610    THENL[MATCH_MP_TAC lemma_in_loop THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A`\r
9611        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP head_on_loop th; CONJUNCT2(CONJUNCT2 th)]); ALL_TAC]\r
9612    THEN MATCH_MP_TAC lemma_in_loop\r
9613    THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A`\r
9614    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP tail_on_loop th; CONJUNCT2(CONJUNCT2 th)]));;\r
9615 \r
9616 let lemma_map_next = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L /\ next L x IN atom H L x \r
9617    ==> next L x = inverse (node_map H) x`,                          \r
9618    REPEAT GEN_TAC\r
9619    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "FC"))))\r
9620    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9621    THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1)\r
9622    THEN USE_THEN "FC" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM])\r
9623    THEN STRIP_TAC\r
9624    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
9625        THEN DISCH_THEN  (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))\r
9626        THEN ASM_CASES_TAC `k:num = 0`\r
9627        THENL[POP_ASSUM SUBST_ALL_TAC\r
9628            THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[POWER_0; I_THM])\r
9629            THEN DISCH_THEN (ASSUME_TAC o ONCE_REWRITE_RULE[SPEC `next (L:(A)loop)` orbit_one_point])\r
9630            THEN USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2))\r
9631            THEN POP_ASSUM SUBST1_TAC\r
9632            THEN DISCH_TAC\r
9633            THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC\r
9634            THENL[POP_ASSUM SUBST1_TAC\r
9635               THEN REWRITE_TAC[SUBSET; IN_SING; node]\r
9636               THEN GEN_TAC\r
9637               THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
9638            THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))); ALL_TAC]\r
9639        THEN REMOVE_THEN "F6" (MP_TAC o REWRITE_RULE[POWER_1; LT1_NZ; LT_NZ ] o SPEC `1`)\r
9640        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
9641    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
9642    THEN DISCH_THEN  (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))\r
9643    THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC\r
9644    THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`]  lemma_atom_sub_node)\r
9645       THEN USE_THEN "FC"(fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_subset (CONJ th1 th)))))\r
9646       THEN DISCH_THEN(fun th->REWRITE_TAC[MATCH_MP lemma_node_identity th])\r
9647       THEN USE_THEN "F3" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1))))\r
9648       THEN REWRITE_TAC[POWER_1]\r
9649       THEN DISCH_THEN(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2))\r
9650       THEN DISCH_THEN SUBST1_TAC\r
9651       THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[iterate_map_valuation] o SYM o AP_TERM `next (L:(A)loop)`)\r
9652       THEN DISCH_THEN (fun th-> MP_TAC (REWRITE_RULE[LT_SUC_LE] (MATCH_MP orbit_cyclic (CONJ (SPEC `k:num` NON_ZERO) th))))\r
9653       THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_two_series_eq)\r
9654       THEN DISCH_THEN SUBST1_TAC\r
9655       THEN DISCH_THEN SUBST1_TAC\r
9656       THEN REWRITE_TAC[SUBSET; IN_ELIM_THM]\r
9657       THEN GEN_TAC\r
9658       THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC o CONJUNCT2))\r
9659       THEN MP_TAC (SPEC `i:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)))\r
9660       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC))\r
9661       THEN REWRITE_TAC[node; lemma_in_orbit]; ALL_TAC]\r
9662    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))));;\r
9663 \r
9664 let next_head_outside_atom =  prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L\r
9665    ==> ~((next L (head H NF x)) IN (atom H L x))`,\r
9666 REPEAT GEN_TAC\r
9667    THEN DISCH_THEN (LABEL_TAC "FC")\r
9668    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9669    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9670    THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1)\r
9671    THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (MP_TAC)) o MATCH_MP head_on_loop)\r
9672    THEN REWRITE_TAC[CONTRAPOS_THM]\r
9673    THEN DISCH_TAC\r
9674    THEN MATCH_MP_TAC lemma_map_next\r
9675    THEN EXISTS_TAC `NF:(A)loop->bool`\r
9676    THEN ASM_REWRITE_TAC[]\r
9677    THEN STRIP_TAC\r
9678    THENL[MATCH_MP_TAC lemma_in_loop\r
9679         THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A`\r
9680         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9681    THEN USE_THEN "F5" (fun th2 -> (ONCE_REWRITE_TAC[GSYM (MATCH_MP lemma_identity_atom th2)]))\r
9682    THEN POP_ASSUM (fun th2 -> (ONCE_REWRITE_TAC[MATCH_MP lemma_identity_atom th2]))\r
9683    THEN REWRITE_TAC[atom_reflect]);;\r
9684 \r
9685 let value_next_of_head =  prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L  ==> next L (head H NF x) = face_map H (head H NF x)`,\r
9686    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC")\r
9687    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9688    THEN REMOVE_THEN "FC"(fun th-> (MP_TAC (MATCH_MP head_on_loop th )))\r
9689    THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)\r
9690    THEN REMOVE_THEN "F3"(fun th->(DISCH_THEN(fun th1->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th th1)))))\r
9691    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9692    THEN DISCH_THEN (MP_TAC o SPEC `head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` o REWRITE_RULE[is_loop] o CONJUNCT1)\r
9693    THEN REWRITE_TAC[one_step_contour]\r
9694    THEN ASM_REWRITE_TAC[]);;\r
9695 \r
9696 let back_tail_outside_atom = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L ==> ~((back L (tail H NF x)) IN (atom H L x))`,\r
9697    REPEAT GEN_TAC\r
9698    THEN DISCH_THEN (LABEL_TAC "FC")\r
9699    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9700    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9701    THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1)\r
9702    THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (MP_TAC)) o MATCH_MP tail_on_loop)\r
9703    THEN REWRITE_TAC[CONTRAPOS_THM]\r
9704    THEN DISCH_TAC\r
9705    THEN ABBREV_TAC `y = back (L:(A)loop) (tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A))`\r
9706    THEN POP_ASSUM (MP_TAC o AP_TERM `next (L:(A)loop)`)\r
9707    THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation]\r
9708    THEN DISCH_THEN SUBST_ALL_TAC\r
9709    THEN MATCH_MP_TAC lemma_map_next\r
9710    THEN EXISTS_TAC `NF:(A)loop->bool`\r
9711    THEN POP_ASSUM (LABEL_TAC "F6")\r
9712    THEN USE_THEN "F6" (fun th2 -> (SUBST_ALL_TAC (SYM(MATCH_MP lemma_identity_atom th2))))\r
9713    THEN ASM_REWRITE_TAC[]\r
9714    THEN MATCH_MP_TAC lemma_in_loop\r
9715    THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);; \r
9716 \r
9717 let face_map_on_margin =  prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L ==>\r
9718 face_map H (head H NF x) belong L /\ inverse (face_map H) (tail H NF x) belong L /\ face_map H (head H NF x) = tail H NF (face_map H (head H NF x))\r
9719 /\ inverse (face_map H) (tail H NF x) = head H NF (inverse (face_map H) (tail H NF x))`,\r
9720    REPEAT GEN_TAC\r
9721    THEN DISCH_THEN (LABEL_TAC "FC")\r
9722    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9723    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9724    THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1)\r
9725    THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) o MATCH_MP head_on_loop)\r
9726    THEN ABBREV_TAC `y = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9727    THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F5"(fun th3->LABEL_TAC "F8" (MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
9728    THEN USE_THEN "F8"(fun th-> (USE_THEN "F4"(MP_TAC o REWRITE_RULE[th; one_step_contour] o SPEC `y:A` o  REWRITE_RULE[is_loop])))\r
9729    THEN USE_THEN "F6" (fun th -> SIMP_TAC[th])\r
9730    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
9731    THEN USE_THEN "F8" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1))))\r
9732    THEN REWRITE_TAC[POWER_1]\r
9733    THEN DISCH_THEN (fun th -> (REWRITE_TAC[th] THEN LABEL_TAC "F9" th))\r
9734    THEN SUBGOAL_THEN `next (L:(A)loop) (y:A) = tail (H:(A)hypermap) (NF:(A)loop->bool) (next L y)` (LABEL_TAC "F10")\r
9735    THENL[CONV_TAC SYM_CONV\r
9736        THEN MATCH_MP_TAC lemma_unique_tail\r
9737        THEN EXISTS_TAC `L:(A)loop`\r
9738        THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation]\r
9739        THEN ASM_REWRITE_TAC[atom_reflect]; ALL_TAC]\r
9740    THEN REMOVE_THEN "F10" (SUBST1_TAC o SYM)\r
9741    THEN SIMP_TAC[]\r
9742    THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12")) o MATCH_MP tail_on_loop)\r
9743    THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9744    THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F11"(fun th3->LABEL_TAC "F14" (MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
9745    THEN USE_THEN "F14" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_back_in_loop th1))))\r
9746    THEN REWRITE_TAC[POWER_1]\r
9747    THEN DISCH_THEN (LABEL_TAC "F15")\r
9748    THEN USE_THEN "F15"(fun th-> (USE_THEN "F4"(MP_TAC o REWRITE_RULE[th; one_step_contour] o SPEC `back (L:(A)loop) (z:A)` o  REWRITE_RULE[is_loop])))\r
9749    THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation]\r
9750    THEN REWRITE_TAC[one_step_contour]\r
9751    THEN USE_THEN "F12" (fun th -> SIMP_TAC[th])\r
9752    THEN REWRITE_TAC[face_map_inverse_representation]\r
9753    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
9754    THEN USE_THEN "F15" (fun th->REWRITE_TAC[th])\r
9755    THEN CONV_TAC SYM_CONV\r
9756    THEN MATCH_MP_TAC lemma_unique_head\r
9757    THEN EXISTS_TAC `L:(A)loop`\r
9758    THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation]\r
9759    THEN ASM_REWRITE_TAC[atom_reflect]);;\r
9760 \r
9761 let node_map_on_margin =  prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L ==> (?L':(A)loop. L' IN NF /\ node_map H (tail H NF x) belong L' /\ node_map H (tail H NF x) = head H NF (node_map H (tail H NF x)))\r
9762 /\ (?P:(A)loop. P IN NF /\ inverse (node_map H) (head H NF x) belong P /\ inverse (node_map H) (head H NF x) = tail H NF (inverse (node_map H) (head H NF x)))`,\r
9763    REPEAT GEN_TAC\r
9764    THEN DISCH_THEN (LABEL_TAC "FC")\r
9765    THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9766    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9767    THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1)\r
9768    THEN STRIP_TAC\r
9769    THENL[USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) o MATCH_MP tail_on_loop)\r
9770       THEN ABBREV_TAC `y = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9771       THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F5"(fun th3->LABEL_TAC "F8" (MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
9772       THEN USE_THEN "F8"(fun th1->(USE_THEN "F2"(fun th2->(MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th2))))))\r
9773       THEN USE_THEN "F1"(fun th1->(DISCH_THEN(fun th2->(MP_TAC (SPEC `1` (MATCH_MP lemma_node_in_support2 (CONJ th1 th2)))))))\r
9774       THEN REWRITE_TAC[POWER_1; lemma_in_support]\r
9775       THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")))\r
9776       THEN EXISTS_TAC `L':(A)loop`\r
9777       THEN ASM_REWRITE_TAC[]\r
9778       THEN CONV_TAC SYM_CONV\r
9779       THEN MATCH_MP_TAC lemma_unique_head\r
9780       THEN EXISTS_TAC `L':(A)loop`\r
9781       THEN ASM_REWRITE_TAC[atom_reflect]\r
9782       THEN REMOVE_THEN "F6" MP_TAC\r
9783       THEN REWRITE_TAC[CONTRAPOS_THM]\r
9784       THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))]\r
9785       THEN DISCH_TAC\r
9786       THEN USE_THEN "F10" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1))))\r
9787       THEN REWRITE_TAC[POWER_1]\r
9788       THEN POP_ASSUM (fun th ->  SUBST1_TAC th THEN LABEL_TAC "F11" th)\r
9789       THEN DISCH_TAC\r
9790       THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC\r
9791       THENL[MATCH_MP_TAC disjoint_loops\r
9792          THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A`\r
9793          THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9794       THEN REMOVE_THEN "F11" (MP_TAC o AP_TERM `back (L:(A)loop)`)\r
9795       THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation]\r
9796       THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
9797       THEN MESON_TAC[EQ_SYM]; ALL_TAC]\r
9798    THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F15") (LABEL_TAC "F16")) o MATCH_MP head_on_loop)\r
9799    THEN ABBREV_TAC `y = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9800    THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F15"(fun th3->LABEL_TAC "F17" (MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
9801    THEN USE_THEN "F17"(fun th1->(USE_THEN "F2"(fun th2->(MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th2))))))\r
9802    THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts))\r
9803    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` ASSUME_TAC)\r
9804    THEN USE_THEN "F1"(fun th1->(DISCH_THEN(fun th2->(MP_TAC (SPEC `j:num` (MATCH_MP lemma_node_in_support2 (CONJ th1 th2)))))))\r
9805    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
9806    THEN REWRITE_TAC[lemma_in_support]\r
9807    THEN DISCH_THEN (X_CHOOSE_THEN `P:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19")))\r
9808    THEN EXISTS_TAC `P:(A)loop`\r
9809    THEN ASM_REWRITE_TAC[]\r
9810    THEN CONV_TAC SYM_CONV\r
9811    THEN MATCH_MP_TAC lemma_unique_tail\r
9812    THEN EXISTS_TAC `P:(A)loop`\r
9813    THEN ASM_REWRITE_TAC[atom_reflect]\r
9814    THEN REMOVE_THEN "F16" MP_TAC\r
9815    THEN REWRITE_TAC[CONTRAPOS_THM]\r
9816    THEN DISCH_THEN (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`)\r
9817    THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))]\r
9818    THEN DISCH_THEN (MP_TAC o AP_TERM `next (P:(A)loop)`)\r
9819    THEN REWRITE_TAC[lemma_inverse_evaluation]\r
9820    THEN DISCH_THEN (SUBST_ALL_TAC o SYM)\r
9821    THEN REMOVE_THEN "F19" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_back_in_loop th1))))\r
9822    THEN REWRITE_TAC[POWER_1]\r
9823    THEN REWRITE_TAC[lemma_inverse_evaluation]\r
9824    THEN DISCH_TAC\r
9825    THEN SUBGOAL_THEN `L:(A)loop = P:(A)loop` SUBST1_TAC\r
9826    THENL[MATCH_MP_TAC disjoint_loops\r
9827        THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A`\r
9828        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
9829    THEN SIMP_TAC[]);;\r
9830 \r
9831 let node_map_free_loop =  prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L ==> node_map H (tail H NF x) = head H NF (node_map H (tail H NF x)) /\ inverse (node_map H) (head H NF x) = tail H NF (inverse (node_map H) (head H NF x))`,\r
9832    MESON_TAC[node_map_on_margin]);;\r
9833 \r
9834 let from_tail = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x \r
9835    ==> (!i:num. i <= index L (tail H NF x) y ==> (next L POWER i) (tail H NF x) = (inverse (node_map H) POWER i) (tail H NF x))`,\r
9836    REPEAT GEN_TAC\r
9837    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
9838    THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> (LABEL_TAC "F5" (MATCH_MP lemma_in_loop (CONJ th th1)))))\r
9839    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th2->(USE_THEN "F3"(fun th3-> MP_TAC (MATCH_MP tail_on_loop (CONJ th (CONJ th2 th3))))))))\r
9840    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))\r
9841    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9842    THEN DISCH_THEN (LABEL_TAC "F8" o CONJUNCT1)\r
9843    THEN USE_THEN "F3" (fun th-> USE_THEN "F6" (fun th1-> (LABEL_TAC "F9" (MATCH_MP lemma_in_loop (CONJ th th1)))))\r
9844    THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9845    THEN REMOVE_THEN "F6" (SUBST_ALL_TAC o MATCH_MP lemma_identity_atom)\r
9846    THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM])\r
9847    THEN STRIP_TAC\r
9848    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
9849        THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")))\r
9850        THEN USE_THEN "F9" (fun th-> USE_THEN "F5" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1)))))\r
9851        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4"))\r
9852        THEN ASM_CASES_TAC `k:num <= top (L:(A)loop)`\r
9853        THENL[USE_THEN "F9"(fun th-> POP_ASSUM (fun th1-> USE_THEN "H1" (fun th2-> MP_TAC (MATCH_MP determine_loop_index (CONJ th (CONJ th1 th2))))))\r
9854            THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
9855        THEN POP_ASSUM(fun th-> MP_TAC (MATCH_MP LT_IMP_LE (REWRITE_RULE[NOT_LE] th)))\r
9856        THEN USE_THEN "H3" (fun th -> DISCH_THEN (fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1))))\r
9857        THEN USE_THEN "H2"(fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP lemma_sub_part (CONJ th th1)])); ALL_TAC]\r
9858    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
9859    THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")))\r
9860    THEN ASM_CASES_TAC `k:num = 0`\r
9861    THENL[POP_ASSUM SUBST_ALL_TAC\r
9862        THEN USE_THEN "G1" (MP_TAC o REWRITE_RULE[POWER_0; I_THM])\r
9863        THEN DISCH_THEN SUBST1_TAC\r
9864        THEN MP_TAC (REWRITE_RULE[I_THM] (SYM(AP_THM (SPEC `next (L:(A)loop)` POWER_0) `y:A`)))\r
9865        THEN MP_TAC (SPEC `top (L:(A)loop)` LE_0)\r
9866        THEN USE_THEN "F5" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
9867        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP determine_loop_index th])\r
9868        THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
9869    THEN USE_THEN "G2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`)\r
9870    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; NOT_LE; LT_EXISTS; CONJUNCT1 ADD])\r
9871    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
9872    THEN USE_THEN "G2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `SUC d`)\r
9873    THEN USE_THEN "G1" (SUBST1_TAC o SYM)\r
9874    THEN REWRITE_TAC[GSYM (COM_POWER_FUNCTION)]\r
9875    THEN USE_THEN "G2" (SUBST1_TAC o SYM o REWRITE_RULE[LE_PLUS] o SPEC `d:num`)\r
9876    THEN USE_THEN "G1" (SUBST1_TAC o SYM o REWRITE_RULE[GSYM (COM_POWER_FUNCTION); lemma_inverse_evaluation] o AP_TERM `back (L:(A)loop)`)\r
9877    THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th]));;\r
9878 \r
9879 let to_head = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x \r
9880    ==> (!i:num. i <= index L y (head H NF x) ==> (next L POWER i) y = (inverse (node_map H) POWER i) y)`,\r
9881    REPEAT GEN_TAC\r
9882    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
9883    THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> (LABEL_TAC "F5" (MATCH_MP lemma_in_loop (CONJ th th1)))))\r
9884    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th2->(USE_THEN "F3"(fun th3-> MP_TAC (MATCH_MP head_on_loop (CONJ th (CONJ th2 th3))))))))\r
9885    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))\r
9886    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
9887    THEN DISCH_THEN (LABEL_TAC "F8" o CONJUNCT1)\r
9888    THEN USE_THEN "F3" (fun th-> USE_THEN "F6" (fun th1-> (LABEL_TAC "F9" (MATCH_MP lemma_in_loop (CONJ th th1)))))\r
9889    THEN ABBREV_TAC `z = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`\r
9890    THEN REMOVE_THEN "F6" (SUBST_ALL_TAC o MATCH_MP lemma_identity_atom)\r
9891    THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM])\r
9892    THEN STRIP_TAC\r
9893    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
9894        THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")))\r
9895        THEN ASM_CASES_TAC `k:num = 0`\r
9896        THENL[POP_ASSUM SUBST_ALL_TAC\r
9897            THEN USE_THEN "G1" (MP_TAC o REWRITE_RULE[POWER_0; I_THM])\r
9898            THEN DISCH_THEN SUBST1_TAC\r
9899            THEN MP_TAC (REWRITE_RULE[I_THM] (SYM(AP_THM (SPEC `next (L:(A)loop)` POWER_0) `z:A`)))\r
9900            THEN MP_TAC (SPEC `top (L:(A)loop)` LE_0)\r
9901            THEN USE_THEN "F9" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
9902            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP determine_loop_index th])\r
9903            THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
9904        THEN USE_THEN "G2" (MP_TAC o SPEC `1`)\r
9905        THEN POP_ASSUM(fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ] th; POWER_1])\r
9906        THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
9907    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
9908    THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")))\r
9909    THEN USE_THEN "F5" (fun th-> USE_THEN "F9" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1)))))\r
9910    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4"))\r
9911    THEN ASM_CASES_TAC `k:num <= top (L:(A)loop)`\r
9912    THENL[USE_THEN "F5"(fun th-> POP_ASSUM (fun th1-> USE_THEN "H1" (fun th2-> MP_TAC (MATCH_MP determine_loop_index (CONJ th (CONJ th1 th2))))))\r
9913        THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
9914    THEN POP_ASSUM(fun th-> MP_TAC (MATCH_MP LT_IMP_LE (REWRITE_RULE[NOT_LE] th)))\r
9915    THEN USE_THEN "H3" (fun th -> DISCH_THEN (fun th1-> ASSUME_TAC (MATCH_MP LE_TRANS (CONJ th th1))))\r
9916    THEN REPEAT STRIP_TAC\r
9917    THEN USE_THEN "H2" (MP_TAC o SPEC `i:num`)\r
9918    THEN POP_ASSUM (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)])));;\r
9919 \r
9920 let add_steps = prove(`!L:(A)loop x:A y:A z:A. x belong L /\ y belong L /\ z belong L /\ index L x y <= index L x z \r
9921    ==> (index L x y) + (index L y z) = index L x z`,\r
9922  REPEAT GEN_TAC\r
9923    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
9924    THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1))))\r
9925    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))\r
9926    THEN USE_THEN "F1"(fun th-> USE_THEN "F3"(fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1))))\r
9927    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))\r
9928    THEN USE_THEN "F2"(fun th-> USE_THEN "F3"(fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1))))\r
9929    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10"))\r
9930    THEN ABBREV_TAC `nz = index (L:(A)loop) y z`\r
9931    THEN ABBREV_TAC `n = index (L:(A)loop) x y`\r
9932    THEN ABBREV_TAC `m = index (L:(A)loop) x z`\r
9933    THEN USE_THEN "F10" MP_TAC\r
9934    THEN USE_THEN "F6" SUBST1_TAC\r
9935    THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
9936    THEN USE_THEN "F8" SUBST1_TAC\r
9937    THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
9938    THEN DISCH_THEN ((X_CHOOSE_THEN `q:num` MP_TAC) o MATCH_MP lemma_congruence_on_loop)\r
9939    THEN ASM_CASES_TAC `q:num = 0`\r
9940    THENL[POP_ASSUM SUBST1_TAC\r
9941        THEN REWRITE_TAC[CONJUNCT1 MULT; CONJUNCT1 ADD; lemma_size]\r
9942        THEN DISCH_THEN (fun th-> REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] th]); ALL_TAC]\r
9943    THEN POP_ASSUM (LABEL_TAC "F11")\r
9944    THEN DISCH_TAC\r
9945    THEN USE_THEN "F11"(fun th-> MP_TAC (MATCH_MP LE_MULT2 (CONJ (REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ] th) (SPEC `size (L:(A)loop)` LE_REFL))))\r
9946    THEN REWRITE_TAC[MULT_CLAUSES]\r
9947    THEN DISCH_TAC THEN MP_TAC(SPECL[`size (L:(A)loop)`; `(q:num) * (size (L:(A)loop))`; `m:num`]  LE_ADD_RCANCEL)\r
9948    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
9949    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
9950    THEN USE_THEN "F9"(fun th-> USE_THEN  "F4" (fun th1-> MP_TAC (MATCH_MP LE_ADD2 (CONJ th th1))))\r
9951    THEN DISCH_THEN (fun th-> DISCH_THEN (fun th1-> (MP_TAC (MATCH_MP LE_TRANS (CONJ th1 th)))))\r
9952    THEN REWRITE_TAC[lemma_size; CONJUNCT2 ADD] THEN ARITH_TAC);;\r
9953 \r
9954 let add_steps_in_atom = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A y:A. is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x \r
9955    ==> (index L (tail H NF x) y) + (index L y (head H NF x)) = index L (tail H NF x) (head H NF x)`,\r
9956  REPEAT GEN_TAC\r
9957    THEN DISCH_THEN (fun th-> LABEL_TAC "FC"(MATCH_MP from_tail th) THEN MP_TAC th)\r
9958    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
9959    THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1->USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP margin_in_loop (CONJ th (CONJ th1 th2))))))\r
9960    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))\r
9961    THEN MATCH_MP_TAC add_steps\r
9962    THEN ASM_REWRITE_TAC[]\r
9963    THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_loop (CONJ th th1)]))\r
9964    THEN USE_THEN "F1" (fun th-> USE_THEN "F2"(fun th1-> USE_THEN "F3" (fun th2-> MP_TAC(MATCH_MP head_on_loop (CONJ th (CONJ th1 th2))))))\r
9965    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))\r
9966    THEN USE_THEN "F6" (fun th-> USE_THEN "F5"(fun th1-> LABEL_TAC "F9" (CONJUNCT2(MATCH_MP lemma_loop_index (CONJ th th1)))))\r
9967    THEN ABBREV_TAC `u = tail (H:(A)hypermap) NF x`\r
9968    THEN ABBREV_TAC `v = head (H:(A)hypermap) NF x`\r
9969    THEN ASM_CASES_TAC `index (L:(A)loop) u y <= index L u v`\r
9970    THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
9971    THEN POP_ASSUM (LABEL_TAC "F10" o REWRITE_RULE[NOT_LE; GSYM LE_SUC_LT])\r
9972    THEN USE_THEN "FC" (MP_TAC o SPEC `SUC(index (L:(A)loop) u v)`)\r
9973    THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th; GSYM COM_POWER_FUNCTION])\r
9974    THEN USE_THEN "FC" (MP_TAC o SPEC `index (L:(A)loop) u v`)\r
9975    THEN USE_THEN "F10" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `index (L:(A)loop) u v` LE_PLUS) th)])\r
9976    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
9977    THEN USE_THEN "F9" (SUBST1_TAC o SYM)\r
9978    THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]));;\r
9979 \r
9980 let lemma_in_atom = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A) (m:num). is_loop H L /\ (!i:num .i <= m ==> ((next L) POWER i) x = ((inverse (node_map H)) POWER i) x)  ==> ((next L) POWER m) x IN atom H L x`,\r
9981     REPEAT GEN_TAC\r
9982     THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F3"))\r
9983     THEN ASM_CASES_TAC `~(x:A belong L:(A)loop)`\r
9984     THENL[POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th])\r
9985         THEN REWRITE_TAC[atom_reflect]; ALL_TAC]\r
9986     THEN POP_ASSUM (LABEL_TAC "F2" o REWRITE_RULE[])\r
9987     THEN ABBREV_TAC `y = ((next (L:(A)loop)) POWER (m:num)) (x:A)`\r
9988     THEN REWRITE_TAC[atom; IN_ELIM_THM]\r
9989     THEN DISJ1_TAC\r
9990     THEN REWRITE_TAC[is_node_going]\r
9991     THEN EXISTS_TAC `m:num`\r
9992     THEN ASM_SIMP_TAC[]);;\r
9993 \r
9994 let lemma_in_atom2 = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L \r
9995    ==> (!i:num. i <= index L x (head H NF x) ==> (next L POWER i) x IN atom H L x)`,\r
9996  REPEAT GEN_TAC\r
9997    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
9998    THEN GEN_TAC\r
9999    THEN DISCH_THEN (LABEL_TAC "F4")\r
10000    THEN USE_THEN "F2" (fun th->(USE_THEN "F1" (LABEL_TAC "F5" o CONJUNCT1 o REWRITE_RULE[th] o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10001    THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect)\r
10002    THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC\r
10003    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10004    THEN DISCH_THEN (MP_TAC o MATCH_MP to_head)\r
10005    THEN DISCH_THEN (fun th-> USE_THEN "F4" (fun th1-> (MP_TAC (MATCH_MP lemma_sub_part (CONJ th th1)))))\r
10006    THEN USE_THEN "F5"(fun th-> DISCH_THEN (fun th1-> (REWRITE_TAC [MATCH_MP lemma_in_atom (CONJ th th1)]))));;\r
10007 \r
10008 let atomic_particles = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L\r
10009   ==> atom H L x = {(next L POWER (i:num)) (tail H NF x) |i:num| i <= index L (tail H NF x) (head H NF x)} /\\r
10010      (!i:num. i <= index L (tail H NF x) (head H NF x) ==> (next L POWER i) (tail H NF x) = (inverse (node_map H) POWER i) (tail H NF x)) /\      \r
10011      atom H L x = {(inverse (node_map H) POWER (i:num)) (tail H NF x) |i:num| i <= index L (tail H NF x) (head H NF x)}`,\r
10012    REPEAT GEN_TAC\r
10013    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
10014    THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1->USE_THEN "F3"(fun th2-> MP_TAC(MATCH_MP margin_in_loop (CONJ th (CONJ th1 th2))))))\r
10015    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))\r
10016    THEN USE_THEN "F5" (fun th-> USE_THEN "F4"(fun th1-> (MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1)))))\r
10017    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))\r
10018    THEN ABBREV_TAC `u = tail (H:(A)hypermap) NF x` THEN POP_ASSUM (LABEL_TAC "UL")\r
10019    THEN ABBREV_TAC `v = head (H:(A)hypermap) NF x` THEN POP_ASSUM (LABEL_TAC "VL")\r
10020    THEN SUBGOAL_THEN `?n:num. (!j:num. j <= n ==> (next (L:(A)loop) POWER j) u = (inverse (node_map (H:(A)hypermap)) POWER j) u) /\ ~(next L ((next L POWER n) u) = inverse (node_map H) ((next L POWER n) u))` MP_TAC\r
10021    THENL[ONCE_REWRITE_TAC[TAUT `A <=> ~ ~A`]\r
10022        THEN GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [NOT_EXISTS_THM; DE_MORGAN_THM;  NOT_FORALL_THM]\r
10023        THEN DISCH_THEN (LABEL_TAC "H1" o REWRITE_RULE[])\r
10024        THEN SUBGOAL_THEN `!n:num. (next (L:(A)loop) POWER n) u = (inverse (node_map (H:(A)hypermap)) POWER n) u` (LABEL_TAC "H2")\r
10025        THENL[MATCH_MP_TAC num_WF\r
10026           THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
10027           THEN DISCH_THEN (LABEL_TAC "G1")\r
10028           THEN USE_THEN "H1" (MP_TAC o SPEC `n:num`)\r
10029           THEN STRIP_TAC\r
10030           THENL[POP_ASSUM MP_TAC THEN USE_THEN "G1" ((fun th-> REWRITE_TAC[th]) o REWRITE_RULE[LT_SUC_LE] o SPEC `j:num`); ALL_TAC]\r
10031           THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM COM_POWER_FUNCTION]\r
10032           THEN USE_THEN "G1" (SUBST1_TAC o SYM o REWRITE_RULE[LT_PLUS] o SPEC `n:num`)\r
10033           THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM th; COM_POWER_FUNCTION]); ALL_TAC]\r
10034        THEN USE_THEN "F5" (MP_TAC o MATCH_MP lemma_transitive_permutation)\r
10035        THEN USE_THEN "H2" (SUBST1_TAC o MATCH_MP lemma_orbit_eq)\r
10036        THEN REWRITE_TAC[MATCH_MP lemma_orbit_inverse_map_eq (SPEC `H:(A)hypermap` node_map_and_darts); GSYM node]\r
10037        THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1-> MP_TAC(SPEC `u:A`(MATCH_MP lemma_loop_outside_node (CONJ th th1)))))\r
10038        THEN REWRITE_TAC[CONTRAPOS_THM] THEN SET_TAC[]; ALL_TAC]\r
10039    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [num_WOP]\r
10040    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` ((CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9")) o CONJUNCT1))\r
10041    THEN SUBGOAL_THEN `n:num <= index (L:(A)loop) u v` (LABEL_TAC "F10")\r
10042    THENL[USE_THEN "F9" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE]\r
10043        THEN DISCH_THEN (LABEL_TAC "H1")\r
10044        THEN USE_THEN "H1"(fun th-> USE_THEN "F8" (MP_TAC o REWRITE_RULE[REWRITE_RULE[GSYM LE_SUC_LT] th ] o SPEC `SUC (index (L:(A)loop) u v)`))\r
10045        THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION]\r
10046        THEN USE_THEN "H1"(fun th-> USE_THEN "F8" (MP_TAC o REWRITE_RULE[MATCH_MP LT_IMP_LE  th ] o SPEC `index (L:(A)loop) u v`))\r
10047        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
10048        THEN USE_THEN "F7" (SUBST1_TAC o SYM)\r
10049        THEN EXPAND_TAC "v"\r
10050        THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1-> USE_THEN "F3"(fun th2-> REWRITE_TAC[MATCH_MP head_on_loop (CONJ th (CONJ th1 th2))]))); ALL_TAC]\r
10051    THEN ABBREV_TAC `w = (next (L:(A)loop) POWER n) u`\r
10052    THEN POP_ASSUM (LABEL_TAC "WL")\r
10053    THEN USE_THEN "WL" (MP_TAC o SYM)\r
10054    THEN USE_THEN "F10"(fun th-> USE_THEN "F6"(fun th1-> MP_TAC(MATCH_MP LE_TRANS (CONJ th th1))))\r
10055    THEN USE_THEN "F5" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10056    THEN DISCH_THEN (ASSUME_TAC o MATCH_MP determine_loop_index)\r
10057    THEN USE_THEN "F8" MP_TAC\r
10058    THEN USE_THEN "F2" (fun th-> USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]))\r
10059    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10060    THEN USE_THEN "WL" (fun th -> DISCH_THEN (MP_TAC o REWRITE_RULE[th] o  MATCH_MP lemma_in_atom))\r
10061    THEN USE_THEN "UL" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
10062    THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1-> USE_THEN "F3"(fun th2-> REWRITE_TAC[GSYM(MATCH_MP change_to_margin (CONJ th (CONJ th1 th2)))])))\r
10063    THEN DISCH_TAC\r
10064    THEN USE_THEN "F9" MP_TAC\r
10065    THEN POP_ASSUM MP_TAC\r
10066    THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10067    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_unique_head)\r
10068    THEN USE_THEN "VL" SUBST1_TAC\r
10069    THEN DISCH_THEN (SUBST_ALL_TAC o SYM)\r
10070    THEN POP_ASSUM (SUBST_ALL_TAC o SYM)\r
10071    THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th])\r
10072    THEN SUBGOAL_THEN `atom (H:(A)hypermap) L x = {(next L POWER i) u | i:num | i <= index L u v}` (LABEL_TAC "F11")\r
10073    THENL[REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:A`\r
10074        THEN EQ_TAC\r
10075        THENL[DISCH_THEN (LABEL_TAC "H1")\r
10076            THEN USE_THEN "H1" (fun th-> USE_THEN "F3" (fun th1-> MP_TAC (MATCH_MP lemma_in_loop (CONJ th1 th))))\r
10077            THEN USE_THEN "F5" (fun th-> DISCH_THEN (ASSUME_TAC o CONJUNCT2 o MATCH_MP lemma_loop_index o CONJ th))\r
10078            THEN EXISTS_TAC `index (L:(A)loop) u y`\r
10079            THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM th])\r
10080            THEN USE_THEN "H1" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC \r
10081            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10082            THEN USE_THEN "UL"(fun th-> USE_THEN "VL"(fun th1-> DISCH_THEN (MP_TAC o REWRITE_RULE[th; th1] o  MATCH_MP add_steps_in_atom)))\r
10083            THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th; LE_ADD]); ALL_TAC]\r
10084        THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")))\r
10085        THEN USE_THEN "F8"(fun th-> USE_THEN "H1" (fun th1-> MP_TAC (MATCH_MP lemma_sub_part (CONJ th th1))))\r
10086        THEN USE_THEN "F2" (fun th-> USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]))\r
10087        THEN REWRITE_TAC[IMP_IMP]\r
10088        THEN USE_THEN "H2" (fun th-> DISCH_THEN (fun th1-> MP_TAC(REWRITE_RULE[SYM th] (MATCH_MP lemma_in_atom th1))))\r
10089        THEN EXPAND_TAC "u"\r
10090        THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1-> USE_THEN "F3"(fun th2-> REWRITE_TAC[GSYM(MATCH_MP change_to_margin (CONJ th (CONJ th1 th2)))]))); ALL_TAC]\r
10091    THEN USE_THEN "F11"(fun th-> REWRITE_TAC[th])\r
10092    THEN USE_THEN "F8"(fun th-> REWRITE_TAC[MATCH_MP lemma_two_series_eq th]));;\r
10093 \r
10094 let atom_one_point = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L /\ head H NF x = tail H NF x \r
10095   ==> atom H L x = {x}`,\r
10096    REPEAT GEN_TAC\r
10097    THEN DISCH_THEN((CONJUNCTS_THEN2 (LABEL_TAC "F1" o REWRITE_RULE[GSYM CONJ_ASSOC]) (LABEL_TAC "F2")) o REWRITE_RULE[CONJ_ASSOC])\r
10098    THEN USE_THEN "F2" (MP_TAC o AP_TERM `next (L:(A)loop) POWER 0`)\r
10099    THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [POWER_0; I_THM]\r
10100    THEN MP_TAC (SPEC `top (L:(A)loop)` LE_0)\r
10101    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP margin_in_loop)\r
10102    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (LABEL_TAC "F3" o MATCH_MP determine_loop_index)\r
10103    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP atomic_particles)\r
10104    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; CONJUNCT1 LE])\r
10105    THEN REWRITE_TAC[SET_RULE `!p:num->A. {p i | i = 0} = {p 0}`; POWER_0; I_THM]\r
10106    THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect)\r
10107    THEN POP_ASSUM (SUBST1_TAC) THEN REWRITE_TAC[IN_SING]\r
10108    THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]));;\r
10109 \r
10110 let lemma_map_next = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L /\ next L x IN atom H L x \r
10111    ==> next L x = inverse (node_map H) x`,\r
10112    REPEAT GEN_TAC\r
10113    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "FC"))))\r
10114    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10115    THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1)\r
10116    THEN USE_THEN "FC" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM])\r
10117    THEN STRIP_TAC\r
10118    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
10119        THEN DISCH_THEN  (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))\r
10120        THEN ASM_CASES_TAC `k:num = 0`\r
10121        THENL[POP_ASSUM SUBST_ALL_TAC\r
10122            THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[POWER_0; I_THM])\r
10123            THEN DISCH_THEN (ASSUME_TAC o ONCE_REWRITE_RULE[SPEC `next (L:(A)loop)` orbit_one_point])\r
10124            THEN USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2))\r
10125            THEN POP_ASSUM SUBST1_TAC\r
10126            THEN DISCH_TAC\r
10127            THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC\r
10128            THENL[POP_ASSUM SUBST1_TAC\r
10129               THEN REWRITE_TAC[SUBSET; IN_SING; node]\r
10130               THEN GEN_TAC\r
10131               THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC]\r
10132            THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))); ALL_TAC]\r
10133        THEN REMOVE_THEN "F6" (MP_TAC o REWRITE_RULE[POWER_1; LT1_NZ; LT_NZ ] o SPEC `1`)\r
10134        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
10135    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going])\r
10136    THEN DISCH_THEN  (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))\r
10137    THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC\r
10138    THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`]  lemma_atom_sub_node)\r
10139       THEN USE_THEN "FC"(fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_subset (CONJ th1 th)))))\r
10140       THEN DISCH_THEN(fun th->REWRITE_TAC[MATCH_MP lemma_node_identity th])\r
10141       THEN USE_THEN "F3" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1))))\r
10142       THEN REWRITE_TAC[POWER_1]\r
10143       THEN DISCH_THEN(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2))\r
10144       THEN DISCH_THEN SUBST1_TAC\r
10145       THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[iterate_map_valuation] o SYM o AP_TERM `next (L:(A)loop)`)\r
10146       THEN DISCH_THEN (fun th-> MP_TAC (REWRITE_RULE[LT_SUC_LE] (MATCH_MP orbit_cyclic (CONJ (SPEC `k:num` NON_ZERO) th))))\r
10147       THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_two_series_eq)\r
10148       THEN DISCH_THEN SUBST1_TAC\r
10149       THEN DISCH_THEN SUBST1_TAC\r
10150       THEN REWRITE_TAC[SUBSET; IN_ELIM_THM]\r
10151       THEN GEN_TAC\r
10152       THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC o CONJUNCT2))\r
10153       THEN MP_TAC (SPEC `i:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)))\r
10154       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC))\r
10155       THEN REWRITE_TAC[node; lemma_in_orbit]; ALL_TAC]\r
10156    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))));;\r
10157 \r
10158 let lemma_atom_node_eq =  prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A) (L:(A)loop). is_normal H NF /\ L IN NF /\ x belong L /\ node_map H (tail H NF x) IN (atom H L x) ==> atom H L x = node H x`,\r
10159    REPEAT GEN_TAC\r
10160    THEN DISCH_THEN ((CONJUNCTS_THEN2 (LABEL_TAC "F1" o REWRITE_RULE[GSYM CONJ_ASSOC]) (LABEL_TAC "F2")) o REWRITE_RULE[CONJ_ASSOC])\r
10161    THEN USE_THEN "F1" (MP_TAC o MATCH_MP margin_in_loop)\r
10162    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))\r
10163    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP node_map_free_loop)\r
10164    THEN USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1-> REWRITE_TAC[CONJUNCT1(MATCH_MP change_parameters (REWRITE_RULE[GSYM CONJ_ASSOC] (CONJ th th1)))]))\r
10165    THEN DISCH_THEN (LABEL_TAC "F5")\r
10166    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP tail_on_loop)\r
10167    THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node)\r
10168    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_subset)\r
10169    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th])\r
10170    THEN USE_THEN "F1"(MP_TAC o CONJUNCT2 o MATCH_MP atomic_particles)\r
10171    THEN USE_THEN "F1"(fun th->REWRITE_TAC[CONJUNCT1(MATCH_MP change_to_margin th)])\r
10172    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))\r
10173    THEN USE_THEN "F3"(fun th-> USE_THEN "F4"(fun th1->MP_TAC(CONJUNCT2(MATCH_MP lemma_loop_index (CONJ th1 th)))))\r
10174    THEN ABBREV_TAC `u = tail (H:(A)hypermap) NF x`\r
10175    THEN ABBREV_TAC `v = head (H:(A)hypermap) NF x`\r
10176    THEN ABBREV_TAC `n = index (L:(A)loop) u v`\r
10177    THEN USE_THEN "F6" (SUBST1_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`)\r
10178    THEN USE_THEN "F5" (SUBST1_TAC o SYM)\r
10179    THEN DISCH_THEN (MP_TAC o SYM)\r
10180    THEN REWRITE_TAC[node_map_inverse_representation; COM_POWER_FUNCTION]\r
10181    THEN DISCH_THEN (fun th->(MP_TAC(MATCH_MP orbit_cyclic (CONJ (SPEC `n:num` NON_ZERO) (SYM th)))))\r
10182    THEN REWRITE_TAC[MATCH_MP lemma_orbit_inverse_map_eq (SPEC `H:(A)hypermap` node_map_and_darts); LT_SUC_LE; GSYM node]\r
10183    THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F7"(fun th-> REWRITE_TAC[th]));;\r
10184 \r
10185 let lemma_fmap = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). ?f:(A->bool)->(A->bool). (!s:A->bool. is_normal H NF ==> \r
10186 (~(s IN quotient_darts H NF) ==> f s = s) /\ \r
10187   (s IN quotient_darts H NF ==> (?L:(A)loop x:A. L IN NF /\ x belong L /\ s = atom H L x /\ f s = atom H L ((face_map H) (head H NF x)))))`,\r
10188    REPEAT GEN_TAC\r
10189    THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
10190    THEN GEN_TAC\r
10191    THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM]\r
10192    THEN DISCH_THEN (LABEL_TAC "F1")\r
10193    THEN ASM_CASES_TAC `~((s:A->bool) IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))`\r
10194    THENL[EXISTS_TAC `s:A->bool`  THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10195    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
10196    THEN ASM_REWRITE_TAC[]\r
10197    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10198    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` MP_TAC))\r
10199    THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) (LABEL_TAC "F4"))\r
10200    THEN ASM_REWRITE_TAC[SWAP_EXISTS_THM]\r
10201    THEN EXISTS_TAC `x:A`\r
10202    THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
10203    THEN EXISTS_TAC `L:(A)loop`\r
10204    THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (face_map H (head H NF (x:A)))`\r
10205    THEN ASM_REWRITE_TAC[]);;\r
10206 \r
10207 let lemma_nmap = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). ?f:(A->bool)->(A->bool). (!s:A->bool. is_normal H NF ==> \r
10208 (~(s IN quotient_darts H NF) ==> f s = s) /\ \r
10209   (s IN quotient_darts H NF ==> (?L:(A)loop L':(A)loop x:A. L IN NF /\ L' IN NF /\ x belong L /\ node_map H (tail H NF x) belong L' /\ s = atom H L x /\\r
10210   f s = atom H L' ((node_map H) (tail H NF x)))))`,\r
10211  REPEAT GEN_TAC\r
10212    THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
10213    THEN GEN_TAC\r
10214    THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM]\r
10215    THEN DISCH_THEN (LABEL_TAC "F1")\r
10216    THEN ASM_CASES_TAC `~((s:A->bool) IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))`\r
10217    THENL[EXISTS_TAC `s:A->bool`  THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10218    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
10219    THEN ASM_REWRITE_TAC[]\r
10220    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10221    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` MP_TAC))\r
10222    THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) (LABEL_TAC "F4"))\r
10223    THEN USE_THEN "F1"(fun th1->(USE_THEN "F2"(fun th2->USE_THEN "F3"(fun th3->MP_TAC (CONJUNCT1(MATCH_MP node_map_on_margin (CONJ th1 (CONJ th2 th3))))))))\r
10224    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3" o CONJUNCT1)))\r
10225    THEN ASM_REWRITE_TAC[SWAP_EXISTS_THM]\r
10226    THEN EXISTS_TAC `x:A`\r
10227    THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
10228    THEN EXISTS_TAC `L:(A)loop`\r
10229    THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
10230    THEN EXISTS_TAC `L':(A)loop`\r
10231    THEN EXISTS_TAC `atom (H:(A)hypermap) (L':(A)loop) (node_map H (tail H NF (x:A)))`\r
10232    THEN ASM_REWRITE_TAC[]);;\r
10233                      \r
10234 let lemma_face_map = new_specification ["fmap"] (REWRITE_RULE[SKOLEM_THM] lemma_fmap);;\r
10235 \r
10236 let lemma_node_map = new_specification ["nmap"] (REWRITE_RULE[SKOLEM_THM] lemma_nmap);;\r
10237 \r
10238 let unique_fmap = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) L:(A)loop x:A. is_normal H NF /\ L IN NF /\ x belong L ==> fmap H NF (atom H L x) =  atom H L ((face_map H) (head H NF x))`,\r
10239    REPEAT GEN_TAC\r
10240    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
10241    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` o MATCH_MP lemma_face_map)\r
10242    THEN USE_THEN "F2" (fun th-> (USE_THEN "F3" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)])))\r
10243    THEN STRIP_TAC\r
10244    THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC\r
10245    THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L':(A)loop`; `x':A`] atom_reflect)\r
10246        THEN UNDISCH_THEN `atom (H:(A)hypermap) (L:(A)loop) (x:A) = atom (H:(A)hypermap) (L':(A)loop) (x':A)` (SUBST1_TAC o SYM)\r
10247        THEN USE_THEN "F3"(fun th2->(DISCH_THEN(fun th3->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
10248        THEN MATCH_MP_TAC disjoint_loops\r
10249        THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x':A`\r
10250        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10251    THEN POP_ASSUM MP_TAC\r
10252    THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x':A`] atom_reflect)\r
10253    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
10254    THEN USE_THEN "F1"(fun th1->(USE_THEN "F2"(fun th2->(USE_THEN "F3"(fun th3->(DISCH_THEN(fun th4->MP_TAC(MATCH_MP change_parameters (CONJ th1 (CONJ th2 (CONJ th3 th4)))))))))))\r
10255    THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1)\r
10256    THEN SIMP_TAC[]);;\r
10257 \r
10258 let unique_nmap = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) L:(A)loop L':(A)loop x:A. is_normal H NF /\ L IN NF /\ L' IN NF /\ x belong L /\ node_map H (tail H NF x) belong L' ==> nmap H NF (atom H L x) = atom H L' ((node_map H) (tail H NF x))`,\r
10259    REPEAT GEN_TAC\r
10260    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))))\r
10261    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` o MATCH_MP lemma_node_map)\r
10262    THEN USE_THEN "F2" (fun th-> (USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)])))\r
10263    THEN STRIP_TAC\r
10264    THEN SUBGOAL_THEN `L'':(A)loop = L:(A)loop` SUBST_ALL_TAC\r
10265    THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L'':(A)loop`; `x':A`] atom_reflect)\r
10266       THEN UNDISCH_THEN `atom (H:(A)hypermap) (L:(A)loop) (x:A) = atom (H:(A)hypermap) (L'':(A)loop) (x':A)` (SUBST1_TAC o SYM)\r
10267       THEN USE_THEN "F4"(fun th2->(DISCH_THEN(fun th3->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
10268       THEN MATCH_MP_TAC disjoint_loops\r
10269       THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x':A`\r
10270       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10271    THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x':A`] atom_reflect)\r
10272    THEN UNDISCH_THEN `atom (H:(A)hypermap) (L:(A)loop) (x:A) = atom (H:(A)hypermap) (L:(A)loop) (x':A)` (SUBST1_TAC o SYM)\r
10273    THEN USE_THEN "F1"(fun th1->(USE_THEN "F2"(fun th2->(USE_THEN "F4"(fun th3->(DISCH_THEN(fun th4->MP_TAC(MATCH_MP change_parameters (CONJ th1 (CONJ th2 (CONJ th3 th4)))))))))))\r
10274    THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2)\r
10275    THEN SUBGOAL_THEN `L''':(A)loop = L':(A)loop` SUBST_ALL_TAC\r
10276    THENL[MATCH_MP_TAC disjoint_loops\r
10277       THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` \r
10278       THEN EXISTS_TAC `node_map (H:(A)hypermap) (tail H (NF:(A)loop->bool) (x':A))`\r
10279       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10280    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
10281    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
10282 \r
10283 let fmap_permute = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (fmap H NF) permutes (quotient_darts H NF)`,\r
10284    REPEAT GEN_TAC\r
10285    THEN DISCH_THEN (LABEL_TAC "F1")\r
10286    THEN REWRITE_TAC[permutes]\r
10287    THEN STRIP_TAC\r
10288    THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_face_map th]); ALL_TAC]\r
10289    THEN REWRITE_TAC[EXISTS_UNIQUE]\r
10290    THEN GEN_TAC\r
10291    THEN ASM_CASES_TAC `~(y:A->bool IN (quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)))`\r
10292    THENL[EXISTS_TAC `y:A->bool`\r
10293        THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y:A->bool` o MATCH_MP lemma_face_map)\r
10294        THEN ASM_REWRITE_TAC[]\r
10295        THEN DISCH_THEN (fun th-> REWRITE_TAC[th] THEN (LABEL_TAC "G1" th))\r
10296        THEN GEN_TAC\r
10297        THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))`\r
10298        THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_face_map)\r
10299           THEN ASM_REWRITE_TAC[]\r
10300           THEN DISCH_THEN(fun th-> REWRITE_TAC[th]); ALL_TAC]     \r
10301        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10302        THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "G2") (LABEL_TAC "G3")) SUBST1_TAC)))\r
10303        THEN USE_THEN "F1"(fun th1->(USE_THEN "G2"(fun th2->(USE_THEN "G3"(fun th3->(MP_TAC(MATCH_MP unique_fmap(CONJ th1 (CONJ th2 th3)))))))))\r
10304        THEN DISCH_THEN (SUBST1_TAC)\r
10305        THEN DISCH_TAC\r
10306        THEN SUBGOAL_THEN `y:A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)` MP_TAC\r
10307        THENL[ POP_ASSUM (SUBST1_TAC o SYM)\r
10308            THEN  MATCH_MP_TAC lemma_in_quotient\r
10309            THEN USE_THEN "F1"(fun th1->(USE_THEN "G2"(fun th2->(USE_THEN "G3"(fun th3->REWRITE_TAC[MATCH_MP face_map_on_margin (CONJ th1 (CONJ th2 th3))])))))\r
10310            THEN USE_THEN "G2" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
10311        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10312    THEN POP_ASSUM (LABEL_TAC "F2" o REWRITE_RULE[])\r
10313     THEN USE_THEN "F2" (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10314     THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) SUBST1_TAC)))\r
10315     THEN USE_THEN "F3" (fun th -> (USE_THEN "F1" (LABEL_TAC "FC" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10316     THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) ((inverse (face_map (H:(A)hypermap))) (tail H (NF:(A)loop->bool) (x:A)))`\r
10317     THEN STRIP_TAC\r
10318     THENL[USE_THEN "F1"(fun th1->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3->MP_TAC(MATCH_MP face_map_on_margin (CONJ th1 (CONJ th2 th3))))))))\r
10319         THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))))\r
10320         THEN USE_THEN "F1"(fun th1->(USE_THEN "F3"(fun th2->(USE_THEN "F6"(fun th3->(MP_TAC(MATCH_MP unique_fmap(CONJ th1 (CONJ th2 th3)))))))))\r
10321         THEN DISCH_THEN SUBST1_TAC\r
10322         THEN POP_ASSUM (SUBST1_TAC o SYM)\r
10323         THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))]\r
10324         THEN CONV_TAC SYM_CONV\r
10325         THEN MATCH_MP_TAC lemma_identity_atom\r
10326         THEN USE_THEN "F1"(fun th1->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3->(REWRITE_TAC[CONJUNCT1(MATCH_MP tail_on_loop (CONJ th1 (CONJ th2 th3)))]))))))\r
10327         THEN USE_THEN "FC" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
10328     THEN GEN_TAC\r
10329     THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))`\r
10330     THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_face_map)\r
10331        THEN ASM_REWRITE_TAC[]\r
10332        THEN DISCH_THEN SUBST1_TAC\r
10333        THEN DISCH_TAC\r
10334        THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl))\r
10335        THEN POP_ASSUM SUBST1_TAC\r
10336        THEN USE_THEN "F3" (fun th-> (USE_THEN "F4" (fun th1 -> (REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)])))); ALL_TAC]\r
10337    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10338    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) SUBST1_TAC)))\r
10339    THEN USE_THEN "F1"(fun th1->(USE_THEN "F5"(fun th2->(USE_THEN "F6"(fun th3->(MP_TAC(MATCH_MP unique_fmap(CONJ th1 (CONJ th2 th3)))))))))\r
10340    THEN DISCH_THEN SUBST1_TAC\r
10341    THEN DISCH_THEN (LABEL_TAC "F7")\r
10342    THEN USE_THEN "F1"(fun th1->(USE_THEN "F5"(fun th2->(USE_THEN "F6"(fun th3->MP_TAC(CONJUNCT1(MATCH_MP face_map_on_margin (CONJ th1 (CONJ th2 th3)))))))))\r
10343    THEN DISCH_THEN (LABEL_TAC "F8")\r
10344    THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC\r
10345    THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect)\r
10346        THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM)\r
10347        THEN USE_THEN "F8"(fun th2->(DISCH_THEN(fun th3->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
10348        THEN MATCH_MP_TAC disjoint_loops\r
10349        THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A`\r
10350        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10351    THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect)\r
10352    THEN USE_THEN "F7" (SUBST1_TAC o SYM)\r
10353    THEN USE_THEN "F1"(fun th1->(USE_THEN "F3"(fun th2->(USE_THEN "F8"(fun th3->(DISCH_THEN(fun th4->MP_TAC(MATCH_MP change_parameters (CONJ th1 (CONJ th2 (CONJ th3 th4)))))))))))\r
10354    THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2)\r
10355    THEN USE_THEN "F1"(fun th1->(USE_THEN "F5"(fun th2->(USE_THEN "F6"(fun th3->MP_TAC(MATCH_MP face_map_on_margin (CONJ th1 (CONJ th2 th3))))))))\r
10356    THEN DISCH_THEN (SUBST1_TAC o SYM o CONJUNCT1 o CONJUNCT2 o CONJUNCT2)\r
10357    THEN REWRITE_TAC [MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))]\r
10358    THEN USE_THEN "F1"(fun th1->(USE_THEN "F5"(fun th2->(USE_THEN "F6"(fun th3->REWRITE_TAC[MATCH_MP change_to_margin (CONJ th1 (CONJ th2 th3))]))))));;\r
10359 \r
10360 let nmap_permute = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (nmap H NF) permutes (quotient_darts H NF)`,\r
10361    REPEAT GEN_TAC\r
10362    THEN DISCH_THEN (LABEL_TAC "F1")\r
10363    THEN REWRITE_TAC[permutes]\r
10364    THEN STRIP_TAC\r
10365    THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_node_map th]); ALL_TAC]\r
10366    THEN REWRITE_TAC[EXISTS_UNIQUE] \r
10367    THEN GEN_TAC\r
10368    THEN ASM_CASES_TAC `~(y:A->bool IN (quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)))`\r
10369 THENL[EXISTS_TAC `y:A->bool`\r
10370        THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y:A->bool` o MATCH_MP lemma_node_map)\r
10371        THEN ASM_REWRITE_TAC[]\r
10372        THEN DISCH_THEN (fun th-> REWRITE_TAC[th] THEN (LABEL_TAC "G1" th))\r
10373        THEN GEN_TAC\r
10374        THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))`\r
10375        THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_node_map)\r
10376           THEN ASM_REWRITE_TAC[]\r
10377           THEN DISCH_THEN(fun th-> REWRITE_TAC[th]); ALL_TAC]\r
10378        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10379        THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "G2") (LABEL_TAC "G3")) SUBST1_TAC)))\r
10380        THEN USE_THEN "G2" (fun th -> (USE_THEN "F1" (LABEL_TAC "FC" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10381        THEN USE_THEN "F1"(fun th->(USE_THEN "G2"(fun th2->(USE_THEN "G3"(fun th3-> MP_TAC (CONJUNCT1 (MATCH_MP node_map_on_margin (CONJ th (CONJ th2 th3)))))))))\r
10382        THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 (LABEL_TAC "G5") (LABEL_TAC "G6"))))\r
10383        THEN DISCH_THEN (LABEL_TAC "G7")\r
10384        THEN USE_THEN "G5" MP_TAC THEN USE_THEN "G3" MP_TAC THEN USE_THEN "G4" MP_TAC THEN USE_THEN "G2" MP_TAC THEN USE_THEN "F1" MP_TAC\r
10385        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10386        THEN DISCH_THEN (MP_TAC o MATCH_MP unique_nmap)\r
10387        THEN POP_ASSUM SUBST1_TAC\r
10388        THEN DISCH_TAC\r
10389        THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl))\r
10390        THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
10391        THEN USE_THEN "G4" (fun th1 -> (USE_THEN "G5" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th1 th2)]))); ALL_TAC]\r
10392    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10393    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) SUBST1_TAC)))\r
10394    THEN USE_THEN "F3" (fun th -> (USE_THEN "F1" (LABEL_TAC "FC" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10395    THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3-> MP_TAC (CONJUNCT2 (MATCH_MP node_map_on_margin (CONJ th (CONJ th2 th3)))))))))\r
10396    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 (LABEL_TAC "G5") (LABEL_TAC "G6"))))\r
10397    THEN EXISTS_TAC `atom (H:(A)hypermap) (L':(A)loop) ((inverse (node_map (H:(A)hypermap))) (head H (NF:(A)loop->bool) (x:A)))`\r
10398   THEN ABBREV_TAC `y = inverse (node_map H) (head H NF (x:A))`\r
10399    THEN POP_ASSUM (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`)\r
10400    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)  [MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))]\r
10401    THEN DISCH_THEN (LABEL_TAC "G7" o SYM)\r
10402    THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3-> MP_TAC (CONJUNCT1 (MATCH_MP head_on_loop (CONJ th (CONJ th2 th3)))))))))\r
10403    THEN USE_THEN "G7" (SUBST1_TAC o SYM)\r
10404    THEN DISCH_THEN (LABEL_TAC "F8")\r
10405    THEN USE_THEN "F4"(fun th2->(USE_THEN "F8"(fun th3-> MP_TAC (MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
10406    THEN USE_THEN "G6" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
10407    THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "G4" MP_TAC THEN USE_THEN "F1" MP_TAC\r
10408    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10409    THEN DISCH_THEN (MP_TAC o MATCH_MP unique_nmap)\r
10410    THEN USE_THEN "G6" (SUBST1_TAC o SYM)\r
10411    THEN USE_THEN "G7" (SUBST1_TAC )\r
10412    THEN DISCH_THEN SUBST1_TAC\r
10413    THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3-> REWRITE_TAC[MATCH_MP change_to_margin (CONJ th (CONJ th2 th3))])))))\r
10414    THEN GEN_TAC\r
10415    THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))`\r
10416    THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_node_map th])\r
10417        THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_node_map)\r
10418        THEN ASM_REWRITE_TAC[]\r
10419        THEN DISCH_THEN SUBST1_TAC\r
10420        THEN DISCH_TAC\r
10421        THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl))\r
10422        THEN POP_ASSUM SUBST1_TAC\r
10423        THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3-> MP_TAC (CONJUNCT1 (MATCH_MP head_on_loop (CONJ th (CONJ th2 th3)))))))))\r
10424        THEN USE_THEN "F4"(fun th2->(DISCH_THEN(fun th3-> MP_TAC (MATCH_MP lemma_in_loop (CONJ th2 th3)))))\r
10425        THEN USE_THEN "F3" (fun th1 -> (DISCH_THEN (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th1 th2)]))); ALL_TAC]\r
10426    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM])\r
10427    THEN DISCH_THEN (X_CHOOSE_THEN `P:(A)loop`(X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) SUBST1_TAC)))\r
10428    THEN USE_THEN "F9" (fun th1 -> (USE_THEN "F10" (fun th2 -> ASSUME_TAC(SPEC `H:(A)hypermap`(MATCH_MP lemma_in_quotient (CONJ th1 th2))))))\r
10429    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `atom (H:(A)hypermap) (P:(A)loop) (z:A)` o MATCH_MP lemma_node_map)\r
10430    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
10431    THEN DISCH_THEN (X_CHOOSE_THEN `Q:(A)loop` (X_CHOOSE_THEN `Q':(A)loop` (X_CHOOSE_THEN `t:A` (CONJUNCTS_THEN2 (LABEL_TAC "F11") MP_TAC))))\r
10432    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (CONJUNCTS_THEN2 (LABEL_TAC "F15") MP_TAC)))\r
10433    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F17") SUBST1_TAC)\r
10434    THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3-> REWRITE_TAC[GSYM(MATCH_MP change_to_margin (CONJ th (CONJ th2 th3)))])))))\r
10435    THEN DISCH_THEN (LABEL_TAC "F18")\r
10436    THEN SUBGOAL_THEN `Q:(A)loop = P:(A)loop` SUBST_ALL_TAC\r
10437    THENL[MP_TAC(SPECL[`H:(A)hypermap`; `P:(A)loop`; `z:A`] atom_reflect)\r
10438       THEN USE_THEN "F17" SUBST1_TAC\r
10439       THEN USE_THEN "F14" MP_TAC\r
10440       THEN USE_THEN "F11" (fun th -> (USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `Q:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10441       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10442       THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop o CONJUNCT2)\r
10443       THEN MATCH_MP_TAC disjoint_loops\r
10444       THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN  EXISTS_TAC `z:A`\r
10445       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10446    THEN SUBGOAL_THEN `Q':(A)loop = L:(A)loop` SUBST_ALL_TAC\r
10447    THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect)\r
10448       THEN USE_THEN "F18" (SUBST1_TAC o  SYM)\r
10449       THEN USE_THEN "F15" MP_TAC\r
10450       THEN USE_THEN "F12" (fun th -> (USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `Q':(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10451       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10452       THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop o (CONJUNCT2))\r
10453       THEN MATCH_MP_TAC disjoint_loops\r
10454       THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN  EXISTS_TAC `x:A`\r
10455       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10456    THEN REMOVE_THEN "F17" (SUBST1_TAC)\r
10457    THEN USE_THEN "F1"(fun th->(USE_THEN "F11"(fun th2->(USE_THEN "F14"(fun th3->MP_TAC(CONJUNCT1(MATCH_MP node_map_free_loop (CONJ th (CONJ th2 th3)))))))))\r
10458    THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `node_map (H:(A)hypermap) (tail H (NF:(A)loop->bool) (t:A))`] atom_reflect)\r
10459    THEN USE_THEN "F18" SUBST1_TAC\r
10460    THEN USE_THEN "F1"(fun th1->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3->(DISCH_THEN(fun th4->MP_TAC(CONJUNCT1(MATCH_MP change_parameters (CONJ th1 (CONJ th2 (CONJ th3 th4))))))))))))\r
10461    THEN DISCH_THEN SUBST1_TAC\r
10462    THEN USE_THEN "G7" (SUBST1_TAC o SYM)\r
10463    THEN REWRITE_TAC[node_map_injective]\r
10464    THEN DISCH_THEN (LABEL_TAC "F19")\r
10465    THEN USE_THEN "F1"(fun th1->(USE_THEN "F11"(fun th2->(USE_THEN "F14"(fun th3->LABEL_TAC "F20"(CONJUNCT1(MATCH_MP change_to_margin (CONJ th1 (CONJ th2 th3)))))))))\r
10466   THEN SUBGOAL_THEN `P:(A)loop = L':(A)loop` SUBST_ALL_TAC\r
10467   THENL[ MP_TAC(SPECL[`H:(A)hypermap`; `P:(A)loop`; `(tail H (NF:(A)loop->bool) (t:A))`] atom_reflect)\r
10468       THEN USE_THEN "F20" (SUBST1_TAC o SYM)\r
10469       THEN USE_THEN "F19" SUBST1_TAC\r
10470       THEN USE_THEN "F14" MP_TAC\r
10471       THEN USE_THEN "F11" (fun th -> (USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `P:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
10472       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10473       THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop o CONJUNCT2)\r
10474       THEN MATCH_MP_TAC disjoint_loops\r
10475       THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A`\r
10476       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10477   THEN REPLICATE_TAC 2 (POP_ASSUM SUBST1_TAC)\r
10478   THEN POP_ASSUM SUBST1_TAC\r
10479   THEN SIMP_TAC[]);;\r
10480 \r
10481 (* THE DEFINITION OF THE QUOTION HYPERMAP *)\r
10482 \r
10483 let emap = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool). emap H NF = inverse (fmap H NF) o inverse (nmap H NF)`;;\r
10484 \r
10485 let emap_permute = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (emap H NF) permutes (quotient_darts H NF)`,\r
10486  REPEAT GEN_TAC\r
10487    THEN DISCH_THEN (LABEL_TAC "F1")\r
10488    THEN REWRITE_TAC[emap]\r
10489    THEN MATCH_MP_TAC PERMUTES_COMPOSE\r
10490    THEN USE_THEN "F1" (MP_TAC o MATCH_MP nmap_permute)\r
10491    THEN DISCH_THEN (fun th->REWRITE_TAC[MATCH_MP PERMUTES_INVERSE th])\r
10492    THEN USE_THEN "F1" (MP_TAC o MATCH_MP fmap_permute)\r
10493    THEN DISCH_THEN (fun th->REWRITE_TAC[MATCH_MP PERMUTES_INVERSE th]));;\r
10494 \r
10495 let quotient = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool). quotient H NF = hypermap (quotient_darts H NF, emap H NF, nmap H NF, fmap H NF)`;;\r
10496 \r
10497 let lemma_quotient = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> dart (quotient H NF) = quotient_darts H NF /\ edge_map (quotient H NF) = emap H NF /\ node_map (quotient H NF) = nmap H NF /\ face_map (quotient H NF) = fmap H NF`,\r
10498     REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1")\r
10499     THEN USE_THEN "F1" (ASSUME_TAC o MATCH_MP lemma_finite_quotient_darts)\r
10500     THEN USE_THEN "F1" (LABEL_TAC "F2" o MATCH_MP nmap_permute)\r
10501     THEN USE_THEN "F1" (LABEL_TAC "F3" o MATCH_MP fmap_permute)\r
10502     THEN USE_THEN "F1" (LABEL_TAC "F4" o MATCH_MP emap_permute)   \r
10503     THEN REWRITE_TAC[quotient]\r
10504     THEN ABBREV_TAC `D = quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)`\r
10505     THEN ABBREV_TAC `e = emap (H:(A)hypermap) (NF:(A)loop->bool)`\r
10506     THEN ABBREV_TAC `n = nmap (H:(A)hypermap) (NF:(A)loop->bool)`\r
10507     THEN ABBREV_TAC `f = fmap (H:(A)hypermap) (NF:(A)loop->bool)`\r
10508     THEN SUBGOAL_THEN `(e:(A->bool)->(A->bool)) o (n:(A->bool)->(A->bool)) o (f:(A->bool)->(A->bool)) = I` ASSUME_TAC\r
10509     THENL[EXPAND_TAC "e" THEN EXPAND_TAC "n" THEN EXPAND_TAC "f"\r
10510        THEN REWRITE_TAC[emap] THEN ASM_REWRITE_TAC[]\r
10511        THEN REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[lemma_4functions]\r
10512        THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID])\r
10513        THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID]); ALL_TAC]\r
10514     THEN MATCH_MP_TAC lemma_hypermap_rep THEN ASM_REWRITE_TAC[]);;\r
10515 \r
10516 let choice_reflect = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF ==> x IN choice H NF x`,\r
10517  REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1")\r
10518    THEN ASM_CASES_TAC `~(x:A IN support_darts NF)`\r
10519    THENL[USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o MATCH_MP first_unique_choice)\r
10520       THEN ASM_REWRITE_TAC[]\r
10521       THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_SING]; ALL_TAC]\r
10522    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_darts; lemma_in_support])\r
10523    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` MP_TAC)\r
10524    THEN POP_ASSUM (fun th -> (DISCH_THEN (fun th1-> MP_TAC (MATCH_MP unique_choice (CONJ th th1)))))\r
10525    THEN DISCH_THEN SUBST1_TAC\r
10526    THEN REWRITE_TAC[atom_reflect]);;\r
10527 \r
10528 let lemma_choice_in_quotient = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (!x:A. choice H NF x IN quotient_darts H NF <=> x IN support_darts NF)`, \r
10529   REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN GEN_TAC\r
10530     THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
10531     THEN EQ_TAC\r
10532     THENL[DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) (ASSUME_TAC))))\r
10533         THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `x:A`] choice_reflect)\r
10534         THEN ASM_REWRITE_TAC[]\r
10535         THEN POP_ASSUM SUBST1_TAC\r
10536         THEN POP_ASSUM (fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_loop (CONJ th th1)))))\r
10537         THEN POP_ASSUM (fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th)))))\r
10538         THEN SIMP_TAC[]; ALL_TAC]\r
10539     THEN REWRITE_TAC[lemma_in_support]\r
10540     THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")))\r
10541     THEN EXISTS_TAC `L':(A)loop`\r
10542     THEN EXISTS_TAC `x:A`\r
10543     THEN ASM_REWRITE_TAC[]\r
10544     THEN MATCH_MP_TAC unique_choice\r
10545     THEN ASM_REWRITE_TAC[]);;\r
10546 \r
10547 let atom_via_choice = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> !atm:A->bool. atm IN quotient_darts H NF <=> ?x:A. x IN support_darts NF /\ atm = choice H NF x`,\r
10548   REPEAT GEN_TAC\r
10549     THEN DISCH_THEN (LABEL_TAC "F1")\r
10550     THEN GEN_TAC\r
10551     THEN EQ_TAC\r
10552     THENL[REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
10553         THEN DISCH_THEN(X_CHOOSE_THEN `L:(A)loop`(X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) (SUBST1_TAC))))\r
10554         THEN EXISTS_TAC `x:A`\r
10555         THEN USE_THEN "F3"(fun th->(USE_THEN "F2"(fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])))\r
10556         THEN CONV_TAC SYM_CONV\r
10557         THEN MATCH_MP_TAC unique_choice\r
10558         THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10559     THEN ASM_MESON_TAC[lemma_choice_in_quotient]);;\r
10560 \r
10561 let choice_identity = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A) (y:A). is_normal H NF /\ y IN choice H NF x  ==> choice H NF y = choice H NF x`,\r
10562    REPEAT GEN_TAC\r
10563    THEN REPEAT GEN_TAC\r
10564    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
10565    THEN ASM_CASES_TAC `~(x:A IN support_darts (NF:(A)loop->bool))`\r
10566    THENL[USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o MATCH_MP first_unique_choice)\r
10567       THEN ASM_REWRITE_TAC[]\r
10568       THEN DISCH_THEN (LABEL_TAC "F3")\r
10569       THEN REMOVE_THEN "F2" MP_TAC   \r
10570       THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th])\r
10571       THEN REWRITE_TAC[IN_SING]\r
10572       THEN DISCH_THEN SUBST1_TAC\r
10573       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10574    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_support])\r
10575    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))\r
10576    THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3->MP_TAC (MATCH_MP unique_choice (CONJ th(CONJ th2 th3))))))))\r
10577    THEN DISCH_THEN SUBST_ALL_TAC\r
10578    THEN USE_THEN "F2" (fun th->REWRITE_TAC[MATCH_MP lemma_identity_atom th])\r
10579    THEN MATCH_MP_TAC unique_choice\r
10580    THEN ASM_REWRITE_TAC[]  \r
10581    THEN USE_THEN "F4"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_in_loop (CONJ th th1)]))));;\r
10582 \r
10583 let choice_at_margin = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF \r
10584   ==> choice H NF x = choice H NF (tail H NF x) /\ choice H NF x = choice H NF (head H NF x)`,\r
10585   REPEAT GEN_TAC\r
10586   THEN DISCH_THEN (LABEL_TAC "F1")\r
10587   THEN ASM_CASES_TAC `~(x:A IN support_darts (NF:(A)loop->bool))`\r
10588   THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `x:A` o MATCH_MP lemma_head_tail)\r
10589        THEN ASM_REWRITE_TAC[]\r
10590        THEN MESON_TAC[]; ALL_TAC]\r
10591   THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_support])\r
10592   THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
10593   THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->LABEL_TAC "F4"(CONJUNCT1(MATCH_MP head_on_loop (CONJ th (CONJ th1 th2)))))))))\r
10594   THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->LABEL_TAC "F5"(CONJUNCT1(MATCH_MP tail_on_loop (CONJ th (CONJ th1 th2)))))))))\r
10595   THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP unique_choice (CONJ th (CONJ th1 th2))))))))\r
10596   THEN DISCH_THEN (SUBST_ALL_TAC o SYM)\r
10597   THEN USE_THEN "F1" (fun th-> (USE_THEN "F4"(fun th1->REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)])))\r
10598   THEN USE_THEN "F1" (fun th-> (USE_THEN "F5"(fun th1->REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)]))));;\r
10599 \r
10600 let choice_and_head_tail = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF \r
10601   ==> tail H NF x IN choice H NF x /\ head H NF x IN choice H NF x`,\r
10602    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1")\r
10603    THEN STRIP_TAC\r
10604    THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `x:A` o  MATCH_MP choice_at_margin)\r
10605        THEN DISCH_THEN SUBST1_TAC\r
10606        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC]\r
10607    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `x:A` o  MATCH_MP choice_at_margin)\r
10608    THEN DISCH_THEN SUBST1_TAC\r
10609    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP choice_reflect th]));;\r
10610 \r
10611 \r
10612 let fmap_via_choice = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF /\ x IN support_darts NF ==>  face_map H (head H NF x) IN support_darts NF /\ face_map H (head H NF x) = tail H NF (face_map H (head H NF x)) /\ fmap H NF (choice H NF x) = choice H NF (face_map H (head H NF x))`,\r
10613    REPEAT GEN_TAC\r
10614    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support]))\r
10615    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
10616    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP face_map_on_margin (CONJ th (CONJ th1 th2))))))))\r
10617    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (SUBST1_TAC o SYM o CONJUNCT1 o CONJUNCT2))\r
10618    THEN REWRITE_TAC[]\r
10619    THEN USE_THEN "F4"(fun th->(USE_THEN "F2"(fun th1->(REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)]))))\r
10620    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP unique_fmap (CONJ th (CONJ th1 th2))))))))\r
10621    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP unique_choice (CONJ th (CONJ th1 th2))))))))\r
10622    THEN DISCH_THEN SUBST1_TAC\r
10623    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F4"(fun th2->MP_TAC(MATCH_MP unique_choice (CONJ th (CONJ th1 th2))))))))\r
10624    THEN DISCH_THEN SUBST1_TAC\r
10625    THEN SIMP_TAC[]);;\r
10626 \r
10627 let nmap_via_choice = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF /\ x IN support_darts NF ==> node_map H (tail H NF x) IN support_darts NF /\ node_map H (tail H NF x) = head H NF (node_map H (tail H NF x)) /\ nmap H NF (choice H NF x) = choice H NF (node_map H (tail H NF x))`,\r
10628  REPEAT GEN_TAC\r
10629    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support]))\r
10630    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
10631    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->MP_TAC(CONJUNCT1(MATCH_MP node_map_on_margin (CONJ th (CONJ th1 th2)))))))))\r
10632    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (SUBST1_TAC o SYM))))\r
10633    THEN REWRITE_TAC[]\r
10634    THEN USE_THEN "F5"(fun th->(USE_THEN "F4"(fun th1->(REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)]))))\r
10635    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))))\r
10636    THEN USE_THEN "F1"(fun th->(USE_THEN "F4"(fun th1->(USE_THEN "F5"(fun th2->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))))\r
10637    THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN  USE_THEN "F4" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC\r
10638    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10639    THEN DISCH_THEN (SUBST1_TAC o MATCH_MP unique_nmap)\r
10640    THEN SIMP_TAC[]);;\r
10641 \r
10642 let emap_via_choice = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF /\ x IN support_darts NF ==> edge_map H (head H NF x) IN support_darts NF /\ edge_map H (head H NF x) = head H NF (edge_map H (head H NF x)) /\ emap H NF (choice H NF x) = choice H NF (edge_map H (head H NF x))`,\r
10643    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support]))\r
10644    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
10645    THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "F3"(fun th2->(MP_TAC(CONJUNCT2(MATCH_MP node_map_on_margin (CONJ th(CONJ th1 th2))))))))))\r
10646    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop`(CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))))\r
10647    THEN USE_THEN "F1"(fun th->(USE_THEN "F4"(fun th1->(USE_THEN "F5"(fun th2->(MP_TAC(CONJUNCT2(MATCH_MP face_map_on_margin (CONJ th(CONJ th1 th2))))))))))\r
10648    THEN USE_THEN "F6" (fun th->REWRITE_TAC[SYM th])\r
10649    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8" o CONJUNCT2))\r
10650    THEN REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse2_hypermap_maps); o_THM]\r
10651    THEN USE_THEN "F8" (SUBST1_TAC o SYM)\r
10652    THEN REWRITE_TAC[emap; o_THM]\r
10653    THEN USE_THEN "F7" (fun th-> (USE_THEN "F4" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])))\r
10654    THEN USE_THEN "F1" (fun th-> MP_TAC (MATCH_MP fmap_permute th))\r
10655    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th])\r
10656    THEN CONV_TAC SYM_CONV\r
10657    THEN USE_THEN "F1" (fun th-> MP_TAC (MATCH_MP nmap_permute th))\r
10658    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th])\r
10659    THEN USE_THEN "F4"(fun th->(USE_THEN "F7"(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th)))))\r
10660    THEN USE_THEN "F1"(fun th->(DISCH_THEN (fun th1->REWRITE_TAC[MATCH_MP fmap_via_choice (CONJ th th1)])))\r
10661    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
10662    THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]\r
10663    THEN USE_THEN "F4"(fun th->(USE_THEN "F5"(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th)))))\r
10664    THEN USE_THEN "F1"(fun th->(DISCH_THEN (fun th1->REWRITE_TAC[MATCH_MP nmap_via_choice (CONJ th th1)])))\r
10665    THEN REMOVE_THEN "F6" (SUBST1_TAC o SYM)\r
10666    THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))]\r
10667    THEN USE_THEN "F1"(fun th->REWRITE_TAC[SYM(CONJUNCT2(SPEC `x:A`(MATCH_MP choice_at_margin th)))]));;\r
10668 \r
10669 let lemmaJMKRXLA = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF /\ plain_hypermap H ==> plain_hypermap (quotient H NF)`,\r
10670  REPEAT GEN_TAC THEN REWRITE_TAC[plain_hypermap]\r
10671    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") ASSUME_TAC)\r
10672    THEN REWRITE_TAC[MATCH_MP convolution_belong (CONJUNCT2 (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` edge_map_and_darts))]\r
10673    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
10674    THEN GEN_TAC\r
10675    THEN USE_THEN "F1"(fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th])\r
10676    THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))\r
10677    THEN USE_THEN "F1"(fun th -> (POP_ASSUM (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1)))))\r
10678    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC)))\r
10679    THEN USE_THEN "F1"(fun th -> (REMOVE_THEN "F3" (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1)))))\r
10680    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
10681    THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2 o CONJUNCT2)\r
10682    THEN POP_ASSUM(fun th->(MP_TAC (AP_THM th `head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`)))\r
10683    THEN REWRITE_TAC[o_THM; I_THM]\r
10684    THEN DISCH_THEN SUBST1_TAC\r
10685    THEN POP_ASSUM (fun th-> MESON_TAC[MATCH_MP choice_at_margin th]));;\r
10686 \r
10687 (* The definition of isomorphic hypermaps *)\r
10688 \r
10689 let COMPOSE_INJ = prove(`!f:A->B  g:B->C s t w. INJ f s t /\ INJ g t w ==> INJ (g o f) s w`,\r
10690  REPEAT GEN_TAC\r
10691    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
10692    THEN SUBGOAL_THEN `!x:A. x IN s ==> (f:A->B) x IN t /\ ((g:B->C) (f x)) IN w` (LABEL_TAC "F3")\r
10693    THENL[GEN_TAC THEN DISCH_TAC\r
10694        THEN POP_ASSUM(fun th-> USE_THEN "F1" (ASSUME_TAC o REWRITE_RULE[th] o  SPEC `x:A` o CONJUNCT1 o REWRITE_RULE[INJ]))\r
10695        THEN ASM_REWRITE_TAC[]\r
10696        THEN POP_ASSUM(fun th-> USE_THEN "F2" (ASSUME_TAC o REWRITE_RULE[th] o  SPEC `(f:A->B) (x:A)` o CONJUNCT1 o REWRITE_RULE[INJ]))\r
10697        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10698    THEN REWRITE_TAC[INJ; o_THM]\r
10699    THEN STRIP_TAC\r
10700    THENL[GEN_TAC\r
10701        THEN DISCH_THEN(fun th->(POP_ASSUM (MP_TAC o CONJUNCT2 o REWRITE_RULE[th] o SPEC `x:A`)))\r
10702        THEN SIMP_TAC[]; ALL_TAC]\r
10703    THEN REPEAT STRIP_TAC\r
10704    THEN USE_THEN "F3" (MP_TAC o SPEC `x:A`)\r
10705    THEN REMOVE_THEN "F3" (MP_TAC o SPEC `y:A`)\r
10706    THEN ASM_REWRITE_TAC[]\r
10707    THEN REPEAT STRIP_TAC\r
10708    THEN REMOVE_THEN "F2" (MP_TAC o SPECL[`(f:A->B) (x:A)`; `(f:A->B) (y:A)`] o CONJUNCT2 o REWRITE_RULE[INJ])\r
10709    THEN ASM_REWRITE_TAC[]\r
10710    THEN DISCH_TAC\r
10711    THEN REMOVE_THEN "F1" (MP_TAC o SPECL[`x:A`; `y:A`] o CONJUNCT2 o REWRITE_RULE[INJ] )\r
10712    THEN ASM_REWRITE_TAC[]);;\r
10713 \r
10714 let COMPOSE_SURJ = prove(`!f:A->B  g:B->C s t w. SURJ f s t /\ SURJ g t w ==> SURJ (g o f) s w`,\r
10715  REPEAT GEN_TAC\r
10716    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
10717    THEN REWRITE_TAC[SURJ; o_THM]\r
10718    THEN STRIP_TAC\r
10719    THENL[REPEAT STRIP_TAC\r
10720       THEN POP_ASSUM(fun th-> USE_THEN "F1" (ASSUME_TAC o REWRITE_RULE[th] o  SPEC `x:A` o CONJUNCT1 o REWRITE_RULE[SURJ]))\r
10721       THEN POP_ASSUM(fun th-> USE_THEN "F2" (ASSUME_TAC o REWRITE_RULE[th] o  SPEC `(f:A->B) (x:A)` o CONJUNCT1 o REWRITE_RULE[SURJ]))\r
10722       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10723    THEN REPEAT STRIP_TAC\r
10724    THEN POP_ASSUM(fun th->(REMOVE_THEN "F2" (MP_TAC o REWRITE_RULE[th] o  SPEC `x:C` o CONJUNCT2 o REWRITE_RULE[SURJ])))\r
10725    THEN DISCH_THEN (X_CHOOSE_THEN `y:B` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)))\r
10726    THEN POP_ASSUM(fun th->(REMOVE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `y:B` o CONJUNCT2 o REWRITE_RULE[SURJ])))\r
10727    THEN DISCH_THEN (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)))\r
10728    THEN EXISTS_TAC `z:A`\r
10729    THEN ASM_REWRITE_TAC[]);;\r
10730 \r
10731 let COMPOSE_BIJ = prove(`!f:A->B  g:B->C s t w. BIJ f s t /\ BIJ g t w ==> BIJ (g o f) s w`,\r
10732    MESON_TAC[BIJ; COMPOSE_INJ; COMPOSE_SURJ]);;\r
10733 \r
10734 let BIJ_INVERSE = prove(`!f:A->B s t. BIJ f s t ==> ?g:B->A. (!x:A. x IN s ==> g (f x) = x) /\ (!x:B. x IN t ==> f (g x) = x) /\ BIJ g t s`,\r
10735    REPEAT GEN_TAC\r
10736    THEN DISCH_THEN (LABEL_TAC "F1" o REWRITE_RULE[BIJ])\r
10737    THEN USE_THEN "F1" (MP_TAC o REWRITE_RULE[INJ] o CONJUNCT1)\r
10738    THEN REWRITE_TAC[ISPECL[`f:A->B`; `s:A->bool`] INJECTIVE_ON_LEFT_INVERSE]\r
10739    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (X_CHOOSE_THEN `g:B->A` (LABEL_TAC "F3")))\r
10740    THEN EXISTS_TAC `g:B->A`\r
10741    THEN ASM_REWRITE_TAC[]\r
10742    THEN SUBGOAL_THEN `SURJ (g:B->A) t s` (LABEL_TAC "F4")\r
10743    THENL[REWRITE_TAC[SURJ]\r
10744        THEN STRIP_TAC\r
10745        THENL[REPEAT STRIP_TAC\r
10746           THEN USE_THEN "F1" (MP_TAC o SPEC `x:B` o CONJUNCT2 o  REWRITE_RULE[SURJ] o CONJUNCT2)\r
10747           THEN ASM_REWRITE_TAC[]\r
10748           THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)))\r
10749           THEN REMOVE_THEN "F3" (MP_TAC o SPEC `y:A`)\r
10750           THEN ASM_REWRITE_TAC[]\r
10751           THEN POP_ASSUM (fun th -> MESON_TAC[th]); ALL_TAC]\r
10752        THEN REPEAT GEN_TAC\r
10753        THEN DISCH_THEN (LABEL_TAC "F4")\r
10754        THEN USE_THEN "F4" (fun th -> (USE_THEN "F2" (ASSUME_TAC o REWRITE_RULE[th] o SPEC `x:A`)))\r
10755        THEN EXISTS_TAC `(f:A->B) x`\r
10756        THEN USE_THEN "F4" (fun th -> (USE_THEN "F3" (MP_TAC o REWRITE_RULE[th] o SPEC `x:A`)))\r
10757        THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC]\r
10758     THEN SUBGOAL_THEN `BIJ (g:B->A) t s` (LABEL_TAC "F5")\r
10759     THENL[REWRITE_TAC[BIJ]\r
10760        THEN ASM_REWRITE_TAC[INJ]\r
10761        THEN STRIP_TAC\r
10762        THENL[POP_ASSUM (fun th-> MESON_TAC[REWRITE_RULE[SURJ] th]); ALL_TAC]\r
10763        THEN REPEAT GEN_TAC\r
10764        THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6")  (LABEL_TAC "F7")))\r
10765        THEN REMOVE_THEN "F5"(fun th->(USE_THEN "F1"(MP_TAC o REWRITE_RULE[th] o SPEC `x:B` o CONJUNCT2 o REWRITE_RULE[SURJ] o CONJUNCT2)))\r
10766        THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST_ALL_TAC o SYM)))\r
10767        THEN REMOVE_THEN "F6"(fun th->(USE_THEN "F1"(MP_TAC o REWRITE_RULE[th] o SPEC `y:B` o CONJUNCT2 o REWRITE_RULE[SURJ] o CONJUNCT2)))\r
10768        THEN DISCH_THEN (X_CHOOSE_THEN `b:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST_ALL_TAC o SYM)))\r
10769        THEN AP_TERM_TAC\r
10770        THEN POP_ASSUM(fun th->(USE_THEN "F3"(MP_TAC o REWRITE_RULE[th] o SPEC `b:A`)))\r
10771        THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM)\r
10772        THEN POP_ASSUM(fun th->(REMOVE_THEN "F3"(MP_TAC o REWRITE_RULE[th] o SPEC `a:A`)))\r
10773        THEN MESON_TAC[]; ALL_TAC]\r
10774     THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
10775     THEN GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1"))\r
10776     THEN USE_THEN "G1" (fun th-> (USE_THEN "F4" (LABEL_TAC "G2" o REWRITE_RULE[th] o SPEC `x:B` o CONJUNCT1 o REWRITE_RULE[SURJ])))\r
10777     THEN USE_THEN "G2" (fun th-> (USE_THEN "F3" (fun thm -> (ASSUME_TAC (MATCH_MP thm th)))))\r
10778     THEN USE_THEN "G2" (fun th-> (USE_THEN "F2" (fun thm -> (ASSUME_TAC (MATCH_MP thm th)))))\r
10779     THEN USE_THEN "F5" (MP_TAC o CONJUNCT1 o REWRITE_RULE[BIJ])\r
10780     THEN USE_THEN "G1" (fun th-> (DISCH_THEN (MP_TAC o REWRITE_RULE[th] o SPECL[`(f:A->B) ((g:B->A) x)`; `x:B`] o CONJUNCT2 o REWRITE_RULE[INJ])))\r
10781     THEN ASM_REWRITE_TAC[]);;\r
10782 \r
10783 let I_BIJ = prove(`!s:A->bool. BIJ I s s`, REWRITE_TAC[BIJ; INJ; SURJ] THEN REWRITE_TAC[I_THM] THEN MESON_TAC[]);;\r
10784 \r
10785 let iso = new_definition `!(H:(A)hypermap) (H':(B)hypermap) . H iso H'  <=> (?f:A->B. BIJ f (dart H) (dart H')  /\\r
10786 !x:A. x IN dart H ==> (edge_map H')  (f x) = f (edge_map H x) /\ (node_map H') (f x) = f (node_map H x) /\ (face_map H') (f x) = f (face_map H x))`;;\r
10787 \r
10788 let iso_reflect = prove(`!(H:(A)hypermap). H iso H`,\r
10789  GEN_TAC THEN REWRITE_TAC[iso] THEN EXISTS_TAC `I:A->A` THEN REWRITE_TAC[I_THM; I_BIJ]);;\r
10790 \r
10791 let iso_sym = prove(`!(H:(A)hypermap) (G:(B)hypermap). H iso G ==> G iso H`,\r
10792   REPEAT GEN_TAC\r
10793    THEN REWRITE_TAC[iso]\r
10794    THEN DISCH_THEN (X_CHOOSE_THEN `f:A->B` (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")))\r
10795    THEN USE_THEN "F1" (MP_TAC o MATCH_MP BIJ_INVERSE)\r
10796    THEN DISCH_THEN(X_CHOOSE_THEN `g:B->A` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2(LABEL_TAC "FC") (LABEL_TAC "F4"))))\r
10797    THEN EXISTS_TAC `g:B->A`\r
10798    THEN ASM_REWRITE_TAC[]\r
10799    THEN GEN_TAC\r
10800    THEN DISCH_THEN (LABEL_TAC "F5")\r
10801    THEN STRIP_TAC\r
10802    THENL[USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT1 o  MATCH_MP lemma_dart_invariant)\r
10803       THEN USE_THEN "F4" (MP_TAC o SPEC `x:B` o CONJUNCT1 o  REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ])\r
10804       THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
10805       THEN DISCH_THEN (LABEL_TAC "F7")\r
10806       THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT1 o  MATCH_MP lemma_dart_invariant)\r
10807       THEN USE_THEN "F7" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `(g:B->A) x`)))\r
10808       THEN USE_THEN "F5" (fun th-> USE_THEN "FC" (MP_TAC o REWRITE_RULE[th] o SPEC `x:B`))\r
10809       THEN DISCH_THEN SUBST1_TAC\r
10810       THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `g:B->A`)\r
10811       THEN USE_THEN "F3" (fun thm-> (USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP thm th]))); ALL_TAC]\r
10812     THEN STRIP_TAC\r
10813     THENL[USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
10814       THEN USE_THEN "F4" (MP_TAC o SPEC `x:B` o CONJUNCT1 o  REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ])\r
10815       THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
10816       THEN DISCH_THEN (LABEL_TAC "F7")\r
10817       THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT1 o CONJUNCT2 o  MATCH_MP lemma_dart_invariant)\r
10818       THEN USE_THEN "F7" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[th] o SPEC `(g:B->A) x`)))\r
10819       THEN USE_THEN "F5" (fun th-> USE_THEN "FC" (MP_TAC o REWRITE_RULE[th] o SPEC `x:B`))\r
10820       THEN DISCH_THEN SUBST1_TAC\r
10821       THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `g:B->A`)\r
10822       THEN USE_THEN "F3" (fun thm-> (USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP thm th]))); ALL_TAC]\r
10823     THEN USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant)\r
10824     THEN USE_THEN "F4" (MP_TAC o SPEC `x:B` o CONJUNCT1 o  REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ])\r
10825     THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
10826     THEN DISCH_THEN (LABEL_TAC "F7")\r
10827     THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT2 o CONJUNCT2 o  MATCH_MP lemma_dart_invariant)\r
10828     THEN USE_THEN "F7" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[th] o SPEC `(g:B->A) x`)))\r
10829     THEN USE_THEN "F5" (fun th-> USE_THEN "FC" (MP_TAC o REWRITE_RULE[th] o SPEC `x:B`))\r
10830     THEN DISCH_THEN SUBST1_TAC\r
10831     THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `g:B->A`)\r
10832     THEN USE_THEN "F3" (fun thm-> (USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP thm th]))));;\r
10833 \r
10834 let iso_trans = prove(`!(H:(A)hypermap) (G:(B)hypermap) (W:(C)hypermap). H iso G /\ G iso W ==> H iso W`,\r
10835  REPEAT GEN_TAC\r
10836    THEN REWRITE_TAC[iso]\r
10837    THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:A->B` (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))) (X_CHOOSE_THEN `g:B->C` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
10838    THEN EXISTS_TAC `(g:B->C) o (f:A->B)`\r
10839    THEN USE_THEN "F1" (fun th-> (USE_THEN "F3" (fun th1-> REWRITE_TAC[MATCH_MP COMPOSE_BIJ (CONJ th th1)])))\r
10840    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5")\r
10841    THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ])\r
10842    THEN USE_THEN "F5" (fun th-> (DISCH_THEN(fun thm-> (LABEL_TAC "F6" (MATCH_MP thm th)))))\r
10843    THEN REWRITE_TAC[o_THM]\r
10844    THEN STRIP_TAC\r
10845    THENL[USE_THEN "F5" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `x:A`)))\r
10846        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
10847        THEN USE_THEN "F6" (fun th-> (USE_THEN "F4" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `(f:A->B) x`)))\r
10848        THEN SIMP_TAC[]; ALL_TAC]\r
10849    THEN STRIP_TAC\r
10850    THENL[USE_THEN "F5" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[th] o SPEC `x:A`)))\r
10851        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
10852        THEN USE_THEN "F6" (fun th-> (USE_THEN "F4" (MP_TAC o CONJUNCT1 o CONJUNCT2 o  REWRITE_RULE[th] o SPEC `(f:A->B) x`)))\r
10853        THEN SIMP_TAC[]; ALL_TAC]\r
10854    THEN USE_THEN "F5" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[th] o SPEC `x:A`)))\r
10855    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
10856    THEN USE_THEN "F6" (fun th-> (USE_THEN "F4" (MP_TAC o CONJUNCT2 o CONJUNCT2 o  REWRITE_RULE[th] o SPEC `(f:A->B) x`)))\r
10857    THEN SIMP_TAC[]);;\r
10858 \r
10859 (* DESCRIBE FACES OF QUOTIENT HYPERMAPS - This is definition of F(L) in the blueprint *)\r
10860 \r
10861 let cycle = new_definition `!(H:(A)hypermap) (L:(A)loop). cycle H L = {atom H L x |x:A | x belong L}`;;\r
10862 \r
10863 let lemma_in_cycle2 = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). x belong L ==> atom H L x IN cycle H L`, \r
10864    REWRITE_TAC[cycle; IN_ELIM_THM] THEN MESON_TAC[]);;\r
10865 \r
10866 let lemma_cycle_eq = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop L':(A)loop. is_normal H NF /\ L IN NF /\ L' IN NF /\ cycle H L = cycle H L'\r
10867     ==> L = L'`,\r
10868    REPEAT GEN_TAC\r
10869    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
10870    THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o  REWRITE_RULE[is_normal])\r
10871    THEN ASM_REWRITE_TAC[]\r
10872    THEN DISCH_THEN (MP_TAC o CONJUNCT2)\r
10873    THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (LABEL_TAC "F3" o CONJUNCT2))\r
10874    THEN SUBGOAL_THEN `atom (H:(A)hypermap) (L:(A)loop) (x:A) IN cycle H L` MP_TAC\r
10875    THENL[REWRITE_TAC[cycle; IN_ELIM_THM]\r
10876       THEN EXISTS_TAC `x:A`\r
10877       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10878    THEN USE_THEN "F2" (SUBST1_TAC o CONJUNCT2 o CONJUNCT2)\r
10879    THEN REWRITE_TAC[cycle; IN_ELIM_THM]\r
10880    THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
10881    THEN MP_TAC(SPECL[`H:(A)hypermap`; `L':(A)loop`; `y:A`] atom_reflect)\r
10882    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
10883    THEN USE_THEN "F3"(fun th->(DISCH_THEN(fun th1->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th th1)))))\r
10884    THEN MATCH_MP_TAC disjoint_loops\r
10885    THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A`\r
10886    THEN ASM_REWRITE_TAC[]);;\r
10887 \r
10888 let lemma_cycle_is_face = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_normal H NF /\ L IN NF /\ x belong L \r
10889    ==> cycle H L = orbit_map (fmap H NF) (atom  H L x)`, \r
10890    REPEAT GEN_TAC\r
10891    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
10892    THEN SUBGOAL_THEN `(!m:num u:A v:A. u belong (L:(A)loop) /\ v belong L /\ v = ((next L) POWER m) u ==> (?j:num. atom (H:(A)hypermap) L v = ((fmap H (NF:(A)loop->bool)) POWER j) (atom H L u)))` (LABEL_TAC "F4")\r
10893    THENL[INDUCT_TAC\r
10894       THENL[REWRITE_TAC[POWER_0; I_THM]\r
10895          THEN REPEAT STRIP_TAC\r
10896          THEN EXISTS_TAC `0`\r
10897          THEN POP_ASSUM SUBST1_TAC\r
10898          THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
10899       THEN POP_ASSUM (LABEL_TAC "G1")\r
10900       THEN REPEAT GEN_TAC\r
10901       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4")))\r
10902       THEN ASM_CASES_TAC `next (L:(A)loop) (u:A) = inverse (node_map (H:(A)hypermap)) u`\r
10903       THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `u:A`] atom_reflect)\r
10904          THEN DISCH_THEN(fun th->POP_ASSUM(fun th1->MP_TAC(MATCH_MP lemma_atom_absorb_quark (CONJ th th1))))\r
10905          THEN DISCH_THEN (SUBST1_TAC o MATCH_MP lemma_identity_atom)\r
10906          THEN USE_THEN "G2" (ASSUME_TAC o REWRITE_RULE[POWER_1] o  SPEC `1` o MATCH_MP lemma_power_next_in_loop)\r
10907          THEN REMOVE_THEN "G4" (ASSUME_TAC o REWRITE_RULE[POWER; o_THM])\r
10908          THEN ABBREV_TAC `z = (next (L:(A)loop) (u:A))`\r
10909          THEN REMOVE_THEN "G1" (MP_TAC o SPECL[`z:A`; `v:A`])\r
10910          THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10911       THEN POP_ASSUM MP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `u:A`] atom_reflect)\r
10912       THEN USE_THEN "G2" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC\r
10913       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
10914       THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_unique_head)\r
10915       THEN USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1->(USE_THEN "G2" (fun th2 -> MP_TAC(MATCH_MP unique_fmap (CONJ th (CONJ th1 th2)))))))\r
10916       THEN USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1->(USE_THEN "G2" (fun th2 -> MP_TAC(MATCH_MP value_next_of_head (CONJ th (CONJ th1 th2)))))))\r
10917       THEN POP_ASSUM SUBST1_TAC\r
10918       THEN DISCH_THEN (SUBST1_TAC o SYM)\r
10919       THEN USE_THEN "G2" (ASSUME_TAC o REWRITE_RULE[POWER_1] o  SPEC `1` o MATCH_MP lemma_power_next_in_loop)\r
10920       THEN DISCH_THEN (LABEL_TAC "G5")\r
10921       THEN REMOVE_THEN "G4" (ASSUME_TAC o REWRITE_RULE[POWER; o_THM])\r
10922       THEN ABBREV_TAC `z = (next (L:(A)loop) (u:A))`\r
10923       THEN REMOVE_THEN "G1" (MP_TAC o SPECL[`z:A`; `v:A`])\r
10924       THEN ASM_REWRITE_TAC[]\r
10925       THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC)\r
10926       THEN REMOVE_THEN "G5" (SUBST1_TAC o SYM)\r
10927       THEN REWRITE_TAC[iterate_map_valuation2]\r
10928       THEN MESON_TAC[]; ALL_TAC]\r
10929    THEN SUBGOAL_THEN `!m:num x:A. x belong (L:(A)loop) ==> ?y:A. y belong L /\ ((fmap (H:(A)hypermap) (NF:(A)loop->bool)) POWER m) (atom H L x) = atom H L y` (LABEL_TAC "F5")\r
10930    THENL[INDUCT_TAC\r
10931        THENL[REPEAT STRIP_TAC THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
10932        THEN GEN_TAC\r
10933        THEN POP_ASSUM (LABEL_TAC "G4")\r
10934        THEN DISCH_THEN (LABEL_TAC "G5")\r
10935        THEN REWRITE_TAC[COM_POWER; o_THM]\r
10936        THEN REMOVE_THEN "G5" (fun th-> (REMOVE_THEN "G4" (MP_TAC o REWRITE_RULE[th] o  SPEC `x':A`)))\r
10937        THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 (LABEL_TAC "G6") (SUBST1_TAC)))\r
10938        THEN EXISTS_TAC `(face_map (H:(A)hypermap)) (head H (NF:(A)loop->bool) (a:A))`\r
10939        THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->(USE_THEN "G6"(fun th2->REWRITE_TAC[MATCH_MP face_map_on_margin (CONJ th (CONJ th1 th2))])))))\r
10940        THEN MATCH_MP_TAC unique_fmap\r
10941        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10942    THEN REWRITE_TAC[EXTENSION]\r
10943    THEN GEN_TAC\r
10944    THEN REWRITE_TAC[cycle; orbit_map; IN_ELIM_THM; GE; LE_0]\r
10945    THEN EQ_TAC\r
10946    THENL[DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (SUBST1_TAC)))\r
10947        THEN USE_THEN "F3"(fun th->(USE_THEN "F6"(fun th1->(MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1))))))\r
10948        THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (ASSUME_TAC o CONJUNCT2))\r
10949        THEN REMOVE_THEN "F4" (MP_TAC o SPECL[`n:num`; `x:A`; `y:A`])\r
10950        THEN ASM_MESON_TAC[]; ALL_TAC]\r
10951    THEN STRIP_TAC\r
10952    THEN POP_ASSUM SUBST1_TAC\r
10953    THEN POP_ASSUM (MP_TAC o SPECL[`n:num`; `x:A`])\r
10954    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]));;\r
10955 \r
10956 let lemma_cycle_finite = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop. is_normal H NF /\ L IN NF ==> FINITE (cycle H L)`,\r
10957    REPEAT GEN_TAC\r
10958    THEN DISCH_THEN (fun th-> LABEL_TAC "F1" th THEN MP_TAC (SPEC `L:(A)loop` (CONJUNCT1(REWRITE_RULE[is_normal] (CONJUNCT1 th)))))\r
10959    THEN ASM_REWRITE_TAC[]\r
10960    THEN DISCH_THEN ((X_CHOOSE_THEN `x:A` (MP_TAC o CONJUNCT2)) o CONJUNCT2)\r
10961    THEN DISCH_THEN (fun th-> USE_THEN "F1" (fun th1-> (REWRITE_TAC[MATCH_MP lemma_cycle_is_face (REWRITE_RULE[GSYM CONJ_ASSOC] (CONJ th1 th))])))\r
10962    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient (CONJUNCT1 th)); GSYM face; FACE_FINITE]));; \r
10963 \r
10964 let lemmaQuotientFace = prove(`!H:(A)hypermap NF:(A)loop->bool. is_normal H NF ==> face_set (quotient H NF) = {cycle H L | L IN NF}`,\r
10965    REPEAT GEN_TAC\r
10966    THEN DISCH_THEN (LABEL_TAC "F1")\r
10967    THEN REWRITE_TAC[EXTENSION; face_set; set_of_orbits; IN_ELIM_THM]\r
10968    THEN GEN_TAC\r
10969    THEN REWRITE_TAC[GSYM EXTENSION]\r
10970    THEN USE_THEN "F1"(fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
10971    THEN EQ_TAC\r
10972    THENL[REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
10973       THEN DISCH_THEN (X_CHOOSE_THEN `atm:A->bool` (CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC)))\r
10974       THEN DISCH_THEN(X_CHOOSE_THEN `L:(A)loop`(X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) SUBST1_TAC)))\r
10975       THEN EXISTS_TAC `L:(A)loop`\r
10976       THEN ASM_REWRITE_TAC[]\r
10977       THEN CONV_TAC SYM_CONV\r
10978       THEN MATCH_MP_TAC lemma_cycle_is_face\r
10979       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10980    THEN DISCH_THEN(X_CHOOSE_THEN `L:(A)loop`(CONJUNCTS_THEN2 (LABEL_TAC "F2") SUBST1_TAC))\r
10981    THEN USE_THEN "F2" (fun th-> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o SPEC `L:(A)loop` o  CONJUNCT1  o REWRITE_RULE[is_normal])))\r
10982    THEN DISCH_THEN ((X_CHOOSE_THEN `x:A` (LABEL_TAC "F3" o CONJUNCT2)) o CONJUNCT2)\r
10983    THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
10984    THEN STRIP_TAC\r
10985    THENL[MATCH_MP_TAC lemma_in_quotient THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
10986    THEN MATCH_MP_TAC lemma_cycle_is_face THEN ASM_REWRITE_TAC[]);;\r
10987 \r
10988 let lemma_support_cycle = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop). is_normal H NF /\ L IN NF ==> dart_of L = UNIONS (cycle H L)`,\r
10989  REPEAT GEN_TAC\r
10990    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
10991    THEN REWRITE_TAC[EXTENSION; IN_UNIONS; GSYM belong]\r
10992    THEN GEN_TAC\r
10993    THEN EQ_TAC\r
10994    THENL[DISCH_TAC\r
10995        THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
10996        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th; atom_reflect]); ALL_TAC]\r
10997    THEN DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[cycle; IN_ELIM_THM]) (LABEL_TAC "F3")))\r
10998    THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") SUBST_ALL_TAC))\r
10999    THEN POP_ASSUM (fun th-> (POP_ASSUM (fun th1 -> (REWRITE_TAC[MATCH_MP lemma_in_loop (CONJ th th1)])))));;\r
11000 \r
11001 let lemmaQF = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_normal H NF /\ L IN NF /\ x belong L \r
11002     ==> face (quotient H NF) (atom H L x) = cycle H L`,\r
11003  REPEAT GEN_TAC\r
11004    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") ASSUME_TAC)\r
11005    THEN REWRITE_TAC[face]\r
11006    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
11007    THEN CONV_TAC SYM_CONV\r
11008    THEN POP_ASSUM (fun th1 -> (POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_cycle_is_face (CONJ th th1)]))));;\r
11009 \r
11010 let lemma_support_QF = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_normal H NF /\ L IN NF /\ x belong L \r
11011     ==> UNIONS(face (quotient H NF) (atom H L x)) = dart_of L`,\r
11012    REPEAT GEN_TAC\r
11013    THEN DISCH_THEN (LABEL_TAC "F1")\r
11014    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemmaQF th]) THEN CONV_TAC SYM_CONV\r
11015    THEN MATCH_MP_TAC lemma_support_cycle\r
11016    THEN EXISTS_TAC `NF:(A)loop->bool` THEN ASM_REWRITE_TAC[]);;\r
11017 \r
11018 let lemma_in_unions = prove(`!s:(A->bool)->bool t:A->bool x:A. x IN t /\ t IN s ==> x IN (UNIONS s)`, SET_TAC[IN_UNIONS]);;\r
11019 \r
11020 let lemma_sub_support = prove(`!s:(A->bool)->bool t:A->bool. t IN s ==> t SUBSET (UNIONS s)`, SET_TAC[]);;\r
11021 \r
11022 let lemma_in_QF = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF /\ x belong L ==> \r
11023   (!y:A. y belong L <=> choice H NF y IN face (quotient H NF) (atom H L x))`,\r
11024  REPEAT GEN_TAC\r
11025    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
11026    THEN GEN_TAC\r
11027    THEN EQ_TAC\r
11028    THENL[DISCH_THEN (fun th -> ASSUME_TAC th THEN MP_TAC th)\r
11029        THEN USE_THEN "F2" (MP_TAC o CONJUNCT1)\r
11030        THEN USE_THEN "F1" MP_TAC\r
11031        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
11032        THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP unique_choice th])\r
11033        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemmaQF (CONJ th th1)]))\r
11034        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th]); ALL_TAC]\r
11035    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_sub_support)\r
11036    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_support_QF (CONJ th th1)]))\r
11037    THEN USE_THEN "F1" (ASSUME_TAC o SPEC `y:A` o  MATCH_MP choice_reflect)\r
11038    THEN DISCH_THEN (fun th-> POP_ASSUM(fun th1 ->  REWRITE_TAC[belong; MATCH_MP lemma_in_subset (CONJ th th1)])));;\r
11039 \r
11040 let lemma_in_QuotientFace = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). \r
11041         is_normal H NF /\ L IN NF /\ x belong L /\ y belong L ==> atom H L y IN face (quotient H NF) (atom H L x)`,\r
11042    REPEAT GEN_TAC THEN DISCH_TAC\r
11043    THEN SUBGOAL_THEN `atom (H:(A)hypermap) (L:(A)loop) (y:A) = choice H (NF:(A)loop->bool) y` SUBST1_TAC\r
11044    THENL[CONV_TAC SYM_CONV\r
11045        THEN MATCH_MP_TAC unique_choice\r
11046        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11047    THEN ASM_MESON_TAC[lemma_in_QF]);;\r
11048 \r
11049 \r
11050 (* DESCRIBE NODES OF QUOTIENT HYPERMAPS *)\r
11051 \r
11052 let support_node = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool) (atm:A->bool). support_node H NF atm = UNIONS (node (quotient H NF) atm)`;;\r
11053 \r
11054 let lemma_node_sub_support_darts = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A. is_normal H NF /\ x IN support_darts NF \r
11055     ==> node H x SUBSET support_darts NF`,\r
11056  REPEAT GEN_TAC THEN DISCH_TAC\r
11057    THEN REWRITE_TAC[SUBSET; node; orbit_map; IN_ELIM_THM; GE; LE_0]\r
11058    THEN GEN_TAC\r
11059    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` SUBST1_TAC)\r
11060    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_node_in_support2 th]));;\r
11061 \r
11062 let lemma_in_node = prove(`!H:(A)hypermap x:A y:A. y IN node H x <=> ?n:num. y = (node_map H POWER n) x`,\r
11063    REWRITE_TAC[node; orbit_map; GE; LE_0; IN_ELIM_THM]);;\r
11064 \r
11065 let lemma_in_node2 = prove(`!H:(A)hypermap x:A n:num. (node_map H POWER n) x IN node H x`, MESON_TAC[lemma_in_node]);;\r
11066 \r
11067 let lemma_choice_sub_node = prove(`!H:(A)hypermap NF:(A)loop->bool x:A. is_normal H NF ==> choice H NF x SUBSET node H x`,\r
11068  REPEAT GEN_TAC\r
11069    THEN DISCH_THEN (LABEL_TAC "F1")\r
11070    THEN ASM_CASES_TAC `~((x:A) IN support_darts (NF:(A)loop->bool))`\r
11071    THENL[USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o  MATCH_MP first_unique_choice)\r
11072       THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
11073       THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUBSET; IN_SING]\r
11074       THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC\r
11075       THEN REWRITE_TAC[node_refl]; ALL_TAC]\r
11076    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_support])\r
11077    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` MP_TAC)\r
11078    THEN POP_ASSUM MP_TAC\r
11079    THEN REWRITE_TAC[IMP_IMP]\r
11080    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP unique_choice th])\r
11081    THEN REWRITE_TAC[lemma_atom_sub_node]);;\r
11082 \r
11083 let lemma_support_QN = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A. is_normal H NF /\ x IN support_darts NF \r
11084    ==> support_node H NF (choice H NF x) = node H x`,\r
11085    REPEAT GEN_TAC\r
11086    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
11087    THEN REWRITE_TAC[EXTENSION; support_node; IN_UNIONS; IN_ELIM_THM]\r
11088    THEN GEN_TAC\r
11089    THEN EQ_TAC\r
11090    THENL[DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[lemma_in_node]) ASSUME_TAC))\r
11091        THEN DISCH_THEN (X_CHOOSE_THEN `n:num` SUBST_ALL_TAC)\r
11092        THEN POP_ASSUM MP_TAC\r
11093        THEN SUBGOAL_THEN `!i:num. (node_map (quotient (H:(A)hypermap) (NF:(A)loop->bool)) POWER i) (choice H NF (x:A)) SUBSET node H x` ASSUME_TAC\r
11094        THENL[INDUCT_TAC\r
11095            THENL[REWRITE_TAC[POWER_0; I_THM]\r
11096               THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_choice_sub_node)\r
11097               THEN SIMP_TAC[]; ALL_TAC]\r
11098            THEN POP_ASSUM (LABEL_TAC "G1")\r
11099            THEN REWRITE_TAC[COM_POWER; o_THM]\r
11100            THEN REMOVE_THEN "F2" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o SYM o SPEC `x:A` o  MATCH_MP lemma_choice_in_quotient))\r
11101            THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1 (MATCH_MP lemma_quotient th))])\r
11102            THEN DISCH_THEN (MP_TAC o SPEC `i:num` o  MATCH_MP lemma_dart_invariant_power_node)\r
11103            THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1 (MATCH_MP lemma_quotient th)])\r
11104            THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th])\r
11105            THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2(LABEL_TAC "G2") SUBST_ALL_TAC))\r
11106            THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP choice_reflect)\r
11107            THEN REMOVE_THEN "G1" (fun th-> (DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1)))))\r
11108            THEN DISCH_THEN (SUBST1_TAC o MATCH_MP lemma_node_identity)\r
11109            THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_quotient th)))])\r
11110            THEN USE_THEN "F1" (LABEL_TAC "G3" o CONJUNCT1 o SPEC `y:A` o  MATCH_MP choice_and_head_tail)\r
11111            THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP lemma_choice_sub_node)\r
11112            THEN DISCH_THEN (fun th -> USE_THEN "G3" (fun th1 -> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1))))\r
11113            THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_node_identity th])\r
11114            THEN USE_THEN "F1"(fun th-> USE_THEN "G2" (fun th1-> REWRITE_TAC[CONJUNCT2(CONJUNCT2(MATCH_MP nmap_via_choice (CONJ th th1)))]))\r
11115            THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (y:A)`\r
11116            THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `z:A`; `1`] lemma_in_node2))\r
11117            THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_node_identity th])\r
11118            THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_choice_sub_node th]); ALL_TAC]\r
11119        THEN POP_ASSUM (MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[IMP_IMP; lemma_in_subset]; ALL_TAC]\r
11120    THEN SUBGOAL_THEN `!i:num. ?j:num. (node_map (H:(A)hypermap) POWER i) x IN ((nmap H (NF:(A)loop->bool) POWER j) (choice H NF x))` ASSUME_TAC\r
11121    THENL[INDUCT_TAC\r
11122        THENL[EXISTS_TAC `0` THEN REWRITE_TAC[POWER_0; I_THM]\r
11123            THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC]\r
11124        THEN POP_ASSUM (X_CHOOSE_THEN `k:num` (LABEL_TAC "F3"))\r
11125        THEN REWRITE_TAC[COM_POWER; o_THM]\r
11126        THEN ABBREV_TAC `y = (node_map (H:(A)hypermap) POWER (i:num)) (x:A)`\r
11127        THEN USE_THEN "F2" (fun th-> USE_THEN "F1" (LABEL_TAC "F4" o REWRITE_RULE[th] o SYM o SPEC `x:A` o MATCH_MP lemma_choice_in_quotient))\r
11128        THEN USE_THEN "F1" (MP_TAC o MATCH_MP nmap_permute)\r
11129        THEN DISCH_THEN (MP_TAC o SPEC `k:num` o  MATCH_MP iterate_orbit)\r
11130        THEN DISCH_THEN (fun thm-> (USE_THEN "F4" (fun th -> (MP_TAC (MATCH_MP thm th)))))\r
11131        THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
11132        THEN DISCH_THEN(X_CHOOSE_THEN `L:(A)loop`(X_CHOOSE_THEN `a:A`(CONJUNCTS_THEN2 (CONJUNCTS_THEN2(LABEL_TAC "F5") (LABEL_TAC "F6")) (LABEL_TAC "F7"))))\r
11133        THEN REMOVE_THEN "F3" MP_TAC\r
11134        THEN USE_THEN "F7" SUBST1_TAC\r
11135        THEN DISCH_THEN (LABEL_TAC "F3")\r
11136        THEN ASM_CASES_TAC `~(y:A = inverse (node_map (H:(A)hypermap)) (back (L:(A)loop) (y:A)))`\r
11137        THENL[EXISTS_TAC `SUC k`\r
11138            THEN REWRITE_TAC[COM_POWER; o_THM]\r
11139            THEN USE_THEN "F7" (SUBST1_TAC)\r
11140            THEN USE_THEN "F1"(fun th->(USE_THEN "F5"(fun th2->(USE_THEN "F6"(fun th3->MP_TAC (MATCH_MP unique_choice (CONJ th(CONJ th2 th3))))))))\r
11141            THEN DISCH_THEN (SUBST1_TAC o SYM)\r
11142            THEN USE_THEN "F6"(fun th->(USE_THEN "F5"(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th th1)))))\r
11143            THEN USE_THEN "F1"(fun th->(DISCH_THEN (fun th1->REWRITE_TAC[MATCH_MP nmap_via_choice (CONJ th th1)])))\r
11144            THEN POP_ASSUM MP_TAC\r
11145            THEN POP_ASSUM MP_TAC\r
11146            THEN USE_THEN "F6" MP_TAC\r
11147            THEN USE_THEN "F5" MP_TAC\r
11148            THEN USE_THEN "F1" MP_TAC\r
11149            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
11150            THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_unique_tail th])\r
11151            THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC]\r
11152        THEN EXISTS_TAC `k:num`\r
11153        THEN USE_THEN "F7" SUBST1_TAC\r
11154        THEN POP_ASSUM (LABEL_TAC "F8" o REWRITE_RULE[])\r
11155        THEN USE_THEN "F3" (fun th-> (USE_THEN "F8" (fun th1 -> MP_TAC (MATCH_MP lemma_second_absorb_quark (CONJ th th1)))))\r
11156        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM node_map_inverse_representation])\r
11157        THEN DISCH_THEN (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
11158    THEN DISCH_THEN (MP_TAC o  REWRITE_RULE[lemma_in_node])\r
11159    THEN DISCH_THEN (X_CHOOSE_THEN `k:num` SUBST1_TAC)\r
11160    THEN POP_ASSUM (MP_TAC o SPEC `k:num`)\r
11161    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F3"))\r
11162    THEN EXISTS_TAC `(nmap (H:(A)hypermap) (NF:(A)loop->bool) POWER (j:num)) (choice (H:(A)hypermap) (NF:(A)loop->bool) (x:A))`\r
11163    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
11164    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_quotient th))))])\r
11165    THEN MESON_TAC[lemma_in_node]);;\r
11166 \r
11167 let lemma_QuotientNode = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A. is_normal H NF /\ x IN support_darts NF \r
11168    ==> node (quotient H NF) (choice H NF x) = {choice H NF y |y:A | y IN node H x}`,\r
11169    REPEAT GEN_TAC\r
11170    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
11171    THEN USE_THEN "F2" (fun th -> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o SYM o SPEC `x:A` o MATCH_MP lemma_choice_in_quotient))\r
11172    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1(MATCH_MP lemma_quotient th))])\r
11173    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_subset)\r
11174    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_quotient th)])\r
11175    THEN DISCH_THEN (LABEL_TAC "F3")\r
11176    THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]\r
11177    THEN GEN_TAC\r
11178    THEN REWRITE_TAC[GSYM EXTENSION]\r
11179    THEN EQ_TAC\r
11180    THENL[DISCH_THEN (fun th-> ASSUME_TAC th THEN MP_TAC th) \r
11181        THEN USE_THEN "F3" MP_TAC\r
11182        THEN REWRITE_TAC[IMP_IMP]\r
11183        THEN DISCH_THEN (MP_TAC o (MATCH_MP lemma_in_subset))\r
11184        THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP atom_via_choice th])\r
11185        THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (SUBST_ALL_TAC o CONJUNCT2))\r
11186        THEN EXISTS_TAC `y:A` THEN SIMP_TAC[]\r
11187        THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_sub_support)\r
11188        THEN REWRITE_TAC[GSYM support_node]\r
11189        THEN USE_THEN "F1" (fun th-> (USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP lemma_support_QN (CONJ th th1)])))\r
11190        THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP choice_reflect)\r
11191        THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[lemma_in_subset]; ALL_TAC]\r
11192    THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC))\r
11193    THEN USE_THEN "F1" (fun th-> (USE_THEN "F2" (fun th1-> REWRITE_TAC[GSYM(MATCH_MP lemma_support_QN (CONJ th th1))])))\r
11194    THEN REWRITE_TAC[support_node; IN_UNIONS]\r
11195    THEN DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 (fun th -> MP_TAC th THEN (LABEL_TAC "GG" th)) (LABEL_TAC "F4")))\r
11196    THEN USE_THEN "F3" (MP_TAC)\r
11197    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_subset)\r
11198    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP atom_via_choice th])\r
11199    THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (SUBST_ALL_TAC o CONJUNCT2))\r
11200    THEN USE_THEN "F1" (fun th-> (USE_THEN "F4" (fun th1 -> (REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)]))))\r
11201    THEN USE_THEN "GG" (fun th-> REWRITE_TAC[th]));;\r
11202 \r
11203 let lemma_in_QN = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF /\ x IN support_darts NF \r
11204    ==> (!y:A. choice H NF y IN node (quotient H NF) (choice H NF x) <=> y IN node H x)`,\r
11205  REPEAT GEN_TAC\r
11206    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
11207    THEN GEN_TAC\r
11208    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_QuotientNode (CONJ th th1)]))\r
11209    THEN REWRITE_TAC[IN_ELIM_THM]\r
11210    THEN EQ_TAC\r
11211    THENL[DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th]) (LABEL_TAC "F3")))\r
11212        THEN MATCH_MP_TAC lemma_in_subset\r
11213        THEN EXISTS_TAC `choice (H:(A)hypermap) (NF:(A)loop->bool) (a:A)`\r
11214        THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP lemma_choice_sub_node)\r
11215        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_choice_sub_node th])\r
11216        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
11217        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC]\r
11218    THEN MESON_TAC[]);;\r
11219 \r
11220 let lemma_in_QuotientNode = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A) (y:A). is_normal H NF /\ x IN support_darts NF /\ y IN node H x\r
11221    ==> choice H NF y IN node (quotient H NF) (choice H NF x)`,\r
11222    MESON_TAC[lemma_in_QN]);;\r
11223 \r
11224 let lemma_in_node3 = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A) (y:A). \r
11225     is_normal H NF /\ x IN support_darts NF /\ choice H NF y IN node (quotient H NF) (choice H NF x) ==> y IN node H x`,\r
11226    MESON_TAC[lemma_in_QN]);;\r
11227 \r
11228 \r
11229 (* The definition of face collections *)\r
11230 \r
11231 let res = new_definition `!f:A->A s:A->bool x:A. res f s x = if x IN s then f x else x`;;\r
11232 \r
11233 let lemma_in_face = prove(`!(H:(A)hypermap) x:A n:num. ((face_map H) POWER n) x IN face H x`, REWRITE_TAC[face; lemma_in_orbit]);;\r
11234 \r
11235 let face_map_restrict = prove(`!(H:(A)hypermap) x:A.  res (face_map H) (face H x) permutes face H x`,\r
11236    REPEAT GEN_TAC THEN REWRITE_TAC[permutes] THEN SIMP_TAC[res]\r
11237    THEN GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE]\r
11238    THEN ASM_CASES_TAC `~((y:A) IN face (H:(A)hypermap) x)`\r
11239    THENL[EXISTS_TAC `y:A` \r
11240       THEN ASM_REWRITE_TAC[]\r
11241       THEN GEN_TAC\r
11242       THEN ASM_CASES_TAC `~(y':A IN face (H:(A)hypermap) x)`\r
11243       THENL[ASM_REWRITE_TAC[]; ALL_TAC]\r
11244       THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
11245       THEN ASM_REWRITE_TAC[]\r
11246       THEN POP_ASSUM (SUBST_ALL_TAC o MATCH_MP lemma_face_identity)\r
11247       THEN DISCH_TAC\r
11248       THEN MP_TAC(REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `y':A`; `1`] lemma_in_face))\r
11249       THEN POP_ASSUM SUBST1_TAC\r
11250       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11251    THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[])\r
11252    THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11253    THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts))\r
11254    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (fun th -> (ASSUME_TAC (AP_THM th `y:A`))))\r
11255    THEN MP_TAC (SPECL[`H:(A)hypermap`; `y:A`; `j:num`] lemma_in_face)\r
11256    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
11257    THEN DISCH_TAC\r
11258    THEN EXISTS_TAC `inverse (face_map (H:(A)hypermap)) y`\r
11259    THEN ASM_REWRITE_TAC[]\r
11260    THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))]\r
11261    THEN GEN_TAC\r
11262    THEN ASM_CASES_TAC `~(y':A IN face (H:(A)hypermap) y)`\r
11263    THENL[ASM_REWRITE_TAC[]\r
11264        THEN DISCH_THEN (SUBST_ALL_TAC)\r
11265        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[face; orbit_reflect])\r
11266        THEN MESON_TAC[]; ALL_TAC]\r
11267    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
11268    THEN ASM_REWRITE_TAC[]\r
11269    THEN MESON_TAC[face_map_inverse_representation]);;\r
11270 \r
11271 let power_res_face_map = prove(`!(H:(A)hypermap) x:A n:num. ((res (face_map H) (face H x)) POWER n) x = ((face_map H) POWER n) x`,\r
11272   REPLICATE_TAC 2 GEN_TAC\r
11273     THEN INDUCT_TAC\r
11274     THENL[REWRITE_TAC[POWER_0; orbit_reflect]; ALL_TAC]\r
11275     THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`; `n:num`] lemma_in_face)\r
11276     THEN ABBREV_TAC `y = (face_map (H:(A)hypermap) POWER n) x`\r
11277     THEN DISCH_TAC\r
11278     THEN REWRITE_TAC[COM_POWER; o_THM]\r
11279     THEN ASM_REWRITE_TAC[res]);;\r
11280 \r
11281 let face_loop = new_definition `!H:(A)hypermap x:A. face_loop H x = loop(face H x, res (face_map H) (face H x))`;;\r
11282 \r
11283 let face_collection = new_definition `!H:(A)hypermap. face_collection H = {face_loop H x |x:A| x IN dart H}`;;\r
11284 \r
11285 let face_loop_rep = prove(`!(H:(A)hypermap) x:A. dart_of (face_loop H x) = face H x /\ next (face_loop H x) = res (face_map H) (face H x)`,\r
11286   REPEAT GEN_TAC\r
11287     THEN REWRITE_TAC[face_loop]\r
11288     THEN MATCH_MP_TAC lemma_loop_representation\r
11289     THEN EXISTS_TAC `x:A`\r
11290     THEN REWRITE_TAC[FACE_FINITE; face_map_restrict]\r
11291     THEN REWRITE_TAC[orbit_map; power_res_face_map; face]);;\r
11292 \r
11293 let lemma_inverse_res = prove(`!(H:(A)hypermap) x:A y:A. y IN face H x ==> inverse (res (face_map H) (face H x))  y = inverse(face_map H) y`,\r
11294     REPEAT STRIP_TAC\r
11295     THEN REWRITE_TAC[face_loop]\r
11296     THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11297     THEN REWRITE_TAC[GSYM face_loop]\r
11298     THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)) \r
11299     THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F0"))\r
11300     THEN USE_THEN "F0" (MP_TAC o SPEC `face_map (H:(A)hypermap)` o  MATCH_MP RIGHT_MULT_MAP)\r
11301     THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]\r
11302     THEN REWRITE_TAC[GSYM (CONJUNCT2 POWER)]\r
11303     THEN DISCH_THEN (LABEL_TAC "F1" o SYM)\r
11304     THEN SUBGOAL_THEN `(res (face_map (H:(A)hypermap)) (face H y)) POWER (SUC j) = I` ASSUME_TAC\r
11305     THENL[REWRITE_TAC[FUN_EQ_THM;I_THM]\r
11306        THEN GEN_TAC\r
11307        THEN ASM_CASES_TAC `~(x:A IN face (H:(A)hypermap) (y:A))`\r
11308        THENL[MATCH_MP_TAC power_permutation_outside_domain\r
11309          THEN EXISTS_TAC `face (H:(A)hypermap) y`\r
11310          THEN ASM_REWRITE_TAC[face_map_restrict; FACE_FINITE]; ALL_TAC] \r
11311        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[])\r
11312        THEN DISCH_THEN (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11313        THEN REWRITE_TAC[power_res_face_map]\r
11314        THEN POP_ASSUM (fun th-> MP_TAC (AP_THM th `x:A`))\r
11315        THEN REWRITE_TAC[I_THM]; ALL_TAC]   \r
11316     THEN POP_ASSUM (MP_TAC o SPEC `inverse(res (face_map (H:(A)hypermap)) (face H y))` o  MATCH_MP RIGHT_MULT_MAP)\r
11317     THEN REWRITE_TAC[POWER; I_O_ID; GSYM o_ASSOC]\r
11318     THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o (SPECL[`H:(A)hypermap`; `y:A`] face_map_restrict); I_O_ID]\r
11319     THEN DISCH_THEN (LABEL_TAC "F3")\r
11320     THEN POP_ASSUM (SUBST1_TAC o SYM)\r
11321     THEN REMOVE_THEN "F0" (SUBST1_TAC)\r
11322     THEN REWRITE_TAC[power_res_face_map]);;\r
11323 \r
11324 let face_loop_lemma = prove(`!(H:(A)hypermap) x:A. is_loop H (face_loop H x)`,\r
11325   REPEAT STRIP_TAC\r
11326     THEN REWRITE_TAC[is_loop; belong; face_loop_rep]\r
11327     THEN REPEAT STRIP_TAC\r
11328     THEN ASM_REWRITE_TAC[res]\r
11329     THEN REWRITE_TAC[one_step_contour]);;\r
11330 \r
11331 let lemma_edge_nondegenerate = prove(`!(H:(A)hypermap). is_edge_nondegenerate H <=> (!x:A. x IN dart H ==> ~(face_map H x = (inverse (node_map H)) x))`,\r
11332    REWRITE_TAC[is_edge_nondegenerate] THEN  MESON_TAC[is_edge_nondegenerate; lemma_edge_degenerate]);;\r
11333 \r
11334 let normal_face_collection = prove(`!(H:(A)hypermap). (!x:A. x IN dart H ==> (?y:A.y IN dart H /\ y IN face H x /\ ~(node H x = node H y))) \r
11335    ==> is_normal H (face_collection H)`,\r
11336    REPEAT GEN_TAC\r
11337    THEN REWRITE_TAC[is_normal]\r
11338    THEN DISCH_THEN (LABEL_TAC "F2")\r
11339    THEN STRIP_TAC\r
11340    THENL[GEN_TAC\r
11341       THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong]\r
11342       THEN STRIP_TAC\r
11343       THEN POP_ASSUM SUBST1_TAC\r
11344       THEN REWRITE_TAC[face_loop_lemma]\r
11345       THEN EXISTS_TAC `x:A`\r
11346       THEN ASM_REWRITE_TAC[face; orbit_reflect; face_loop_rep]; ALL_TAC]\r
11347    THEN STRIP_TAC\r
11348    THENL[GEN_TAC\r
11349      THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong]\r
11350      THEN STRIP_TAC\r
11351      THEN POP_ASSUM SUBST1_TAC\r
11352      THEN REWRITE_TAC[face_loop_rep]\r
11353      THEN EXISTS_TAC `x:A`\r
11354      THEN REWRITE_TAC[face; orbit_reflect]\r
11355      THEN REWRITE_TAC[GSYM face]\r
11356      THEN USE_THEN "F2" (fun thm->(POP_ASSUM (fun th-> MESON_TAC[MATCH_MP thm th]))); ALL_TAC]\r
11357    THEN STRIP_TAC\r
11358    THENL[REPEAT GEN_TAC\r
11359      THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong]\r
11360      THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G1"))) (CONJUNCTS_THEN2 (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G2"))) MP_TAC))\r
11361      THEN REMOVE_THEN "G1" SUBST_ALL_TAC\r
11362      THEN REMOVE_THEN "G2" SUBST_ALL_TAC\r
11363      THEN REWRITE_TAC[face_loop_rep]\r
11364      THEN STRIP_TAC\r
11365      THEN REWRITE_TAC[face_loop]\r
11366      THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11367      THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11368      THEN SIMP_TAC[]; ALL_TAC]\r
11369    THEN REPEAT GEN_TAC\r
11370    THEN REWRITE_TAC [face_collection;IN_ELIM_THM; belong]\r
11371    THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) MP_TAC)\r
11372    THEN POP_ASSUM SUBST1_TAC\r
11373    THEN REWRITE_TAC[face_loop_rep]\r
11374    THEN POP_ASSUM (LABEL_TAC "H1")\r
11375    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3"))\r
11376    THEN EXISTS_TAC `face_loop (H:(A)hypermap) y`\r
11377    THEN REWRITE_TAC[face_loop_rep; face; orbit_reflect]\r
11378    THEN EXISTS_TAC `y:A`\r
11379    THEN SIMP_TAC[]\r
11380    THEN USE_THEN "H1" (MP_TAC o MATCH_MP lemma_face_subset)\r
11381    THEN USE_THEN "H2" (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11382    THEN REWRITE_TAC[face]\r
11383    THEN DISCH_THEN (fun th-> MP_TAC (MATCH_MP lemma_in_subset (CONJ th (SPECL[`face_map (H:(A)hypermap)`; `x:A`] orbit_reflect))))\r
11384    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_subset)\r
11385    THEN USE_THEN "H3" (SUBST_ALL_TAC o MATCH_MP lemma_node_identity)\r
11386    THEN DISCH_THEN (fun th-> (POP_ASSUM(fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)]))));;\r
11387 \r
11388 let lemma_support_face_collection = prove(`!(H:(A)hypermap). support_darts (face_collection H) = dart H`,\r
11389  GEN_TAC\r
11390    THEN REWRITE_TAC[EXTENSION]\r
11391    THEN GEN_TAC\r
11392    THEN REWRITE_TAC[lemma_in_support]\r
11393    THEN REWRITE_TAC[face_collection; IN_ELIM_THM]\r
11394    THEN EQ_TAC\r
11395    THENL[STRIP_TAC\r
11396       THEN POP_ASSUM MP_TAC\r
11397       THEN POP_ASSUM SUBST1_TAC\r
11398       THEN REWRITE_TAC[belong; face_loop_rep]\r
11399       THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_face_subset)\r
11400       THEN REWRITE_TAC[IMP_IMP; lemma_in_subset]; ALL_TAC]\r
11401    THEN STRIP_TAC\r
11402    THEN EXISTS_TAC `face_loop (H:(A)hypermap) x`\r
11403    THEN REWRITE_TAC[belong; face; face_loop_rep; orbit_reflect]\r
11404    THEN EXISTS_TAC `x:A`\r
11405    THEN ASM_REWRITE_TAC[]);;\r
11406 \r
11407 let lemma_card_face_collection = prove(`!(H:(A)hypermap). FINITE (face_collection H) /\ CARD (face_collection H) = number_of_faces H`,\r
11408   GEN_TAC\r
11409   THEN SUBGOAL_THEN `?t:(A->bool)->(A)loop.(!s:(A->bool).s IN face_set H ==> ?x:A.x IN dart H /\ s = face (H:(A)hypermap) x /\ t s = face_loop H x)` MP_TAC\r
11410   THENL[REWRITE_TAC[GSYM SKOLEM_THM]\r
11411       THEN GEN_TAC\r
11412       THEN REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]\r
11413       THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_face_representation)\r
11414       THEN STRIP_TAC\r
11415       THEN REWRITE_TAC[SWAP_EXISTS_THM]\r
11416       THEN EXISTS_TAC `x:A`\r
11417       THEN EXISTS_TAC `face_loop (H:(A)hypermap) (x:A)`\r
11418       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11419    THEN DISCH_THEN (X_CHOOSE_THEN `t:(A->bool)->(A)loop` (LABEL_TAC "F1"))\r
11420    THEN SUBGOAL_THEN `IMAGE (t:(A->bool)->(A)loop) (face_set (H:(A)hypermap)) = (face_collection H)` (LABEL_TAC "F2")\r
11421    THENL[REWRITE_TAC[IMAGE; face_collection; face_set; EXTENSION; IN_ELIM_THM]\r
11422       THEN GEN_TAC\r
11423       THEN EQ_TAC\r
11424       THENL[REWRITE_TAC[set_of_orbits; IN_ELIM_THM]\r
11425           THEN REWRITE_TAC[GSYM face]\r
11426           THEN STRIP_TAC\r
11427           THEN EXISTS_TAC `x'':A`\r
11428           THEN POP_ASSUM SUBST1_TAC\r
11429           THEN POP_ASSUM SUBST1_TAC\r
11430           THEN ASM_REWRITE_TAC[]\r
11431           THEN USE_THEN "F1" (MP_TAC o SPEC `face (H:(A)hypermap) x''`)\r
11432           THEN POP_ASSUM (fun th -> ASSUME_TAC th THEN REWRITE_TAC[REWRITE_RULE[lemma_in_face_set] th])\r
11433           THEN STRIP_TAC\r
11434           THEN ASM_REWRITE_TAC[]\r
11435           THEN REWRITE_TAC[face_loop]\r
11436           THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11437       THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G1") SUBST1_TAC))\r
11438       THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM; GSYM face]\r
11439       THEN EXISTS_TAC `face (H:(A)hypermap) (y:A)`\r
11440       THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11441       THEN USE_THEN "F1" (MP_TAC o SPEC `face (H:(A)hypermap) (y:A)`)\r
11442       THEN USE_THEN "G1" (fun th -> REWRITE_TAC[REWRITE_RULE[lemma_in_face_set] th])\r
11443       THEN STRIP_TAC\r
11444       THEN POP_ASSUM SUBST1_TAC\r
11445       THEN REWRITE_TAC[face_loop]\r
11446       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11447    THEN SUBGOAL_THEN `FINITE (face_collection (H:(A)hypermap))` (LABEL_TAC "F3")\r
11448    THENL[ POP_ASSUM (SUBST1_TAC o SYM)\r
11449       THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC]\r
11450    THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[number_of_faces] THEN REMOVE_THEN "F2" (SUBST1_TAC o SYM)\r
11451    THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]\r
11452    THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))\r
11453    THEN REMOVE_THEN "F4" (fun th -> USE_THEN "F1" (fun thm -> MP_TAC (MATCH_MP thm th))) THEN STRIP_TAC\r
11454    THEN REMOVE_THEN "F5" (fun th -> USE_THEN "F1" (fun thm -> MP_TAC (MATCH_MP thm th)))\r
11455    THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "F6" MP_TAC\r
11456    THEN POP_ASSUM SUBST1_TAC\r
11457    THEN UNDISCH_THEN `(t:(A->bool)->(A)loop) x = face_loop (H:(A)hypermap) (x')` SUBST1_TAC\r
11458    THEN DISCH_THEN (MP_TAC o AP_TERM `dart_of:(A)loop->(A->bool)`)\r
11459    THEN REWRITE_TAC[face_loop_rep]);;\r
11460 \r
11461 let lemma_inverse_in_face = prove(`!(H:(A)hypermap) (x:A) (y:A). y IN face H x ==> inverse (face_map H) y IN face H x`,\r
11462     REPEAT STRIP_TAC\r
11463     THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11464     THEN REPEAT GEN_TAC\r
11465     THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts))\r
11466     THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
11467     THEN REWRITE_TAC[lemma_in_face]);;\r
11468 \r
11469 let lemma_power_inverse_in_face = prove(`!(H:(A)hypermap) (x:A) (y:A) (n:num).y IN face H x ==> (inverse (face_map H) POWER n) y IN face H x`,\r
11470     REPEAT STRIP_TAC\r
11471     THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity)\r
11472     THEN REPEAT GEN_TAC\r
11473     THEN (X_CHOOSE_THEN `j:num` (fun th -> (SUBST1_TAC (AP_THM th `y:A`)))) (SPEC `n:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)))\r
11474     THEN REWRITE_TAC[lemma_in_face]);;\r
11475 \r
11476 let lemma_power_inverse_in_face2 = prove(`!(H:(A)hypermap) (x:A) (n:num).(inverse (face_map H) POWER n) x IN face H x`,\r
11477     REPEAT GEN_TAC\r
11478     THEN REPEAT GEN_TAC\r
11479     THEN (X_CHOOSE_THEN `j:num` (fun th -> (SUBST1_TAC (AP_THM th `x:A`)))) (SPEC `n:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)))\r
11480     THEN REWRITE_TAC[lemma_in_face]);;\r
11481 \r
11482 let lemma_inverse_in_node = prove(`!(H:(A)hypermap) (x:A) (y:A). y IN node H x ==> inverse (node_map H) y IN node H x`,\r
11483     REPEAT STRIP_TAC\r
11484     THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_node_identity)\r
11485     THEN REPEAT GEN_TAC\r
11486     THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts))\r
11487     THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
11488     THEN REWRITE_TAC[lemma_in_node2]);;\r
11489 \r
11490 let lemma_power_inverse_in_node = prove(`!(H:(A)hypermap) (x:A) (y:A) (n:num).y IN node H x ==> (inverse (node_map H) POWER n) y IN node H x`,\r
11491     REPEAT STRIP_TAC\r
11492     THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_node_identity)\r
11493     THEN REPEAT GEN_TAC\r
11494     THEN (X_CHOOSE_THEN `j:num` (fun th -> (SUBST1_TAC (AP_THM th `y:A`)))) (SPEC `n:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)))\r
11495     THEN REWRITE_TAC[lemma_in_node2]);;\r
11496 \r
11497 let lemma_power_inverse_in_node2 = prove(`!(H:(A)hypermap) (x:A) (n:num).(inverse (node_map H) POWER n) x IN node H x`,\r
11498     REPEAT GEN_TAC\r
11499     THEN REPEAT GEN_TAC\r
11500     THEN (X_CHOOSE_THEN `j:num` (fun th -> (SUBST1_TAC (AP_THM th `x:A`)))) (SPEC `n:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)))\r
11501     THEN REWRITE_TAC[lemma_in_node2]);;\r
11502 \r
11503 \r
11504 let SING_EQ = prove(`!x:A y:A. {x} = {y} <=> x = y`, SET_TAC[]);;\r
11505 \r
11506 let face_quotient_lemma = prove(`!(H:(A)hypermap). is_edge_nondegenerate H /\ (!x:A. x IN dart H ==> (?y:A. y IN dart H /\ y IN face H x /\ ~(node H x = node H y))) ==> (!x:A. choice H (face_collection H) x = {x}) /\ H iso (quotient H (face_collection H))`,\r
11507   GEN_TAC\r
11508    THEN REWRITE_TAC[lemma_edge_nondegenerate]\r
11509    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
11510    THEN USE_THEN "F2"(LABEL_TAC "F3" o MATCH_MP normal_face_collection)\r
11511    THEN SUBGOAL_THEN `!x:A. choice (H:(A)hypermap) (face_collection H) x = {x}` (LABEL_TAC "F4")\r
11512    THENL[GEN_TAC\r
11513       THEN ASM_CASES_TAC `~(x:A IN dart (H:(A)hypermap))`\r
11514       THENL[POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM lemma_support_face_collection])\r
11515          THEN USE_THEN "F3" (MP_TAC o SPEC `x:A` o  CONJUNCT1 o MATCH_MP first_unique_choice)\r
11516          THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11517       THEN POP_ASSUM (LABEL_TAC "G4" o REWRITE_RULE[])\r
11518       THEN USE_THEN "G4" (MP_TAC o REWRITE_RULE[GSYM lemma_support_face_collection])\r
11519       THEN USE_THEN "F3" (fun th -> REWRITE_TAC[GSYM(MATCH_MP lemma_choice_in_quotient th)])\r
11520       THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
11521       THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "G5") (LABEL_TAC "G6")) (LABEL_TAC "G7"))))\r
11522       THEN USE_THEN "G5" (MP_TAC o REWRITE_RULE[face_collection; IN_ELIM_THM])\r
11523       THEN DISCH_THEN (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 (LABEL_TAC "G8") (LABEL_TAC "G9")))\r
11524       THEN USE_THEN "F3" (MP_TAC o SPEC `x:A` o MATCH_MP  choice_reflect)\r
11525       THEN REMOVE_THEN "G7" SUBST1_TAC\r
11526       THEN USE_THEN "G6" (MP_TAC o REWRITE_RULE[belong])\r
11527       THEN USE_THEN "G9" SUBST1_TAC\r
11528       THEN REWRITE_TAC[face_loop_rep]\r
11529       THEN DISCH_THEN (LABEL_TAC "G10")\r
11530       THEN DISCH_THEN (LABEL_TAC "G11")\r
11531       THEN SUBGOAL_THEN `~(next (L:(A)loop) y = inverse (node_map (H:(A)hypermap)) y)` MP_TAC\r
11532       THENL[USE_THEN "G9" (fun th-> REWRITE_TAC[th])\r
11533          THEN REWRITE_TAC[face_loop_rep]\r
11534          THEN USE_THEN "G10" (fun th-> REWRITE_TAC[res; th])\r
11535          THEN USE_THEN "F1" (MP_TAC o SPEC `y:A`)\r
11536          THEN USE_THEN "G8" (MP_TAC o MATCH_MP lemma_face_subset)\r
11537          THEN DISCH_THEN (fun th -> (USE_THEN "G10" (fun th1-> (LABEL_TAC "G12" (MATCH_MP lemma_in_subset (CONJ th th1))))))\r
11538          THEN USE_THEN "G12" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
11539       THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `y:A`] atom_reflect)\r
11540       THEN USE_THEN "G6" MP_TAC THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC\r
11541       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
11542       THEN DISCH_THEN (LABEL_TAC "G14" o MATCH_MP lemma_unique_head)\r
11543       THEN SUBGOAL_THEN `~(y = inverse (node_map (H:(A)hypermap)) (back (L:(A)loop) y))` MP_TAC\r
11544       THENL[ONCE_REWRITE_TAC[lemma_inverse_on_loop]\r
11545          THEN REWRITE_TAC[face_loop_rep]\r
11546          THEN USE_THEN "G9" SUBST1_TAC\r
11547          THEN REWRITE_TAC[face_loop_rep]\r
11548          THEN USE_THEN "G10" (fun th-> REWRITE_TAC[MATCH_MP lemma_inverse_res th])\r
11549          THEN USE_THEN "G10" (ASSUME_TAC o MATCH_MP lemma_inverse_in_face)\r
11550          THEN ABBREV_TAC `t = inverse (face_map (H:(A)hypermap)) y`\r
11551          THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[GSYM face_map_inverse_representation] o SYM)\r
11552          THEN USE_THEN "F1" (MP_TAC o SPEC `t:A`)\r
11553          THEN USE_THEN "G8" (MP_TAC o MATCH_MP lemma_face_subset)\r
11554          THEN DISCH_THEN (fun th -> (POP_ASSUM (fun th1-> (ASSUME_TAC (MATCH_MP lemma_in_subset (CONJ th th1))))))\r
11555          THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
11556       THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `y:A`] atom_reflect)\r
11557       THEN USE_THEN "G6" MP_TAC THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC\r
11558       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
11559       THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP lemma_unique_tail)\r
11560       THEN POP_ASSUM(fun th-> (DISCH_THEN (fun th1 -> (ASSUME_TAC (MATCH_MP EQ_TRANS (CONJ th th1))))))\r
11561       THEN POP_ASSUM MP_TAC THEN USE_THEN "G6" MP_TAC THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC\r
11562       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
11563       THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP atom_one_point)\r
11564       THEN DISCH_TAC\r
11565       THEN REMOVE_THEN "G11" MP_TAC\r
11566       THEN USE_THEN "G9" (SUBST1_TAC o SYM)\r
11567       THEN POP_ASSUM (SUBST1_TAC o SYM)\r
11568       THEN REWRITE_TAC[IN_SING]\r
11569       THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
11570    THEN ASM_REWRITE_TAC[]\r
11571    THEN REWRITE_TAC[iso]\r
11572    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
11573    THEN EXISTS_TAC `(\x:A. {x})`\r
11574    THEN STRIP_TAC\r
11575    THENL[REWRITE_TAC[BIJ]\r
11576       THEN STRIP_TAC\r
11577       THENL[REWRITE_TAC[INJ]\r
11578           THEN STRIP_TAC\r
11579           THENL[GEN_TAC\r
11580               THEN REWRITE_TAC[GSYM lemma_support_face_collection]\r
11581               THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_choice_in_quotient th)])\r
11582               THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
11583               THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
11584               THEN MESON_TAC[SING_EQ]; ALL_TAC]\r
11585           THEN REWRITE_TAC[SURJ]\r
11586           THEN STRIP_TAC      \r
11587           THENL[GEN_TAC\r
11588              THEN REWRITE_TAC[GSYM lemma_support_face_collection]\r
11589              THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_choice_in_quotient th)])\r
11590              THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
11591              THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
11592           THEN GEN_TAC\r
11593           THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th])\r
11594           THEN REWRITE_TAC[lemma_support_face_collection]\r
11595           THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th])\r
11596           THEN MESON_TAC[]; ALL_TAC]\r
11597    THEN REWRITE_TAC[]\r
11598    THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==>  nmap H (face_collection H) {x} = {node_map H x}` (LABEL_TAC "F5")\r
11599    THENL[REWRITE_TAC[GSYM lemma_support_face_collection] \r
11600        THEN GEN_TAC\r
11601        THEN DISCH_THEN (LABEL_TAC "G1")\r
11602        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[GSYM th])\r
11603        THEN USE_THEN "F3"(fun th-> (USE_THEN "G1" (fun th1-> REWRITE_TAC[MATCH_MP nmap_via_choice (CONJ th th1)])))\r
11604        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th])\r
11605        THEN USE_THEN "F3" (fun th-> MP_TAC(CONJUNCT1(SPEC `x:A` (GSYM(MATCH_MP choice_at_margin th)))))\r
11606        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th; SING_EQ])\r
11607        THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
11608    THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==>  fmap H (face_collection H) {x} = {face_map H x}` (LABEL_TAC "F6")\r
11609    THENL[REWRITE_TAC[GSYM lemma_support_face_collection]\r
11610        THEN GEN_TAC\r
11611        THEN DISCH_THEN (LABEL_TAC "G1")\r
11612        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[GSYM th])\r
11613        THEN USE_THEN "F3"(fun th-> (USE_THEN "G1" (fun th1-> REWRITE_TAC[MATCH_MP fmap_via_choice (CONJ th th1)])))\r
11614        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th])\r
11615        THEN USE_THEN "F3" (fun th-> MP_TAC(CONJUNCT2(SPEC `x:A` (GSYM(MATCH_MP choice_at_margin th)))))\r
11616        THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th; SING_EQ])\r
11617        THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
11618    THEN ASM_REWRITE_TAC[emap]\r
11619    THEN GEN_TAC\r
11620    THEN DISCH_THEN (LABEL_TAC "F7")\r
11621    THEN USE_THEN "F7"(fun th-> (USE_THEN "F5"(fun thm -> REWRITE_TAC[MATCH_MP thm th])))\r
11622    THEN USE_THEN "F7"(fun th-> (USE_THEN "F6"(fun thm -> REWRITE_TAC[MATCH_MP thm th])))\r
11623    THEN REWRITE_TAC [o_THM]\r
11624    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)])\r
11625    THEN CONV_TAC SYM_CONV\r
11626    THEN REWRITE_TAC[GSYM face_map_inverse_representation]\r
11627    THEN CONV_TAC SYM_CONV\r
11628    THEN REWRITE_TAC[GSYM node_map_inverse_representation]\r
11629    THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
11630    THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT1 o MATCH_MP lemma_dart_invariant)\r
11631    THEN USE_THEN "F8" (fun th-> (USE_THEN "F6" (fun thm -> REWRITE_TAC[MATCH_MP thm th])))\r
11632    THEN USE_THEN "F8" (LABEL_TAC "F9" o CONJUNCT2 o CONJUNCT2 o  MATCH_MP lemma_dart_invariant)\r
11633    THEN USE_THEN "F9" (fun th-> (USE_THEN "F5" (fun thm -> REWRITE_TAC[MATCH_MP thm th])))\r
11634    THEN MP_TAC (AP_THM (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_cyclic)) `x:A`)\r
11635    THEN DISCH_THEN (MP_TAC o SYM o REWRITE_RULE[o_THM; I_THM])\r
11636    THEN REWRITE_TAC[SING_EQ]);;\r
11637 \r
11638 let canon_loop = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool). canon_loop H NF = {qf:(A->bool)->bool | qf IN face_set (quotient H NF) /\ (!s:A->bool. s IN qf ==> CARD s = 1)}`;;\r
11639 \r
11640 let set_one_point = prove(`!s:A->bool x:A. FINITE s /\ CARD s = 1 /\ x IN s ==> s = {x}`,\r
11641  REPEAT GEN_TAC\r
11642    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
11643    THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP CARD_DELETE)\r
11644    THEN ASM_REWRITE_TAC[SUB_REFL]\r
11645    THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP FINITE_DELETE_IMP)\r
11646    THEN REWRITE_TAC[IMP_IMP; GSYM HAS_SIZE; HAS_SIZE_0]\r
11647    THEN DISCH_TAC\r
11648    THEN USE_THEN "F3" (fun th-> MP_TAC th THEN MP_TAC (MATCH_MP INSERT_DELETE th))\r
11649    THEN POP_ASSUM SUBST1_TAC\r
11650    THEN ASM_REWRITE_TAC[EQ_SYM]);;\r
11651 \r
11652 let lemma_canonical_function = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (!t:(A->bool)->bool. t IN canon_loop H NF  <=> (?L:(A)loop. L IN NF /\ t = cycle H L /\ (!x:A. x belong L ==> L = face_loop H x /\ atom H L x = {x})))`,\r
11653    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN GEN_TAC\r
11654    THEN EQ_TAC\r
11655    THENL[REWRITE_TAC[canon_loop; IN_ELIM_THM; IN_ELIM_THM]\r
11656        THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F2"))\r
11657        THEN USE_THEN "F1"(fun th -> REWRITE_TAC[MATCH_MP lemmaQuotientFace th; IN_ELIM_THM])\r
11658        THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F3") SUBST_ALL_TAC))\r
11659        THEN EXISTS_TAC `L:(A)loop`\r
11660        THEN ASM_REWRITE_TAC[]\r
11661        THEN SUBGOAL_THEN `!y:A. atom (H:(A)hypermap) (L:(A)loop) (y:A) = {y}` (LABEL_TAC "F4")\r
11662        THENL[GEN_TAC\r
11663           THEN ASM_CASES_TAC `y:A belong L`\r
11664           THENL[MATCH_MP_TAC set_one_point\r
11665              THEN USE_THEN "F2" (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (y:A)`)\r
11666              THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th])\r
11667              THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
11668              THEN REWRITE_TAC[lemma_atom_finite; atom_reflect]; ALL_TAC]\r
11669           THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_atom_out_side_loop th]); ALL_TAC]\r
11670       THEN SUBGOAL_THEN `!z:A. z belong L ==> (!n:num. ((next (L:(A)loop)) POWER n) z = ((face_map (H:(A)hypermap)) POWER n) z)` (LABEL_TAC "F5")\r
11671       THENL[REWRITE_TAC[RIGHT_IMP_FORALL_THM]\r
11672          THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM]\r
11673          THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
11674          THEN GEN_TAC\r
11675          THEN POP_ASSUM (LABEL_TAC "F5")\r
11676          THEN DISCH_THEN (LABEL_TAC "F6")\r
11677          THEN REWRITE_TAC[COM_POWER; o_THM]\r
11678          THEN USE_THEN "F6"(fun th-> (USE_THEN "F5"(fun thm->REWRITE_TAC[SYM(MATCH_MP thm th)])))\r
11679          THEN USE_THEN "F6" (LABEL_TAC "F7" o SPEC `n:num` o MATCH_MP lemma_power_next_in_loop)\r
11680          THEN ABBREV_TAC `a = (next (L:(A)loop) POWER n) z`\r
11681          THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F7"(fun th3-> MP_TAC (MATCH_MP value_next_of_head (CONJ th (CONJ th2 th3))))))))\r
11682          THEN USE_THEN "F1"(fun th->(USE_THEN "F3"(fun th2->(USE_THEN "F7"(fun th3-> MP_TAC(CONJUNCT1(MATCH_MP head_on_loop (CONJ th (CONJ th2 th3)))))))))\r
11683          THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th; IN_SING])\r
11684          THEN DISCH_THEN SUBST1_TAC\r
11685          THEN SIMP_TAC[]; ALL_TAC]\r
11686       THEN SUBGOAL_THEN `!z:A. z belong L ==>dart_of L = face H z` (LABEL_TAC "F6")\r
11687       THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7")\r
11688          THEN USE_THEN "F7" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
11689          THEN USE_THEN "F7" (fun th-> USE_THEN "F5"(fun thm-> (MP_TAC ( MATCH_MP thm th))))\r
11690          THEN REWRITE_TAC[face; orbit_map; GE; LE_0]\r
11691          THEN ASM_ASM_SET_TAC; ALL_TAC]\r
11692       THEN ASM_REWRITE_TAC[]\r
11693       THEN REWRITE_TAC[lemma_loop_identity; face_loop_rep]\r
11694       THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7")\r
11695       THEN USE_THEN "F7" (fun th-> (USE_THEN "F6"(fun thm-> (LABEL_TAC "F8" (MATCH_MP thm th)))))\r
11696       THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th])\r
11697       THEN REWRITE_TAC[FUN_EQ_THM]\r
11698       THEN GEN_TAC\r
11699       THEN ASM_CASES_TAC `~(x':A belong L)`\r
11700       THENL[POP_ASSUM (LABEL_TAC "F9")\r
11701          THEN USE_THEN "F9" (fun th-> REWRITE_TAC[MATCH_MP lemma_back_and_next_outside_loop th])\r
11702          THEN POP_ASSUM (MP_TAC o REWRITE_RULE[belong])\r
11703          THEN POP_ASSUM SUBST1_TAC\r
11704          THEN MESON_TAC[res]; ALL_TAC]\r
11705       THEN POP_ASSUM (LABEL_TAC "F9" o REWRITE_RULE[])\r
11706       THEN USE_THEN "F5"(fun thm -> USE_THEN "F9" (fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP thm th))]))\r
11707       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[belong])\r
11708       THEN POP_ASSUM SUBST1_TAC\r
11709       THEN MESON_TAC[res]; ALL_TAC]\r
11710    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 SUBST1_TAC (LABEL_TAC "F3"))))\r
11711    THEN REWRITE_TAC[canon_loop; IN_ELIM_THM]\r
11712    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemmaQuotientFace th])\r
11713    THEN STRIP_TAC THENL[ASM_ASM_SET_TAC; ALL_TAC]\r
11714    THEN GEN_TAC\r
11715    THEN REWRITE_TAC[cycle; IN_ELIM_THM]\r
11716    THEN STRIP_TAC\r
11717    THEN POP_ASSUM SUBST1_TAC\r
11718    THEN USE_THEN "F3" (MP_TAC o SPEC `x:A`)\r
11719    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
11720    THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2)\r
11721    THEN REWRITE_TAC[CARD_SINGLETON]);;\r
11722 \r
11723 let lemmaSTKBEPH = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF /\ number_of_faces H <= CARD (canon_loop H NF) \r
11724   ==> NF = face_collection H /\ H iso quotient H NF`,\r
11725   REPEAT GEN_TAC\r
11726   THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
11727   THEN SUBGOAL_THEN `?t:(A)loop->((A->bool)->bool).(!L:(A)loop.L IN (NF:(A)loop->bool)/\cycle (H:(A)hypermap) L IN canon_loop H NF ==>t L = cycle H L)` MP_TAC\r
11728    THENL[REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC \r
11729        THEN REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]\r
11730        THEN STRIP_TAC THEN EXISTS_TAC `cycle (H:(A)hypermap) (L:(A)loop)` THEN SIMP_TAC[]; ALL_TAC]\r
11731    THEN DISCH_THEN(X_CHOOSE_THEN `t:(A)loop->((A->bool)->bool)` (LABEL_TAC "F3"))\r
11732    THEN ABBREV_TAC `S = {L:(A)loop | L IN (NF:(A)loop->bool) /\ cycle (H:(A)hypermap) L IN canon_loop H NF}`\r
11733    THEN SUBGOAL_THEN `IMAGE (t:(A)loop->((A->bool)->bool)) (S:(A)loop->bool) = canon_loop (H:(A)hypermap) (NF:(A)loop->bool)` (LABEL_TAC "F4")\r
11734    THENL[REWRITE_TAC[EXTENSION] THEN GEN_TAC\r
11735        THEN REWRITE_TAC[IMAGE; IN_ELIM_THM]\r
11736        THEN EQ_TAC\r
11737        THENL[DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC))\r
11738           THEN EXPAND_TAC "S"\r
11739           THEN REWRITE_TAC[IN_ELIM_THM]\r
11740           THEN DISCH_THEN (fun th-> (USE_THEN "F3"(fun thm-> REWRITE_TAC[MATCH_MP thm th])) THEN REWRITE_TAC[th]); ALL_TAC]\r
11741        THEN DISCH_THEN (fun th -> (LABEL_TAC "F4" th THEN MP_TAC th))\r
11742        THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_canonical_function th])\r
11743        THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (ASSUME_TAC) (SUBST_ALL_TAC o CONJUNCT1)))\r
11744        THEN EXISTS_TAC `L:(A)loop`\r
11745        THEN EXPAND_TAC "S"\r
11746        THEN ASM_REWRITE_TAC[IN_ELIM_THM]\r
11747        THEN REMOVE_THEN "F3" (MP_TAC o SPEC `L:(A)loop`)\r
11748        THEN ASM_REWRITE_TAC[]\r
11749        THEN MESON_TAC[]; ALL_TAC]\r
11750    THEN SUBGOAL_THEN `(S:(A)loop->bool) = face_collection (H:(A)hypermap)` (LABEL_TAC "F5")\r
11751    THENL[SUBGOAL_THEN `(S:(A)loop->bool) SUBSET face_collection (H:(A)hypermap)` (LABEL_TAC "GG")\r
11752       THENL[EXPAND_TAC "S"\r
11753          THEN REWRITE_TAC[SUBSET; IN_ELIM_THM]\r
11754          THEN GEN_TAC\r
11755          THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (MP_TAC))\r
11756          THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_canonical_function th])\r
11757          THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "G3"))))\r
11758          THEN USE_THEN "G2" MP_TAC THEN USE_THEN "G1" MP_TAC THEN USE_THEN "F1" MP_TAC\r
11759          THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
11760          THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP lemma_cycle_eq)\r
11761          THEN USE_THEN "G1" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
11762          THEN DISCH_THEN (MP_TAC o CONJUNCT2)\r
11763          THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (LABEL_TAC "G5")))\r
11764          THEN REWRITE_TAC[face_collection; IN_ELIM_THM]\r
11765          THEN EXISTS_TAC `x:A`\r
11766          THEN USE_THEN "G3" (MP_TAC o SPEC `x:A`)\r
11767          THEN ASM_MESON_TAC[]; ALL_TAC]\r
11768       THEN MP_TAC (SPEC `H:(A)hypermap` lemma_card_face_collection)\r
11769       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))\r
11770       THEN USE_THEN "G1"(fun th->(USE_THEN "GG"(fun th1->(MP_TAC(MATCH_MP FINITE_SUBSET (CONJ th th1))))))\r
11771       THEN DISCH_THEN (MP_TAC o ISPEC `t:(A)loop->((A->bool)->bool)` o  MATCH_MP CARD_IMAGE_LE)\r
11772       THEN REMOVE_THEN "F4" SUBST1_TAC\r
11773       THEN REMOVE_THEN "F2" (fun th-> (DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP LE_TRANS (CONJ th  th1)))))\r
11774       THEN POP_ASSUM (SUBST1_TAC o SYM)\r
11775       THEN USE_THEN "GG"(fun th->(USE_THEN "G1"(fun th1->(MP_TAC(MATCH_MP CARD_SUBSET (CONJ th th1))))))\r
11776       THEN REWRITE_TAC[IMP_IMP]\r
11777       THEN DISCH_THEN (LABEL_TAC "G3" o REWRITE_RULE[LE_ANTISYM])\r
11778       THEN MATCH_MP_TAC CARD_SUBSET_EQ\r
11779       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11780    THEN SUBGOAL_THEN `S:(A)loop->bool SUBSET NF:(A)loop->bool` (LABEL_TAC "F6")\r
11781    THENL[EXPAND_TAC "S" THEN SET_TAC[]; ALL_TAC]\r
11782    THEN SUBGOAL_THEN `S:(A)loop->bool = NF:(A)loop->bool` (LABEL_TAC "F7")\r
11783    THENL[MATCH_MP_TAC SUBSET_ANTISYM\r
11784      THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th])\r
11785      THEN REWRITE_TAC[SUBSET]\r
11786      THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "G7")\r
11787      THEN USE_THEN "G7" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `x:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
11788      THEN DISCH_THEN (MP_TAC o CONJUNCT2)\r
11789      THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G9") (LABEL_TAC "G10"))) \r
11790      THEN SUBGOAL_THEN `face_loop (H:(A)hypermap) (y:A) IN face_collection H` MP_TAC\r
11791      THENL[REWRITE_TAC[face_collection;IN_ELIM_THM]\r
11792          THEN EXISTS_TAC `y:A` THEN USE_THEN "G9" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
11793      THEN REMOVE_THEN "F5" (SUBST1_TAC o SYM)\r
11794      THEN DISCH_THEN (LABEL_TAC "G11")\r
11795      THEN SUBGOAL_THEN `y:A belong face_loop (H:(A)hypermap) y` (LABEL_TAC "G12")\r
11796      THENL[REWRITE_TAC[belong; face_loop_rep; face; orbit_reflect]; ALL_TAC]\r
11797      THEN ABBREV_TAC `L' = face_loop (H:(A)hypermap) y`\r
11798      THEN SUBGOAL_THEN `x:(A)loop = L'` SUBST1_TAC\r
11799      THENL[MATCH_MP_TAC disjoint_loops\r
11800         THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A`\r
11801         THEN ASM_REWRITE_TAC[]\r
11802         THEN USE_THEN "F6"(fun th-> (USE_THEN "G11" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)]))); ALL_TAC]\r
11803      THEN USE_THEN "G11" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
11804    THEN STRIP_TAC\r
11805    THENL[USE_THEN "F7" (SUBST1_TAC o SYM) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
11806    THEN SUBGOAL_THEN `is_edge_nondegenerate (H:(A)hypermap)` (LABEL_TAC "F8")\r
11807    THENL[REWRITE_TAC[lemma_edge_nondegenerate]\r
11808       THEN GEN_TAC\r
11809       THEN DISCH_THEN (LABEL_TAC "G1")\r
11810       THEN SUBGOAL_THEN `x:A belong  face_loop (H:(A)hypermap) x`  (LABEL_TAC "G2")\r
11811       THENL[REWRITE_TAC[belong; face_loop_rep; face; orbit_reflect]; ALL_TAC]\r
11812       THEN SUBGOAL_THEN `face_loop (H:(A)hypermap) x IN face_collection H`  MP_TAC\r
11813       THENL[REWRITE_TAC[face_collection; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11814       THEN ABBREV_TAC `L = face_loop (H:(A)hypermap) x`\r
11815       THEN USE_THEN "F5" (SUBST1_TAC o SYM)\r
11816       THEN EXPAND_TAC "S"\r
11817       THEN REWRITE_TAC[IN_ELIM_THM]\r
11818       THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G3") MP_TAC)\r
11819       THEN USE_THEN "F1"(fun th ->REWRITE_TAC[MATCH_MP lemma_canonical_function th])\r
11820       THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "G5"))))\r
11821       THEN REMOVE_THEN "G4" MP_TAC THEN USE_THEN "G3" MP_TAC THEN USE_THEN "F1" MP_TAC\r
11822       THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
11823       THEN DISCH_THEN (SUBST_ALL_TAC o SYM o MATCH_MP lemma_cycle_eq)\r
11824       THEN POP_ASSUM (MP_TAC o SPEC `x:A`)\r
11825       THEN USE_THEN "G2" (fun th -> REWRITE_TAC[th])\r
11826       THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2)\r
11827       THEN USE_THEN "F1"(fun th->USE_THEN "G3"(fun th1->(USE_THEN "G2" (fun th2 -> MP_TAC(MATCH_MP value_next_of_head (CONJ th (CONJ th1 th2)))))))\r
11828       THEN USE_THEN "F1"(fun th->USE_THEN "G3"(fun th1->(USE_THEN "G2" (fun th2 -> MP_TAC(MATCH_MP head_on_loop (CONJ th (CONJ th1 th2)))))))\r
11829       THEN POP_ASSUM SUBST1_TAC\r
11830       THEN REWRITE_TAC[IN_SING]\r
11831       THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) (MP_TAC))\r
11832       THEN POP_ASSUM SUBST1_TAC\r
11833       THEN DISCH_TAC\r
11834       THEN DISCH_THEN (SUBST1_TAC o SYM)\r
11835       THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
11836     THEN SUBGOAL_THEN `!x:A. x IN dart H ==> (?y:A. y IN dart H /\ y IN face H x /\ ~(node H x = node H y))` MP_TAC\r
11837     THENL[ GEN_TAC\r
11838       THEN DISCH_THEN (LABEL_TAC "G1")\r
11839       THEN SUBGOAL_THEN `x:A belong face_loop (H:(A)hypermap) x` (LABEL_TAC "G2")\r
11840       THENL[REWRITE_TAC[belong; face_loop_rep; face; orbit_reflect]; ALL_TAC]\r
11841       THEN SUBGOAL_THEN `face_loop (H:(A)hypermap) x IN face_collection (H:(A)hypermap)` MP_TAC\r
11842       THENL[REWRITE_TAC[face_collection; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11843       THEN USE_THEN "F5" (SUBST1_TAC o SYM)\r
11844       THEN USE_THEN "F7" SUBST1_TAC\r
11845       THEN DISCH_THEN (LABEL_TAC "G3")\r
11846       THEN REWRITE_TAC[GSYM face_loop_rep; GSYM belong]\r
11847       THEN ABBREV_TAC `L = face_loop (H:(A)hypermap) x`\r
11848       THEN ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`]\r
11849       THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [NOT_EXISTS_THM; DE_MORGAN_THM; TAUT `~ ~A <=> A`]\r
11850       THEN STRIP_TAC\r
11851       THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC\r
11852       THENL[REWRITE_TAC[SUBSET; GSYM belong]\r
11853          THEN GEN_TAC\r
11854          THEN POP_ASSUM (LABEL_TAC "G20")\r
11855          THEN DISCH_THEN (LABEL_TAC "G21")\r
11856          THEN REMOVE_THEN "G20" (MP_TAC o SPEC `x':A`)\r
11857          THEN USE_THEN "F1"(fun th->(USE_THEN "G3"(fun th2->(USE_THEN "G21"(fun th3-> ASSUME_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th2 th3))))))))\r
11858          THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th]))\r
11859          THEN DISCH_THEN SUBST1_TAC\r
11860          THEN REWRITE_TAC[node; orbit_reflect]; ALL_TAC]\r
11861       THEN USE_THEN "F1" (fun th -> (USE_THEN "G3" (fun th1-> REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))); ALL_TAC]\r
11862    THEN USE_THEN "F7" (SUBST1_TAC o SYM)\r
11863    THEN USE_THEN "F5" SUBST1_TAC\r
11864    THEN POP_ASSUM MP_TAC\r
11865    THEN REWRITE_TAC[IMP_IMP]\r
11866    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP face_quotient_lemma th]));;\r
11867 \r
11868 (* Cyclic hypermaps *)\r
11869 \r
11870 let edge_cyclic_map_lemma = prove(`!p:num->A q:num->A k:num. ?e:A->A. !x:A. ((~(x IN ((support_list p k) UNION (support_list q k))) ==> e x = x) /\\r
11871 (x IN ((support_list p k) UNION (support_list q k)) ==> (x IN support_list p k ==> ?j:num. j <= k /\ x = p j /\ e x = q (SUC j MOD (SUC k))) /\ (~(x IN support_list p k) ==> ?j:num. j <= k /\ x = q j /\ e x = p ((j+k) MOD (SUC k)))))`,\r
11872    REPEAT GEN_TAC\r
11873    THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
11874    THEN GEN_TAC\r
11875    THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))`\r
11876    THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11877    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
11878    THEN ASM_REWRITE_TAC[]\r
11879    THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[IN_UNION])\r
11880    THEN ASM_CASES_TAC `x:A IN support_list (p:num->A) (k:num)`\r
11881    THENL[ASM_REWRITE_TAC[]\r
11882       THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
11883       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM])\r
11884       THEN STRIP_TAC THEN EXISTS_TAC `i:num`\r
11885       THEN EXISTS_TAC `(q:num->A) (SUC i MOD SUC k)`\r
11886       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11887    THEN ASM_REWRITE_TAC[]\r
11888    THEN REMOVE_THEN "F1" MP_TAC\r
11889    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
11890    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM])\r
11891    THEN STRIP_TAC\r
11892    THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
11893    THEN EXISTS_TAC `i:num`\r
11894    THEN EXISTS_TAC `(p:num->A) (((i:num) + (k:num)) MOD (SUC k))`\r
11895    THEN ASM_REWRITE_TAC[]);;\r
11896 \r
11897 let node_cyclic_map_lemma = prove(`!p:num->A q:num->A k:num. ?n:A->A. !x:A. ((~(x IN ((support_list p k) UNION (support_list q k))) ==> n x = x) /\\r
11898 ((x IN ((support_list p k) UNION (support_list q k)) ==> ((x IN support_list p k ==> ?j:num. j <= k /\ x = p j /\ n x = q j)) /\ (~(x IN support_list p k) ==> ?j:num. j <= k /\ x = q j /\ n x = p j))))`,\r
11899    REPEAT GEN_TAC\r
11900    THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
11901    THEN GEN_TAC\r
11902    THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))`\r
11903    THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11904    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
11905    THEN ASM_REWRITE_TAC[]\r
11906    THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[IN_UNION])\r
11907    THEN ASM_CASES_TAC `x:A IN support_list (p:num->A) (k:num)`\r
11908    THENL[ASM_REWRITE_TAC[]\r
11909       THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
11910       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM])\r
11911       THEN STRIP_TAC THEN EXISTS_TAC `i:num`\r
11912       THEN EXISTS_TAC `(q:num->A) i`\r
11913       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11914    THEN ASM_REWRITE_TAC[]\r
11915    THEN REMOVE_THEN "F1" MP_TAC\r
11916    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
11917    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM])\r
11918    THEN STRIP_TAC\r
11919    THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
11920    THEN EXISTS_TAC `i:num`\r
11921    THEN EXISTS_TAC `(p:num->A) i`\r
11922    THEN ASM_REWRITE_TAC[]);;\r
11923 \r
11924 let face_cyclic_map_lemma = prove(`!p:num->A q:num->A k:num. ?f:A->A. !x:A. ((~(x IN ((support_list p k) UNION (support_list q k))) ==> f x = x) /\\r
11925 (x IN ((support_list p k) UNION (support_list q k)) ==> (x IN support_list p k ==> ?j:num. j <= k /\ x = p j /\ f x = p ((SUC j) MOD (SUC k))) /\ (~(x IN support_list p k) ==> ?j:num. j <= k /\ x = q j /\ f x = q ((j + k) MOD (SUC k)))))`,\r
11926    REPEAT GEN_TAC\r
11927    THEN REWRITE_TAC[GSYM SKOLEM_THM]\r
11928    THEN GEN_TAC\r
11929    THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))`\r
11930    THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11931    THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[])\r
11932    THEN ASM_REWRITE_TAC[]\r
11933    THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[IN_UNION])\r
11934    THEN ASM_CASES_TAC `x:A IN support_list (p:num->A) (k:num)`\r
11935    THENL[ASM_REWRITE_TAC[]\r
11936       THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
11937       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM])\r
11938       THEN STRIP_TAC THEN EXISTS_TAC `i:num`\r
11939       THEN EXISTS_TAC `(p:num->A) ((SUC i) MOD (SUC k))`\r
11940       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
11941    THEN ASM_REWRITE_TAC[]\r
11942    THEN REMOVE_THEN "F1" MP_TAC\r
11943    THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
11944    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM])\r
11945    THEN STRIP_TAC\r
11946    THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM]\r
11947    THEN EXISTS_TAC `i:num`\r
11948    THEN EXISTS_TAC `(q:num->A) ((i + k) MOD (SUC k))`\r
11949    THEN ASM_REWRITE_TAC[]);;\r
11950 \r
11951 let lemma_cyclic_edge_map = new_specification ["cyc_emap"] (REWRITE_RULE[SKOLEM_THM] edge_cyclic_map_lemma);;\r
11952 \r
11953 let lemma_cyclic_node_map = new_specification ["cyc_nmap"] (REWRITE_RULE[SKOLEM_THM] node_cyclic_map_lemma);;\r
11954 \r
11955 let lemma_cyclic_face_map = new_specification ["cyc_fmap"] (REWRITE_RULE[SKOLEM_THM] face_cyclic_map_lemma);;\r
11956 \r
11957 let lemma_cyclic_emap = prove(`!p:num->A q:num->A k:num. is_inj_list p k /\ is_inj_list q k /\ is_disjoint p q k k \r
11958     ==> (!i:num. i <= k ==> cyc_emap p q k (p i) = (q (SUC i MOD SUC k)) /\ cyc_emap p q k (q i) = p ((i+k) MOD SUC k))`,\r
11959  REPEAT GEN_TAC\r
11960    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
11961    THEN GEN_TAC\r
11962    THEN DISCH_THEN (LABEL_TAC "F4")\r
11963    THEN STRIP_TAC\r
11964    THENL[MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(p:num->A) i`] lemma_cyclic_edge_map))\r
11965        THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `p:num->A` lemma_element_in_list) th))\r
11966        THEN SUBGOAL_THEN `(p:num->A) i IN (support_list p (k:num) UNION support_list (q:num->A) k)` (fun th -> REWRITE_TAC[th])\r
11967        THENL[REWRITE_TAC[IN_UNION; GSYM in_list]\r
11968            THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
11969        THEN USE_THEN "F5" (fun th -> REWRITE_TAC[REWRITE_RULE[in_list] th])\r
11970        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC)))\r
11971        THEN USE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`] o  REWRITE_RULE[lemma_inj_list2])\r
11972        THEN ASM_REWRITE_TAC[]\r
11973        THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
11974    THEN MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(q:num->A) i`] lemma_cyclic_edge_map))\r
11975    THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `q:num->A` lemma_element_in_list) th))\r
11976    THEN SUBGOAL_THEN `(q:num->A) i IN (support_list p (k:num) UNION support_list (q:num->A) k)` (fun th -> REWRITE_TAC[th])\r
11977    THENL[REWRITE_TAC[IN_UNION; GSYM in_list]\r
11978        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
11979    THEN SUBGOAL_THEN `~((q:num->A) i IN (support_list p (k:num)))`(fun th -> REWRITE_TAC[th])\r
11980    THENL[REWRITE_TAC[GSYM in_list]\r
11981        THEN USE_THEN "F3" (MP_TAC o SPEC `i:num` o REWRITE_RULE[lemma_list_disjoint2])\r
11982        THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]); ALL_TAC]\r
11983    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC)))\r
11984    THEN USE_THEN "F2" (MP_TAC o SPECL[`j:num`; `i:num`] o  REWRITE_RULE[lemma_inj_list2])\r
11985    THEN ASM_REWRITE_TAC[]\r
11986    THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;\r
11987 \r
11988 let lemma_cyclic_nmap = prove(`!p:num->A q:num->A k:num. is_inj_list p k /\ is_inj_list q k /\ is_disjoint p q k k \r
11989    ==> (!i:num. i <= k ==> cyc_nmap p q k (p i) = q i /\ cyc_nmap p q k (q i) = p i)`,\r
11990  REPEAT GEN_TAC\r
11991    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
11992    THEN GEN_TAC\r
11993    THEN DISCH_THEN (LABEL_TAC "F4")\r
11994    THEN STRIP_TAC\r
11995    THENL[MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(p:num->A) i`] lemma_cyclic_node_map)) \r
11996        THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `p:num->A` lemma_element_in_list) th))\r
11997        THEN SUBGOAL_THEN `(p:num->A) i IN (support_list p (k:num) UNION support_list (q:num->A) k)` (fun th -> REWRITE_TAC[th])\r
11998        THENL[REWRITE_TAC[IN_UNION; GSYM in_list]\r
11999            THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12000        THEN USE_THEN "F5" (fun th -> REWRITE_TAC[REWRITE_RULE[in_list] th])\r
12001        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC)))\r
12002        THEN USE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`] o  REWRITE_RULE[lemma_inj_list2])\r
12003        THEN ASM_REWRITE_TAC[]\r
12004        THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
12005    THEN MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(q:num->A) i`] lemma_cyclic_node_map))\r
12006    THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `q:num->A` lemma_element_in_list) th))\r
12007    THEN SUBGOAL_THEN `(q:num->A) i IN (support_list p (k:num) UNION support_list (q:num->A) k)` (fun th -> REWRITE_TAC[th])\r
12008    THENL[REWRITE_TAC[IN_UNION; GSYM in_list]\r
12009        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12010    THEN SUBGOAL_THEN `~((q:num->A) i IN (support_list p (k:num)))`(fun th -> REWRITE_TAC[th])\r
12011    THENL[REWRITE_TAC[GSYM in_list]\r
12012        THEN USE_THEN "F3" (MP_TAC o SPEC `i:num` o REWRITE_RULE[lemma_list_disjoint2])\r
12013        THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12014    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC)))\r
12015    THEN USE_THEN "F2" (MP_TAC o SPECL[`j:num`; `i:num`] o  REWRITE_RULE[lemma_inj_list2])\r
12016    THEN ASM_REWRITE_TAC[]\r
12017    THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;\r
12018 \r
12019 let lemma_cyclic_fmap = prove(`!p:num->A q:num->A k:num. is_inj_list p k /\ is_inj_list q k /\ is_disjoint p q k k \r
12020    ==> (!i:num. i <= k ==> cyc_fmap p q k (p i) = (p (SUC i MOD SUC k)) /\ cyc_fmap p q k (q i) = q ((i+k) MOD SUC k))`,\r
12021  REPEAT GEN_TAC\r
12022    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
12023    THEN GEN_TAC\r
12024    THEN DISCH_THEN (LABEL_TAC "F4")\r
12025    THEN STRIP_TAC\r
12026    THENL[MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(p:num->A) i`] lemma_cyclic_face_map))\r
12027        THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `p:num->A` lemma_element_in_list) th))\r
12028        THEN SUBGOAL_THEN `(p:num->A) i IN (support_list p (k:num) UNION support_list (q:num->A) k)` (fun th -> REWRITE_TAC[th])\r
12029        THENL[REWRITE_TAC[IN_UNION; GSYM in_list]\r
12030            THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12031        THEN USE_THEN "F5" (fun th -> REWRITE_TAC[REWRITE_RULE[in_list] th])\r
12032        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC)))\r
12033        THEN USE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`] o  REWRITE_RULE[lemma_inj_list2])\r
12034        THEN ASM_REWRITE_TAC[]\r
12035        THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
12036    THEN MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(q:num->A) i`] lemma_cyclic_face_map))\r
12037    THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `q:num->A` lemma_element_in_list) th))\r
12038    THEN SUBGOAL_THEN `(q:num->A) i IN (support_list p (k:num) UNION support_list (q:num->A) k)` (fun th -> REWRITE_TAC[th])\r
12039    THENL[REWRITE_TAC[IN_UNION; GSYM in_list]\r
12040        THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12041    THEN SUBGOAL_THEN `~((q:num->A) i IN (support_list p (k:num)))`(fun th -> REWRITE_TAC[th])\r
12042    THENL[REWRITE_TAC[GSYM in_list]\r
12043        THEN USE_THEN "F3" (MP_TAC o SPEC `i:num` o REWRITE_RULE[lemma_list_disjoint2])\r
12044        THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12045    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC)))\r
12046    THEN USE_THEN "F2" (MP_TAC o SPECL[`j:num`; `i:num`] o  REWRITE_RULE[lemma_inj_list2])\r
12047    THEN ASM_REWRITE_TAC[]\r
12048    THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;\r
12049 \r
12050 let cyclic_hypermap = new_definition `!p:num->A q:num->A k:num. cyclic_hypermap p q k \r
12051     = hypermap(support_list p k UNION support_list q k, cyc_emap p q k, cyc_nmap p q k, cyc_fmap p q k)`;; \r
12052 \r
12053 let lemma_cyclic_hypermap = prove(`!p:num->A q:num->A k:num. is_inj_list p k /\ is_inj_list q k /\ is_disjoint p q k k ==> dart (cyclic_hypermap p q k) = support_list p k UNION support_list q k /\ edge_map (cyclic_hypermap p q k) = cyc_emap p q k /\ node_map (cyclic_hypermap p q k) = cyc_nmap p q k /\ face_map (cyclic_hypermap p q k) = cyc_fmap p q k`,\r
12054   REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FF")\r
12055    THEN REWRITE_TAC[cyclic_hypermap]\r
12056    THEN MATCH_MP_TAC lemma_hypermap_rep\r
12057    THEN SUBGOAL_THEN `FINITE (support_list (p:num->A) (k:num) UNION support_list (q:num->A) k)` (LABEL_TAC "F1")\r
12058    THENL[REWRITE_TAC[FINITE_UNION; lemma_finite_list]; ALL_TAC]\r
12059    THEN USE_THEN "F1" (fun th->REWRITE_TAC[th])\r
12060    THEN STRIP_TAC\r
12061    THENL[MATCH_MP_TAC lemma_permutes_via_surjetive\r
12062        THEN USE_THEN "F1" (fun th->REWRITE_TAC[th])\r
12063        THEN REWRITE_TAC[lemma_cyclic_edge_map]\r
12064        THEN STRIP_TAC\r
12065        THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]\r
12066            THEN STRIP_TAC\r
12067            THENL[DISJ2_TAC\r
12068                THEN POP_ASSUM SUBST1_TAC\r
12069                THEN EXISTS_TAC `SUC i  MOD SUC k`\r
12070                THEN REWRITE_TAC[LE_MOD_SUC]\r
12071                THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_emap)\r
12072                THEN POP_ASSUM (fun th->REWRITE_TAC[th])\r
12073                THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1)\r
12074                THEN SIMP_TAC[]; ALL_TAC]\r
12075            THEN DISJ1_TAC\r
12076            THEN POP_ASSUM SUBST1_TAC\r
12077            THEN EXISTS_TAC `((i:num) + (k:num)) MOD SUC k`\r
12078            THEN REWRITE_TAC[LE_MOD_SUC]\r
12079            THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_emap)\r
12080            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
12081            THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) THEN SIMP_TAC[]; ALL_TAC]\r
12082        THEN GEN_TAC\r
12083        THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]\r
12084        THEN STRIP_TAC\r
12085        THENL[POP_ASSUM SUBST1_TAC\r
12086            THEN EXISTS_TAC `(q:num->A) (SUC i MOD SUC k)`\r
12087            THEN USE_THEN "FF" (MP_TAC o CONJUNCT2 o REWRITE_RULE[LE_MOD_SUC] o SPEC `SUC i MOD SUC k` o MATCH_MP lemma_cyclic_emap)\r
12088            THEN DISCH_THEN SUBST1_TAC\r
12089            THEN AP_TERM_TAC\r
12090            THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [GSYM(MATCH_MP MOD_LT (SPEC `k:num` LT_PLUS))]\r
12091            THEN REWRITE_TAC[MATCH_MP MOD_ADD_MOD (SPEC `k:num` NON_ZERO)]\r
12092            THEN REWRITE_TAC[ADD]\r
12093            THEN REWRITE_TAC[GSYM ADD_SUC]\r
12094            THEN ONCE_REWRITE_TAC[ADD_SYM]\r
12095            THEN REWRITE_TAC[(REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC k`; `i:num`] MOD_MULT_ADD))]\r
12096            THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (REWRITE_RULE[GSYM LT_SUC_LE] th)]); ALL_TAC]\r
12097        THEN POP_ASSUM SUBST1_TAC\r
12098        THEN EXISTS_TAC `(p:num->A) (((i:num) + k) MOD SUC k)`\r
12099        THEN USE_THEN "FF" (MP_TAC o CONJUNCT1 o REWRITE_RULE[LE_MOD_SUC] o SPEC `((i:num) + k) MOD SUC k` o MATCH_MP lemma_cyclic_emap)\r
12100        THEN DISCH_THEN SUBST1_TAC\r
12101        THEN POP_ASSUM (fun th->REWRITE_TAC[MATCH_MP lemma_from_index th]); ALL_TAC]\r
12102    THEN STRIP_TAC\r
12103    THENL[MATCH_MP_TAC lemma_permutes_via_surjetive\r
12104        THEN USE_THEN "F1" (fun th->REWRITE_TAC[th])\r
12105        THEN REWRITE_TAC[lemma_cyclic_node_map]\r
12106        THEN STRIP_TAC\r
12107        THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]\r
12108            THEN STRIP_TAC\r
12109            THENL[DISJ2_TAC\r
12110                THEN POP_ASSUM SUBST1_TAC\r
12111                THEN EXISTS_TAC `i:num`\r
12112                THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_nmap)\r
12113                THEN POP_ASSUM (fun th->REWRITE_TAC[th])\r
12114                THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1)\r
12115                THEN SIMP_TAC[]; ALL_TAC]\r
12116            THEN DISJ1_TAC\r
12117            THEN POP_ASSUM SUBST1_TAC\r
12118            THEN EXISTS_TAC `i:num`\r
12119            THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_nmap)\r
12120            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
12121            THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) THEN SIMP_TAC[]; ALL_TAC]\r
12122        THEN GEN_TAC\r
12123        THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]\r
12124        THEN STRIP_TAC\r
12125        THENL[POP_ASSUM SUBST1_TAC\r
12126            THEN EXISTS_TAC `(q:num->A) i`\r
12127            THEN POP_ASSUM(fun th1-> USE_THEN "FF"(MP_TAC o CONJUNCT2 o REWRITE_RULE[th1] o SPEC `i:num` o MATCH_MP lemma_cyclic_nmap))\r
12128            THEN SIMP_TAC[]; ALL_TAC]\r
12129        THEN POP_ASSUM SUBST1_TAC\r
12130        THEN EXISTS_TAC `(p:num->A) i`\r
12131        THEN POP_ASSUM (fun th-> (USE_THEN "FF" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `i:num` o MATCH_MP lemma_cyclic_nmap)))\r
12132        THEN SIMP_TAC[]; ALL_TAC]\r
12133    THEN STRIP_TAC\r
12134    THENL[MATCH_MP_TAC lemma_permutes_via_surjetive\r
12135        THEN USE_THEN "F1" (fun th->REWRITE_TAC[th])\r
12136        THEN REWRITE_TAC[lemma_cyclic_face_map]\r
12137        THEN STRIP_TAC\r
12138        THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]\r
12139            THEN STRIP_TAC\r
12140            THENL[DISJ1_TAC\r
12141                THEN POP_ASSUM SUBST1_TAC\r
12142                THEN EXISTS_TAC `SUC i  MOD SUC k`\r
12143                THEN REWRITE_TAC[LE_MOD_SUC]\r
12144                THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_fmap)\r
12145                THEN POP_ASSUM (fun th->REWRITE_TAC[th])\r
12146                THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1)\r
12147                THEN SIMP_TAC[]; ALL_TAC]\r
12148            THEN DISJ2_TAC\r
12149            THEN POP_ASSUM SUBST1_TAC\r
12150            THEN EXISTS_TAC `((i:num) + (k:num)) MOD SUC k`\r
12151            THEN REWRITE_TAC[LE_MOD_SUC]\r
12152            THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_fmap)\r
12153            THEN POP_ASSUM (fun th -> REWRITE_TAC[th])\r
12154            THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) THEN SIMP_TAC[]; ALL_TAC]\r
12155        THEN GEN_TAC\r
12156        THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]\r
12157        THEN STRIP_TAC\r
12158        THENL[POP_ASSUM SUBST1_TAC\r
12159            THEN EXISTS_TAC `(p:num->A) (((i:num) + (k:num)) MOD SUC k)`\r
12160            THEN USE_THEN "FF" (MP_TAC o CONJUNCT1 o REWRITE_RULE[LE_MOD_SUC] o SPEC `((i:num) + k) MOD SUC k` o MATCH_MP lemma_cyclic_fmap)\r
12161            THEN DISCH_THEN SUBST1_TAC\r
12162            THEN AP_TERM_TAC\r
12163            THEN POP_ASSUM (fun th->REWRITE_TAC[MATCH_MP lemma_from_index th]); ALL_TAC]\r
12164        THEN POP_ASSUM SUBST1_TAC\r
12165        THEN EXISTS_TAC `(q:num->A) (SUC i MOD SUC k)`\r
12166        THEN USE_THEN "FF" (MP_TAC o CONJUNCT2 o REWRITE_RULE[LE_MOD_SUC] o SPEC `SUC i MOD SUC k` o MATCH_MP lemma_cyclic_fmap)\r
12167        THEN DISCH_THEN SUBST1_TAC\r
12168        THEN AP_TERM_TAC\r
12169        THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma_from_index2 th]); ALL_TAC]\r
12170    THEN REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM]\r
12171    THEN GEN_TAC\r
12172    THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))`\r
12173    THENL[POP_ASSUM (LABEL_TAC "G10")\r
12174        THEN MP_TAC (CONJUNCT1(SPECL[`p:num->A`; `q:num->A`; `k:num`; `x:A`] lemma_cyclic_face_map))\r
12175        THEN USE_THEN "G10" (fun th-> REWRITE_TAC[th])\r
12176        THEN DISCH_THEN SUBST1_TAC\r
12177        THEN MP_TAC (CONJUNCT1(SPECL[`p:num->A`; `q:num->A`; `k:num`; `x:A`] lemma_cyclic_node_map))\r
12178        THEN USE_THEN "G10" (fun th-> REWRITE_TAC[th])\r
12179        THEN DISCH_THEN SUBST1_TAC\r
12180        THEN MP_TAC (CONJUNCT1(SPECL[`p:num->A`; `q:num->A`; `k:num`; `x:A`] lemma_cyclic_edge_map))\r
12181        THEN USE_THEN "G10" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12182    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[IN_UNION; support_list; IN_ELIM_THM])\r
12183    THEN STRIP_TAC\r
12184    THENL[POP_ASSUM SUBST1_TAC\r
12185        THEN POP_ASSUM (LABEL_TAC "H1")\r
12186        THEN USE_THEN "H1" (fun th-> USE_THEN "FF" (SUBST1_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `i:num` o MATCH_MP lemma_cyclic_fmap))\r
12187        THEN USE_THEN "FF" (SUBST1_TAC o CONJUNCT1 o REWRITE_RULE[LE_MOD_SUC] o SPEC `SUC i MOD SUC k` o MATCH_MP lemma_cyclic_nmap)\r
12188        THEN USE_THEN "FF" (SUBST1_TAC o CONJUNCT2 o REWRITE_RULE[LE_MOD_SUC] o SPEC `SUC i MOD SUC k` o MATCH_MP lemma_cyclic_emap)\r
12189        THEN AP_TERM_TAC\r
12190        THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma_from_index2 th]); ALL_TAC]\r
12191    THEN POP_ASSUM SUBST1_TAC\r
12192    THEN POP_ASSUM (LABEL_TAC "H1")\r
12193    THEN USE_THEN "H1" (fun th-> USE_THEN "FF" (SUBST1_TAC o CONJUNCT2 o REWRITE_RULE[th] o SPEC `i:num` o MATCH_MP lemma_cyclic_fmap))\r
12194    THEN USE_THEN "FF" (SUBST1_TAC o CONJUNCT2 o REWRITE_RULE[LE_MOD_SUC] o SPEC `((i:num) + k)  MOD SUC k` o MATCH_MP lemma_cyclic_nmap)\r
12195    THEN USE_THEN "FF" (SUBST1_TAC o CONJUNCT1 o REWRITE_RULE[LE_MOD_SUC] o SPEC `((i:num) +k) MOD SUC k` o MATCH_MP lemma_cyclic_emap)\r
12196    THEN AP_TERM_TAC\r
12197    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_from_index th]));;\r
12198 \r
12199 \r
12200 (* no double joints *)\r
12201 \r
12202 let is_no_double_joins = new_definition `is_no_double_joins (H:(A)hypermap) \r
12203    <=> (!x y. x IN dart H /\ y IN node H x /\ edge_map H y IN node H (edge_map H x) ==> x = y)`;;\r
12204 \r
12205 let margin_in_support_darts = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A. is_normal H NF /\ x IN support_darts NF \r
12206    ==> head H NF x IN support_darts NF /\ tail H NF x IN support_darts NF`,\r
12207    REPEAT GEN_TAC\r
12208    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support]))\r
12209    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))\r
12210    THEN STRIP_TAC\r
12211    THENL[MATCH_MP_TAC lemma_in_support2\r
12212       THEN EXISTS_TAC `L:(A)loop`\r
12213       THEN ASM_REWRITE_TAC[belong]\r
12214       THEN MATCH_MP_TAC lemma_in_subset\r
12215       THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
12216       THEN USE_THEN "F4"(fun th -> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th])\r
12217      THEN USE_THEN "F1"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2->REWRITE_TAC[CONJUNCT2(MATCH_MP change_to_margin (CONJ th (CONJ th1 th2)))])))\r
12218       THEN REWRITE_TAC[atom_reflect]; ALL_TAC]\r
12219    THEN MATCH_MP_TAC lemma_in_support2\r
12220    THEN EXISTS_TAC `L:(A)loop`\r
12221    THEN ASM_REWRITE_TAC[belong]\r
12222    THEN MATCH_MP_TAC lemma_in_subset\r
12223    THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
12224    THEN USE_THEN "F4" (fun th->REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th])\r
12225    THEN USE_THEN "F1"(fun th->USE_THEN "F3" (fun th1->USE_THEN "F4"(fun th2->REWRITE_TAC[CONJUNCT1(MATCH_MP change_to_margin (CONJ th (CONJ th1 th2)))])))\r
12226    THEN REWRITE_TAC[atom_reflect]);;\r
12227 \r
12228 let lemmaQuotientNoDoubleJoins = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF /\ is_no_double_joins H /\ plain_hypermap H \r
12229    ==> is_no_double_joins (quotient H NF)`,\r
12230    REPEAT GEN_TAC\r
12231    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
12232    THEN REWRITE_TAC[is_no_double_joins]\r
12233    THEN REPEAT GEN_TAC\r
12234    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))\r
12235    THEN USE_THEN "F5" (MP_TAC o MATCH_MP lemma_node_subset)\r
12236    THEN DISCH_THEN (fun th-> (USE_THEN "F6" (fun th1 -> LABEL_TAC "F8" (MATCH_MP lemma_in_subset (CONJ th th1)))))\r
12237    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_quotient)\r
12238    THEN DISCH_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC (SUBST_ALL_TAC o CONJUNCT1))\r
12239    THEN REMOVE_THEN "F5" MP_TAC\r
12240    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th])\r
12241    THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") MP_TAC))\r
12242    THEN USE_THEN "F1" (fun th -> ONCE_REWRITE_TAC[CONJUNCT2 (SPEC `a:A`(MATCH_MP choice_at_margin th))])\r
12243    THEN DISCH_THEN SUBST_ALL_TAC\r
12244    THEN REMOVE_THEN "F8" MP_TAC\r
12245    THEN USE_THEN "F1" (fun th-> ONCE_REWRITE_TAC[MATCH_MP atom_via_choice th])\r
12246    THEN DISCH_THEN (X_CHOOSE_THEN `b:A` (CONJUNCTS_THEN2 (LABEL_TAC "F8") MP_TAC))\r
12247    THEN USE_THEN "F1" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2 (SPEC `b:A`(MATCH_MP choice_at_margin th))])\r
12248    THEN DISCH_THEN SUBST_ALL_TAC\r
12249    THEN REMOVE_THEN "F7" MP_TAC\r
12250    THEN USE_THEN "F1" (fun th-> (USE_THEN "F5" (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1)))))\r
12251    THEN USE_THEN "F1"(fun th->GEN_REWRITE_TAC(LAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2 (SPEC `a:A`(MATCH_MP choice_at_margin th))])\r
12252    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC))\r
12253    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
12254    THEN USE_THEN "F1" (fun th-> (USE_THEN "F8" (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1)))))\r
12255    THEN USE_THEN "F1" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2 (SPEC `b:A`(MATCH_MP choice_at_margin th))])\r
12256    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F10") (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC))\r
12257    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
12258    THEN DISCH_THEN (LABEL_TAC "F7")\r
12259    THEN USE_THEN "F1" (fun th-> (REMOVE_THEN "F5" (fun th1-> (LABEL_TAC "F5" (CONJUNCT1 (MATCH_MP margin_in_support_darts (CONJ th th1)))))))\r
12260    THEN USE_THEN "F1" (fun th-> (REMOVE_THEN "F8" (fun th1-> (LABEL_TAC "F8" (CONJUNCT1 (MATCH_MP margin_in_support_darts (CONJ th th1)))))))\r
12261    THEN ABBREV_TAC `u = head (H:(A)hypermap) (NF:(A)loop->bool) (a:A)`\r
12262    THEN ABBREV_TAC `v = head (H:(A)hypermap) (NF:(A)loop->bool) (b:A)`\r
12263    THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F1" MP_TAC\r
12264    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
12265    THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_node3)\r
12266    THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F9" MP_TAC THEN USE_THEN "F1" MP_TAC\r
12267    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
12268    THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_node3)\r
12269    THEN REMOVE_THEN "F2" (MP_TAC o SPECL[`u:A`; `v:A`] o REWRITE_RULE[is_no_double_joins])\r
12270    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
12271    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
12272    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_finite_support)\r
12273    THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)]))\r
12274    THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;\r
12275 \r
12276 let lemmaSimpleQuotient = prove(`!H:(A)hypermap NF:(A)loop->bool. is_normal H NF \r
12277    ==> (simple_hypermap (quotient H NF) <=> (!L:(A)loop x:A y:A. L IN NF /\ x belong L /\ y belong L /\ y IN node H x ==> atom H L x = atom H L y))`,\r
12278    REPEAT GEN_TAC\r
12279    THEN DISCH_THEN (LABEL_TAC "F1")\r
12280    THEN EQ_TAC\r
12281    THENL[DISCH_THEN (LABEL_TAC "F2" o REWRITE_RULE[simple_hypermap])\r
12282        THEN REPEAT GEN_TAC\r
12283        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))))\r
12284        THEN REMOVE_THEN "F2" (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`)\r
12285        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
12286        THEN USE_THEN "F3" (fun th-> (USE_THEN "F4" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)])))\r
12287        THEN DISCH_THEN (LABEL_TAC "F2")\r
12288        THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1 -> MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th))))\r
12289        THEN USE_THEN "F1"(fun th->DISCH_THEN(fun th1->USE_THEN "F6"(fun th2->MP_TAC (MATCH_MP lemma_in_QuotientNode (CONJ th (CONJ th1 th2))))))\r
12290        THEN USE_THEN "F1"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2 ->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))\r
12291        THEN USE_THEN "F1"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F5"(fun th2 ->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))\r
12292        THEN DISCH_THEN (LABEL_TAC "F7")\r
12293        THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
12294        THEN USE_THEN "F1"(fun th->USE_THEN "F3"(fun th1->DISCH_THEN(fun th2->MP_TAC (MATCH_MP lemma_in_QuotientFace (CONJ th (CONJ th1 th2))))))\r
12295        THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
12296        THEN POP_ASSUM SUBST1_TAC\r
12297        THEN REWRITE_TAC[IN_SING; EQ_SYM]; ALL_TAC]\r
12298    THEN DISCH_THEN (LABEL_TAC "F2")\r
12299    THEN REWRITE_TAC[simple_hypermap]\r
12300    THEN GEN_TAC\r
12301    THEN DISCH_TAC\r
12302    THEN MATCH_MP_TAC SUBSET_ANTISYM\r
12303    THEN STRIP_TAC\r
12304    THENL[POP_ASSUM MP_TAC\r
12305        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
12306        THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
12307        THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) SUBST1_TAC)))\r
12308        THEN REWRITE_TAC[SUBSET; IN_SING]\r
12309        THEN GEN_TAC\r
12310        THEN REWRITE_TAC[IN_INTER]\r
12311        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") MP_TAC)\r
12312        THEN USE_THEN "F1"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2 ->REWRITE_TAC[MATCH_MP lemmaQF (CONJ th (CONJ th1 th2))])))\r
12313        THEN REWRITE_TAC[cycle; IN_ELIM_THM]\r
12314        THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F6") SUBST_ALL_TAC))\r
12315        THEN SUBGOAL_THEN `(y:A) IN node (H:(A)hypermap) (x:A)` (LABEL_TAC "F7")\r
12316        THENL[MATCH_MP_TAC lemma_in_node3\r
12317           THEN EXISTS_TAC `NF:(A)loop->bool`\r
12318           THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th])\r
12319           THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th)]))\r
12320           THEN USE_THEN "F1"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2 ->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))\r
12321           THEN USE_THEN "F1"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F6"(fun th2 ->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))\r
12322           THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12323        THEN REMOVE_THEN "F2" (MP_TAC o SPECL[`L:(A)loop`; `x:A`; `y:A`])\r
12324        THEN ASM_REWRITE_TAC[EQ_SYM]; ALL_TAC]\r
12325     THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_SING]\r
12326     THEN GEN_TAC\r
12327     THEN DISCH_THEN SUBST1_TAC\r
12328     THEN REWRITE_TAC[IN_INTER; node_refl; face_refl]\r
12329   );;\r
12330 \r
12331 let lemmaNodalFixedPoint = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). (is_normal H NF /\ simple_hypermap (quotient H NF) \r
12332   ==> (~(is_node_nondegenerate (quotient H NF)) <=> (?(L:(A)loop) x:A. L IN NF /\ x belong L /\ node H x SUBSET (dart_of L))))`,\r
12333    REPEAT GEN_TAC\r
12334    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
12335    THEN REWRITE_TAC[is_node_nondegenerate; NOT_FORALL_THM; NOT_IMP]\r
12336    THEN EQ_TAC\r
12337    THENL[USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
12338        THEN DISCH_THEN (X_CHOOSE_THEN `atm:A->bool` (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F3")))\r
12339        THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM]\r
12340        THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A`(CONJUNCTS_THEN2(CONJUNCTS_THEN2 (LABEL_TAC "F4")(LABEL_TAC "F5")) SUBST_ALL_TAC)))\r
12341        THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `x:A`\r
12342        THEN ASM_REWRITE_TAC[]\r
12343        THEN REMOVE_THEN "F3" MP_TAC\r
12344        THEN REWRITE_TAC[ISPEC `nmap (H:(A)hypermap) (NF:(A)loop->bool)`  orbit_one_point]\r
12345        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)])\r
12346        THEN REWRITE_TAC[GSYM node]\r
12347        THEN DISCH_THEN (LABEL_TAC "F6")\r
12348        THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (fun th1 -> (MP_TAC (MATCH_MP lemma_in_support2 (CONJ th th1)))))\r
12349        THEN USE_THEN "F1" (fun th->DISCH_THEN(fun th1-> (MP_TAC(MATCH_MP lemma_support_QN (CONJ th th1)))))\r
12350        THEN REWRITE_TAC[support_node]\r
12351        THEN USE_THEN "F1"(fun th->USE_THEN "F4"(fun th1->USE_THEN "F5"(fun th2 ->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))\r
12352        THEN POP_ASSUM SUBST1_TAC\r
12353        THEN REWRITE_TAC[UNIONS_1]\r
12354        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
12355        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th]); ALL_TAC]\r
12356    THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4")(CONJUNCTS_THEN2(LABEL_TAC "F5")(LABEL_TAC "F6")))))\r
12357    THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (fun th1 -> (LABEL_TAC "F7" (MATCH_MP lemma_in_support2 (CONJ th th1)))))\r
12358    THEN SUBGOAL_THEN `atom (H:(A)hypermap) (L:(A)loop) (x:A) = node H x` (LABEL_TAC "F8")\r
12359    THENL[MATCH_MP_TAC SUBSET_ANTISYM\r
12360        THEN REWRITE_TAC[lemma_atom_sub_node]\r
12361        THEN REWRITE_TAC[SUBSET] THEN GEN_TAC\r
12362        THEN DISCH_THEN (LABEL_TAC "G1")\r
12363        THEN USE_THEN "F6" (fun th-> USE_THEN "G1" (fun th1-> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1))))\r
12364        THEN REWRITE_TAC[GSYM belong]\r
12365        THEN DISCH_THEN (LABEL_TAC "G2")\r
12366        THEN USE_THEN "G2" (fun th-> USE_THEN "F4" (fun th1 -> (LABEL_TAC "G3" (MATCH_MP lemma_in_support2 (CONJ th th1)))))\r
12367        THEN USE_THEN "F1"(fun th->USE_THEN "F7"(fun th1->USE_THEN "G1"(fun th2->MP_TAC (MATCH_MP lemma_in_QuotientNode (CONJ th (CONJ th1 th2))))))\r
12368        THEN USE_THEN "F1"(fun th->USE_THEN "F4"(fun th1->USE_THEN "F5"(fun th2 ->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))\r
12369        THEN USE_THEN "F1"(fun th->USE_THEN "F4"(fun th1->USE_THEN "G2"(fun th2 ->REWRITE_TAC[MATCH_MP unique_choice (CONJ th (CONJ th1 th2))])))\r
12370        THEN DISCH_THEN (LABEL_TAC "G4")\r
12371        THEN USE_THEN "G2" MP_TAC\r
12372        THEN USE_THEN "F5" MP_TAC\r
12373        THEN REWRITE_TAC[IMP_IMP]\r
12374        THEN USE_THEN "F1"(fun th->USE_THEN "F4"(fun th1->DISCH_THEN(fun th2->MP_TAC (MATCH_MP lemma_in_QuotientFace (CONJ th (CONJ th1 th2))))))\r
12375        THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
12376        THEN USE_THEN "F2" (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` o  REWRITE_RULE[simple_hypermap])\r
12377        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
12378        THEN USE_THEN "F4"(fun th->USE_THEN "F5"(fun th1->REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)]))\r
12379        THEN DISCH_THEN SUBST1_TAC\r
12380        THEN REWRITE_TAC[IN_SING]\r
12381        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
12382        THEN REWRITE_TAC[atom_reflect]; ALL_TAC]\r
12383    THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
12384    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
12385    THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)]))\r
12386    THEN POP_ASSUM MP_TAC\r
12387    THEN USE_THEN "F1"(fun th->USE_THEN "F4"(fun th1->USE_THEN "F5"(fun th2 ->REWRITE_TAC[SYM(MATCH_MP unique_choice (CONJ th (CONJ th1 th2)))])))\r
12388    THEN DISCH_THEN (LABEL_TAC "F9")\r
12389    THEN USE_THEN "F1" (fun th-> USE_THEN "F7" (fun th1 -> REWRITE_TAC[CONJUNCT2(CONJUNCT2(MATCH_MP nmap_via_choice (CONJ th th1)))]))\r
12390    THEN USE_THEN "F1" (MP_TAC o SPEC `tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` o MATCH_MP choice_reflect)\r
12391    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1(SPEC `x:A` (MATCH_MP choice_at_margin th)))])\r
12392    THEN USE_THEN "F9" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
12393    THEN REWRITE_TAC[node; orbit_map; GE; LE_0; IN_ELIM_THM]\r
12394    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (MP_TAC o REWRITE_RULE[GSYM COM_POWER] o AP_TERM `node_map (H:(A)hypermap)`))\r
12395    THEN MP_TAC (AP_THM (SPECL[`n:num`; `node_map (H:(A)hypermap)`] COM_POWER) `x:A`)\r
12396    THEN REWRITE_TAC[o_THM]\r
12397    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
12398    THEN DISCH_TAC\r
12399    THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `SUC n`]lemma_in_node2)\r
12400    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
12401    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
12402    THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)])));;\r
12403 \r
12404 (* Complementary contours and complementary contour loops - name: complement. Only for face contours *)\r
12405 \r
12406 let ind = new_recursive_definition num_RECURSION \r
12407    `(!H:(A)hypermap x:A. ind H x 0 = 0) \r
12408     /\ (!H:(A)hypermap x:A n:num. ind H x (SUC n) = (ind H x n) + PRE(CARD (node H ((inverse (face_map H) POWER (SUC n)) x))))`;;\r
12409 \r
12410 let mirror = new_recursive_definition num_RECURSION `(!H:(A)hypermap x:A. mirror H x 0 = node_contour H (node_map H x)) /\(!H:(A)hypermap x:A n:num. mirror H x (SUC n) = join (mirror H x n) (node_contour H (inverse (node_map H) ((inverse (face_map H) POWER (SUC n)) x))) (ind H x n))`;;\r
12411 \r
12412 let complement = new_definition `!H:(A)hypermap x:A n:num. complement H x n = mirror H x n n`;;\r
12413 \r
12414 let lemma_node_nondegenerate = prove(`!H:(A)hypermap. is_node_nondegenerate H <=> (!x:A. x IN dart H ==> 2 <= CARD (node H x))`, \r
12415    GEN_TAC THEN EQ_TAC\r
12416    THENL[DISCH_THEN (LABEL_TAC "F1")\r
12417        THEN GEN_TAC THEN STRIP_TAC\r
12418        THEN MATCH_MP_TAC CARD_ATLEAST_2\r
12419        THEN EXISTS_TAC `node_map (H:(A)hypermap) (x:A)` THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[NODE_FINITE; node_refl]\r
12420        THEN REWRITE_TAC[REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `x:A`; `1`] lemma_in_node2)]\r
12421        THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A` o REWRITE_RULE[is_node_nondegenerate])\r
12422        THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
12423    THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[is_node_nondegenerate]\r
12424    THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A`)\r
12425    THEN POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[SPEC `node_map (H:(A)hypermap)` orbit_one_point])\r
12426    THEN REWRITE_TAC[GSYM node]\r
12427    THEN DISCH_THEN SUBST1_TAC\r
12428    THEN ASM_REWRITE_TAC[CARD_SINGLETON] THEN ARITH_TAC);;\r
12429 \r
12430 let lemma_in_node1 = prove(`!H:(A)hypermap x:A y:A. y IN node H x ==> node_map H y IN node H x`,\r
12431    REPEAT GEN_TAC\r
12432    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th])\r
12433    THEN MESON_TAC[lemma_in_node2; POWER_1]);;\r
12434 \r
12435 let lemma_increasing_index_one = prove(`!H:(A)hypermap x:A n:num. is_node_nondegenerate H /\ x IN dart H ==> ind H x n < ind H x (SUC n)`,\r
12436    REPLICATE_TAC 2 GEN_TAC\r
12437    THEN INDUCT_TAC\r
12438    THENL[REWRITE_TAC[ind; ONE; POWER; o_THM; I_THM; ADD ]\r
12439        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps))\r
12440        THEN DISCH_THEN (fun th-> POP_ASSUM (fun th1 -> MP_TAC (MATCH_MP (REWRITE_RULE[lemma_node_nondegenerate] th1) th)))\r
12441        THEN ARITH_TAC; ALL_TAC]\r
12442    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
12443    THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))\r
12444    THEN ASM_REWRITE_TAC[]\r
12445    THEN DISCH_THEN (LABEL_TAC "F3")\r
12446    THEN REWRITE_TAC[ind; LT_ADD]\r
12447    THEN MP_TAC (SPEC `SUC(SUC n)` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)))\r
12448    THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC)\r
12449    THEN REMOVE_THEN "F2" (MP_TAC o SPEC `j:num` o  MATCH_MP lemma_dart_invariant_power_face)\r
12450    THEN ABBREV_TAC `y:A = (face_map (H:(A)hypermap) POWER j) x` THEN DISCH_TAC\r
12451    THEN REMOVE_THEN "F1" (MP_TAC o SPEC `y:A` o  REWRITE_RULE[lemma_node_nondegenerate])\r
12452    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
12453    THEN ARITH_TAC);;\r
12454 \r
12455 let lemma_increasing_index = prove(`!H:(A)hypermap x:A n:num m:num. is_node_nondegenerate H /\ x IN dart H /\ n < m ==> ind H x n < ind H x m`,\r
12456  REPEAT GEN_TAC\r
12457    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC))\r
12458    THEN SPEC_TAC (`m:num`, `m:num`)\r
12459    THEN INDUCT_TAC THENL[REWRITE_TAC[LT]; ALL_TAC]\r
12460    THEN ASM_CASES_TAC `n:num = m:num`\r
12461    THENL[POP_ASSUM SUBST1_TAC\r
12462        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP lemma_increasing_index_one (CONJ th th1)])); ALL_TAC]\r
12463    THEN DISCH_THEN(fun th-> POP_ASSUM(fun th1-> ASSUME_TAC(REWRITE_RULE[GSYM LT_LE] (CONJ (REWRITE_RULE[LT_SUC_LE] th) th1))))\r
12464    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC(SPEC `m:num` (MATCH_MP lemma_increasing_index_one (CONJ th th1)))))\r
12465    THEN POP_ASSUM (fun th-> POP_ASSUM (fun thm -> MP_TAC (MATCH_MP thm th)))\r
12466    THEN REWRITE_TAC[IMP_IMP; LT_TRANS]);;\r
12467 \r
12468 let lemma_lower_bound_index = prove(`!H:(A)hypermap x:A n:num. is_node_nondegenerate H /\ x IN dart H ==> n <=  ind H x n`,\r
12469    REPLICATE_TAC 2 GEN_TAC\r
12470    THEN INDUCT_TAC\r
12471    THENL[REWRITE_TAC[LE_0]; ALL_TAC]\r
12472    THEN POP_ASSUM (fun thm-> (DISCH_THEN (fun th-> MP_TAC (MATCH_MP thm th) THEN ASSUME_TAC th)))\r
12473    THEN POP_ASSUM (MP_TAC o SPEC `n:num` o MATCH_MP lemma_increasing_index_one) THEN ARITH_TAC);;\r
12474 \r
12475 let lemma_segment_complement = prove(`!H:(A)hypermap x:A n:num i:num. is_node_nondegenerate H /\ x IN dart H /\ i <= n \r
12476    ==> (!j:num. j <= ind H x i ==> mirror H x i j = mirror H x n j)`,\r
12477  REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC))\r
12478    THEN SPEC_TAC (`i:num`, `i:num`)\r
12479    THEN SPEC_TAC (`n:num`, `n:num`)\r
12480    THEN MATCH_MP_TAC num_WF\r
12481    THEN INDUCT_TAC\r
12482    THENL[REWRITE_TAC[LT]\r
12483       THEN GEN_TAC THEN REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REWRITE_TAC[ind; LE] THEN DISCH_THEN SUBST1_TAC; ALL_TAC]\r
12484    THEN POP_ASSUM (LABEL_TAC "F3")\r
12485    THEN DISCH_THEN (LABEL_TAC "F4")\r
12486    THEN GEN_TAC\r
12487    THEN DISCH_TAC\r
12488    THEN ASM_CASES_TAC `i:num = SUC n`\r
12489    THENL[POP_ASSUM SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC]\r
12490    THEN POP_ASSUM (fun th -> (POP_ASSUM (fun th1 -> LABEL_TAC "F5" (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th)))))\r
12491    THEN GEN_TAC\r
12492    THEN DISCH_THEN (LABEL_TAC "F6")\r
12493    THEN REWRITE_TAC[mirror; join]\r
12494    THEN USE_THEN "F5" (LABEL_TAC "F7" o REWRITE_RULE[LT_SUC_LE])\r
12495    THEN SUBGOAL_THEN `j:num <= ind (H:(A)hypermap) (x:A) (n:num)` (LABEL_TAC "F8")\r
12496    THENL[ASM_CASES_TAC `i:num = n`\r
12497       THENL[POP_ASSUM (SUBST1_TAC o SYM)\r
12498           THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12499       THEN POP_ASSUM (fun th-> (POP_ASSUM(fun th1-> (MP_TAC (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th))))))\r
12500       THEN USE_THEN "F1"(fun th-> (USE_THEN "F2"(fun th1->DISCH_THEN(fun th2-> MP_TAC(MATCH_MP lemma_increasing_index (CONJ th (CONJ th1 th2)))))))\r
12501       THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ARITH_TAC; ALL_TAC]\r
12502    THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th])\r
12503    THEN USE_THEN "F7" (fun th-> USE_THEN "F4" (MP_TAC o REWRITE_RULE[th] o SPEC `i:num` o REWRITE_RULE[LT_PLUS] o SPEC `n:num`))\r
12504    THEN DISCH_THEN(fun thm-> USE_THEN "F6"(MP_TAC o MATCH_MP thm)) THEN SIMP_TAC[]);;\r
12505 \r
12506 let lemma_indepentdent_complement = prove(`!H:(A)hypermap x:A n:num m:num. is_node_nondegenerate H /\ x IN dart H /\  n <= m \r
12507    ==> complement H x n = mirror H x m n`,\r
12508  REPEAT GEN_TAC\r
12509    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (MP_TAC o REWRITE_RULE[LE_EXISTS])))\r
12510    THEN DISCH_THEN (X_CHOOSE_THEN `i:num` SUBST1_TAC)\r
12511    THEN SPEC_TAC (`i:num`, `i:num`)\r
12512    THEN INDUCT_TAC THENL[REWRITE_TAC[ADD_0; complement]; ALL_TAC]\r
12513    THEN REWRITE_TAC[ADD_SUC]\r
12514    THEN REWRITE_TAC[mirror; join]\r
12515    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (SPEC `(n:num) + i` (MATCH_MP lemma_lower_bound_index (CONJ th th1)))))\r
12516    THEN DISCH_THEN (fun th-> REWRITE_TAC[COND_ELIM_THM; MATCH_MP (ARITH_RULE `!n:num i m. n + i <= m ==> n <= m`) th])\r
12517    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
12518 \r
12519 let lemma_evaluation_complement = prove(`!H:(A)hypermap x:A n:num i:num. is_node_nondegenerate H /\ x IN dart H /\ n <= ind H x i\r
12520    ==> complement H x n = mirror H x i n`,\r
12521   REPEAT GEN_TAC\r
12522     THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC))\r
12523     THEN DISCH_THEN (LABEL_TAC "F3")\r
12524     THEN ASM_CASES_TAC `n:num <= i:num`\r
12525     THENL[POP_ASSUM(fun th2->USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_indepentdent_complement (CONJ th (CONJ th1 th2))])))\r
12526         ;ALL_TAC]\r
12527     THEN REWRITE_TAC[complement] THEN CONV_TAC SYM_CONV\r
12528     THEN POP_ASSUM (ASSUME_TAC o MATCH_MP LT_IMP_LE o REWRITE_RULE[NOT_LE])\r
12529     THEN REMOVE_THEN "F3" MP_TAC\r
12530     THEN POP_ASSUM (fun th2->USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_segment_complement (CONJ th (CONJ th1 th2))]))));;\r
12531 \r
12532 let lemma_inc_monotone = prove(`!id:num->num.(!i:num. id i < id (SUC i)) ==> (!i:num j:num. i < j <=> id i < id j)`,\r
12533    REPEAT GEN_TAC\r
12534    THEN DISCH_THEN (LABEL_TAC "F1")\r
12535    THEN SUBGOAL_THEN `!i:num j:num. i < j ==> (id:num->num) i < id j` (LABEL_TAC "F2")\r
12536    THENL[REPEAT GEN_TAC THEN DISCH_THEN ((X_CHOOSE_THEN `k:num` SUBST1_TAC) o REWRITE_RULE[LT_EXISTS])\r
12537       THEN SPEC_TAC(`k:num`, `k:num`)\r
12538       THEN INDUCT_TAC\r
12539       THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[GSYM ONE; GSYM ADD1; th]); ALL_TAC]\r
12540       THEN REMOVE_THEN "F1" (MP_TAC o SPEC `((i:num) + (SUC k))`)\r
12541       THEN REWRITE_TAC[GSYM ADD_SUC]\r
12542       THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[LT_TRANS]; ALL_TAC]\r
12543    THEN REPEAT GEN_TAC\r
12544    THEN EQ_TAC\r
12545    THENL[POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12546    THEN ASM_CASES_TAC `i:num = j:num`\r
12547    THENL[POP_ASSUM SUBST1_TAC THEN ARITH_TAC; ALL_TAC]\r
12548    THEN ASM_CASES_TAC `j:num < i:num`\r
12549    THENL[REMOVE_THEN "F2" (fun thm -> POP_ASSUM (MP_TAC o MATCH_MP thm))\r
12550       THEN REWRITE_TAC[IMP_IMP]\r
12551       THEN REWRITE_TAC[ARITH_RULE `!a:num b. a < b /\ b < a <=> F`]; ALL_TAC]\r
12552    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LT])\r
12553    THEN DISCH_THEN (fun th-> POP_ASSUM (fun th1 -> REWRITE_TAC[REWRITE_RULE[GSYM LT_LE] (CONJ th th1)])));;\r
12554 \r
12555 let lemma_inc_injective = prove(`!id:num->num.(!i:num. id i < id (SUC i)) ==> (!i:num j:num. i = j <=> id i = id j)`,\r
12556  REPEAT GEN_TAC THEN (DISCH_THEN (LABEL_TAC "F1"))\r
12557    THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[EQ_REFL]\r
12558    THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC]\r
12559    THEN REPEAT GEN_TAC\r
12560    THEN DISCH_THEN (fun th-> REWRITE_TAC[REWRITE_RULE[LT_LE] th] THEN ASSUME_TAC th)\r
12561    THEN REMOVE_THEN "F1" (fun th-> (MP_TAC (SPECL[`i:num`; `n:num`] (MATCH_MP lemma_inc_monotone th))))\r
12562    THEN POP_ASSUM (fun th-> REWRITE_TAC[th; LT_LE]) THEN SIMP_TAC[]);;\r
12563 \r
12564 let lemma_inc_not_decreasing = prove(`!id:num->num.(!i:num. id i < id (SUC i)) ==> (!i:num j:num. i <= j <=> id i <= id j)`,\r
12565    MESON_TAC[lemma_inc_injective; lemma_inc_monotone; LE_LT]);;\r
12566 \r
12567 let lemma_num_partition = prove(`!id:num->num. id 0 = 0 /\ (!i:num. id i < id (SUC i)) \r
12568     ==> (!n:num. (?i:num. n = id i) \/ (?j:num. id j < n /\ n < id (SUC j)))`, \r
12569    REPEAT GEN_TAC\r
12570    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
12571    THEN GEN_TAC\r
12572    THEN SUBGOAL_THEN `!i:num. i <= (id:num->num) i` (LABEL_TAC "F3")\r
12573    THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0]; ALL_TAC]\r
12574       THEN USE_THEN "F2" (MP_TAC o SPEC `i:num`) THEN POP_ASSUM MP_TAC\r
12575       THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LET_TRANS) THEN ARITH_TAC; ALL_TAC]\r
12576    THEN SUBGOAL_THEN `!i:num j:num. i < j ==> (id:num->num) i < id j` (LABEL_TAC "GG")\r
12577    THENL[REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV) [LT_EXISTS]\r
12578       THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC)\r
12579       THEN SPEC_TAC (`d:num`, `d:num`)\r
12580       THEN INDUCT_TAC\r
12581       THENL[USE_THEN "F2" (fun th-> REWRITE_TAC[GSYM ONE; GSYM ADD1; th]); ALL_TAC]\r
12582       THEN USE_THEN "F2" (MP_TAC o SPEC `(i:num) + (SUC d)`)\r
12583       THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD_SUC; IMP_IMP] THEN ARITH_TAC; ALL_TAC]\r
12584    THEN ASM_CASES_TAC `n:num = 0`\r
12585    THENL[DISJ1_TAC THEN EXISTS_TAC `0` THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12586    THEN POP_ASSUM (LABEL_TAC "F4" o REWRITE_RULE[GSYM LT_NZ])\r
12587    THEN SUBGOAL_THEN `(?x:num. (id:num->num) x < n) /\ (?M:num. !x:num. id x < n ==> x <= M)` MP_TAC\r
12588    THENL[STRIP_TAC \r
12589       THENL[EXISTS_TAC `0` THEN USE_THEN "F1" SUBST1_TAC\r
12590           THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12591       THEN EXISTS_TAC `n:num`\r
12592       THEN GEN_TAC\r
12593       THEN USE_THEN "F3" (MP_TAC o SPEC `x:num`) THEN REWRITE_TAC[IMP_IMP] THEN ARITH_TAC; ALL_TAC]\r
12594    THEN GEN_REWRITE_TAC (LAND_CONV) [num_MAX]\r
12595    THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))\r
12596    THEN SUBGOAL_THEN `(?x:num. n <= (id:num->num) x)` MP_TAC\r
12597    THENL[EXISTS_TAC `n:num` THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12598    THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP]\r
12599    THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")))\r
12600    THEN SUBGOAL_THEN `m:num < k:num` (LABEL_TAC "F9")\r
12601    THENL[USE_THEN "F7" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
12602        THEN REWRITE_TAC[NOT_LT; NOT_LE]\r
12603        THEN GEN_REWRITE_TAC (LAND_CONV)[LE_LT]\r
12604        THEN STRIP_TAC\r
12605        THENL[USE_THEN "GG" (fun thm -> POP_ASSUM (MP_TAC o MATCH_MP thm))\r
12606            THEN USE_THEN "F7" MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
12607            THEN DISCH_THEN (MP_TAC o MATCH_MP  LET_TRANS)\r
12608            THEN USE_THEN "F5" MP_TAC THEN ARITH_TAC; ALL_TAC]\r
12609        THEN POP_ASSUM SUBST_ALL_TAC\r
12610        THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12611    THEN ASM_CASES_TAC `n:num = (id:num->num) k`\r
12612    THENL[DISJ1_TAC THEN EXISTS_TAC `k:num` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12613    THEN REMOVE_THEN "F7" (fun th-> (POP_ASSUM (fun th1 -> (LABEL_TAC "F7" (REWRITE_RULE[GSYM LT_LE] (CONJ th th1))))))\r
12614    THEN DISJ2_TAC\r
12615    THEN EXISTS_TAC `m:num` THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
12616    THEN REMOVE_THEN "F9" (MP_TAC o REWRITE_RULE[LT_EXISTS])\r
12617    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC))\r
12618    THEN ASM_CASES_TAC `1 <= d:num`\r
12619    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS])\r
12620        THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (SUBST_ALL_TAC))\r
12621        THEN REMOVE_THEN "F8" (MP_TAC o SPEC `(m:num) + 1` o ONCE_REWRITE_RULE[GSYM ADD_SUC])\r
12622        THEN REWRITE_TAC[ARITH_RULE `!a:num b:num. a + 1 < a + 1 + (SUC b)`]\r
12623        THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[NOT_LE; GSYM ADD1])\r
12624        THEN REMOVE_THEN "F6" (MP_TAC o SPEC `SUC m`)\r
12625        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN ARITH_TAC; ALL_TAC]\r
12626    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; ARITH_RULE `d:num < 1 <=> d = 0`])\r
12627    THEN DISCH_THEN (fun th-> POP_ASSUM (MP_TAC o REWRITE_RULE[th; GSYM ONE; GSYM ADD1]))\r
12628    THEN SIMP_TAC[]);;\r
12629 \r
12630 let index_representation = prove(`!m:num u:num n:num. m < n /\ n < u ==> ?j:num. 1 <= j /\ j < u - m /\ n = m + j`,\r
12631  REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
12632    THEN REMOVE_THEN "F1" (MP_TAC o REWRITE_RULE[LT_EXISTS])\r
12633    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
12634    THEN EXISTS_TAC `SUC d` THEN REWRITE_TAC[EQ_REFL; GE_1]\r
12635    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS])\r
12636    THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC))\r
12637    THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [GSYM ADD_ASSOC]\r
12638    THEN REWRITE_TAC[ADD_SUB2] THEN ARITH_TAC);;\r
12639 \r
12640 let lemma_num_partition2 = prove(`!id:num->num. id 0 = 0 /\ (!i:num. id i < id (SUC i)) \r
12641   ==> (!n:num. n = 0 \/ (?i:num j:num. 1 <= j /\ j <= (id (SUC i)) - (id i) /\ n = (id i) + j))`,\r
12642  GEN_TAC THEN (DISCH_THEN (LABEL_TAC "F1"))\r
12643    THEN GEN_TAC\r
12644    THEN ASM_CASES_TAC `n:num = 0` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12645    THEN POP_ASSUM (fun th-> REWRITE_TAC[th] THEN ASSUME_TAC th)\r
12646    THEN USE_THEN "F1" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_num_partition)\r
12647    THEN STRIP_TAC\r
12648    THENL[POP_ASSUM MP_TAC\r
12649       THEN ASM_CASES_TAC `i:num = 0`\r
12650       THENL[POP_ASSUM SUBST1_TAC\r
12651           THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1 th])\r
12652           THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; TAUT `~A /\ A <=> F`]; ALL_TAC]\r
12653       THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; ADD])\r
12654       THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC)\r
12655       THEN DISCH_THEN SUBST1_TAC\r
12656       THEN EXISTS_TAC `d:num`\r
12657       THEN EXISTS_TAC `((id:num->num) (SUC d)) - (id d)`\r
12658       THEN REWRITE_TAC[LE_REFL]\r
12659       THEN USE_THEN "F1" (MP_TAC o REWRITE_RULE[LT_EXISTS] o  SPEC `d:num` o CONJUNCT2)\r
12660       THEN DISCH_THEN (X_CHOOSE_THEN `m:num` SUBST1_TAC)\r
12661       THEN REWRITE_TAC[ADD_SUB2; GE_1]; ALL_TAC]\r
12662    THEN POP_ASSUM MP_TAC THEN (POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS]))\r
12663    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST1_TAC))\r
12664    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[LT_EXISTS])\r
12665    THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (ASSUME_TAC o REWRITE_RULE[GSYM ADD_ASSOC]))\r
12666    THEN EXISTS_TAC `j:num` THEN EXISTS_TAC `SUC d`\r
12667    THEN REWRITE_TAC[EQ_REFL; GE_1]\r
12668    THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM ADD_ASSOC; ADD_SUB2] THEN ARITH_TAC);;\r
12669 \r
12670 let lemma_complement_path = prove(`!(H:(A)hypermap) (x:A). plain_hypermap H /\ is_node_nondegenerate H /\ x IN dart H ==> \r
12671 (!i:num. complement H x (ind H x i) = node_map H ((inverse (face_map H) POWER i) x))\r
12672 /\ (!i:num. complement H x (SUC (ind H x i)) = inverse (node_map H) ((inverse (face_map H) POWER (SUC i)) x))\r
12673 /\ (!i:num. face_map H (complement H x (ind H x i)) = complement H x (SUC (ind H x i)))\r
12674 /\ (!i:num j:num. 1 <= j /\ j < CARD (node H ((inverse (face_map H) POWER (SUC i)) x)) ==> complement H x ((ind H x i) + j) = (inverse (node_map H) POWER j) ((inverse (face_map H) POWER (SUC i)) x))\r
12675 /\ (!n:num. is_contour H (complement H x) n)`,\r
12676    REPEAT GEN_TAC\r
12677    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
12678    THEN SUBGOAL_THEN `!i:num. complement (H:(A)hypermap) (x:A) (ind H x i) = node_map H ((inverse (face_map H) POWER i) x)` (LABEL_TAC "F4")\r
12679    THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER; ind; I_THM; complement; mirror; node_contour]; ALL_TAC]\r
12680        THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1-> REWRITE_TAC[MATCH_MP lemma_evaluation_complement (CONJ th (CONJ th1 (SPEC `ind (H:(A)hypermap) (x:A) (SUC i)` LE_REFL)))]))\r
12681        THEN REWRITE_TAC[mirror; join]\r
12682        THEN USE_THEN "F2" (fun th-> USE_THEN "F3" (fun th1 -> (LABEL_TAC "G1" (SPEC `i:num` (MATCH_MP lemma_increasing_index_one (CONJ th th1))))))\r
12683        THEN USE_THEN "G1" (fun th -> REWRITE_TAC[REWRITE_RULE[GSYM NOT_LE] th])\r
12684        THEN REWRITE_TAC[node_contour; ind; ADD_SUB2]\r
12685        THEN REWRITE_TAC[COM_POWER; o_THM]\r
12686        THEN ONCE_REWRITE_TAC[COM_POWER_FUNCTION]\r
12687        THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC i)) x`\r
12688        THEN CONV_TAC SYM_CONV\r
12689        THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))]\r
12690        THEN REWRITE_TAC[POWER_FUNCTION]\r
12691        THEN CONV_TAC SYM_CONV\r
12692        THEN REWRITE_TAC[GSYM node_map_inverse_representation; COM_POWER_FUNCTION]\r
12693        THEN POP_ASSUM (LABEL_TAC "G2")\r
12694        THEN MP_TAC (SPEC `SUC i` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)))\r
12695        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (fun th -> (ASSUME_TAC (AP_THM th `x:A`))))\r
12696        THEN USE_THEN "F3" (MP_TAC o SPEC `j:num` o MATCH_MP lemma_dart_invariant_power_face)\r
12697        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
12698        THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th])\r
12699        THEN USE_THEN "F2" (fun th-> (DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[lemma_node_nondegenerate] th))))\r
12700        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP SUC_PRE_2 th])\r
12701        THEN REWRITE_TAC[lemma_node_cycle]; ALL_TAC]\r
12702    THEN STRIP_TAC\r
12703    THENL[POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12704  THEN SUBGOAL_THEN `!i:num. complement (H:(A)hypermap) (x:A) (SUC(ind H x i))=inverse(node_map H)((inverse (face_map H) POWER (SUC i)) x)` (LABEL_TAC "F5")\r
12705    THENL[GEN_TAC\r
12706        THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1-> MP_TAC(SPEC `i:num` (MATCH_MP lemma_increasing_index_one (CONJ th th1)))))\r
12707        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LE_SUC_LT]\r
12708        THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1->DISCH_THEN (fun th2->REWRITE_TAC[MATCH_MP lemma_evaluation_complement (CONJ th (CONJ th1 th2))])))\r
12709        THEN REWRITE_TAC[mirror; join; REWRITE_RULE[GSYM NOT_LE] (SPEC `i:num` LT_PLUS)]\r
12710        THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [ADD1; ADD_SUB2]\r
12711        THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [ONE; PRE]\r
12712        THEN REWRITE_TAC[node_contour; POWER_0; I_THM]; ALL_TAC]\r
12713    THEN STRIP_TAC THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12714    THEN SUBGOAL_THEN `!i:num. face_map (H:(A)hypermap) (complement H (x:A) (ind H x i)) = complement H x (SUC (ind H x i))` (LABEL_TAC "F6")\r
12715    THENL[REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th]))\r
12716        THEN GEN_TAC\r
12717        THEN REWRITE_TAC[COM_POWER; o_THM]\r
12718        THEN ABBREV_TAC `y = (node_map (H:(A)hypermap)) ((inverse (face_map H) POWER (i:num)) (x:A))`\r
12719        THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[node_map_inverse_representation] (SYM th)])\r
12720        THEN REWRITE_TAC[GSYM (ISPECL[`inverse (face_map (H:(A)hypermap))`; `inverse(node_map (H:(A)hypermap))`; `y:A`] o_THM)]\r
12721        THEN REWRITE_TAC[GSYM inverse2_hypermap_maps]\r
12722        THEN CONV_TAC SYM_CONV\r
12723        THEN REWRITE_TAC[face_map_inverse_representation]\r
12724        THEN REWRITE_TAC[GSYM (ISPECL[`inverse (face_map (H:(A)hypermap))`; `inverse(node_map (H:(A)hypermap))`] o_THM)]\r
12725        THEN REWRITE_TAC[GSYM inverse2_hypermap_maps]\r
12726        THEN REWRITE_TAC[GSYM (ISPECL[`edge_map (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] o_THM)]\r
12727        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[REWRITE_RULE[plain_hypermap] th; I_THM]); ALL_TAC]\r
12728    THEN STRIP_TAC THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12729    THEN SUBGOAL_THEN `(!i:num j:num. 1 <= j /\ j < CARD (node (H:(A)hypermap) ((inverse (face_map H) POWER (SUC i)) (x:A))) ==> complement H x ((ind H x i) + j) = (inverse (node_map H) POWER j) ((inverse (face_map H) POWER (SUC i)) x))` (LABEL_TAC "F7")\r
12730    THENL[REPEAT GEN_TAC\r
12731        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4"))\r
12732        THEN SUBGOAL_THEN `(ind (H:(A)hypermap) (x:A) (i:num)) + (j:num) <= ind H x (SUC i)` MP_TAC\r
12733        THENL[REWRITE_TAC[ind; LE_ADD_LCANCEL] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC]\r
12734        THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1->DISCH_THEN(fun th2-> REWRITE_TAC[MATCH_MP lemma_evaluation_complement (CONJ th (CONJ th1 th2))])))\r
12735        THEN REWRITE_TAC[mirror; join]\r
12736        THEN USE_THEN "G3" (fun th-> (REWRITE_TAC[MATCH_MP (ARITH_RULE `!n:num j:num. 1 <= j ==> ~(n +j <= n)`) th]))\r
12737        THEN REWRITE_TAC[ADD_SUB2]\r
12738        THEN REWRITE_TAC[node_contour; POWER_FUNCTION]\r
12739        THEN USE_THEN "G3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP LT_SUC_PRE (REWRITE_RULE[LT1_NZ] th))]); ALL_TAC]\r
12740    THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th])\r
12741    THEN GEN_TAC\r
12742    THEN REWRITE_TAC[lemma_def_contour]\r
12743    THEN REPEAT STRIP_TAC THEN REWRITE_TAC[one_step_contour]\r
12744    THEN SUBGOAL_THEN `ind (H:(A)hypermap) (x:A) 0 = 0 /\ (!i:num. ind H x i < ind H x (SUC i))` MP_TAC\r
12745    THENL[USE_THEN "F2" (fun th -> (USE_THEN "F3" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_increasing_index_one (CONJ th th1); ind]))); ALL_TAC]\r
12746    THEN DISCH_THEN (MP_TAC o SPEC `i:num` o MATCH_MP lemma_num_partition)\r
12747    THEN STRIP_TAC\r
12748    THENL[DISJ1_TAC THEN POP_ASSUM SUBST1_TAC\r
12749        THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
12750    THEN DISJ2_TAC\r
12751    THEN POP_ASSUM (fun th1 -> POP_ASSUM (fun th-> MP_TAC (MATCH_MP index_representation (CONJ th th1))))\r
12752    THEN REWRITE_TAC[ind; ADD_SUB2]\r
12753    THEN DISCH_THEN (X_CHOOSE_THEN `t:num` (CONJUNCTS_THEN2 (LABEL_TAC "F10") (CONJUNCTS_THEN2 (LABEL_TAC "F11") SUBST1_TAC)))\r
12754    THEN USE_THEN "F11" (MP_TAC o MATCH_MP (ARITH_RULE `a:num < PRE b ==> a < b`))\r
12755    THEN USE_THEN "F10" (fun th -> DISCH_THEN (fun th1 -> USE_THEN "F7"(fun thm -> REWRITE_TAC[MATCH_MP thm (CONJ th th1)])))\r
12756    THEN REWRITE_TAC[GSYM ADD_SUC]\r
12757    THEN POP_ASSUM (MP_TAC o MATCH_MP (ARITH_RULE `a:num < PRE b ==> SUC a < b`))\r
12758    THEN POP_ASSUM (MP_TAC o MATCH_MP (ARITH_RULE `1 <= t:num ==> 1 <= SUC t `))\r
12759    THEN REWRITE_TAC[IMP_IMP]\r
12760    THEN USE_THEN "F7" (fun thm -> DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP thm th]))\r
12761    THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC j)) (x:A)`\r
12762    THEN REWRITE_TAC[COM_POWER; o_THM]);;\r
12763 \r
12764 let lemma_inj_complement = prove(`!H:(A)hypermap x:A. plain_hypermap H /\ simple_hypermap H /\ is_node_nondegenerate H /\ x IN dart H\r
12765    ==> is_inj_contour H (complement H x) (PRE (ind H x (CARD (face H x))))`,\r
12766    REPEAT GEN_TAC\r
12767    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
12768    THEN REWRITE_TAC[lemma_inj_contour_via_list]\r
12769    THEN USE_THEN "F1"(fun th-> USE_THEN "F3"(fun th1-> USE_THEN "F4"(fun th2-> (LABEL_TAC "GG" (CONJ th (CONJ th1 th2))))))\r
12770    THEN USE_THEN "GG" (LABEL_TAC "GH" o MATCH_MP lemma_increasing_index_one o CONJUNCT2)  \r
12771    THEN SUBGOAL_THEN `ind (H:(A)hypermap) (x:A) 0 = 0 /\ (!i:num. ind H x i < ind H x (SUC i))` (LABEL_TAC "F6")\r
12772    THENL[USE_THEN "F3" (fun th -> (USE_THEN "F4" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_increasing_index_one (CONJ th th1); ind]))); ALL_TAC]  \r
12773    THEN USE_THEN "GG" (fun th -> REWRITE_TAC[MATCH_MP lemma_complement_path th])\r
12774    THEN REWRITE_TAC[lemma_inj_list2]\r
12775    THEN MATCH_MP_TAC WLOG_LT\r
12776    THEN SIMP_TAC[] THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC]\r
12777    THEN REPEAT GEN_TAC\r
12778    THEN DISCH_THEN (LABEL_TAC "F7")\r
12779    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F8") (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")))\r
12780    THEN ASM_CASES_TAC `i:num = 0`\r
12781    THENL[POP_ASSUM SUBST_ALL_TAC\r
12782        THEN SUBGOAL_THEN `!a:num b:num. 2 <= b ==> PRE (a + (PRE b)) = a + (PRE (PRE b))` (LABEL_TAC "N1")\r
12783        THENL[REPEAT GEN_TAC\r
12784            THEN DISCH_THEN ((X_CHOOSE_THEN `d:num` SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM]) o  REWRITE_RULE[LE_EXISTS])\r
12785            THEN REWRITE_TAC[TWO; ADD_SUC; GSYM ADD1; PRE]; ALL_TAC]\r
12786        THEN USE_THEN "F6" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_num_partition2)\r
12787        THEN USE_THEN "F7" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REWRITE_RULE[LT_NZ] th])\r
12788        THEN SIMP_TAC[]\r
12789        THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `j:num`(CONJUNCTS_THEN2(LABEL_TAC "G1")(CONJUNCTS_THEN2 MP_TAC SUBST_ALL_TAC))))\r
12790        THEN REWRITE_TAC[ind; ADD_SUB2]\r
12791        THEN DISCH_THEN (LABEL_TAC "G3")\r
12792        THEN REMOVE_THEN "F10" (MP_TAC o ONCE_REWRITE_RULE[SYM(SPECL[`H:(A)hypermap`; `x:A`] (CONJUNCT1 ind))])\r
12793        THEN USE_THEN "GG" (fun th -> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_complement_path th); POWER_0; I_THM])\r
12794        THEN USE_THEN "GG" (fun th -> MP_TAC(SPECL[`m:num`; `j:num`] (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_complement_path th)))))))\r
12795        THEN USE_THEN "G1" (fun th-> REWRITE_TAC[th])\r
12796        THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC m)) (x:A)` \r
12797        THEN POP_ASSUM (LABEL_TAC "G4")\r
12798        THEN USE_THEN "G4"(LABEL_TAC "G5" o SYM o REWRITE_RULE[GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts)))] o SYM)\r
12799        THEN USE_THEN "G3" (ASSUME_TAC o REWRITE_RULE[MATCH_MP LE_SUC_PRE (SPECL[`H:(A)hypermap`; `y:A`]  NODE_NOT_EMPTY)] o ONCE_REWRITE_RULE[GSYM LE_SUC])\r
12800        THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ (SPEC `j:num` LT_PLUS) th)])\r
12801        THEN DISCH_THEN SUBST1_TAC\r
12802        THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))]\r
12803        THEN REWRITE_TAC[POWER_FUNCTION]\r
12804        THEN DISCH_THEN (LABEL_TAC "G6" o SYM)\r
12805        THEN USE_THEN "G6" (fun th-> (ASSUME_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `x:A`; `SUC j`] lemma_in_node2))))\r
12806        THEN USE_THEN "G4" (fun th-> (MP_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `x:A`; `SUC m`] lemma_power_inverse_in_face2))))\r
12807        THEN POP_ASSUM MP_TAC\r
12808        THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
12809        THEN USE_THEN "F4" (fun th -> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th]))\r
12810        THEN REWRITE_TAC[IN_SING]\r
12811        THEN DISCH_THEN SUBST_ALL_TAC\r
12812        THEN USE_THEN "G1" (fun th-> USE_THEN "F9" (fun th1-> (MP_TAC (MATCH_MP (ARITH_RULE `!a:num b c. 1 <= b /\ a + b <= PRE c ==> a < c`) (CONJ th th1)))))\r
12813        THEN USE_THEN "GH" (fun th -> REWRITE_TAC[GSYM(MATCH_MP lemma_inc_monotone th)])\r
12814        THEN REWRITE_TAC[GSYM LE_SUC_LT]\r
12815        THEN ONCE_REWRITE_TAC[LE_LT]\r
12816        THEN STRIP_TAC\r
12817        THENL[MP_TAC (SPECL[`x:A`;`SUC m`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` face_map_and_darts)))\r
12818           THEN REWRITE_TAC[GSYM face]\r
12819           THEN POP_ASSUM (fun th -> (LABEL_TAC "G7" th THEN REWRITE_TAC[th; lemma_def_inj_orbit]))\r
12820           THEN DISCH_THEN (MP_TAC o SPECL[`SUC m`; `0`])\r
12821           THEN REWRITE_TAC[LE_REFL; LT_NZ; NON_ZERO; POWER_0; I_THM]\r
12822           THEN USE_THEN "G5" (fun th-> (REWRITE_TAC[th])); ALL_TAC]\r
12823        THEN POP_ASSUM (SUBST_ALL_TAC o SYM)\r
12824        THEN USE_THEN "F9" (MP_TAC o REWRITE_RULE[ind])\r
12825        THEN USE_THEN "G4" SUBST1_TAC\r
12826        THEN USE_THEN "F4" (fun th1-> USE_THEN "F3" (fun th-> (LABEL_TAC "G8" (MATCH_MP (REWRITE_RULE[lemma_node_nondegenerate] th) th1))))\r
12827        THEN USE_THEN "G8" (fun th -> USE_THEN "N1"(fun thm -> REWRITE_TAC[MATCH_MP thm th]))\r
12828        THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
12829        THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
12830        THEN DISCH_THEN (ASSUME_TAC o MATCH_MP (ARITH_RULE `!a:num b. 2 <= b /\ a <= PRE (PRE b) ==> SUC a < b`))\r
12831        THEN MP_TAC (SPECL[`x:A`;`SUC j`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` node_map_and_darts)))\r
12832        THEN REWRITE_TAC[GSYM node]\r
12833        THEN POP_ASSUM (fun th -> REWRITE_TAC[th;lemma_def_inj_orbit])\r
12834        THEN DISCH_THEN (MP_TAC o SPECL[`SUC j`; `0`])\r
12835        THEN REWRITE_TAC[LE_REFL; LT_NZ; NON_ZERO; POWER_0; I_THM]\r
12836        THEN USE_THEN "G6" (fun th-> (REWRITE_TAC[th])); ALL_TAC]\r
12837    THEN POP_ASSUM (LABEL_TAC "H1" o REWRITE_RULE[GSYM LT_NZ])\r
12838    THEN USE_THEN "H1" (fun th-> USE_THEN "F7" (fun th1-> (LABEL_TAC "H2" (MATCH_MP LT_TRANS (CONJ th th1)))))\r
12839    THEN USE_THEN "F6" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_num_partition2)\r
12840    THEN USE_THEN "H2" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REWRITE_RULE[LT_NZ] th])\r
12841    THEN SIMP_TAC[]\r
12842    THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `k:num`(CONJUNCTS_THEN2(LABEL_TAC "H3")(CONJUNCTS_THEN2 MP_TAC SUBST_ALL_TAC))))\r
12843    THEN REWRITE_TAC[ind; ADD_SUB2]\r
12844    THEN DISCH_THEN (LABEL_TAC "H4")\r
12845    THEN USE_THEN "F6" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_num_partition2)\r
12846    THEN USE_THEN "H1" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REWRITE_RULE[LT_NZ] th])\r
12847    THEN SIMP_TAC[]\r
12848    THEN DISCH_THEN(X_CHOOSE_THEN `u:num` (X_CHOOSE_THEN `v:num`(CONJUNCTS_THEN2(LABEL_TAC "H5")(CONJUNCTS_THEN2 MP_TAC SUBST_ALL_TAC))))\r
12849    THEN REWRITE_TAC[ind; ADD_SUB2]\r
12850    THEN DISCH_THEN (LABEL_TAC "H6")\r
12851    THEN REMOVE_THEN "F10" (MP_TAC o ONCE_REWRITE_RULE[SYM(SPECL[`H:(A)hypermap`; `x:A`] (CONJUNCT1 ind))])\r
12852    THEN USE_THEN "GG" (fun th -> MP_TAC(SPECL[`m:num`; `k:num`] (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_complement_path th)))))))\r
12853    THEN USE_THEN "H3" (fun th-> REWRITE_TAC[th])\r
12854    THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC m)) (x:A)`\r
12855    THEN POP_ASSUM (LABEL_TAC "H7")\r
12856    THEN USE_THEN "H7"(LABEL_TAC "H8" o SYM o REWRITE_RULE[GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts)))] o SYM)\r
12857    THEN USE_THEN "H4" (ASSUME_TAC o REWRITE_RULE[MATCH_MP LE_SUC_PRE (SPECL[`H:(A)hypermap`; `y:A`]  NODE_NOT_EMPTY)] o ONCE_REWRITE_RULE[GSYM LE_SUC])\r
12858    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ (SPEC `k:num` LT_PLUS) th)])\r
12859    THEN DISCH_THEN SUBST1_TAC\r
12860    THEN USE_THEN "GG" (fun th -> MP_TAC(SPECL[`u:num`; `v:num`] (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_complement_path th)))))))\r
12861    THEN USE_THEN "H5" (fun th-> REWRITE_TAC[th])\r
12862    THEN ABBREV_TAC `z = (inverse (face_map (H:(A)hypermap)) POWER (SUC u)) (x:A)`\r
12863    THEN POP_ASSUM (LABEL_TAC "H9")\r
12864    THEN USE_THEN "H9"(LABEL_TAC "K1" o SYM o REWRITE_RULE[GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts)))] o SYM)\r
12865    THEN USE_THEN "H6" (ASSUME_TAC o REWRITE_RULE[MATCH_MP LE_SUC_PRE (SPECL[`H:(A)hypermap`; `y:A`]  NODE_NOT_EMPTY)] o ONCE_REWRITE_RULE[GSYM LE_SUC])\r
12866    THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ (SPEC `v:num` LT_PLUS) th)])\r
12867    THEN DISCH_THEN SUBST1_TAC\r
12868    THEN DISCH_THEN (LABEL_TAC "K2")\r
12869    THEN SUBGOAL_THEN `(z:A) IN face H (y:A)` MP_TAC\r
12870    THENL[USE_THEN "H8" (MP_TAC)\r
12871       THEN USE_THEN "K1" (SUBST1_TAC o SYM)\r
12872       THEN GEN_REWRITE_TAC (LAND_CONV) [MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]\r
12873       THEN MP_TAC(SPEC `SUC u` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)))\r
12874       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC))\r
12875       THEN REWRITE_TAC[GSYM lemma_add_exponent_function; ADD_SUC]\r
12876       THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[lemma_in_face]; ALL_TAC]\r
12877    THEN SUBGOAL_THEN `(z:A) IN node H (y:A)` MP_TAC\r
12878    THENL[USE_THEN "K2" (MP_TAC o SYM)\r
12879       THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))]\r
12880       THEN MP_TAC(SPEC `k:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)))\r
12881       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC))\r
12882       THEN REWRITE_TAC[GSYM lemma_add_exponent_function; ADD_SUC]\r
12883       THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[lemma_in_node2]; ALL_TAC]\r
12884    THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
12885    THEN SUBGOAL_THEN `y:A IN dart (H:(A)hypermap)` (LABEL_TAC "K3")\r
12886    THENL[USE_THEN "H7" (MP_TAC o SYM)\r
12887       THEN MP_TAC(SPEC `SUC m` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)))\r
12888       THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC))\r
12889       THEN DISCH_THEN SUBST1_TAC\r
12890       THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant_power_face th]); ALL_TAC]\r
12891    THEN USE_THEN "K3" (fun th -> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th]))\r
12892    THEN REWRITE_TAC[IN_SING]\r
12893    THEN DISCH_THEN SUBST_ALL_TAC\r
12894    THEN SUBGOAL_THEN `v:num = k:num` (SUBST_ALL_TAC)\r
12895    THENL[MP_TAC (MATCH_MP (ARITH_RULE `!i:num. 1 <= i ==> PRE i < i`) (SPECL[`H:(A)hypermap`; `y:A`] NODE_NOT_EMPTY))\r
12896       THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list] o MATCH_MP lemma_inj_node_contour)\r
12897       THEN DISCH_THEN (MP_TAC o REWRITE_RULE[node_contour] o SPECL[`v:num`; `k:num`] o REWRITE_RULE[lemma_inj_list2])\r
12898       THEN USE_THEN "K2" (fun th -> REWRITE_TAC[th])\r
12899       THEN USE_THEN "H4" (fun th -> REWRITE_TAC[th])\r
12900       THEN USE_THEN "H6" (fun th -> REWRITE_TAC[th]); ALL_TAC]\r
12901    THEN REWRITE_TAC[EQ_ADD_RCANCEL]\r
12902    THEN REMOVE_THEN "F7" (MP_TAC o REWRITE_RULE[LT_ADD_RCANCEL])\r
12903    THEN USE_THEN "GH" (fun th -> (DISCH_THEN (MP_TAC o REWRITE_RULE[GSYM(MATCH_MP lemma_inc_monotone th)])))\r
12904    THEN USE_THEN "H5" (fun th-> USE_THEN "F9" (fun th1-> (MP_TAC (MATCH_MP (ARITH_RULE `!a:num b c. 1 <= b /\ a + b <= PRE c ==> a < c`) (CONJ th th1)))))\r
12905    THEN USE_THEN "GH" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM(MATCH_MP lemma_inc_monotone th)])\r
12906    THEN USE_THEN "K1" (fun th-> (MP_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `y:A`; `SUC u`] lemma_in_face))))\r
12907    THEN DISCH_THEN (SUBST1_TAC o SYM o MATCH_MP lemma_face_identity)\r
12908    THEN DISCH_THEN (LABEL_TAC "K4")\r
12909    THEN DISCH_THEN ((X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) o REWRITE_RULE[LT_EXISTS])\r
12910    THEN USE_THEN "K1" MP_TAC THEN USE_THEN "H8" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
12911    THEN REWRITE_TAC[GSYM (CONJUNCT2 ADD); addition_exponents; o_THM]\r
12912    THEN MP_TAC (SPEC `SUC u` (MATCH_MP power_permutation (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))))\r
12913    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE th])\r
12914    THEN DISCH_TAC\r
12915    THEN USE_THEN "K4" (MP_TAC o MATCH_MP (ARITH_RULE `!a:num b c. a + b < c ==> b < c`))\r
12916    THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list] o MATCH_MP lemma_inj_face_contour)\r
12917    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[face_contour] o SPECL[`0`; `SUC d`] o REWRITE_RULE[lemma_inj_list2])\r
12918    THEN REWRITE_TAC[LE_0; LE_REFL; POWER_0; I_THM]\r
12919    THEN POP_ASSUM (fun th-> MESON_TAC[th; GSYM NON_ZERO]));;\r
12920 \r
12921 \r
12922 (* Restricted hypermap *)\r
12923 \r
12924 let is_restricted = new_definition `!H:(A)hypermap. is_restricted H <=> (~(dart H = {}) /\ planar_hypermap H /\ plain_hypermap H /\ connected_hypermap H /\ simple_hypermap H /\ is_no_double_joins H /\ is_edge_nondegenerate H /\ is_node_nondegenerate H /\ (!x:A. x IN dart H ==> 3 <= CARD (face H x)))`;;\r
12925 \r
12926 let canon = new_definition `!H:(A)hypermap NF:(A)loop->bool. \r
12927     canon H NF = {L |L:(A)loop| L IN NF /\ ?x:A. x belong L /\ L = face_loop H x}`;;\r
12928 \r
12929 let canon_darts = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool). canon_darts H NF  = UNIONS {dart_of (L:(A)loop) | L:(A)loop | L IN canon H NF}`;;\r
12930 \r
12931 let is_in_canon_darts = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) L:(A)loop (x:A). x belong L /\ L IN canon H NF ==> x IN canon_darts H NF`,\r
12932    REWRITE_TAC[belong; canon_darts] THEN SET_TAC[]);;\r
12933 \r
12934 let lemma_in_canon_darts = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). x IN canon_darts H NF <=> ?L:(A)loop. L IN canon H NF /\ x belong L`,\r
12935    REPEAT GEN_TAC\r
12936    THEN EQ_TAC\r
12937    THENL[REWRITE_TAC[canon_darts; IN_UNIONS; IN_ELIM_THM]\r
12938       THEN REPEAT STRIP_TAC\r
12939       THEN EXISTS_TAC `L:(A)loop`\r
12940       THEN POP_ASSUM MP_TAC\r
12941       THEN POP_ASSUM SUBST1_TAC\r
12942       THEN REWRITE_TAC[GSYM belong]\r
12943       THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
12944    THEN MESON_TAC[is_in_canon_darts]);;\r
12945 \r
12946 let lemma_not_in_canon_darts = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) L:(A)loop (x:A). is_normal H NF /\ L IN NF /\ ~(L IN canon H NF) /\ x belong L  \r
12947    ==> ~(x IN canon_darts H NF)`,\r
12948  REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl))\r
12949    THEN ONCE_REWRITE_TAC[CONTRAPOS_THM]\r
12950    THEN REWRITE_TAC[lemma_in_canon_darts]\r
12951    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` STRIP_ASSUME_TAC)\r
12952    THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC\r
12953    THENL[MATCH_MP_TAC disjoint_loops\r
12954        THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A`\r
12955        THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `L':(A)loop IN canon (H:(A)hypermap) (NF:(A)loop->bool)`\r
12956        THEN SIMP_TAC[canon; IN_ELIM_THM]; ALL_TAC]\r
12957    THEN ASM_REWRITE_TAC[]);;\r
12958 \r
12959 let GET_EDGE_NONDEGENERATE hpmap = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap))))))));;\r
12960 \r
12961 let lemma_power_canon_next = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. L IN canon H NF /\ x belong L \r
12962    ==> (!n:num.((face_map H) POWER n) x = (next L POWER n) x)`,\r
12963  REPEAT GEN_TAC\r
12964    THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[canon; IN_ELIM_THM]) (LABEL_TAC "F1"))\r
12965    THEN DISCH_THEN ((X_CHOOSE_THEN `y:A` (SUBST_ALL_TAC o CONJUNCT2)) o CONJUNCT2)\r
12966    THEN POP_ASSUM MP_TAC\r
12967    THEN REWRITE_TAC[belong; face_loop_rep]\r
12968    THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_face_identity th])\r
12969    THEN REWRITE_TAC[power_res_face_map]);;\r
12970 \r
12971 let lemma_true_loop1 = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop. is_restricted H /\ is_normal H NF /\ L IN NF \r
12972    ==> (L IN canon H NF <=> ?x:A. x belong L /\ (!n. ((face_map H) POWER n) x = (next L POWER n) x))`,\r
12973    REPEAT GEN_TAC\r
12974    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2" o GET_EDGE_NONDEGENERATE) (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F3")))\r
12975    THEN EQ_TAC\r
12976    THENL[REWRITE_TAC[canon; IN_ELIM_THM]\r
12977        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
12978        THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
12979        THEN EXISTS_TAC `x:A` THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
12980        THEN POP_ASSUM SUBST1_TAC THEN GEN_TAC\r
12981        THEN REWRITE_TAC[face_loop_rep; GSYM power_res_face_map]; ALL_TAC]\r
12982    THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
12983    THEN REWRITE_TAC[canon; IN_ELIM_THM]\r
12984    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
12985    THEN EXISTS_TAC `x:A` THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
12986    THEN REWRITE_TAC[lemma_loop_identity; face_loop_rep]\r
12987    THEN SUBGOAL_THEN `dart_of (L:(A)loop) = face (H:(A)hypermap) (x:A)` (LABEL_TAC "F6")\r
12988    THENL[USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
12989        THEN REWRITE_TAC[face; orbit_map]\r
12990        THEN CONV_TAC SYM_CONV THEN POP_ASSUM MP_TAC THEN SET_TAC[]; ALL_TAC]\r
12991    THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th])\r
12992    THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC\r
12993    THEN ASM_CASES_TAC `~((x':A) IN (dart_of (L:(A)loop)))`\r
12994    THENL[POP_ASSUM (LABEL_TAC "F7")\r
12995        THEN USE_THEN "F7" (fun th-> REWRITE_TAC[MATCH_MP lemma_permutes_exception (CONJ (CONJUNCT1 (SPEC `L:(A)loop` lemma_permute_loop)) th)])\r
12996        THEN REMOVE_THEN "F6" (fun th-> REMOVE_THEN "F7" (LABEL_TAC "F8" o REWRITE_RULE[th]))\r
12997        THEN USE_THEN "F8" (fun th-> REWRITE_TAC[MATCH_MP lemma_permutes_exception (CONJ (SPECL[`H:(A)hypermap`; `x:A`] face_map_restrict) th)]); ALL_TAC]\r
12998    THEN USE_THEN "F6" (fun th-> POP_ASSUM (LABEL_TAC "F9" o REWRITE_RULE[th]))\r
12999    THEN USE_THEN "F9" (fun th-> REWRITE_TAC[MATCH_MP lemma_face_identity th])\r
13000    THEN REWRITE_TAC[res; face_refl]\r
13001    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[face; orbit_map; IN_ELIM_THM; GE; LE_0])\r
13002    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` SUBST1_TAC)\r
13003    THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
13004    THEN USE_THEN "F5" (fun th-> REWRITE_TAC[SPEC `n:num` th])\r
13005    THEN REWRITE_TAC[COM_POWER_FUNCTION]);;\r
13006 \r
13007 let GET_SIMPLE_PROPERTY hpmap = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap))))));;\r
13008 \r
13009 let GET_NODE_NONDEGENERATE hpmap \r
13010     = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap)))))))));;\r
13011 \r
13012 let lemma_true_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop. is_restricted H /\ is_normal H NF /\ L IN NF \r
13013    ==> (L IN canon H NF <=> ?x:A. dart_of L = face H x)`,\r
13014  REPEAT GEN_TAC\r
13015    THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
13016    THEN DISCH_THEN (fun th-> (LABEL_TAC "F1" (GET_SIMPLE_PROPERTY th) THEN LABEL_TAC "F2" (GET_NODE_NONDEGENERATE th) THEN (LABEL_TAC "GC" th)))\r
13017    THEN EQ_TAC\r
13018    THENL[USE_THEN "GC"(fun th-> USE_THEN "F4"(fun th1-> USE_THEN "F5"(fun th2-> REWRITE_TAC[MATCH_MP lemma_true_loop1 (CONJ th (CONJ th1 th2))])))\r
13019        THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")))\r
13020        THEN EXISTS_TAC `y:A` THEN USE_THEN "G1" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th])\r
13021        THEN REWRITE_TAC[face; orbit_map] THEN POP_ASSUM MP_TAC THEN SET_TAC[]; ALL_TAC]\r
13022    THEN DISCH_THEN(X_CHOOSE_THEN `x:A` (LABEL_TAC "H1"))\r
13023    THEN USE_THEN "GC"(fun th-> USE_THEN "F4"(fun th1-> USE_THEN "F5"(fun th2-> REWRITE_TAC[MATCH_MP lemma_true_loop1 (CONJ th (CONJ th1 th2))])))\r
13024    THEN EXISTS_TAC `x:A` THEN USE_THEN "H1" (fun th-> (LABEL_TAC "H2" (REWRITE_RULE[SYM th; GSYM belong] (SPECL[`H:(A)hypermap`; `x:A`] face_refl))))\r
13025    THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th])\r
13026    THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC]\r
13027    THEN CONV_TAC SYM_CONV\r
13028    THEN REWRITE_TAC[COM_POWER; o_THM]\r
13029    THEN USE_THEN "H2" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_power_next_in_loop)\r
13030    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
13031    THEN DISCH_THEN (LABEL_TAC "H3")\r
13032    THEN LABEL_TAC "H4" (SPECL[`H:(A)hypermap`; `x:A`; `n:num`] lemma_in_face)\r
13033    THEN ABBREV_TAC `y:A = (face_map (H:(A)hypermap) POWER (n:num)) (x:A)` \r
13034    THEN REMOVE_THEN "H4" (fun th-> SUBST_ALL_TAC (MATCH_MP lemma_face_identity  th))\r
13035    THEN USE_THEN "F4" (MP_TAC o SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])\r
13036    THEN DISCH_THEN (fun thm-> USE_THEN "F5" (MP_TAC o SPEC `y:A` o  REWRITE_RULE[is_loop] o CONJUNCT1 o  MATCH_MP thm))\r
13037    THEN USE_THEN "H3" (fun th-> REWRITE_TAC[th; one_step_contour])\r
13038    THEN STRIP_TAC\r
13039    THEN USE_THEN "H3" (MP_TAC o REWRITE_RULE[belong; POWER_1] o SPEC `1` o  MATCH_MP lemma_power_next_in_loop)\r
13040    THEN USE_THEN "H1" (SUBST1_TAC)\r
13041    THEN POP_ASSUM (LABEL_TAC "H4")\r
13042    THEN USE_THEN "H4" (fun th-> (MP_TAC (REWRITE_RULE[SYM th] (MATCH_MP lemma_inverse_in_node (SPECL[`H:(A)hypermap`; `y:A`] node_refl)))))\r
13043    THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
13044    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_simple_hypermap th; IN_SING])\r
13045    THEN POP_ASSUM (fun th-> (GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]))\r
13046    THEN CONV_TAC (LAND_CONV SYM_CONV)\r
13047    THEN ONCE_REWRITE_TAC[GSYM node_map_inverse_representation]\r
13048    THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `y:A` o REWRITE_RULE[is_node_nondegenerate])\r
13049    THEN USE_THEN "F4"(fun th-> USE_THEN "F5"(fun th1-> USE_THEN "H3"(fun th2-> REWRITE_TAC[MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))])))\r
13050    THEN REWRITE_TAC[IMP_IMP] THEN MESON_TAC[]);;\r
13051 \r
13052 let lemma_true_loop_via_map = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop. is_restricted H /\ is_normal H NF /\ L IN NF \r
13053    ==> (L IN canon H NF <=> (!x:A. x belong L ==> next L x = face_map H x))`,\r
13054  REPEAT GEN_TAC\r
13055    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
13056    THEN EQ_TAC\r
13057    THENL[DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
13058        THEN DISCH_THEN (fun th -> REWRITE_TAC[REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP lemma_power_canon_next th))]); ALL_TAC]\r
13059    THEN DISCH_THEN (LABEL_TAC "F4")\r
13060    THEN USE_THEN "F3" (fun th -> (USE_THEN "F2" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
13061    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (X_CHOOSE_THEN `y:A` (LABEL_TAC "F6" o CONJUNCT2)))\r
13062    THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1-> USE_THEN "F3"(fun th2-> REWRITE_TAC[MATCH_MP lemma_true_loop1 (CONJ th (CONJ th1 th2))])))\r
13063    THEN EXISTS_TAC `y:A` THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th])\r
13064    THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
13065    THEN REWRITE_TAC[COM_POWER; o_THM]\r
13066    THEN POP_ASSUM (fun th-> SUBST1_TAC th THEN ASSUME_TAC th)\r
13067    THEN CONV_TAC SYM_CONV\r
13068    THEN USE_THEN "F6" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_power_next_in_loop)\r
13069    THEN USE_THEN "F4" (fun thm -> DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP thm th])));;\r
13070 \r
13071 let lemma_false_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop. is_restricted H /\ is_normal H NF /\ L IN NF \r
13072    ==> (~(L IN canon H NF) <=> (?x:A. x belong L /\ next L x = inverse (node_map H) x))`,\r
13073    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1")\r
13074    THEN ONCE_REWRITE_TAC[TAUT `(~A <=> B) <=> (A <=> ~B)`]\r
13075    THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; TAUT `(~A \/ B) <=> (A ==> B)`]\r
13076    THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_true_loop_via_map th])\r
13077    THEN EQ_TAC\r
13078    THENL[DISCH_THEN (LABEL_TAC "F2") THEN GEN_TAC\r
13079        THEN DISCH_THEN (LABEL_TAC "F3")\r
13080        THEN POP_ASSUM (fun th-> REWRITE_TAC[th] THEN (LABEL_TAC "F3" th))\r
13081        THEN USE_THEN "F2" (fun th-> USE_THEN "F3" (SUBST1_TAC o MATCH_MP th))\r
13082        THEN REMOVE_THEN "F1" (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))\r
13083        THEN USE_THEN "F5" (fun th-> USE_THEN "F3" (fun th1-> ASSUME_TAC (MATCH_MP lemma_in_dart (REWRITE_RULE[GSYM CONJ_ASSOC] (CONJ th th1)))))\r
13084        THEN USE_THEN "F4" (MP_TAC o SPEC `x:A` o  REWRITE_RULE[lemma_edge_nondegenerate] o GET_EDGE_NONDEGENERATE)\r
13085        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13086    THEN DISCH_THEN (LABEL_TAC "F6")\r
13087    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7")\r
13088    THEN USE_THEN "F6" (fun th-> (USE_THEN "F7" (LABEL_TAC "F8" o MATCH_MP th)))\r
13089    THEN USE_THEN "F1" (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "G2") (LABEL_TAC "G3")))\r
13090    THEN USE_THEN "G3" (fun th -> (USE_THEN "G2" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
13091    THEN DISCH_THEN (MP_TAC o SPEC `x:A` o REWRITE_RULE[is_loop] o CONJUNCT1)\r
13092    THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th; one_step_contour])\r
13093    THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]));;\r
13094 \r
13095 let lemma_next_on_normal_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_normal H NF /\ L IN NF /\ x belong L \r
13096    ==> next L x = face_map H x \/ next L x = inverse(node_map H) x`,\r
13097  REPEAT GEN_TAC\r
13098    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") ASSUME_TAC))\r
13099    THEN USE_THEN "F2" (fun th -> (USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
13100    THEN DISCH_THEN (MP_TAC o SPEC `x:A` o REWRITE_RULE[is_loop] o CONJUNCT1)\r
13101    THEN POP_ASSUM (fun th-> REWRITE_TAC[th; one_step_contour]));;\r
13102 \r
13103 let lemma_next_exclusive = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L \r
13104    ==> (next L x = face_map H x <=> ~(next L x = inverse(node_map H) x))`,\r
13105  REPEAT GEN_TAC\r
13106    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1" o GET_EDGE_NONDEGENERATE) (LABEL_TAC "F2"))\r
13107    THEN USE_THEN "F2" (STRIP_ASSUME_TAC o MATCH_MP lemma_next_on_normal_loop)\r
13108    THENL[POP_ASSUM (fun th-> REWRITE_TAC[th])\r
13109        THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A` o REWRITE_RULE[lemma_edge_nondegenerate])\r
13110        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_dart th]); ALL_TAC]\r
13111    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
13112    THEN CONV_TAC (RAND_CONV SYM_CONV)\r
13113    THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A` o REWRITE_RULE[lemma_edge_nondegenerate])\r
13114    THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_dart th]));;\r
13115 \r
13116 let lemma_next_exclusive2 = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L \r
13117    ==> (next L x = inverse(node_map H) x <=> ~(next L x = face_map H x))`,\r
13118    ONCE_REWRITE_TAC[TAUT `(A <=> ~B) <=> (B <=> ~A)`] THEN REWRITE_TAC[lemma_next_exclusive]);;\r
13119 \r
13120 let lemma_head_via_restricted = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L \r
13121    ==> (head H NF x = x <=> next L x = face_map H x)`,\r
13122  REPEAT GEN_TAC\r
13123    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
13124    THEN EQ_TAC\r
13125    THENL[DISCH_TAC THEN USE_THEN "F2" (MP_TAC o CONJUNCT2 o MATCH_MP head_on_loop)\r
13126        THEN POP_ASSUM SUBST1_TAC\r
13127        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> MP_TAC (MATCH_MP lemma_next_exclusive (CONJ th th1))))\r
13128        THEN SIMP_TAC[]; ALL_TAC]\r
13129    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC [MATCH_MP lemma_next_exclusive (CONJ th th1)]))\r
13130    THEN DISCH_TAC THEN MATCH_MP_TAC lemma_unique_head\r
13131    THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[atom_reflect]);;\r
13132 \r
13133 let lemma_head = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x ==> (head H NF x = y <=> next L y = face_map H y)`,\r
13134  REPEAT GEN_TAC\r
13135    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC))\r
13136    THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(CONJUNCT1(MATCH_MP change_parameters th))] THEN MP_TAC th)\r
13137    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC))\r
13138    THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop)\r
13139    THEN MATCH_MP_TAC lemma_head_via_restricted THEN ASM_REWRITE_TAC[]);;\r
13140 \r
13141 let lemma_tail_via_restricted = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L \r
13142    ==> (tail H NF x = x <=> x = face_map H (back L x))`,\r
13143  REPEAT GEN_TAC\r
13144    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
13145    THEN EQ_TAC\r
13146    THENL[DISCH_TAC THEN USE_THEN "F2" (MP_TAC o CONJUNCT2 o MATCH_MP tail_on_loop)\r
13147        THEN POP_ASSUM SUBST1_TAC\r
13148        THEN REMOVE_THEN "F2" (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
13149        THEN USE_THEN "F5" (LABEL_TAC "F6" o REWRITE_RULE[POWER_1] o SPEC `1` o (MATCH_MP lemma_power_back_in_loop))\r
13150        THEN ABBREV_TAC `y = back (L:(A)loop) (x:A)`\r
13151        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_inverse_evaluation] o AP_TERM `next (L:(A)loop)`)\r
13152        THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC\r
13153        THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F4" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13154        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_next_exclusive)\r
13155        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13156    THEN REMOVE_THEN "F2" (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
13157    THEN USE_THEN "F5" (LABEL_TAC "F6" o REWRITE_RULE[POWER_1] o SPEC `1` o (MATCH_MP lemma_power_back_in_loop))\r
13158    THEN ABBREV_TAC `y = back (L:(A)loop) (x:A)` THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_inverse_evaluation] o AP_TERM `next (L:(A)loop)`)\r
13159    THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC\r
13160    THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F4" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13161    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_next_exclusive)\r
13162    THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN SIMP_TAC[]\r
13163    THEN DISCH_TAC THEN MATCH_MP_TAC lemma_unique_tail\r
13164    THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[atom_reflect]\r
13165    THEN USE_THEN "F6" (fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP lemma_power_next_in_loop th))])\r
13166    THEN POP_ASSUM (fun th -> REWRITE_TAC[lemma_inverse_evaluation; th]));;\r
13167 \r
13168 let lemma_tail = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) (y:A). is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L /\ y IN atom H L x ==> (tail H NF x = y <=> y = face_map H (back L y))`,\r
13169  REPEAT GEN_TAC\r
13170    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC))\r
13171    THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(CONJUNCT2(MATCH_MP change_parameters th))] THEN MP_TAC th)\r
13172    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC))\r
13173    THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop)\r
13174    THEN MATCH_MP_TAC lemma_tail_via_restricted THEN ASM_REWRITE_TAC[]);;\r
13175 \r
13176 let lemma_singleton_atom = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L \r
13177    ==> (atom H L x = {x} <=> next L x = face_map H x /\ face_map H (back L x) = x)`,\r
13178  REPEAT GEN_TAC\r
13179    THEN DISCH_THEN (LABEL_TAC "F1")\r
13180    THEN USE_THEN "F1" (LABEL_TAC "F2" o CONJUNCT2)\r
13181    THEN EQ_TAC\r
13182    THENL[DISCH_THEN (LABEL_TAC "F3")\r
13183        THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o MATCH_MP head_on_loop)\r
13184        THEN USE_THEN "F3" SUBST1_TAC\r
13185        THEN REWRITE_TAC[IN_SING]\r
13186        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_head_via_restricted th])\r
13187        THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
13188        THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o MATCH_MP tail_on_loop)\r
13189        THEN USE_THEN "F3" SUBST1_TAC\r
13190        THEN REWRITE_TAC[IN_SING]\r
13191        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_tail_via_restricted th])\r
13192        THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]); ALL_TAC]\r
13193    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))\r
13194    THEN MATCH_MP_TAC atom_one_point\r
13195    THEN EXISTS_TAC `NF:(A)loop->bool` THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th])\r
13196    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_head_via_restricted)\r
13197    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th])                                 \r
13198    THEN DISCH_THEN SUBST1_TAC\r
13199    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_tail_via_restricted)\r
13200    THEN USE_THEN "F4" (fun th-> MESON_TAC[SYM th; EQ_SYM]));;\r
13201 \r
13202 \r
13203 (* the condition which neeeds to split a loop into two other special loops *)\r
13204 \r
13205 let is_split_condition = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_split_condition H NF L x \r
13206     <=> is_restricted H  /\ is_normal H NF /\ L IN NF /\ ~(L IN canon H NF) /\ x belong L /\ head H NF x = x`;;\r
13207 \r
13208 let lemma_mInside_Exists = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x   \r
13209    ==> ?m:num. ((!i:num. i <= SUC m ==> ((next L POWER i) x = (face_map H POWER i) x)) \r
13210                 /\ ~((next L POWER (SUC (SUC m))) x = (face_map H POWER (SUC (SUC m))) x))`,\r
13211  REPEAT GEN_TAC\r
13212    THEN REWRITE_TAC[is_split_condition] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))))))\r
13213    THEN REMOVE_THEN "F4" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
13214    THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; NOT_FORALL_THM;NOT_IMP ]\r
13215    THEN DISCH_THEN (LABEL_TAC "F7")\r
13216    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> USE_THEN "F3" (fun th2-> REWRITE_TAC[MATCH_MP lemma_true_loop1 (CONJ th (CONJ th1 th2))])))\r
13217    THEN EXISTS_TAC `x:A` THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
13218    THEN MATCH_MP_TAC num_WF\r
13219    THEN INDUCT_TAC THENL[REWRITE_TAC[ARITH_RULE `m:num < 0 <=> F`; POWER_0; I_THM]; ALL_TAC]\r
13220    THEN POP_ASSUM (LABEL_TAC "F8")\r
13221    THEN DISCH_THEN (LABEL_TAC "F9")\r
13222    THEN ASM_CASES_TAC `n:num = 0`\r
13223    THENL[POP_ASSUM SUBST_ALL_TAC\r
13224        THEN REWRITE_TAC[GSYM ONE; POWER_1] THEN CONV_TAC SYM_CONV\r
13225        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th2-> USE_THEN "F3" (fun th3-> USE_THEN "F5" (fun th5-> MP_TAC (MATCH_MP lemma_head_via_restricted (CONJ th (CONJ th2 (CONJ th3 th5))))))))\r
13226        THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13227    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; ADD])\r
13228    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
13229    THEN REMOVE_THEN "F7" (MP_TAC o SPEC `d:num`)\r
13230    THEN STRIP_TAC \r
13231    THENL[USE_THEN "F9" (MP_TAC o REWRITE_RULE[LT_SUC_LE] o SPEC `i:num`)\r
13232        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
13233        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13234    THEN POP_ASSUM SUBST1_TAC THEN SIMP_TAC[]);;\r
13235 \r
13236 (* The notion of flag is actually defined on quotient hypermaps. I only use this notion for those with restricted cover hypermap,\r
13237    so I define that in term of cover hypermaps. *)\r
13238 \r
13239 let lemma_mInside = new_specification["mInside"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_mInside_Exists);;\r
13240 \r
13241 let lemma_bound_mInside = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x \r
13242     ==> SUC (mInside H NF L x) < CARD (face H x)`,\r
13243  REPEAT GEN_TAC\r
13244    THEN DISCH_THEN (LABEL_TAC "F1")\r
13245    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))))) o REWRITE_RULE[is_split_condition])\r
13246    THEN USE_THEN "F1" (LABEL_TAC "F8" o CONJUNCT1 o MATCH_MP lemma_mInside)\r
13247    THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT]\r
13248    THEN DISCH_THEN (LABEL_TAC "F9")\r
13249    THEN USE_THEN "F2" (fun th-> USE_THEN "F3"(fun th1-> USE_THEN "F4" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_true_loop1 (CONJ th (CONJ th1 th2))])))\r
13250    THEN EXISTS_TAC `x:A` THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC\r
13251    THEN MP_TAC (REWRITE_RULE[LT1_NZ; LT_NZ] (SPECL[`H:(A)hypermap`; `x:A`] FACE_NOT_EMPTY))\r
13252    THEN DISCH_THEN (MP_TAC o SPEC `n:num` o MATCH_MP DIVMOD_EXIST)\r
13253    THEN DISCH_THEN (X_CHOOSE_THEN `q:num` (X_CHOOSE_THEN `r:num` (CONJUNCTS_THEN2 (SUBST1_TAC o REWRITE_RULE[ADD_SYM]) (LABEL_TAC "G1"))))\r
13254    THEN REWRITE_TAC[lemma_add_exponent_function]\r
13255    THEN LABEL_TAC "G2" (SPECL[`H:(A)hypermap`; `x:A`] lemma_face_cycle)\r
13256    THEN USE_THEN "G2" (fun th-> REWRITE_TAC[MATCH_MP power_map_fix_point th])\r
13257    THEN USE_THEN "F8" (MP_TAC o SPEC `CARD (face (H:(A)hypermap) (x:A))`)\r
13258    THEN USE_THEN "F9" (fun th-> REWRITE_TAC[th])\r
13259    THEN POP_ASSUM SUBST1_TAC\r
13260    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP power_map_fix_point th])\r
13261    THEN REMOVE_THEN "F8" (MP_TAC o SPEC `r:num`)\r
13262    THEN USE_THEN "G1" (fun th-> USE_THEN "F9" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (MATCH_MP LT_IMP_LE th) th1); EQ_SYM])));;\r
13263 \r
13264 let lemma_congruence_on_face = prove(`!H:(A)hypermap x:A n:num m:num. n < CARD (face H x) /\ (face_map H POWER n) x = (face_map H POWER m) x \r
13265    ==> ?q:num. m = q * CARD (face H x) + n`,\r
13266    REWRITE_TAC[face] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma_congruence_on_orbit\r
13267    THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[SPEC`H:(A)hypermap` face_map_and_darts]);;\r
13268 \r
13269 let dart_inside = new_definition `!H:(A)hypermap (NF:(A)loop->bool) (L:(A)loop) (x:A). \r
13270     dart_inside H NF L x = {((face_map H) POWER i) x | i:num | 1 <= i /\ i <= mInside  H NF L x}`;;\r
13271 \r
13272 let lemma_dart_inside_sub_loop = prove(`!H:(A)hypermap (NF:(A)loop->bool) (L:(A)loop) (x:A). is_split_condition H NF L x \r
13273     ==>  dart_inside H NF L x SUBSET dart_of L`,\r
13274    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[SUBSET; dart_inside; IN_ELIM_THM; GSYM belong]\r
13275    THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) SUBST1_TAC))\r
13276    THEN USE_THEN "F1" (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_mInside)\r
13277    THEN USE_THEN "F3"(fun th->REWRITE_TAC[MATCH_MP LT_IMP_LE (MATCH_MP LET_TRANS (CONJ th (SPEC `mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` LT_PLUS)))])\r
13278    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
13279    THEN MATCH_MP_TAC lemma_power_next_in_loop THEN USE_THEN "F1" (fun th-> REWRITE_TAC[REWRITE_RULE[is_split_condition] th]));;\r
13280 \r
13281 let canon_flag = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool). canon_flag H NF <=> (!x:A y:A. x IN canon_darts H NF /\ y IN canon_darts H NF ==> (?p:num->A k:num. p 0 = x /\ p k = y /\ is_contour H p k /\  support_list p k SUBSET canon_darts H NF)) /\ (!L:(A)loop x:A. L IN NF /\ ~(L IN canon H NF) /\ x belong L ==> edge_map H (head H NF x) IN canon_darts H NF)`;;\r
13282 \r
13283 let flag = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). flag H NF L x <=> ((!u:A v:A. u IN canon_darts H NF /\ v IN canon_darts H NF ==> (?p:num->A k:num. p 0 = u /\ p k = v /\ is_contour H p k /\ support_list p k SUBSET canon_darts H NF)) \r
13284     /\ (!L':(A)loop y:A. L' IN NF /\ ~(L' IN canon H NF) /\ y belong L' /\  ~(head H NF y IN dart_inside H NF L x)  ==> edge_map H (head H NF y) IN (canon_darts H NF UNION dart_inside H NF L x)))`;;\r
13285 \r
13286 let heading = new_definition `!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. heading H NF L x = ((face_map H) POWER (SUC(mInside H NF L x))) x`;;\r
13287 \r
13288 let lemma_loop_eq_face = prove(`!H:(A)hypermap L:(A)loop x:A n:num. 1 <= n /\ x belong L /\ (!i:num. i <= n ==> (next L POWER i) x = (face_map H POWER i) x) /\ (next L POWER n) x = x ==> dart_of L = face H x /\ size L <= n`, \r
13289  REPEAT GEN_TAC\r
13290    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1" o REWRITE_RULE[LT1_NZ; LT_NZ]) (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
13291    THEN USE_THEN "F4" (fun th-> USE_THEN "F3" (ASSUME_TAC o SYM o REWRITE_RULE[LE_REFL; th] o  SPEC `n:num`))\r
13292    THEN USE_THEN "F2" (fun th -> REWRITE_TAC[size; MATCH_MP lemma_transitive_permutation th; face])\r
13293    THEN STRIP_TAC\r
13294    THENL[USE_THEN "F1"(fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1)])) \r
13295        THEN USE_THEN "F1"(fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1)]))\r
13296        THEN REMOVE_THEN "F1" (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; ADD])\r
13297        THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
13298        THEN REWRITE_TAC[LT_SUC_LE]\r
13299        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_add_one_assumption])\r
13300        THEN REWRITE_TAC[lemma_two_series_eq]; ALL_TAC]\r
13301    THEN USE_THEN "F1"(fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1); CARD_FINITE_SERIES_LE])));;\r
13302 \r
13303 let lemma_on_heading = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x  ==> (heading H NF L x) belong L /\ next L (heading H NF L x) = (inverse (node_map H) (heading H NF L x)) /\ ~(node H (heading H NF L x) = node H x)`,\r
13304    REPEAT GEN_TAC\r
13305    THEN DISCH_THEN (LABEL_TAC "F1")\r
13306    THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_mInside)\r
13307    THEN DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `SUC (mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A))`) MP_TAC)\r
13308    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COM_POWER]\r
13309    THEN REWRITE_TAC[o_THM; LE_REFL; GSYM heading] THEN (DISCH_THEN (LABEL_TAC "F2"))\r
13310    THEN DISCH_THEN (SUBST_ALL_TAC o SYM)\r
13311    THEN ABBREV_TAC `m = SUC (mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A))` \r
13312    THEN POP_ASSUM (LABEL_TAC "FC") \r
13313    THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_split_condition])\r
13314    THEN DISCH_THEN (LABEL_TAC "F3" o SPEC `m:num` o MATCH_MP lemma_power_next_in_loop)\r
13315    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
13316    THEN ABBREV_TAC `y = (next (L:(A)loop) POWER (m:num)) (x:A)` THEN USE_THEN "F3" MP_TAC\r
13317    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1))) o  REWRITE_RULE[is_split_condition])\r
13318    THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC)\r
13319    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13320    THEN USE_THEN "F2" (fun th-> DISCH_THEN (fun th1 -> REWRITE_TAC[REWRITE_RULE[th] (MATCH_MP lemma_next_exclusive th1)]))\r
13321    THEN POP_ASSUM (LABEL_TAC "F4")\r
13322    THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
13323    THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `m:num`] lemma_in_face)\r
13324    THEN USE_THEN "FC" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th; LE_REFL] o SPEC `m:num` o CONJUNCT1 o  MATCH_MP lemma_mInside))\r
13325    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
13326    THEN USE_THEN "F4" SUBST1_TAC\r
13327    THEN MP_TAC(SPECL[`H:(A)hypermap`; `y:A`] node_refl)\r
13328    THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
13329    THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted] o CONJUNCT1 o REWRITE_RULE[is_split_condition])\r
13330    THEN SUBGOAL_THEN `x:A IN dart (H:(A)hypermap)` MP_TAC\r
13331    THENL[MATCH_MP_TAC lemma_in_dart\r
13332         THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `L:(A)loop` THEN USE_THEN "F1" (fun th-> REWRITE_TAC[REWRITE_RULE[is_split_condition] th])\r
13333         ; ALL_TAC]\r
13334    THEN DISCH_THEN (fun th-> (POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th; IN_SING])))\r
13335    THEN DISCH_THEN SUBST1_TAC\r
13336    THEN USE_THEN "F1" (MP_TAC o REWRITE_RULE[POWER_1; GE_1] o SPEC `1` o CONJUNCT1 o  MATCH_MP lemma_mInside)\r
13337    THEN SIMP_TAC[]);;\r
13338 \r
13339 let CONJ3 th1 th2 th3 = (CONJ th1 (CONJ th2 th3));;\r
13340 \r
13341 let CONJ4 th1 th2 th3 th4 = (CONJ th1 (CONJ th2 (CONJ th3 th4)));;\r
13342 \r
13343 let lemma_face_contour_on_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A m:num. is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L /\ head H NF x = x /\ (!i:num. i <= SUC m ==> (next L POWER i) x = (face_map H POWER i) x) ==> ((!i:num. 1 <= i /\ i <= m ==> atom H L ((next L POWER i) x) = {(face_map H POWER i)x}) /\ (!i:num. 1 <= i /\ i <= m ==> (face_map (quotient H NF) POWER i) (atom H L x) = {(face_map H POWER i) x}) /\\r
13344 ((face_map (quotient H NF) POWER (SUC m)) (atom H L x) = atom H L ((face_map H POWER (SUC m)) x)))`,\r
13345    REPEAT GEN_TAC\r
13346    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))))))\r
13347    THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
13348    THEN SUBGOAL_THEN `!i:num. 1 <= i /\ i <= m:num ==> atom (H:(A)hypermap) L ((next L POWER i) x) = {(face_map H POWER i) x}` (LABEL_TAC "F7")\r
13349    THENL[GEN_TAC\r
13350        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
13351        THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS))))\r
13352        THEN USE_THEN "F6" (fun th-> DISCH_THEN (SUBST1_TAC o SYM o MATCH_MP th))\r
13353        THEN USE_THEN "F4" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop)\r
13354        THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13355        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_singleton_atom th])\r
13356        THEN STRIP_TAC\r
13357        THENL[REWRITE_TAC[COM_POWER_FUNCTION]\r
13358            THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS))))\r
13359            THEN USE_THEN "F6" (fun th-> DISCH_THEN (SUBST1_TAC o MATCH_MP th))\r
13360            THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
13361            THEN USE_THEN "H2" (fun th-> USE_THEN "F6"(fun th1-> REWRITE_TAC[MATCH_MP th1 (ONCE_REWRITE_RULE[GSYM LE_SUC] th)])); ALL_TAC]\r
13362        THEN USE_THEN "H1" ((X_CHOOSE_THEN `d:num` (MP_TAC o REWRITE_RULE[GSYM ADD1] o ONCE_REWRITE_RULE[ADD_SYM]) o REWRITE_RULE[LE_EXISTS]))\r
13363        THEN DISCH_THEN (fun th-> LABEL_TAC "H3" th THEN SUBST1_TAC th)\r
13364        THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [GSYM COM_POWER_FUNCTION; lemma_inverse_evaluation]\r
13365        THEN USE_THEN "H3" (fun th-> USE_THEN "H2" (MP_TAC o REWRITE_RULE[th]))\r
13366        THEN DISCH_THEN (MP_TAC o MATCH_MP LE_TRANS o CONJ (SPEC `d:num` LE_PLUS))\r
13367        THEN DISCH_THEN (fun th-> MP_TAC(MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS))))\r
13368        THEN DISCH_THEN (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP th1 th; COM_POWER_FUNCTION]))\r
13369        THEN USE_THEN "H3" (fun th-> USE_THEN "H2" (MP_TAC o REWRITE_RULE[th]))\r
13370        THEN DISCH_THEN (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS))))\r
13371        THEN USE_THEN "F6"(fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC]\r
13372    THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th])\r
13373    THEN SUBGOAL_THEN `!i:num. 1 <= i /\ i <= (m:num) ==> (fmap (H:(A)hypermap) NF POWER i) (atom H L x) = {(face_map H POWER i) x}` (LABEL_TAC "F8")\r
13374    THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM] THEN ARITH_TAC; ALL_TAC]\r
13375        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
13376        THEN ASM_CASES_TAC `i:num = 0`\r
13377        THENL[POP_ASSUM (LABEL_TAC "H3")\r
13378            THEN USE_THEN "H3" (fun th-> REWRITE_TAC[th; GSYM ONE; POWER_1; I_THM])\r
13379            THEN USE_THEN "F2" (fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2-> REWRITE_TAC[MATCH_MP unique_fmap (CONJ3 th th1 th2)])))\r
13380            THEN USE_THEN "F5" SUBST1_TAC\r
13381            THEN USE_THEN "F7" (MP_TAC o SPEC `SUC 0`)\r
13382            THEN USE_THEN "H2" MP_TAC THEN USE_THEN "H3" SUBST1_TAC THEN REWRITE_TAC[GSYM ONE]\r
13383            THEN DISCH_THEN (fun th-> REWRITE_TAC[th; LE_REFL; POWER_1])\r
13384            THEN USE_THEN "F6" (fun th-> REWRITE_TAC[REWRITE_RULE[GE_1; POWER_1] (SPEC `1` th)]); ALL_TAC]\r
13385        THEN POP_ASSUM (LABEL_TAC "H3" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
13386        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM COM_POWER_FUNCTION]\r
13387        THEN FIRST_ASSUM (MP_TAC o check (is_imp o concl))\r
13388        THEN USE_THEN "H3"(fun th->USE_THEN "H2" (fun th1-> REWRITE_TAC[th; MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS)th1)]))\r
13389        THEN DISCH_THEN SUBST1_TAC\r
13390        THEN USE_THEN "F4" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop)\r
13391        THEN USE_THEN "F7" (MP_TAC o SPEC `i:num`)\r
13392        THEN USE_THEN "H3" (fun th1-> (USE_THEN "H2"(fun th-> REWRITE_TAC[th1; MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)])))\r
13393        THEN USE_THEN "F6" (MP_TAC o SPEC `i:num`)\r
13394        THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)))\r
13395        THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS))])\r
13396        THEN DISCH_THEN SUBST1_TAC\r
13397        THEN DISCH_THEN (LABEL_TAC "H4")\r
13398        THEN USE_THEN "H4" (fun th-> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
13399        THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION]\r
13400        THEN ABBREV_TAC `u = (face_map (H:(A)hypermap) POWER i) x`\r
13401        THEN DISCH_THEN (LABEL_TAC "H5")\r
13402        THEN USE_THEN "F2" (fun th->USE_THEN "F3"(fun th1->USE_THEN "H5"(fun th2-> REWRITE_TAC[MATCH_MP unique_fmap (CONJ3 th th1 th2)])))\r
13403        THEN USE_THEN "F2" (fun th->USE_THEN "F3"(fun th1->USE_THEN "H5"(fun th2-> MP_TAC(CONJUNCT1(MATCH_MP head_on_loop (CONJ3 th th1 th2))))))\r
13404        THEN USE_THEN "H4" SUBST1_TAC\r
13405        THEN REWRITE_TAC[IN_SING]\r
13406        THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "u"\r
13407        THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
13408        THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS))))\r
13409        THEN DISCH_THEN(fun th->USE_THEN "F6"(fun th1->GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [SYM(MATCH_MP th1 th)]))\r
13410        THEN USE_THEN "H1"(fun th->USE_THEN "H2"(fun th1->USE_THEN "F7"(fun th2-> REWRITE_TAC [MATCH_MP th2 (CONJ th th1)]))); ALL_TAC]\r
13411    THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th])\r
13412    THEN ASM_CASES_TAC `m = 0`\r
13413    THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM ONE; POWER_1]\r
13414        THEN USE_THEN "F2" (fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2-> REWRITE_TAC[MATCH_MP unique_fmap (CONJ3 th th1 th2)])))\r
13415        THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13416    THEN POP_ASSUM (LABEL_TAC "H1" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
13417    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)[GSYM COM_POWER_FUNCTION]\r
13418    THEN USE_THEN "H1" (fun th-> USE_THEN "F8" (SUBST1_TAC o REWRITE_RULE[th; LE_REFL] o SPEC `m:num`))\r
13419    THEN USE_THEN "F4" (MP_TAC o SPEC `m:num` o MATCH_MP lemma_power_next_in_loop)\r
13420    THEN USE_THEN "F7" (MP_TAC o SPEC `m:num`)\r
13421    THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th; LE_REFL])\r
13422    THEN USE_THEN "F6" (MP_TAC o REWRITE_RULE[LE_PLUS] o SPEC `m:num`)\r
13423    THEN DISCH_THEN SUBST1_TAC\r
13424    THEN DISCH_THEN (LABEL_TAC "H2")\r
13425    THEN USE_THEN "H2" (fun th-> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
13426    THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION]\r
13427    THEN ABBREV_TAC `u = (face_map (H:(A)hypermap) POWER m) x`\r
13428    THEN DISCH_THEN (LABEL_TAC "H3")\r
13429    THEN USE_THEN "F2" (fun th->USE_THEN "F3"(fun th1->USE_THEN "H3"(fun th2-> REWRITE_TAC[MATCH_MP unique_fmap (CONJ3 th th1 th2)])))\r
13430    THEN USE_THEN "F2" (fun th->USE_THEN "F3"(fun th1->USE_THEN "H3"(fun th2-> MP_TAC(CONJUNCT1(MATCH_MP head_on_loop (CONJ3 th th1 th2))))))\r
13431    THEN USE_THEN "H2" SUBST1_TAC\r
13432    THEN REWRITE_TAC[IN_SING]\r
13433    THEN DISCH_THEN (fun th-> REWRITE_TAC[th]));;\r
13434 \r
13435 let lemma_atom_on_inside_dart  = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x ==> (!i:num. 1 <= i /\ i <= mInside H NF L x ==> ((face_map (quotient H NF) POWER i) (atom H L x) = {(face_map H POWER i) x}))  /\ ((face_map (quotient H NF) POWER (SUC(mInside H NF L x))) (atom H L x) = atom H L (heading H NF L x))`,\r
13436    REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC")\r
13437    THEN USE_THEN "FC" (MP_TAC o REWRITE_RULE[is_split_condition])\r
13438    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))))))\r
13439    THEN REWRITE_TAC[heading]\r
13440    THEN USE_THEN "FC" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_mInside)\r
13441    THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC\r
13442    THEN ABBREV_TAC `m = mInside (H:(A)hypermap) NF L x` THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13443    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_face_contour_on_loop th]));;\r
13444 \r
13445 let lemma_mInside_and_length_cycle = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x \r
13446    ==> SUC (mInside H NF L x) < CARD (cycle H L)`,\r
13447    REPEAT GEN_TAC\r
13448    THEN DISCH_THEN (LABEL_TAC "F1")\r
13449    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))))) o REWRITE_RULE[is_split_condition])\r
13450    THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
13451    THEN REWRITE_TAC[NOT_LT; CONJUNCT2 LE]\r
13452    THEN STRIP_TAC\r
13453    THENL[MP_TAC (SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` (MATCH_MP lemma_cycle_orbit (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` face_map_and_darts)))\r
13454       THEN USE_THEN "F3"(fun th->(USE_THEN "F4"(fun th2->(USE_THEN "F6"(fun th3-> MP_TAC(GSYM(MATCH_MP lemma_cycle_is_face (CONJ th (CONJ th2 th3)))))))))\r
13455       THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)])\r
13456       THEN DISCH_THEN SUBST1_TAC\r
13457       THEN POP_ASSUM SUBST1_TAC\r
13458       THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_atom_on_inside_dart th])\r
13459       THEN DISCH_TAC\r
13460       THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`] atom_reflect)\r
13461       THEN POP_ASSUM SUBST1_TAC\r
13462       THEN DISCH_THEN (fun th-> (MP_TAC (MATCH_MP lemma_in_subset (CONJ (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node) th))))\r
13463       THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP lemma_node_identity)\r
13464       THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_heading th]); ALL_TAC]\r
13465    THEN POP_ASSUM (LABEL_TAC "F10")\r
13466    THEN USE_THEN "F1" (MP_TAC o SPEC `CARD (cycle (H:(A)hypermap) (L:(A)loop))` o CONJUNCT1 o MATCH_MP lemma_atom_on_inside_dart)\r
13467    THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th])\r
13468    THEN SUBGOAL_THEN `1 <= CARD (cycle (H:(A)hypermap) (L:(A)loop))` (LABEL_TAC "F11")\r
13469    THENL[MATCH_MP_TAC CARD_ATLEAST_1\r
13470       THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`\r
13471       THEN USE_THEN "F3" (fun th-> (USE_THEN "F4"(fun th1-> REWRITE_TAC[MATCH_MP lemma_cycle_finite (CONJ th th1)])))\r
13472       THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th]); ALL_TAC]\r
13473    THEN USE_THEN "F11" (fun th-> REWRITE_TAC[th])\r
13474    THEN MP_TAC (SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` (MATCH_MP lemma_cycle_orbit (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` face_map_and_darts)))\r
13475    THEN USE_THEN "F3"(fun th->(USE_THEN "F4"(fun th2->(USE_THEN "F6"(fun th3-> MP_TAC(GSYM(MATCH_MP lemma_cycle_is_face (CONJ th (CONJ th2 th3)))))))))\r
13476    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)])\r
13477    THEN DISCH_THEN SUBST1_TAC\r
13478    THEN DISCH_THEN SUBST1_TAC\r
13479    THEN ABBREV_TAC `n = CARD (cycle (H:(A)hypermap) (L:(A)loop))` THEN DISCH_TAC\r
13480    THEN MP_TAC (SPECL[`(H:(A)hypermap)`;`(L:(A)loop)`; `(x:A)`] atom_reflect)\r
13481    THEN POP_ASSUM SUBST1_TAC\r
13482    THEN REWRITE_TAC[IN_SING]\r
13483    THEN DISCH_THEN (LABEL_TAC "F12" o SYM)\r
13484    THEN SUBGOAL_THEN `!i:num. i <= n:num ==> (next (L:(A)loop) POWER i) (x:A) = (face_map (H:(A)hypermap) POWER i) x` (LABEL_TAC "F14")\r
13485    THENL[REPEAT STRIP_TAC\r
13486       THEN USE_THEN "F1" (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_mInside)\r
13487       THEN POP_ASSUM(fun th-> USE_THEN "F10" (fun th1 -> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1))))\r
13488       THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (SPEC `mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` LE_PLUS))])\r
13489       ; ALL_TAC]\r
13490    THEN USE_THEN "F14" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`)\r
13491    THEN USE_THEN "F12" SUBST1_TAC\r
13492    THEN DISCH_THEN (LABEL_TAC "F15")\r
13493    THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F4" (fun th2-> REWRITE_TAC[MATCH_MP lemma_true_loop (CONJ th (CONJ th1 th2))])))\r
13494    THEN EXISTS_TAC `x:A`\r
13495    THEN USE_THEN "F15" MP_TAC THEN USE_THEN "F14" MP_TAC THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F11" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13496    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_loop_eq_face th]));;\r
13497 \r
13498 let lemma_mAdd_Exists = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x ==> \r
13499    ?p:num. (!i:num. 1 <= i /\ i <= p ==> ~((face_map H POWER i) (heading H NF L x) IN support_darts NF)) \r
13500            /\ ((face_map H POWER (SUC p)) (heading H NF L x) IN support_darts NF)`,\r
13501  REPEAT GEN_TAC\r
13502    THEN DISCH_THEN (LABEL_TAC "F1")\r
13503    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13504    THEN POP_ASSUM (LABEL_TAC "F2")\r
13505    THEN SUBGOAL_THEN `?n:num. 1 <= n /\ (face_map (H:(A)hypermap) POWER n) (y:A) IN support_darts (NF:(A)loop->bool)` ASSUME_TAC\r
13506    THENL[POP_ASSUM (MP_TAC o SYM o REWRITE_RULE[heading])\r
13507        THEN REWRITE_TAC[MATCH_MP inverse_power_function (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))]\r
13508        THEN MP_TAC (SPEC `SUC (mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A))` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)))\r
13509        THEN DISCH_THEN (X_CHOOSE_THEN `j:num`  SUBST1_TAC)\r
13510        THEN DISCH_THEN (MP_TAC o AP_TERM `face_map (H:(A)hypermap) POWER (CARD (face H (x:A)))`)\r
13511        THEN REWRITE_TAC[lemma_face_cycle; GSYM lemma_add_exponent_function]\r
13512        THEN ABBREV_TAC `k = CARD (face (H:(A)hypermap) (x:A)) + (j:num)`\r
13513        THEN POP_ASSUM (fun th-> (LABEL_TAC "F2" (MATCH_MP (ARITH_RULE `!m:num n:num t:num. 1 <= m /\ m + n = t ==> 1 <= t`) (CONJ (SPECL[`H:(A)hypermap`; `x:A`] FACE_NOT_EMPTY) th))))\r
13514        THEN DISCH_THEN (ASSUME_TAC o SYM)\r
13515        THEN EXISTS_TAC `k:num` THEN POP_ASSUM (SUBST1_TAC)\r
13516        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[lemma_in_support] THEN EXISTS_TAC `L:(A)loop`\r
13517        THEN POP_ASSUM (fun th-> (REWRITE_TAC[REWRITE_RULE[is_split_condition] th])); ALL_TAC]\r
13518    THEN POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[num_WOP])\r
13519    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[LE_EXISTS]) (LABEL_TAC "F3")) (LABEL_TAC "F4")))\r
13520    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
13521    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC o REWRITE_RULE[GSYM ADD1]))\r
13522    THEN EXISTS_TAC `d:num` THEN REMOVE_THEN "F3" (fun th-> REWRITE_TAC[th])\r
13523    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_SUC_LE; DE_MORGAN_THM])\r
13524    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `(A ==> ~B \/ C) <=> (A /\ B ==> C)`] THEN SIMP_TAC[]);;\r
13525 \r
13526 let lemma_mAdd = new_specification["mAdd"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_mAdd_Exists);;\r
13527 \r
13528 let is_marked = new_definition `!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x <=> is_restricted H /\ is_normal H NF /\ L IN NF /\ x belong L /\ next L x = face_map H x /\ simple_hypermap (quotient H NF) /\ is_node_nondegenerate (quotient H NF) /\ (edge_map H x IN canon_darts H NF) /\\r
13529 (L IN canon H NF ==> canon_flag H NF) /\ (~(L IN canon H NF) ==> flag H NF L x)`;;\r
13530 \r
13531 let lemma_marked_dart = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x \r
13532    ==> head H NF x = x /\ inverse (node_map H) x IN canon_darts H NF`,\r
13533    REPEAT GEN_TAC\r
13534    THEN REWRITE_TAC[is_marked]\r
13535    THEN DISCH_THEN(CONJUNCTS_THEN2(LABEL_TAC "F1")(CONJUNCTS_THEN2(LABEL_TAC "F2")(CONJUNCTS_THEN2(LABEL_TAC "F3")(CONJUNCTS_THEN2(LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2))))))\r
13536    THEN USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1->USE_THEN "F3"(fun th2->USE_THEN "F4"(fun th3->MP_TAC(MATCH_MP lemma_head_via_restricted (CONJ th (CONJ th1 (CONJ th2 th3))))))))\r
13537    THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
13538    THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
13539    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_canon_darts])\r
13540    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")))\r
13541    THEN USE_THEN "F7" (MP_TAC o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop)\r
13542    THEN USE_THEN "F6" (fun th-> USE_THEN "F7" (fun th1-> MP_TAC (REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP lemma_power_canon_next (CONJ th th1))))))\r
13543    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
13544    THEN ONCE_REWRITE_TAC[CONJUNCT1 (SPEC `H:(A)hypermap` inverse2_hypermap_maps)]\r
13545    THEN REWRITE_TAC[o_THM; MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]\r
13546    THEN USE_THEN "F6"(fun th-> DISCH_THEN(fun th1-> REWRITE_TAC[MATCH_MP is_in_canon_darts (CONJ th1 th)])));;\r
13547 \r
13548 let lemma_split_marked_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) \r
13549    ==> is_split_condition H NF L x`,\r
13550    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") ASSUME_TAC) THEN REWRITE_TAC[is_split_condition]\r
13551    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_marked_dart th])\r
13552    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
13553    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[REWRITE_RULE[is_marked] th]));;\r
13554 \r
13555 let attach = new_definition `!H:(A)hypermap (NF:(A)loop->bool) (L:(A)loop) (x:A). \r
13556     attach H NF L x = ((face_map H) POWER (SUC (mAdd H NF L x))) (heading H NF L x)`;;\r
13557 \r
13558 let lemma_new_darts_in_face = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. heading H NF L x IN face H x /\ attach H NF L x IN face H x`,\r
13559    REWRITE_TAC[attach; heading; GSYM lemma_add_exponent_function; lemma_in_face]);;\r
13560 \r
13561 let lemma_on_attach = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x\r
13562     ==> ~(node H (heading H NF L x) = node H (attach H NF L x)) /\ SUC (mAdd H NF L x) < CARD (face H x)`,\r
13563    REPEAT GEN_TAC\r
13564    THEN DISCH_THEN (LABEL_TAC "F1")\r
13565    THEN USE_THEN "F1" (LABEL_TAC "F2" o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_split_condition])\r
13566    THEN USE_THEN "F1"((CONJUNCTS_THEN2 (LABEL_TAC "F6")(CONJUNCTS_THEN2(LABEL_TAC "F7")(LABEL_TAC "F8" o CONJUNCT1))) o REWRITE_RULE[is_split_condition])\r
13567    THEN USE_THEN "F7"(fun th->USE_THEN "F8"(fun th1->USE_THEN "F2" (fun th2->LABEL_TAC "FA" (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
13568    THEN STRIP_TAC\r
13569    THENL[ USE_THEN "F1" (LABEL_TAC "F3" o CONJUNCT1 o MATCH_MP lemma_mInside)\r
13570       THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_mAdd)\r
13571       THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [TAUT `(A ==> ~B) <=> ~(A /\B)`; GSYM NOT_EXISTS_THM]\r
13572       THEN REWRITE_TAC[CONTRAPOS_THM]\r
13573       THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13574       THEN POP_ASSUM (LABEL_TAC "F4")\r
13575       THEN REWRITE_TAC[attach]\r
13576       THEN ABBREV_TAC `p = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13577       THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13578       THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `y:A`; `SUC p`] lemma_in_face)\r
13579       THEN MP_TAC(SPECL[`H:(A)hypermap`; `(face_map (H:(A)hypermap) POWER (SUC p)) (y:A)`] node_refl)\r
13580       THEN POP_ASSUM (SUBST1_TAC o SYM)\r
13581       THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
13582       THEN POP_ASSUM (LABEL_TAC "F5")\r
13583       THEN USE_THEN "FA" (MP_TAC o SPEC `SUC m` o MATCH_MP lemma_dart_invariant_power_face)\r
13584       THEN EXPAND_TAC "m" THEN USE_THEN "F5" (fun th-> REWRITE_TAC[GSYM heading; th])\r
13585       THEN DISCH_THEN (LABEL_TAC "F9")\r
13586       THEN USE_THEN "F6" (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
13587       THEN USE_THEN "F9" (fun th-> (POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th; IN_SING])))\r
13588       THEN ASM_CASES_TAC `p:num = 0`\r
13589       THENL[POP_ASSUM (fun th-> REWRITE_TAC[th; GSYM ONE; POWER_1])\r
13590           THEN ONCE_REWRITE_TAC[SPEC `face_map (H:(A)hypermap)` orbit_one_point]\r
13591           THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[GSYM face])\r
13592           THEN USE_THEN "F6" (MP_TAC o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
13593           THEN DISCH_THEN (MP_TAC o SPEC `y:A`)\r
13594           THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th; CARD_SINGLETON]) THEN ARITH_TAC; ALL_TAC]\r
13595       THEN POP_ASSUM (LABEL_TAC "F10" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
13596       THEN USE_THEN "F5" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)[SYM th])\r
13597       THEN REWRITE_TAC[heading; COM_POWER; o_THM;face_map_injective]\r
13598       THEN USE_THEN "F4" SUBST1_TAC\r
13599       THEN USE_THEN "F3" (fun th-> MP_TAC(MATCH_MP th (MATCH_MP LT_IMP_LE (SPEC `m:num` LT_PLUS))))\r
13600       THEN DISCH_THEN (SUBST1_TAC o SYM) THEN DISCH_TAC THEN EXISTS_TAC `p:num` THEN POP_ASSUM SUBST1_TAC\r
13601       THEN POP_ASSUM (fun th-> REWRITE_TAC[th; LE_REFL])\r
13602       THEN MATCH_MP_TAC lemma_in_support2\r
13603       THEN EXISTS_TAC `L:(A)loop` THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th])\r
13604       THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC]\r
13605    THEN SUBGOAL_THEN `1 < CARD (face (H:(A)hypermap) (x:A))` MP_TAC\r
13606    THENL[\r
13607      USE_THEN "F6" (MP_TAC o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
13608      THEN DISCH_THEN (fun th-> USE_THEN "FA" (MP_TAC o MATCH_MP th))\r
13609      THEN REWRITE_TAC[THREE] THEN ARITH_TAC; ALL_TAC]\r
13610    THEN DISCH_THEN ((X_CHOOSE_THEN `d:num` (MP_TAC o REWRITE_RULE[GSYM ADD1] o ONCE_REWRITE_RULE[ADD_SYM])) o REWRITE_RULE[LT_EXISTS])\r
13611    THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F9" SUBST1_TAC THEN REWRITE_TAC[LT_SUC]\r
13612    THEN USE_THEN "F1" (MP_TAC o SPEC `PRE (CARD (face (H:(A)hypermap) (x:A)))` o CONJUNCT1 o MATCH_MP lemma_mAdd)\r
13613    THEN USE_THEN "F9" SUBST1_TAC THEN REWRITE_TAC[PRE; GE_1]\r
13614    THEN REWRITE_TAC[GSYM NOT_LT]\r
13615    THEN REWRITE_TAC[CONTRAPOS_THM] THEN SIMP_TAC[] THEN DISCH_THEN (fun th-> (MATCH_MP_TAC th))\r
13616    THEN REWRITE_TAC[heading]\r
13617    THEN REWRITE_TAC[GSYM (SPEC `face_map (H:(A)hypermap)` lemma_add_exponent_function)]\r
13618    THEN ONCE_REWRITE_TAC[ADD_SYM] \r
13619    THEN REWRITE_TAC[ARITH_RULE `!m:num n:num. (SUC m) + (SUC n) = m + SUC (SUC n)`]\r
13620    THEN USE_THEN "F9" (SUBST1_TAC o SYM)\r
13621    THEN REWRITE_TAC[SPEC `face_map (H:(A)hypermap)` lemma_add_exponent_function]\r
13622    THEN REWRITE_TAC[lemma_face_cycle]\r
13623    THEN USE_THEN "F1" (MP_TAC o SPEC `mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` o  CONJUNCT1 o MATCH_MP lemma_mInside)\r
13624    THEN REWRITE_TAC[LE_PLUS]\r
13625    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
13626    THEN MATCH_MP_TAC lemma_in_support2\r
13627    THEN EXISTS_TAC `L:(A)loop` THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th])\r
13628    THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]));;\r
13629 \r
13630 let lemmaLoopSeparation = prove(`!(H:(A)hypermap) L:(A)loop p:num->A k:num. is_loop H L /\ 1 <= k /\ is_contour H p k /\ (p 0) belong L /\ p 1 = face_map H (p 0) /\ (!i:num. 1 <= i /\ i <= k ==> ~((p i) belong L)) /\ ~(node H (p 0) = node H (p k)) /\ (?y:A. y IN node H (p k) /\ y belong L) ==> ~(planar_hypermap H)`,\r
13631    REPEAT GEN_TAC THEN (DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")))\r
13632    THEN SUBGOAL_THEN `?g:num->A m:num. is_Moebius_contour (H:(A)hypermap) (g:num->A) (m:num)` MP_TAC\r
13633    THENL[POP_ASSUM MP_TAC\r
13634       THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)  [ARITH_RULE `!i:num. 1 <= i:num <=> 0 < i`]\r
13635       THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
13636       THEN REWRITE_TAC[NOT_EXISTS_THM] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
13637       THEN DISCH_THEN (MP_TAC o MATCH_MP lemmaICJHAOQ) THEN REWRITE_TAC[CONTRAPOS_THM]\r
13638       THEN DISCH_TAC THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]; ALL_TAC]\r
13639    THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[lemmaLIPYTUI]);;\r
13640 \r
13641 let lemmaHQYMRTX = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_marked H NF L x /\ ~(L IN canon H NF)\r
13642    ==> attach H NF L x belong L /\ (!k:num. 1 <= k /\ k <= SUC (mInside H NF L x) ==> ~(attach H NF L x = ((face_map H) POWER k) x))`,\r
13643    REPEAT GEN_TAC\r
13644    THEN DISCH_THEN (fun th -> LABEL_TAC "FC" (CONJUNCT1 th) THEN LABEL_TAC "F1" (MATCH_MP lemma_split_marked_loop th))\r
13645    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")))))) o REWRITE_RULE[is_split_condition])\r
13646    THEN SUBGOAL_THEN `flag (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` (LABEL_TAC "F2")\r
13647    THENL[USE_THEN "F6" MP_TAC THEN USE_THEN "FC" (fun th-> REWRITE_TAC[REWRITE_RULE[is_marked] th]); ALL_TAC]\r
13648    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) o MATCH_MP lemma_mInside)\r
13649    THEN USE_THEN "F1"((CONJUNCTS_THEN2 (LABEL_TAC "F11" o REWRITE_RULE[heading])(LABEL_TAC "F12" o REWRITE_RULE[heading])) o MATCH_MP lemma_mAdd)\r
13650    THEN USE_THEN "F1" (LABEL_TAC "HD" o REWRITE_RULE[heading] o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
13651    THEN REWRITE_TAC[attach; heading]\r
13652    THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13653    THEN POP_ASSUM (LABEL_TAC "MN")\r
13654    THEN ABBREV_TAC `p = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13655    THEN POP_ASSUM (LABEL_TAC "PN")\r
13656    THEN ABBREV_TAC `y = (face_map (H:(A)hypermap) POWER (SUC m)) (x:A)`\r
13657    THEN POP_ASSUM (LABEL_TAC "F14")\r
13658    THEN ABBREV_TAC `z = (face_map (H:(A)hypermap) POWER (SUC p)) (y:A)`\r
13659    THEN POP_ASSUM (LABEL_TAC "F15")\r
13660    THEN SUBGOAL_THEN `!k:num. 1 <= k /\ k <= SUC m ==> ~((z:A) = (face_map H POWER k) (x:A))` (LABEL_TAC "F16")\r
13661    THENL[GEN_TAC\r
13662        THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
13663        THEN REWRITE_TAC[DE_MORGAN_THM; NOT_LE]\r
13664        THEN USE_THEN "F15" (SUBST1_TAC o SYM)\r
13665        THEN ASM_CASES_TAC `k:num < 1`\r
13666        THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13667        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM ADD1] o ONCE_REWRITE_RULE[GSYM ADD_SYM] o  REWRITE_RULE[NOT_LT; LE_EXISTS])\r
13668        THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC)\r
13669        THEN REWRITE_TAC[COM_POWER; o_THM; face_map_injective]\r
13670        THEN DISCH_THEN (LABEL_TAC "G1")\r
13671        THEN ASM_CASES_TAC `p:num = 0`\r
13672        THENL[POP_ASSUM (fun th-> POP_ASSUM (MP_TAC o REWRITE_RULE[th; POWER_0; I_THM]))\r
13673            THEN USE_THEN "F14" (SUBST1_TAC o SYM)\r
13674            THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_bound_mInside)\r
13675            THEN USE_THEN "MN" (fun th-> REWRITE_TAC[th])\r
13676            THEN REWRITE_TAC[IMP_IMP]\r
13677            THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_congruence_on_face)\r
13678            THEN DISCH_THEN (X_CHOOSE_THEN `q:num` MP_TAC) THEN ARITH_TAC ; ALL_TAC]\r
13679        THEN POP_ASSUM (LABEL_TAC "G2" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
13680        THEN ASM_CASES_TAC `SUC m < SUC d` THENL[POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC]\r
13681        THEN POP_ASSUM (LABEL_TAC "G3" o REWRITE_RULE[NOT_LT])\r
13682        THEN USE_THEN "F11" (MP_TAC o SPEC `p:num`)\r
13683        THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th; LE_REFL])\r
13684        THEN DISCH_TAC\r
13685        THEN USE_THEN "F7" (MP_TAC o SPEC `d:num` o MATCH_MP lemma_power_next_in_loop)\r
13686        THEN USE_THEN "F9" (MP_TAC o SPEC `d:num`)\r
13687        THEN USE_THEN "G3" (fun th-> (REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (MATCH_MP LT_IMP_LE (SPEC `d:num` LT_PLUS)) th)]))\r
13688        THEN DISCH_THEN SUBST1_TAC\r
13689        THEN USE_THEN "G1" (SUBST1_TAC o SYM)\r
13690        THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> MP_TAC(MATCH_MP lemma_in_support2 (CONJ th th1))))\r
13691        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13692    THEN USE_THEN "F16" (fun th-> REWRITE_TAC[th])\r
13693    THEN REMOVE_THEN "F12" (MP_TAC o REWRITE_RULE[lemma_in_support])\r
13694    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F17") (LABEL_TAC "F18")))\r
13695    THEN ASM_CASES_TAC `L':(A)loop = L:(A)loop`\r
13696    THENL[POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13697    THEN POP_ASSUM (LABEL_TAC "F19")\r
13698    THEN ASM_CASES_TAC `L':(A)loop IN canon (H:(A)hypermap) (NF:(A)loop->bool)`\r
13699    THENL[POP_ASSUM (LABEL_TAC "G4")\r
13700        THEN USE_THEN "F15" MP_TAC THEN USE_THEN "F14" (SUBST1_TAC o SYM)\r
13701        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
13702        THEN DISCH_THEN (fun th-> MP_TAC (MATCH_MP power_power_relation (REWRITE_RULE[GSYM CONJ_ASSOC](CONJ (SPEC `H:(A)hypermap` face_map_and_darts) th))))\r
13703        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` MP_TAC)\r
13704        THEN USE_THEN "G4" (fun th-> USE_THEN "F18" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_power_canon_next (CONJ th th1)]))\r
13705        THEN DISCH_TAC THEN USE_THEN "F18" (MP_TAC o SPEC `j:num` o MATCH_MP lemma_power_next_in_loop)\r
13706        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
13707        THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F17" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13708        THEN DISCH_THEN (MP_TAC o MATCH_MP disjoint_loops)\r
13709        THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F18" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13710    THEN POP_ASSUM (LABEL_TAC "F20")\r
13711    THEN USE_THEN "F4"(fun th->USE_THEN "F17"(fun th1->USE_THEN "F18"(fun th2->LABEL_TAC "F21"(CONJUNCT1(MATCH_MP head_on_loop (CONJ th (CONJ th1 th2)))))))\r
13712    THEN USE_THEN "F21"(fun th->USE_THEN "F18"(fun th1-> LABEL_TAC "F22"(MATCH_MP lemma_in_loop (CONJ th1 th))))\r
13713    THEN SUBGOAL_THEN `~(head (H:(A)hypermap) (NF:(A)loop->bool) (z:A) IN dart_inside H NF (L:(A)loop) x)` (LABEL_TAC "F23")\r
13714    THENL[USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
13715       THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_dart_inside_sub_loop) THEN REWRITE_TAC[IMP_IMP]\r
13716       THEN DISCH_THEN (MP_TAC o REWRITE_RULE[GSYM belong] o MATCH_MP lemma_in_subset)\r
13717       THEN USE_THEN "F22" MP_TAC THEN USE_THEN "F5" MP_TAC THEN  USE_THEN "F17" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13718       THEN MESON_TAC[disjoint_loops]; ALL_TAC]\r
13719    THEN USE_THEN "F23" MP_TAC THEN USE_THEN "F18" MP_TAC THEN USE_THEN "F20" MP_TAC THEN USE_THEN "F17" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13720    THEN USE_THEN "F2"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP (CONJUNCT2 (REWRITE_RULE[flag] th))))\r
13721    THEN REWRITE_TAC[IN_UNION]\r
13722    THEN STRIP_TAC\r
13723    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_canon_darts])\r
13724        THEN ABBREV_TAC `u = head (H:(A)hypermap) (NF:(A)loop->bool) (z:A)`\r
13725        THEN POP_ASSUM (LABEL_TAC "H1")\r
13726        THEN DISCH_THEN (X_CHOOSE_THEN `K:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3")))\r
13727        THEN USE_THEN "H3" (MP_TAC o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop)\r
13728        THEN USE_THEN "H2" (fun th-> USE_THEN "H3" (fun th1-> MP_TAC (REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP lemma_power_canon_next (CONJ th th1))))))\r
13729        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
13730        THEN REWRITE_TAC[CONJUNCT1 (SPEC `H:(A)hypermap` inverse2_hypermap_maps); o_THM]\r
13731        THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]\r
13732        THEN DISCH_THEN (LABEL_TAC "H4")\r
13733        THEN USE_THEN "FC" (LABEL_TAC "H5" o CONJUNCT2 o MATCH_MP lemma_marked_dart)\r
13734        THEN USE_THEN "F18"(fun th-> USE_THEN "F22"(fun th1-> MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1))))\r
13735        THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H6") (LABEL_TAC "H7")))\r
13736        THEN  SUBGOAL_THEN `face_contour (H:(A)hypermap) (y:A) (SUC p) = loop_path (L':(A)loop) (z:A) 0` (LABEL_TAC "HG")\r
13737        THENL[USE_THEN "F15" (fun th-> REWRITE_TAC[face_contour; loop_path; POWER_0; I_THM; th]); ALL_TAC]\r
13738        THEN   SUBGOAL_THEN `is_contour (H:(A)hypermap) (glue (face_contour H (y:A)) (loop_path (L':(A)loop) (z:A)) (SUC p))  ((SUC p) + (k:num))` (LABEL_TAC "H8")\r
13739        THENL[MATCH_MP_TAC lemma_glue_contours\r
13740            THEN REWRITE_TAC[lemma_face_contour]\r
13741            THEN USE_THEN "F17" (fun th -> (USE_THEN "F4" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L':(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
13742            THEN DISCH_THEN (fun th-> USE_THEN "F18" (fun th1 -> MP_TAC (CONJUNCT1(MATCH_MP let_order_for_loop (CONJ th th1)))))\r
13743            THEN USE_THEN "H6"(fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[th] o SPEC `k:num` o MATCH_MP lemma_sub_inj_contour))\r
13744            THEN DISCH_THEN (fun th-> REWRITE_TAC[REWRITE_RULE[lemma_def_inj_contour] th])\r
13745            THEN USE_THEN "HG" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13746        THEN ABBREV_TAC `fway = glue (face_contour H (y:A)) (loop_path (L':(A)loop) (z:A)) (SUC p)`\r
13747        THEN POP_ASSUM (LABEL_TAC "H9")\r
13748        THEN USE_THEN "H5" MP_TAC\r
13749        THEN USE_THEN "H4" (fun th-> USE_THEN "H2" (fun th1-> MP_TAC (MATCH_MP is_in_canon_darts (CONJ th th1))))\r
13750        THEN REWRITE_TAC[IMP_IMP]\r
13751        THEN USE_THEN "F2" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP (CONJUNCT1(REWRITE_RULE[flag] th))))\r
13752        THEN DISCH_THEN (X_CHOOSE_THEN `sway:num->A` (X_CHOOSE_THEN `s:num` (CONJUNCTS_THEN2 (LABEL_TAC "H10") (CONJUNCTS_THEN2 (LABEL_TAC "H11") (CONJUNCTS_THEN2 (LABEL_TAC "H12") (LABEL_TAC "H14"))))))       \r
13753      THEN SUBGOAL_THEN `is_contour (H:(A)hypermap) (join (fway:num->A) (sway:num->A) ((SUC p)+(k:num))) (((SUC p)+(k:num))+(s:num)+1)` (LABEL_TAC "H15")\r
13754        THENL[MATCH_MP_TAC lemma_join_contours\r
13755            THEN USE_THEN "H8" (fun th-> REWRITE_TAC[th])\r
13756            THEN USE_THEN "H12" (fun th-> REWRITE_TAC[th])\r
13757            THEN USE_THEN "H10" (fun th-> REWRITE_TAC[th])\r
13758            THEN EXPAND_TAC "fway"\r
13759            THEN USE_THEN "HG" (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
13760            THEN USE_THEN "H7" (fun th-> REWRITE_TAC[loop_path; SYM th; one_step_contour]); ALL_TAC]   \r
13761     THEN ABBREV_TAC `way = join (fway:num->A) (sway:num->A) ((SUC p) + (k:num))`\r
13762     THEN SUBGOAL_THEN `~(planar_hypermap (H:(A)hypermap))` MP_TAC\r
13763     THENL[MATCH_MP_TAC lemmaLoopSeparation\r
13764            THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `way:num->A` THEN EXISTS_TAC `((SUC p)+(k:num)) + (s:num) +1`\r
13765            THEN USE_THEN "H15" (fun th-> REWRITE_TAC[th])\r
13766           THEN USE_THEN "F5" (fun th -> (USE_THEN "F4" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
13767            THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
13768            THEN STRIP_TAC THENL[REWRITE_TAC [ADD_ASSOC; GSYM ADD1; GE_1]; ALL_TAC]\r
13769            THEN SUBGOAL_THEN `(way:num->A) 0 = (y:A)` SUBST1_TAC\r
13770            THENL[EXPAND_TAC "way" THEN REWRITE_TAC[join; LE_0] THEN EXPAND_TAC "fway"\r
13771                THEN REWRITE_TAC[glue; LE_0] THEN REWRITE_TAC[face_contour; POWER_0;I_THM]; ALL_TAC]\r
13772            THEN USE_THEN "HD" (fun th-> REWRITE_TAC[th])\r
13773            THEN STRIP_TAC\r
13774            THENL[EXPAND_TAC "way" THEN REWRITE_TAC[join]\r
13775                THEN REWRITE_TAC[CONJUNCT2 ADD; GE_1] THEN EXPAND_TAC "fway" THEN REWRITE_TAC[glue; GE_1; face_contour; POWER_1]; ALL_TAC]\r
13776            THEN SUBGOAL_THEN `(way:num->A) (((SUC p) +(k:num)) +(s:num) + 1) = inverse (node_map (H:(A)hypermap)) (x:A)` SUBST1_TAC\r
13777            THENL[EXPAND_TAC "way" THEN GEN_REWRITE_TAC (DEPTH_CONV) [GSYM ADD1]\r
13778                THEN REWRITE_TAC[second_join_evaluation] THEN USE_THEN "H11" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13779            THEN STRIP_TAC\r
13780            THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H16") (LABEL_TAC "H17"))\r
13781                THEN ASM_CASES_TAC `i:num <= (SUC p) + (k:num)`\r
13782                THENL[POP_ASSUM (LABEL_TAC "H18")\r
13783                    THEN EXPAND_TAC "way" THEN USE_THEN "H18" (fun th -> REWRITE_TAC[join; th])\r
13784                    THEN ASM_CASES_TAC `i <= SUC p`\r
13785                    THENL[POP_ASSUM (LABEL_TAC "H19")\r
13786                        THEN EXPAND_TAC "fway"\r
13787                        THEN USE_THEN "H19" (fun th -> REWRITE_TAC[glue; th; face_contour])\r
13788                        THEN ASM_CASES_TAC `i:num = SUC p`\r
13789                        THENL[POP_ASSUM SUBST1_TAC\r
13790                            THEN USE_THEN "H19" (fun th-> REWRITE_TAC[th])\r
13791                            THEN USE_THEN "F15" SUBST1_TAC\r
13792                            THEN USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
13793                            THEN DISCH_TAC THEN MATCH_MP_TAC disjoint_loops\r
13794                            THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `z:A`\r
13795                            THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
13796                            THEN USE_THEN "F18" (fun th-> REWRITE_TAC[th])\r
13797                            THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
13798                            THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th])\r
13799                            THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13800                        THEN POP_ASSUM (fun th-> POP_ASSUM (fun th1 -> LABEL_TAC "H20" (REWRITE_RULE[LT_SUC_LE ] (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th)))))\r
13801                        THEN USE_THEN "F11" (MP_TAC o SPEC `i:num`)\r
13802                        THEN USE_THEN "H20" (fun th-> REWRITE_TAC[th])\r
13803                        THEN USE_THEN "H16" (fun th-> REWRITE_TAC[th])\r
13804                        THEN REWRITE_TAC[CONTRAPOS_THM]\r
13805                        THEN DISCH_THEN (fun th1-> USE_THEN "F5"(fun th-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th)])); ALL_TAC]\r
13806                    THEN POP_ASSUM (LABEL_TAC "H21")\r
13807                    THEN EXPAND_TAC "fway"\r
13808                    THEN USE_THEN "H21" (fun th-> REWRITE_TAC[glue; th])\r
13809                    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
13810                    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC)\r
13811                    THEN REWRITE_TAC[ADD_SUB2; loop_path]\r
13812                    THEN USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
13813                    THEN DISCH_TAC THEN MATCH_MP_TAC disjoint_loops\r
13814                    THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `(next (L':(A)loop) POWER (SUC d)) (z:A)` \r
13815                    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
13816                    THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
13817                    THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th])\r
13818                    THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
13819                    THEN USE_THEN "F18" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC]\r
13820                THEN POP_ASSUM (LABEL_TAC "H21")\r
13821                THEN EXPAND_TAC "way"\r
13822                THEN USE_THEN "H21" (fun th-> REWRITE_TAC[join; th])\r
13823                THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
13824                THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "H22"))\r
13825                THEN USE_THEN "H22" (SUBST1_TAC)\r
13826                THEN REWRITE_TAC[ADD_SUB2; PRE]\r
13827                THEN POP_ASSUM (fun th-> USE_THEN "H17" (LABEL_TAC "H24" o REWRITE_RULE[th; LE_ADD_LCANCEL; GSYM ADD1; LE_SUC]))\r
13828                THEN USE_THEN "H24" (MP_TAC o REWRITE_RULE[in_list] o SPEC `sway:num->A` o MATCH_MP lemma_element_in_list)\r
13829                THEN DISCH_THEN (fun th1-> USE_THEN "H14" (fun th-> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1))))\r
13830                THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
13831                THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[])\r
13832                THEN MATCH_MP_TAC lemma_not_in_canon_darts\r
13833                THEN EXISTS_TAC `L:(A)loop`\r
13834                THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
13835                THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
13836                THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th])\r
13837                THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13838            THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `x:A`; `1`] lemma_power_inverse_in_node2))\r
13839            THEN DISCH_THEN (SUBST1_TAC o SYM o MATCH_MP lemma_node_identity)\r
13840            THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_on_heading)\r
13841            THEN REWRITE_TAC[heading]\r
13842            THEN USE_THEN "MN" (fun th-> REWRITE_TAC[th])\r
13843            THEN USE_THEN "F14" SUBST1_TAC\r
13844            THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN EXISTS_TAC `x:A`\r
13845            THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th; node_refl]); ALL_TAC]  \r
13846    THEN USE_THEN "F3"(fun th-> REWRITE_TAC[REWRITE_RULE[is_restricted] th]); ALL_TAC]\r
13847    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[dart_inside; IN_ELIM_THM])\r
13848    THEN USE_THEN "MN" SUBST1_TAC\r
13849    THEN ABBREV_TAC `u = head (H:(A)hypermap) (NF:(A)loop->bool) (z:A)`\r
13850    THEN POP_ASSUM (LABEL_TAC "G1")\r
13851    THEN DISCH_THEN(X_CHOOSE_THEN `i:num`(CONJUNCTS_THEN2(CONJUNCTS_THEN2(LABEL_TAC "G2")(LABEL_TAC "G3"))(MP_TAC o AP_TERM `face_map (H:(A)hypermap)`)))\r
13852    THEN REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse2_hypermap_maps); o_THM;  COM_POWER_FUNCTION]\r
13853    THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))]\r
13854    THEN DISCH_THEN (LABEL_TAC "G4")\r
13855    THEN USE_THEN "F9" (MP_TAC o SPEC `SUC i`)\r
13856    THEN USE_THEN "G3" (fun th-> REWRITE_TAC[ONCE_REWRITE_RULE[GSYM LE_SUC] th])\r
13857    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
13858    THEN DISCH_THEN (LABEL_TAC "G5" o SYM)\r
13859    THEN USE_THEN "F7" (LABEL_TAC "G6" o SPEC `SUC i` o MATCH_MP lemma_power_next_in_loop)\r
13860    THEN ABBREV_TAC `v = (next (L:(A)loop) POWER (SUC i)) (x:A)`\r
13861    THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `u:A`; `1`] lemma_power_inverse_in_node2))\r
13862    THEN USE_THEN "G5" SUBST1_TAC\r
13863    THEN DISCH_TAC\r
13864    THEN USE_THEN "F4"(fun th->(USE_THEN "F17"(fun th2->(USE_THEN "F18"(fun th3->MP_TAC(CONJUNCT1(MATCH_MP head_on_loop (CONJ th (CONJ th2 th3)))))))))\r
13865    THEN MP_TAC (SPECL[`H:(A)hypermap`; `L':(A)loop`; `z:A`] lemma_atom_sub_node)\r
13866    THEN REWRITE_TAC[IMP_IMP]\r
13867    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_subset)\r
13868    THEN USE_THEN "G1" SUBST1_TAC\r
13869    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity)\r
13870    THEN DISCH_THEN (fun th-> POP_ASSUM (LABEL_TAC "G7" o REWRITE_RULE[SYM th]))\r
13871    THEN SUBGOAL_THEN `~(planar_hypermap (H:(A)hypermap))` MP_TAC\r
13872    THENL[MATCH_MP_TAC lemmaLoopSeparation\r
13873        THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `face_contour (H:(A)hypermap) (y:A)` THEN EXISTS_TAC `SUC p`\r
13874        THEN REWRITE_TAC[GE_1; lemma_face_contour; face_contour; POWER_0; I_THM; POWER_1]\r
13875        THEN USE_THEN "F5" (fun th -> (USE_THEN "F4" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
13876        THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
13877        THEN USE_THEN "HD" (fun th-> REWRITE_TAC[th])\r
13878        THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_on_attach)\r
13879        THEN REWRITE_TAC[attach; heading]\r
13880        THEN USE_THEN "MN" (fun th-> REWRITE_TAC[th])\r
13881        THEN USE_THEN "PN" (fun th-> REWRITE_TAC[th])\r
13882        THEN USE_THEN "F14" (fun th-> REWRITE_TAC[th])\r
13883        THEN USE_THEN "F15" (fun th-> REWRITE_TAC[th])\r
13884        THEN DISCH_THEN (CONJUNCTS_THEN2 (fun th-> REWRITE_TAC[th]) (LABEL_TAC "G8"))\r
13885        THEN STRIP_TAC\r
13886        THENL[GEN_TAC\r
13887            THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G9") (LABEL_TAC "G10"))\r
13888            THEN ASM_CASES_TAC `i':num = SUC p`\r
13889            THENL[POP_ASSUM SUBST1_TAC\r
13890                THEN USE_THEN "F15" (fun th-> REWRITE_TAC[th])\r
13891                THEN USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
13892                THEN USE_THEN "F18" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F17" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13893                THEN REWRITE_TAC[disjoint_loops]; ALL_TAC]\r
13894            THEN POP_ASSUM (fun th-> POP_ASSUM(fun th1-> (LABEL_TAC "G11" (REWRITE_RULE[GSYM LT_LE; LT_SUC_LE] (CONJ th1 th)))))\r
13895            THEN USE_THEN "F11" (MP_TAC o SPEC `i':num`)\r
13896            THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th]))\r
13897            THEN REWRITE_TAC[CONTRAPOS_THM]\r
13898            THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC]\r
13899        THEN EXISTS_TAC `v:A` THEN USE_THEN "G6" (fun th-> REWRITE_TAC[th])\r
13900        THEN USE_THEN "G7" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
13901    THEN USE_THEN "F3"(fun th-> REWRITE_TAC[REWRITE_RULE[is_restricted] th]));;\r
13902 \r
13903 let lemma_route_exists = prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_marked H NF L x /\ ~(L IN canon H NF) \r
13904    ==> ?q:num. mInside H NF L x < q /\ q < CARD (cycle H L) /\ (face_map (quotient H NF) POWER (SUC q)) (atom H L x) = atom H L (attach H NF L x)`,      REPEAT GEN_TAC\r
13905    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
13906    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")))))) o REWRITE_RULE[is_split_condition])\r
13907    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
13908    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13909    THEN POP_ASSUM (LABEL_TAC "F10")\r
13910    THEN USE_THEN "FC" (fun th-> (USE_THEN "F6" (fun th1 -> (CONJUNCTS_THEN2 (LABEL_TAC "F12") (LABEL_TAC "F14") (MATCH_MP lemmaHQYMRTX (CONJ th th1))))))\r
13911    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13912    THEN POP_ASSUM (LABEL_TAC "F15")\r
13913    THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
13914    THEN POP_ASSUM (LABEL_TAC "MN")\r
13915    THEN SUBGOAL_THEN `2 <= CARD (cycle (H:(A)hypermap) (L:(A)loop))` (LABEL_TAC "F16")\r
13916    THENL[MATCH_MP_TAC CARD_ATLEAST_2\r
13917        THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (y:A)`\r
13918        THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (z:A)`\r
13919        THEN USE_THEN "F4"(fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_cycle_finite (CONJ th th1)]))\r
13920        THEN USE_THEN "F9" (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th])\r
13921        THEN USE_THEN "F12" (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th])\r
13922        THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_on_attach)\r
13923        THEN USE_THEN "F15" (fun th -> USE_THEN "F10" (fun th1-> REWRITE_TAC[th; th1; CONTRAPOS_THM]))\r
13924        THEN DISCH_TAC\r
13925        THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect)\r
13926        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
13927        THEN DISCH_THEN (fun th-> MP_TAC(MATCH_MP lemma_in_subset (CONJ (SPECL[`H:(A)hypermap`; `L:(A)loop`; `y:A`] lemma_atom_sub_node) th)))\r
13928        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th]); ALL_TAC]\r
13929    THEN USE_THEN "F12" (MP_TAC o SPEC `H:(A)hypermap` o MATCH_MP lemma_in_cycle2)\r
13930    THEN USE_THEN "F4"(fun th->(USE_THEN "F5"(fun th2->(USE_THEN "F7"(fun th3-> LABEL_TAC "CF" (MATCH_MP lemma_cycle_is_face (CONJ th (CONJ th2 th3))))))))\r
13931    THEN USE_THEN "CF" SUBST1_TAC\r
13932    THEN MP_TAC (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` face_map_and_darts)\r
13933    THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
13934    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
13935    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_index_on_orbit)\r
13936    THEN USE_THEN "CF" (SUBST1_TAC o SYM)\r
13937    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19")))\r
13938    THEN USE_THEN "F4"(LABEL_TAC "QF" o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_quotient)\r
13939    THEN ASM_CASES_TAC `n = 0`\r
13940    THENL[REMOVE_THEN "F19" MP_TAC\r
13941        THEN POP_ASSUM SUBST1_TAC\r
13942        THEN REWRITE_TAC[POWER_0; I_THM]\r
13943        THEN DISCH_THEN (LABEL_TAC "F19")\r
13944        THEN EXISTS_TAC `PRE (CARD (cycle (H:(A)hypermap) (L:(A)loop)))`\r
13945        THEN ONCE_REWRITE_TAC[GSYM LT_SUC]\r
13946        THEN USE_THEN "F16" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ (SPEC `1` LE_PLUS) (REWRITE_RULE[TWO] th))))\r
13947        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th; LT_PLUS])\r
13948        THEN EXPAND_TAC "m"\r
13949        THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_mInside_and_length_cycle th])\r
13950        THEN POP_ASSUM SUBST1_TAC\r
13951        THEN MP_TAC (MATCH_MP lemma_cycle_orbit (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` face_map_and_darts))\r
13952        THEN DISCH_THEN (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`)\r
13953        THEN USE_THEN "QF" SUBST1_TAC\r
13954        THEN USE_THEN "CF" (SUBST1_TAC o SYM)\r
13955        THEN SIMP_TAC[]; ALL_TAC]\r
13956    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; CONJUNCT1 ADD])\r
13957    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
13958    THEN EXISTS_TAC `d:num` THEN USE_THEN "F19" (fun th-> REWRITE_TAC[SYM th])\r
13959    THEN USE_THEN "F18" (fun th->REWRITE_TAC[MATCH_MP LT_TRANS (CONJ (SPEC `d:num` LT_PLUS) th)])\r
13960    THEN USE_THEN "F6" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
13961    THEN REWRITE_TAC[NOT_LT; LE_LT]\r
13962    THEN STRIP_TAC\r
13963    THENL[POP_ASSUM (LABEL_TAC "F24")\r
13964        THEN USE_THEN "F1" (MP_TAC o SPEC `SUC d` o CONJUNCT1 o MATCH_MP lemma_atom_on_inside_dart)\r
13965        THEN USE_THEN "MN" SUBST1_TAC\r
13966        THEN USE_THEN "F24" (fun th-> REWRITE_TAC[GE_1; REWRITE_RULE[GSYM LE_SUC_LT] th])\r
13967        THEN USE_THEN "QF" SUBST1_TAC\r
13968        THEN USE_THEN "F19" (SUBST1_TAC o SYM)\r
13969        THEN DISCH_TAC\r
13970        THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect)\r
13971        THEN POP_ASSUM SUBST1_TAC\r
13972        THEN REWRITE_TAC[IN_SING]\r
13973        THEN USE_THEN "F14" (MP_TAC o SPEC `SUC d`)\r
13974        THEN USE_THEN "F24" (fun th-> REWRITE_TAC[GE_1; MATCH_MP LT_IMP_LE (ONCE_REWRITE_RULE[GSYM LT_SUC] th)])\r
13975        THEN SIMP_TAC[]; ALL_TAC]\r
13976    THEN USE_THEN "F19" MP_TAC\r
13977    THEN POP_ASSUM SUBST1_TAC\r
13978    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_atom_on_inside_dart)\r
13979    THEN USE_THEN "MN" SUBST1_TAC\r
13980    THEN USE_THEN "QF" SUBST1_TAC\r
13981    THEN DISCH_THEN (SUBST1_TAC)\r
13982    THEN USE_THEN "F10" SUBST1_TAC\r
13983    THEN DISCH_TAC\r
13984    THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect)\r
13985    THEN POP_ASSUM SUBST1_TAC\r
13986    THEN DISCH_THEN (fun th-> MP_TAC (MATCH_MP lemma_in_subset (CONJ (SPECL[`H:(A)hypermap`; `L:(A)loop`; `y:A`] lemma_atom_sub_node) th)))\r
13987    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity)\r
13988    THEN EXPAND_TAC "y" THEN EXPAND_TAC "z"\r
13989    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_attach th]));;\r
13990 \r
13991 let lemma_route = new_specification["mRoute"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_route_exists);;\r
13992 \r
13993 let lemmaParameters = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==> mInside H NF L x < mRoute H NF L x /\ mRoute H NF L x < CARD(cycle H L) /\ SUC (mInside H NF L x)  < (mAdd H NF L x) + (mRoute H NF L x) /\ ~(node H (heading H NF L x) = node H x) /\ ~(node H (heading H NF L x) = node H (attach H NF L x))`,\r
13994    REPEAT GEN_TAC\r
13995    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
13996    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")))))) o REWRITE_RULE[is_split_condition])\r
13997    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (MATCH_MP lemma_route (CONJ th th1))))\r
13998    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 (LABEL_TAC "F10") (LABEL_TAC "F11")))\r
13999    THEN USE_THEN "F9" (fun th-> REWRITE_TAC[th])\r
14000    THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th])\r
14001    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_heading th])\r
14002    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_attach th])\r
14003    THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14004    THEN POP_ASSUM (LABEL_TAC "F12")\r
14005    THEN ABBREV_TAC `p = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14006    THEN POP_ASSUM (LABEL_TAC "F14")\r
14007    THEN ABBREV_TAC `q = mRoute (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14008    THEN POP_ASSUM (LABEL_TAC "F15")\r
14009    THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
14010    THEN USE_THEN "F9" (MP_TAC o REWRITE_RULE[LT_EXISTS])\r
14011    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (MP_TAC o REWRITE_RULE[ADD_SYM; ADD_SUC]))\r
14012    THEN REWRITE_TAC[GSYM ADD_SUC]\r
14013    THEN DISCH_THEN (SUBST_ALL_TAC o ONCE_REWRITE_RULE[ADD_SYM])\r
14014    THEN REWRITE_TAC[GSYM ADD_ASSOC]\r
14015    THEN REWRITE_TAC[LT_ADD]\r
14016    THEN ASM_CASES_TAC `~((d:num) + (p:num) = 0)`\r
14017    THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ]) THEN SIMP_TAC[]; ALL_TAC]\r
14018    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[])\r
14019    THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `!a:num b:num. a + b = 0 ==> a = 0 /\ b = 0`))\r
14020    THEN DISCH_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC SUBST_ALL_TAC)\r
14021    THEN USE_THEN "F11" MP_TAC\r
14022    THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION]\r
14023    THEN REWRITE_TAC[ADD_0]\r
14024    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_atom_on_inside_dart)\r
14025    THEN USE_THEN "F12" SUBST1_TAC\r
14026    THEN DISCH_THEN (SUBST1_TAC)\r
14027    THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])\r
14028    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14029    THEN POP_ASSUM (LABEL_TAC "F16")\r
14030    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14031    THEN POP_ASSUM (LABEL_TAC "F17")\r
14032    THEN USE_THEN "F16" (MP_TAC o REWRITE_RULE[heading])\r
14033    THEN USE_THEN "F7" (MP_TAC o SPEC `SUC m` o MATCH_MP lemma_power_next_in_loop)\r
14034    THEN USE_THEN "F1" (MP_TAC o SPEC `SUC m` o CONJUNCT1 o MATCH_MP lemma_mInside)\r
14035    THEN EXPAND_TAC "m" THEN REWRITE_TAC[LE_REFL]\r
14036    THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM heading]\r
14037    THEN USE_THEN "F16" SUBST1_TAC \r
14038    THEN DISCH_THEN (LABEL_TAC "F18")\r
14039    THEN USE_THEN "F4" (fun th->USE_THEN "F5"(fun th1->USE_THEN "F18"(fun th2->REWRITE_TAC[MATCH_MP unique_fmap (CONJ th (CONJ th1 th2))])))\r
14040    THEN DISCH_TAC\r
14041    THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `face_map (H:(A)hypermap) (head H (NF:(A)loop->bool) (y:A))`] atom_reflect)\r
14042    THEN POP_ASSUM SUBST1_TAC\r
14043    THEN DISCH_THEN (fun th -> MP_TAC(MATCH_MP lemma_in_subset (CONJ (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] lemma_atom_sub_node) th)))\r
14044    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_node1)\r
14045    THEN USE_THEN "F3" (fun th-> LABEL_TAC "CV"(REWRITE_RULE[edge_map_convolution] (CONJUNCT1(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] th))))))\r
14046    THEN USE_THEN "CV" (fun th-> MP_TAC (AP_THM th `head (H:(A)hypermap) (NF:(A)loop->bool) (y:A)`))\r
14047    THEN DISCH_THEN (SUBST1_TAC o SYM o REWRITE_RULE[o_THM])\r
14048    THEN DISCH_THEN (LABEL_TAC "F19")\r
14049    THEN USE_THEN "F17" (MP_TAC o REWRITE_RULE[attach])\r
14050    THEN USE_THEN "F14" SUBST1_TAC THEN REWRITE_TAC[GSYM ONE; POWER_1]\r
14051    THEN USE_THEN "F16" SUBST1_TAC\r
14052    THEN DISCH_TAC\r
14053    THEN MP_TAC (SPECL[`H:(A)hypermap`; `z:A`] node_refl)\r
14054    THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
14055    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_node1)\r
14056    THEN USE_THEN "CV" (fun th -> MP_TAC (AP_THM th `y:A`))\r
14057    THEN REWRITE_TAC[o_THM]\r
14058    THEN DISCH_THEN (SUBST1_TAC o SYM)\r
14059    THEN DISCH_THEN (LABEL_TAC "F20" o MATCH_MP lemma_node_identity)\r
14060    THEN REMOVE_THEN "F19"  MP_TAC\r
14061    THEN POP_ASSUM SUBST1_TAC\r
14062    THEN DISCH_THEN (LABEL_TAC "F21")\r
14063    THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1->USE_THEN "F18" (fun th2-> MP_TAC (MATCH_MP head_on_loop (CONJ th (CONJ th1 th2))))))\r
14064    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F22") (LABEL_TAC "F24"))\r
14065    THEN USE_THEN "F22" (fun th-> (LABEL_TAC "F25" (MATCH_MP lemma_in_subset (CONJ (SPECL[`H:(A)hypermap`; `L:(A)loop`; `y:A`] lemma_atom_sub_node) th))))\r
14066    THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1->USE_THEN "F18" (fun th2-> ASSUME_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14067    THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14068    THEN DISCH_THEN (MP_TAC o SPECL[`y:A`; `head (H:(A)hypermap) (NF:(A)loop->bool) (y:A)`] o  REWRITE_RULE[is_no_double_joins])\r
14069    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
14070    THEN USE_THEN "F25" (fun th-> REWRITE_TAC[th])\r
14071    THEN USE_THEN "F21" (fun th-> REWRITE_TAC[th])\r
14072    THEN DISCH_THEN (fun th-> USE_THEN "F24" (LABEL_TAC "F26" o REWRITE_RULE[SYM th]))\r
14073    THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_mInside)\r
14074    THEN ONCE_REWRITE_TAC[COM_POWER]\r
14075    THEN REWRITE_TAC[o_THM]\r
14076    THEN USE_THEN "F1" (MP_TAC o SPEC `SUC m` o CONJUNCT1 o MATCH_MP lemma_mInside)\r
14077    THEN EXPAND_TAC "m" THEN REWRITE_TAC[LE_REFL]\r
14078    THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM heading]\r
14079    THEN USE_THEN "F16" SUBST1_TAC\r
14080    THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1->USE_THEN "F5" (fun th2-> (USE_THEN "F18"(fun th3-> MP_TAC (MATCH_MP lemma_next_exclusive (CONJ th (CONJ th1 (CONJ th2  th3)))))))))\r
14081    THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
14082    THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;\r
14083 \r
14084 let genex = new_definition `!H:(A)hypermap  (NF:(A)loop->bool) (L:(A)loop) x:A. genex H NF L x \r
14085 = glue (loop_path L (attach H NF L x)) (face_contour H (heading H NF L x)) (index L (attach H NF L x) (heading H NF L x))`;;\r
14086 \r
14087 let tpx = new_definition `!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. tpx H NF L x = (index L (attach H NF L x) (heading H NF L x)) + (mAdd H NF L x)`;;\r
14088 \r
14089 let geney = new_definition `!H:(A)hypermap  (NF:(A)loop->bool) (L:(A)loop) x:A. geney H NF L x \r
14090 = glue (loop_path L (inverse (node_map H) (heading H NF L x))) (complement H (attach H NF L x)) (index L (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x)))`;;\r
14091  \r
14092 let tpy = new_definition `!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. tpy H NF L x = (index L (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x))) + (ind H (attach H NF L x) (mAdd H NF L x))`;;\r
14093 \r
14094 let dnax = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). dnax H NF L x = loop(support_list (genex H NF L x) (tpx H NF L x), samsara (genex H NF L x) (tpx H NF L x))`;;\r
14095 \r
14096 let dnay = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). dnay H NF L x = loop(support_list (geney H NF L x) (tpy H NF L x), samsara (geney H NF L x) (tpy H NF L x))`;;\r
14097 \r
14098 let lemma_genex_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) \r
14099    ==> (is_inj_contour H (genex H NF L x) (tpx H NF L x) /\ face_map H (genex H NF L x (tpx H NF L x)) = genex H NF L x 0)`,\r
14100    REPEAT GEN_TAC\r
14101    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
14102    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
14103    THEN USE_THEN "F5"(fun th->(USE_THEN "F4"(LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
14104    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14105    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14106    THEN REWRITE_TAC[genex; tpx; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
14107    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14108    THEN POP_ASSUM (LABEL_TAC "YEL")\r
14109    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14110    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
14111    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14112    THEN POP_ASSUM (LABEL_TAC "MN")\r
14113    THEN USE_THEN "F10" (fun th-> USE_THEN "F9" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1))))\r
14114    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12"))\r
14115    THEN ABBREV_TAC `id = index (L:(A)loop) (z:A) (y:A)`\r
14116    THEN STRIP_TAC\r
14117    THENL[MATCH_MP_TAC lemma_glue_inj_contours\r
14118        THEN USE_THEN "F8" (fun th-> USE_THEN "F10" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP let_order_for_loop (CONJ th th1)))))\r
14119        THEN USE_THEN "F11"(fun th-> DISCH_THEN(fun th1-> REWRITE_TAC[REWRITE_RULE[th] (SPEC `id:num` (MATCH_MP lemma_sub_inj_contour th1))]))\r
14120        THEN USE_THEN "MN" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o CONJUNCT2 o MATCH_MP lemma_on_attach))\r
14121        THEN DISCH_THEN (fun th-> MP_TAC(MATCH_MP LT_TRANS (CONJ (SPEC `m:num` LT_PLUS) th)))\r
14122        THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] lemma_new_darts_in_face))\r
14123        THEN USE_THEN "YEL" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
14124        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_face_identity th])\r
14125        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_inj_face_contour th])\r
14126        THEN REWRITE_TAC[is_glueing]\r
14127        THEN USE_THEN "F12" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [loop_path; face_contour; POWER_0; GSYM th; I_THM])\r
14128        THEN SIMP_TAC[]\r
14129        THEN GEN_TAC\r
14130        THEN REWRITE_TAC[face_contour]\r
14131        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))\r
14132        THEN USE_THEN "MN" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o  SPEC `j:num` o CONJUNCT1 o MATCH_MP lemma_mAdd))\r
14133        THEN USE_THEN "G1" (fun th-> USE_THEN "G2" (fun th1-> USE_THEN "YEL" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
14134        THEN REWRITE_TAC[CONTRAPOS_THM; loop_path; lemma_in_list]\r
14135        THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC o CONJUNCT2))\r
14136        THEN MATCH_MP_TAC lemma_in_support2\r
14137        THEN EXISTS_TAC `L:(A)loop` THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th])\r
14138        THEN USE_THEN "F10" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC]\r
14139    THEN SUBGOAL_THEN `loop_path (L:(A)loop) (z:A) (id:num) = face_contour (H:(A)hypermap) (y:A) 0` MP_TAC\r
14140    THENL[USE_THEN "F12" (fun th-> REWRITE_TAC[loop_path; face_contour; POWER_0;I_THM; th]); ALL_TAC]\r
14141    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
14142    THEN REWRITE_TAC[face_contour; COM_POWER_FUNCTION]\r
14143    THEN EXPAND_TAC "z"\r
14144    THEN USE_THEN "YEL" (fun th-> USE_THEN "MN" (fun th1-> REWRITE_TAC[attach; th; th1])));;\r
14145 \r
14146 let complement_index = prove(`!H:(A)hypermap x:A m:num k:num. is_node_nondegenerate H /\ x IN dart H /\ 1 <= k /\ k <= ind H x m \r
14147     ==> ?i:num j:num. i < m /\ 1 <= j /\ j < CARD (node H ((inverse (face_map H) POWER (SUC i)) x)) /\ k = (ind H x i) + j`,\r
14148  REPEAT GEN_TAC\r
14149    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))\r
14150    THEN USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1-> MP_TAC(MATCH_MP lemma_increasing_index_one (CONJ th th1))))\r
14151    THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] (CONJUNCT1 ind))\r
14152    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (LABEL_TAC "INC")\r
14153    THEN USE_THEN "INC" (MP_TAC o SPEC `k:num` o  MATCH_MP lemma_num_partition2)\r
14154    THEN USE_THEN "F3" (fun th->REWRITE_TAC[REWRITE_RULE[LT1_NZ; LT_NZ] th])\r
14155    THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F6")))))\r
14156    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [ind; ADD_SUB2; GSYM LT_SUC_LE]\r
14157    THEN REWRITE_TAC[MATCH_MP LE_SUC_PRE (SPECL[`H:(A)hypermap`; `(inverse (face_map (H:(A)hypermap)) POWER (SUC i)) (x:A)`] NODE_NOT_EMPTY)]\r
14158    THEN DISCH_THEN ASSUME_TAC\r
14159    THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[]\r
14160    THEN USE_THEN "INC" (fun th-> ONCE_REWRITE_TAC[MATCH_MP lemma_inc_monotone (CONJUNCT2 th)])\r
14161    THEN USE_THEN "F4" MP_TAC THEN USE_THEN "F6" SUBST1_TAC\r
14162    THEN USE_THEN "F5" (MP_TAC o REWRITE_RULE[GSYM (SPEC `ind (H:(A)hypermap) (x:A) (i:num)` LT_ADD)] o REWRITE_RULE[LT1_NZ])\r
14163    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LTE_TRANS) THEN SIMP_TAC[]);;\r
14164 \r
14165 let reduce_exponent = prove(`!s:A->bool p:A->A m:num n:num x:A. p permutes s /\ m <= n ==> (inverse p POWER m) ((p POWER n) x) = (p POWER (n - m)) x`,\r
14166    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[LE_EXISTS]))\r
14167    THEN DISCH_THEN (X_CHOOSE_THEN `i:num` SUBST1_TAC)\r
14168    THEN REWRITE_TAC[ADD_SUB2; lemma_add_exponent_function ]\r
14169    THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_inverse th])\r
14170    THEN USE_THEN "F1" (MP_TAC o SPEC `m:num` o MATCH_MP power_permutation)\r
14171    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]));;\r
14172 \r
14173 let lemma_on_adding_darts = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==> next L (heading H NF L x) = inverse (node_map H) (heading H NF L x) /\ back L (attach H NF L x) = node_map H (attach H NF L x)`,\r
14174    REPEAT GEN_TAC\r
14175    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
14176    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
14177    THEN USE_THEN "F5" (fun th->(USE_THEN "F4" (LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
14178    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14179    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14180    THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
14181    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14182    THEN POP_ASSUM (LABEL_TAC "YEL")\r
14183    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14184    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
14185    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14186    THEN POP_ASSUM (LABEL_TAC "MN")\r
14187    THEN USE_THEN "YEL" (fun th->  USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_on_heading))\r
14188    THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
14189    THEN ABBREV_TAC `u = back (L:(A)loop) (z:A)` THEN POP_ASSUM (LABEL_TAC "G1")\r
14190    THEN USE_THEN "G1" (MP_TAC o AP_TERM `next (L:(A)loop)`)\r
14191    THEN REWRITE_TAC[lemma_inverse_evaluation]\r
14192    THEN DISCH_THEN SUBST1_TAC\r
14193    THEN USE_THEN "G1" (fun th-> USE_THEN "F10" (LABEL_TAC "G2" o REWRITE_RULE[th] o  MATCH_MP lemma_back_in_loop))\r
14194    THEN REWRITE_TAC[node_map_inverse_representation]\r
14195    THEN ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`]\r
14196    THEN USE_THEN "F3"(fun th->USE_THEN "F4"(fun th1-> USE_THEN "F5"(fun th2->USE_THEN "G2"(fun th3->GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM(MATCH_MP lemma_next_exclusive (CONJ th (CONJ th1 (CONJ th2 th3))))]))))\r
14197    THEN USE_THEN "G1" (SUBST1_TAC o SYM)\r
14198    THEN REWRITE_TAC[lemma_inverse_evaluation]\r
14199    THEN ASM_CASES_TAC `m:num = 0`\r
14200    THENL[EXPAND_TAC "z"\r
14201        THEN USE_THEN "YEL" (fun th1-> USE_THEN "MN"(fun th-> REWRITE_TAC[attach; GSYM COM_POWER_FUNCTION; th; th1]))\r
14202        THEN POP_ASSUM SUBST1_TAC\r
14203        THEN REWRITE_TAC[POWER_0; I_THM; face_map_injective]\r
14204        THEN DISCH_THEN (MP_TAC o AP_TERM `next (L:(A)loop)`)\r
14205        THEN REWRITE_TAC[lemma_inverse_evaluation]\r
14206        THEN USE_THEN "YEL" (fun th-> USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[th] o MATCH_MP lemma_on_heading))\r
14207        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `A <=> ~(~A)`]\r
14208        THEN REWRITE_TAC[CONTRAPOS_THM]\r
14209        THEN USE_THEN "F3"(fun th->USE_THEN "F4"(fun th1-> USE_THEN "F5"(fun th2->USE_THEN "F9"(fun th3->GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP lemma_next_exclusive (CONJ th (CONJ th1 (CONJ th2 th3)))]))))\r
14210        THEN SIMP_TAC[]; ALL_TAC]\r
14211    THEN USE_THEN "ZEL" (fun th-> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
14212    THEN USE_THEN "YEL" (fun th1-> USE_THEN "MN"(fun th-> REWRITE_TAC[attach; GSYM COM_POWER_FUNCTION; th; th1]))\r
14213    THEN REWRITE_TAC[POWER_0; I_THM; face_map_injective]\r
14214    THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
14215    THEN DISCH_THEN(fun th->USE_THEN "MN"(fun th1-> USE_THEN "F1"(MP_TAC o REWRITE_RULE[th1;th;LE_REFL] o SPEC `m:num` o CONJUNCT1 o  MATCH_MP lemma_mAdd)))\r
14216    THEN USE_THEN "YEL" (fun th-> REWRITE_TAC[CONTRAPOS_THM; th])\r
14217    THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G1" SUBST1_TAC\r
14218    THEN USE_THEN "G2" (fun th -> USE_THEN "F5"(fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])));;\r
14219 \r
14220 let lemma_geney_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF)\r
14221      ==> (is_inj_contour H (geney H NF L x) (tpy H NF L x) /\ face_map H (geney H NF L x (tpy H NF L x)) = geney H NF L x 0)`, \r
14222    REPEAT GEN_TAC\r
14223    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
14224    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
14225    THEN USE_THEN "F5" (fun th->(USE_THEN "F4" (LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
14226    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14227    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14228    THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
14229    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14230    THEN POP_ASSUM (LABEL_TAC "YEL")\r
14231    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14232    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
14233    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14234    THEN POP_ASSUM (LABEL_TAC "MN")\r
14235    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC(MATCH_MP lemma_on_adding_darts (CONJ th th1))))\r
14236    THEN USE_THEN "YEL" (fun th-> USE_THEN "ZEL" (fun th1-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th; th1]))\r
14237    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12"))\r
14238    THEN USE_THEN "F11" (fun th-> USE_THEN "F9" (LABEL_TAC "F14" o REWRITE_RULE[th] o MATCH_MP lemma_next_in_loop))\r
14239    THEN USE_THEN "F12" (fun th-> USE_THEN "F10" (LABEL_TAC "F15" o REWRITE_RULE[th] o MATCH_MP lemma_back_in_loop))\r
14240    THEN ABBREV_TAC `v = node_map (H:(A)hypermap) (z:A)` THEN POP_ASSUM (LABEL_TAC "VL")\r
14241    THEN ABBREV_TAC `u = inverse (node_map (H:(A)hypermap)) (y:A)` THEN POP_ASSUM (LABEL_TAC "UL")\r
14242    THEN USE_THEN "F14" (fun th-> USE_THEN "F15" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1))))\r
14243    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F16") (LABEL_TAC "F17"))\r
14244    THEN ABBREV_TAC `id = index (L:(A)loop) (u:A) (v:A)`\r
14245    THEN USE_THEN "F3" (MP_TAC o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14246    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "R1") ((CONJUNCTS_THEN2 (LABEL_TAC "R2") (MP_TAC o CONJUNCT2)) o CONJUNCT2))\r
14247    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "R3") (LABEL_TAC "R4" o CONJUNCT1))\r
14248    THEN USE_THEN "F10"(fun th2->USE_THEN "F5"(fun th1-> USE_THEN "F4"(fun th-> LABEL_TAC "F18" (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14249    THEN STRIP_TAC\r
14250    THENL[MATCH_MP_TAC lemma_glue_inj_contours\r
14251        THEN USE_THEN "F8" (fun th-> USE_THEN "F14" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP let_order_for_loop (CONJ th th1)))))\r
14252        THEN USE_THEN "F16"(fun th-> DISCH_THEN(fun th1-> REWRITE_TAC[REWRITE_RULE[th] (SPEC `id:num` (MATCH_MP lemma_sub_inj_contour th1))]))\r
14253        THEN USE_THEN "F18" MP_TAC THEN USE_THEN "R4" MP_TAC THEN USE_THEN "R2" MP_TAC THEN USE_THEN "R1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14254        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_inj_complement)\r
14255        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_sub_inj_contour)\r
14256        THEN USE_THEN "MN" (fun th-> USE_THEN "F1"(LABEL_TAC "F19" o REWRITE_RULE[th] o CONJUNCT2 o MATCH_MP lemma_on_attach))\r
14257        THEN USE_THEN "F19" (MP_TAC o MATCH_MP LT_TRANS o CONJ (SPEC `m:num` LT_PLUS))\r
14258        THEN USE_THEN "ZEL"(fun th->MP_TAC(REWRITE_RULE[th](CONJUNCT2(SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] lemma_new_darts_in_face))))\r
14259        THEN DISCH_THEN (LABEL_TAC "F20" o MATCH_MP lemma_face_identity)\r
14260        THEN USE_THEN "F20"(fun th-> REWRITE_TAC[th])\r
14261        THEN USE_THEN "R4"(fun th->USE_THEN "F18"(fun th1->DISCH_THEN(fun th2-> (MP_TAC (MATCH_MP lemma_increasing_index (CONJ th (CONJ th1 th2)))))))\r
14262        THEN DISCH_THEN (MP_TAC o MATCH_MP LT_PRE_LE)\r
14263        THEN DISCH_THEN (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP th1 th]))\r
14264        THEN REWRITE_TAC[is_glueing]\r
14265        THEN USE_THEN "F17" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [loop_path; face_contour; POWER_0; GSYM th; I_THM])\r
14266        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM(SPECL[`H:(A)hypermap`; `z:A`] (CONJUNCT1 ind))]\r
14267        THEN USE_THEN "R1"(fun th-> USE_THEN "R4"(fun th1-> USE_THEN "F18"(fun th2-> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_complement_path (CONJ th (CONJ th1 th2)))])))\r
14268        THEN USE_THEN "VL" (fun th-> REWRITE_TAC[POWER_0; I_THM; th])\r
14269        THEN GEN_TAC\r
14270        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F21") (LABEL_TAC "F22"))\r
14271        THEN USE_THEN "R4" (fun th-> USE_THEN "F18"(fun th1-> USE_THEN "F21" (fun th2-> USE_THEN "F22" (fun th3-> MP_TAC(MATCH_MP complement_index (CONJ th (CONJ th1 (CONJ th2 th3))))))))\r
14272        THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `i:num` MP_TAC))\r
14273        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F23") (CONJUNCTS_THEN2 (LABEL_TAC "F24") (CONJUNCTS_THEN2 (LABEL_TAC "F25") SUBST1_TAC)))\r
14274        THEN USE_THEN "R1" (fun th-> USE_THEN "R4" (fun th1-> USE_THEN "F18" (fun th2->MP_TAC (SPECL[`k:num`; `i:num`] (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_complement_path (CONJ th (CONJ th1 th2)))))))))))\r
14275        THEN USE_THEN "F24" (fun th-> USE_THEN "F25" (fun th1-> REWRITE_TAC[th; th1]))\r
14276        THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "z"\r
14277        THEN USE_THEN "MN" (fun th-> REWRITE_TAC[attach; th])\r
14278        THEN USE_THEN "F23" (MP_TAC o MATCH_MP LT_IMP_LE o ONCE_REWRITE_RULE[GSYM LT_SUC])\r
14279        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) th)])\r
14280        THEN REWRITE_TAC[SUB_SUC] THEN USE_THEN "F23" (MP_TAC o REWRITE_RULE[LT_EXISTS])\r
14281        THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "F26"))\r
14282        THEN USE_THEN "F26" (SUBST1_TAC)\r
14283        THEN REWRITE_TAC[ADD_SUB2]\r
14284        THEN USE_THEN "F1" (MP_TAC o SPEC `SUC d` o CONJUNCT1 o MATCH_MP lemma_mAdd)\r
14285        THEN USE_THEN "MN" (fun th-> USE_THEN "YEL" (fun th1-> REWRITE_TAC[th; th1; GE_1]))\r
14286        THEN USE_THEN "F26" (fun th-> REWRITE_TAC[th; LE_ADDR; CONTRAPOS_THM; lemma_in_list; loop_path])\r
14287        THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (MP_TAC o CONJUNCT2))\r
14288        THEN ABBREV_TAC `g = (face_map (H:(A)hypermap) POWER (SUC d)) (y:A)`\r
14289        THEN DISCH_THEN (fun th-> USE_THEN "F14" (MP_TAC o REWRITE_RULE[SYM th] o SPEC `n:num` o MATCH_MP lemma_power_next_in_loop))\r
14290        THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1-> MP_TAC (MATCH_MP lemma_in_support2 (CONJ th th1))))\r
14291        THEN USE_THEN "F4" (fun th-> DISCH_THEN(fun th1-> MP_TAC (MATCH_MP lemma_node_sub_support_darts (CONJ th th1))))\r
14292        THEN MP_TAC (SPECL[`H:(A)hypermap`; `g:A`; `i:num`] lemma_power_inverse_in_node2)\r
14293        THEN DISCH_THEN (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_node_identity th)])\r
14294        THEN DISCH_THEN(fun th->REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th (SPECL[`H:(A)hypermap`; `g:A`] node_refl))]); ALL_TAC]\r
14295    THEN SUBGOAL_THEN `loop_path (L:(A)loop) (u:A) (id:num) = complement (H:(A)hypermap) (z:A) 0` MP_TAC\r
14296    THENL[GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM(SPECL[`H:(A)hypermap`; `z:A`] (CONJUNCT1 ind))]\r
14297        THEN USE_THEN "R1"(fun th-> USE_THEN "R4"(fun th1-> USE_THEN "F18"(fun th2-> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_complement_path (CONJ th (CONJ th1 th2)))])))\r
14298        THEN USE_THEN "VL" (fun th-> REWRITE_TAC[POWER_0; I_THM; loop_path; th])\r
14299        THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
14300    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th])\r
14301    THEN USE_THEN "R1" (fun th-> USE_THEN "R4"(fun th1-> USE_THEN "F18" (fun th2-> (REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_complement_path (CONJ th (CONJ th1 th2)))]))))\r
14302    THEN EXPAND_TAC "z"\r
14303    THEN USE_THEN "MN" (fun th-> USE_THEN "YEL" (fun th1-> REWRITE_TAC[attach; th; th1]))\r
14304    THEN REWRITE_TAC[MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) (SPEC `m:num` LE_PLUS))]\r
14305    THEN REWRITE_TAC[ADD1; ADD_SUB2; POWER_1]\r
14306    THEN ONCE_REWRITE_TAC[GSYM(MATCH_MP PERMUTES_INJECTIVE (CONJUNCT2 (SPEC`H:(A)hypermap` node_map_and_darts)))]\r
14307    THEN USE_THEN "R1" (MP_TAC o SPEC `y:A` o REWRITE_RULE[edge_convolution])\r
14308    THEN USE_THEN "F4"(fun th-> USE_THEN "F5"(fun th1-> USE_THEN "F9" (fun th2-> REWRITE_TAC[MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))])))\r
14309    THEN DISCH_THEN SUBST1_TAC\r
14310    THEN USE_THEN "UL" (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`)\r
14311    THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts))]);;\r
14312 \r
14313 let genesis = new_definition `!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. genesis H NF L x = (NF DELETE L) UNION {dnax H NF L x, dnay H NF L x}`;;\r
14314 \r
14315 let lemma_in_couple = prove(`!x:A a:A b:A. x IN {a, b} <=> x = a \/ x = b`, SET_TAC[]);;\r
14316 \r
14317 let lemma_on_dnax = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==> (genex H NF L x 0 = attach H NF L x) /\ attach H NF L x belong dnax H NF L x  /\ top (dnax H NF L x) = tpx H NF L x /\ (!i:num. i <= index L (attach H NF L x) (heading H NF L x) ==> (next (dnax H NF L x) POWER i) (attach H NF L x) = (next L POWER i) (attach H NF L x)) /\ (!i:num. i <= mAdd H NF L x ==> (next (dnax H NF L x) POWER ((index L (attach H NF L x) (heading H NF L x)) + i)) (attach H NF L x) = (face_map H POWER i) (heading H NF L x))`,\r
14318    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
14319    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC(CONJUNCT1(MATCH_MP lemma_genex_loop (CONJ th th1)))))\r
14320    THEN DISCH_THEN (LABEL_TAC "F3" o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list])\r
14321    THEN SUBGOAL_THEN `genex (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) 0 = attach H NF L x` (LABEL_TAC "F4")\r
14322    THENL[REWRITE_TAC[genex; start_glue_evaluation; loop_path; POWER_0; I_THM]; ALL_TAC]\r
14323    THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) \r
14324    THEN STRIP_TAC\r
14325    THENL[REWRITE_TAC[belong]\r
14326        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th; GSYM in_list])\r
14327        THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN MP_TAC (SPEC `tpx (H:(A)hypermap) NF L x` LE_0)\r
14328        THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC]\r
14329    THEN STRIP_TAC\r
14330    THENL[ONCE_REWRITE_TAC[GSYM EQ_SUC] THEN REWRITE_TAC[GSYM lemma_size; size]\r
14331        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th])\r
14332        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP lemma_size_list th]); ALL_TAC]\r
14333    THEN STRIP_TAC\r
14334    THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5")\r
14335        THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
14336        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th])\r
14337        THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `i:num` (CONJUNCT2 (MATCH_MP lemma_samsara_power th))))\r
14338        THEN SUBGOAL_THEN `i:num <= tpx (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th])\r
14339        THENL[MATCH_MP_TAC LE_TRANS\r
14340            THEN EXISTS_TAC `index (L:(A)loop) (attach (H:(A)hypermap) NF L x) (heading H NF L x)`\r
14341            THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th; tpx; LE_ADD]); ALL_TAC]\r
14342        THEN DISCH_THEN SUBST1_TAC\r
14343        THEN REWRITE_TAC[genex]\r
14344        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th; loop_path]); ALL_TAC] \r
14345    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1")\r
14346    THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
14347    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th])\r
14348    THEN ABBREV_TAC `m = index (L:(A)loop) (attach (H:(A)hypermap) NF L x) (heading H NF L x)`\r
14349    THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `(m:num) + (i:num)` (CONJUNCT2 (MATCH_MP lemma_samsara_power th))))\r
14350    THEN SUBGOAL_THEN `(m:num) + (i:num) <= tpx (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th])\r
14351    THENL[EXPAND_TAC "m" THEN USE_THEN "H1" (fun th->REWRITE_TAC[tpx; LE_ADD_LCANCEL; th]); ALL_TAC]\r
14352    THEN DISCH_THEN SUBST1_TAC\r
14353    THEN SUBGOAL_THEN `loop_path (L:(A)loop) (attach (H:(A)hypermap) NF L x) (m:num) = face_contour H (heading H NF L x) 0` MP_TAC\r
14354    THENL[REWRITE_TAC[loop_path; face_contour; POWER_0; I_THM] THEN EXPAND_TAC "m"\r
14355        THEN POP_ASSUM (LABEL_TAC "H2")\r
14356        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (MATCH_MP lemma_split_marked_loop (CONJ th th1))))\r
14357        THEN DISCH_THEN (MP_TAC o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14358        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14359        THEN REWRITE_TAC[IMP_IMP]\r
14360        THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(CONJUNCT2(MATCH_MP lemma_loop_index th))]); ALL_TAC]\r
14361    THEN REWRITE_TAC[genex]\r
14362    THEN POP_ASSUM SUBST1_TAC\r
14363    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th; face_contour]));;\r
14364 \r
14365 let lemma_on_dnay = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==> geney H NF L x 0 = inverse (node_map H) (heading H NF L x) /\ inverse (node_map H) (heading H NF L x) belong dnay H NF L x /\ top (dnay H NF L x) = tpy H NF L x /\ (!i:num. i <= index L (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x)) ==> (next (dnay H NF L x) POWER i) (inverse (node_map H) (heading H NF L x)) = (next L POWER i) (inverse (node_map H) (heading H NF L x))) /\ (!i:num. i <= ind H (attach H NF L x) (mAdd H NF L x) ==> (next (dnay H NF L x) POWER ((index L (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x))) + i))(inverse (node_map H) (heading H NF L x)) = complement H (attach H NF L x) i)`,\r
14366    REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))\r
14367    THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC(CONJUNCT1(MATCH_MP lemma_geney_loop (CONJ th th1)))))\r
14368    THEN DISCH_THEN (LABEL_TAC "F3" o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list])\r
14369    THEN SUBGOAL_THEN `geney (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) 0 = inverse (node_map H) (heading H NF L x)` (LABEL_TAC "F4")\r
14370    THENL[REWRITE_TAC[geney; start_glue_evaluation; loop_path; POWER_0; I_THM]; ALL_TAC]\r
14371    THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th])\r
14372    THEN STRIP_TAC \r
14373    THENL[REWRITE_TAC[belong]\r
14374        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th; GSYM in_list])\r
14375        THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN MP_TAC (SPEC `tpy (H:(A)hypermap) NF L x` LE_0)\r
14376        THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC]\r
14377    THEN STRIP_TAC\r
14378    THENL[ONCE_REWRITE_TAC[GSYM EQ_SUC] THEN REWRITE_TAC[GSYM lemma_size; size]\r
14379        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th])\r
14380        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP lemma_size_list th]); ALL_TAC]\r
14381    THEN STRIP_TAC\r
14382    THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5")\r
14383        THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
14384        THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th])\r
14385        THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `i:num` (CONJUNCT2 (MATCH_MP lemma_samsara_power th))))\r
14386        THEN SUBGOAL_THEN `i:num <= tpy (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th])\r
14387        THENL[MATCH_MP_TAC LE_TRANS\r
14388            THEN EXISTS_TAC `index (L:(A)loop) (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x))`\r
14389            THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th; tpy; LE_ADD]); ALL_TAC]\r
14390        THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[geney]\r
14391        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th; loop_path]); ALL_TAC]\r
14392    THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1")\r
14393    THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
14394    THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th])\r
14395    THEN ABBREV_TAC `m = index (L:(A)loop) (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x))`\r
14396    THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `(m:num) + (i:num)` (CONJUNCT2 (MATCH_MP lemma_samsara_power th))))\r
14397    THEN SUBGOAL_THEN `(m:num) + (i:num) <= tpy (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th])\r
14398    THENL[EXPAND_TAC "m" THEN USE_THEN "H1" (fun th->REWRITE_TAC[tpy; LE_ADD_LCANCEL; th]); ALL_TAC]\r
14399    THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (LABEL_TAC "H2")\r
14400    THEN SUBGOAL_THEN `loop_path (L:(A)loop) (inverse (node_map H) (heading H NF L x)) (m:num) = complement H (attach H NF L x) 0` MP_TAC\r
14401    THENL[REWRITE_TAC[loop_path; face_contour; POWER_0; I_THM] THEN EXPAND_TAC "m"\r
14402        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> LABEL_TAC "H3" (MATCH_MP lemma_split_marked_loop (CONJ th th1))))\r
14403        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14404        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_back_in_loop)\r
14405        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1))]))\r
14406        THEN USE_THEN "H3" ((CONJUNCTS_THEN2 MP_TAC (ASSUME_TAC o CONJUNCT1)) o MATCH_MP lemma_on_heading)\r
14407        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_next_in_loop)\r
14408        THEN POP_ASSUM (SUBST1_TAC)\r
14409        THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (SUBST1_TAC o SYM o CONJUNCT2 o MATCH_MP lemma_loop_index)\r
14410        THEN ONCE_REWRITE_TAC[SYM(SPECL[`H:(A)hypermap`; `attach (H:(A)hypermap) NF L x`] (CONJUNCT1 ind))]\r
14411        THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14412        THEN USE_THEN "H3" (MP_TAC o CONJUNCT2 o REWRITE_RULE[is_split_condition])\r
14413        THEN DISCH_THEN (fun th-> (MP_TAC (CONJUNCT1 (CONJUNCT2 th)) THEN MP_TAC (CONJUNCT1 th)))\r
14414        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14415        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_dart)\r
14416        THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[is_marked])\r
14417        THEN DISCH_THEN ((CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14418        THEN DISCH_THEN (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2)\r
14419        THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP;GSYM  CONJ_ASSOC]\r
14420        THEN DISCH_THEN (fun th-> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_complement_path th)])\r
14421        THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
14422    THEN USE_THEN "H2" (fun th-> REWRITE_TAC[geney; th])\r
14423    THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]));;\r
14424 \r
14425 \r
14426 let lemma_node_outside_support_darts = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A i:num. is_split_condition H NF L x /\ 1 <= i /\ i <= mAdd H NF L x ==> (!y:A. y IN node H ((face_map H POWER i) (heading H NF L x)) ==> ~(y IN support_darts NF))`,\r
14427  REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))\r
14428    THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
14429    THEN REWRITE_TAC[lemma_in_support]\r
14430    THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))\r
14431    THEN USE_THEN "F1" (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_mAdd)\r
14432    THEN USE_THEN "F2" (fun th-> USE_THEN "F3" (fun th1-> REWRITE_TAC[th; th1]))\r
14433    THEN REWRITE_TAC[CONTRAPOS_THM]\r
14434    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity)\r
14435    THEN ABBREV_TAC `z = (face_map (H:(A)hypermap) POWER (i:num)) (heading H NF L x)`\r
14436    THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `z:A`] node_refl)\r
14437    THEN POP_ASSUM SUBST1_TAC\r
14438    THEN DISCH_THEN (LABEL_TAC "F6")\r
14439    THEN USE_THEN "F1" (LABEL_TAC "F7" o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_split_condition])\r
14440    THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (fun th1-> MP_TAC (MATCH_MP lemma_in_support2 (CONJ th th1))))\r
14441    THEN USE_THEN "F7" (fun th-> DISCH_THEN (fun th1-> MP_TAC (MATCH_MP lemma_node_sub_support_darts (CONJ th th1))))\r
14442    THEN DISCH_THEN (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)])));;\r
14443 \r
14444 let lemma_in_dnax = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==> (!y:A. y belong dnax H NF L x <=> \r
14445 (?i:num. i <= index L (attach H NF L x) (heading H NF L x) /\ y = (next L POWER i) (attach H NF L x)) \/ ((?i:num. 1 <= i /\ i <= mAdd H NF L x /\ y = (face_map H POWER i) (heading H NF L x))))`,\r
14446  REPEAT GEN_TAC\r
14447    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
14448    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
14449    THEN USE_THEN "F5" (fun th->(USE_THEN "F4" (LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
14450    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14451    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14452    THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
14453    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14454    THEN POP_ASSUM (LABEL_TAC "YEL")\r
14455    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14456    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
14457    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14458    THEN POP_ASSUM (LABEL_TAC "MN")\r
14459    THEN GEN_TAC\r
14460    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_on_dnax o CONJ th))\r
14461    THEN USE_THEN "YEL" (fun th-> USE_THEN "ZEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[tpx; th; th1; th2])))\r
14462    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (LABEL_TAC "F15"))))\r
14463    THEN USE_THEN "F11" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong_loop th])\r
14464    THEN USE_THEN "F12" SUBST1_TAC\r
14465    THEN EQ_TAC\r
14466    THENL[DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")))\r
14467        THEN ASM_CASES_TAC `i:num <= index (L:(A)loop) z y`\r
14468        THENL[POP_ASSUM (LABEL_TAC "H3")\r
14469            THEN USE_THEN "F14" (fun th-> USE_THEN "H3" (MP_TAC o MATCH_MP th))\r
14470            THEN USE_THEN "H2" (fun th-> REWRITE_TAC[SYM th])\r
14471            THEN DISCH_TAC THEN DISJ1_TAC THEN EXISTS_TAC `i:num`\r
14472            THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
14473        THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H4")) o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
14474        THEN USE_THEN "H1" MP_TAC\r
14475        THEN USE_THEN "H4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [th; LE_ADD_LCANCEL])\r
14476        THEN DISCH_THEN (LABEL_TAC "F5") THEN DISJ2_TAC\r
14477        THEN USE_THEN "F15" (fun th-> USE_THEN "F5" (MP_TAC o MATCH_MP th))\r
14478        THEN USE_THEN "H4" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[SYM th; SYM th1]))\r
14479        THEN DISCH_TAC\r
14480        THEN EXISTS_TAC `SUC d`\r
14481        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
14482        THEN POP_ASSUM (fun th-> REWRITE_TAC[GE_1; th]); ALL_TAC]\r
14483    THEN ASM_CASES_TAC `(?i:num. i <= index (L:(A)loop) z y /\ y' = (next L POWER (i:num)) z)`\r
14484    THENL[POP_ASSUM (fun th-> REWRITE_TAC[th] THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H6") SUBST1_TAC)  th))\r
14485        THEN EXISTS_TAC `i:num`\r
14486        THEN USE_THEN "H6" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (SPECL[`index (L:(A)loop) z y`; `m:num`] LE_ADD))])\r
14487        THEN USE_THEN "H6" (fun th-> USE_THEN "F14" (fun th1-> REWRITE_TAC[SYM (MATCH_MP th1 th)])); ALL_TAC]\r
14488    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
14489    THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H7") (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)))\r
14490    THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H7")) o REWRITE_RULE[LE_EXISTS])\r
14491    THEN USE_THEN "H7" (SUBST1_TAC)\r
14492    THEN EXISTS_TAC `(index (L:(A)loop) z y)+ i`\r
14493    THEN REWRITE_TAC[ADD_ASSOC; LE_ADD]\r
14494    THEN USE_THEN "H7" (fun th-> MP_TAC(REWRITE_RULE[SYM th] (SPECL[`i:num`; `d:num`] LE_ADD)))\r
14495    THEN DISCH_THEN (fun th-> USE_THEN "F15" (fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)])));;\r
14496 \r
14497 let lemma_in_dnax1 = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A y:A i:num. is_marked H NF L x /\ ~(L IN canon H NF) /\ i <= index L (attach H NF L x) (heading H NF L x) /\ y = (next L POWER i) (attach H NF L x) ==> y belong dnax H NF L x`,\r
14498    MESON_TAC[lemma_in_dnax]);;\r
14499 \r
14500 let lemma_in_dnax2 = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A y:A i:num. is_marked H NF L x /\ ~(L IN canon H NF) /\ 1 <= i /\ i <= mAdd H NF L x /\ y = (face_map H POWER i) (heading H NF L x) ==> y belong dnax H NF L x`,\r
14501    MESON_TAC[lemma_in_dnax]);;\r
14502 \r
14503 let lemma_in_dnay = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==> (!y:A. y belong dnay H NF L x <=> \r
14504 (?i:num. i <= index L (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x)) /\ y = (next L POWER i) (inverse (node_map H) (heading H NF L x))) \/ (?i:num j:num. 1 <= i /\ i <= mAdd H NF L x /\ 1 <= j /\ j < CARD (node H ((face_map H POWER i) (heading H NF L x))) /\ y = (inverse (node_map H) POWER j) ((face_map H POWER i) (heading H NF L x))))`,\r
14505    REPEAT GEN_TAC\r
14506    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
14507    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
14508    THEN USE_THEN "F5" (fun th->(USE_THEN "F4" (LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
14509    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14510    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14511    THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
14512    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14513    THEN POP_ASSUM (LABEL_TAC "YEL")\r
14514    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14515    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
14516    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14517    THEN POP_ASSUM (LABEL_TAC "MN")\r
14518    THEN USE_THEN "YEL" (fun th->  USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_on_heading))\r
14519    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12" o CONJUNCT1))\r
14520    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1)))))\r
14521    THEN USE_THEN "ZEL" (fun th-> REWRITE_TAC[th])\r
14522    THEN DISCH_THEN (LABEL_TAC "F15")\r
14523    THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> REWRITE_TAC[GSYM th; GSYM th1]))\r
14524    THEN USE_THEN "F9" (LABEL_TAC "A3" o MATCH_MP lemma_next_in_loop)\r
14525    THEN USE_THEN "F10" (LABEL_TAC "A4" o MATCH_MP lemma_back_in_loop)\r
14526    THEN USE_THEN "A4" (fun th-> USE_THEN "A3" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th)))))\r
14527    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A5") (LABEL_TAC "A6"))\r
14528    THEN ABBREV_TAC `ny = index (L:(A)loop) (next L y) (back L z)` THEN POP_ASSUM (LABEL_TAC "A8")\r
14529    THEN GEN_TAC\r
14530    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_on_dnay o CONJ th))\r
14531    THEN USE_THEN "YEL" (fun th-> USE_THEN "ZEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[tpy; th; th1; th2])))\r
14532    THEN USE_THEN "A8" (fun th2-> USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1-> REWRITE_TAC[SYM th; SYM th1; th2])))\r
14533    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "B1") (CONJUNCTS_THEN2 (LABEL_TAC "B2") (CONJUNCTS_THEN2 (LABEL_TAC "B3") (LABEL_TAC "B4"))))\r
14534    THEN USE_THEN "B1" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong_loop th])\r
14535    THEN USE_THEN "B2" SUBST1_TAC\r
14536    THEN EQ_TAC\r
14537    THENL[DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")))\r
14538        THEN ASM_CASES_TAC `i:num <= ny`\r
14539        THENL[POP_ASSUM (LABEL_TAC "H3") THEN DISJ1_TAC\r
14540            THEN USE_THEN "B3" (fun th-> USE_THEN "H3" (MP_TAC o MATCH_MP th))\r
14541            THEN USE_THEN "H2" (fun th-> REWRITE_TAC[SYM th])\r
14542            THEN DISCH_TAC THEN EXISTS_TAC `i:num`\r
14543            THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
14544        THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H4")) o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
14545        THEN USE_THEN "H1" MP_TAC\r
14546        THEN USE_THEN "H4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [th; LE_ADD_LCANCEL])\r
14547        THEN DISCH_THEN (LABEL_TAC "H5")\r
14548        THEN DISJ2_TAC\r
14549        THEN USE_THEN "H5" MP_TAC THEN MP_TAC (SPEC `d:num` GE_1)\r
14550        THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14551        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14552        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14553        THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index)\r
14554        THEN DISCH_THEN (X_CHOOSE_THEN `a:num` (X_CHOOSE_THEN `b:num` (CONJUNCTS_THEN2 (LABEL_TAC "H6") (CONJUNCTS_THEN2 (LABEL_TAC "H7") (CONJUNCTS_THEN2 (LABEL_TAC "H8") (LABEL_TAC "H9"))))))\r
14555        THEN USE_THEN "B4" (fun th-> USE_THEN "H5" (MP_TAC o MATCH_MP th))\r
14556        THEN USE_THEN "H4" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[SYM th; SYM th1]))\r
14557        THEN DISCH_TAC\r
14558        THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14559        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14560        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14561        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14562        THEN DISCH_THEN (MP_TAC o SPECL[`a:num`; `b:num`] o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_complement_path)\r
14563        THEN USE_THEN "H7" (fun th-> USE_THEN "H8" (fun th1-> USE_THEN "H9" (fun th2-> REWRITE_TAC[th; th1; SYM th2])))\r
14564        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
14565        THEN REMOVE_THEN "H8" MP_TAC THEN REWRITE_TAC[IMP_IMP]\r
14566        THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
14567        THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
14568        THEN DISCH_THEN SUBST1_TAC\r
14569        THEN USE_THEN "H6" (fun th-> MP_TAC (SPEC `y:A` (MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) (MATCH_MP LT_IMP_LE (ONCE_REWRITE_RULE[GSYM LT_SUC] th))))))\r
14570        THEN REWRITE_TAC[SUB_SUC]\r
14571        THEN USE_THEN "H6" ((X_CHOOSE_THEN `s:num` (LABEL_TAC "H10") o REWRITE_RULE[LT_EXISTS]))\r
14572        THEN USE_THEN "H10" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [th; ADD_SUB2])\r
14573        THEN USE_THEN "H10" (fun th -> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [SYM th])\r
14574        THEN DISCH_THEN (SUBST1_TAC)\r
14575        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H11") (LABEL_TAC "H12"))\r
14576        THEN EXISTS_TAC `SUC s` THEN EXISTS_TAC `b:num`\r
14577        THEN USE_THEN "H7" (fun th-> USE_THEN "H11" (fun th1 -> USE_THEN "H12" (fun th2-> REWRITE_TAC[th; th1; th2; GE_1])))\r
14578        THEN USE_THEN "H10" (fun th-> REWRITE_TAC[th; LE_ADDR]); ALL_TAC]\r
14579    THEN ASM_CASES_TAC `(?i:num. i <= ny:num /\ y' = (next (L:(A)loop) POWER (i:num)) (next L y))`\r
14580    THENL[POP_ASSUM (fun th-> REWRITE_TAC[th] THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "T1") SUBST1_TAC)  th))\r
14581        THEN EXISTS_TAC `i:num`\r
14582        THEN USE_THEN "T1" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (SPECL[`ny:num`; `ind (H:(A)hypermap) z m`] LE_ADD))])\r
14583        THEN USE_THEN "T1" (fun th-> USE_THEN "B3" (fun th1-> REWRITE_TAC[SYM (MATCH_MP th1 th)])); ALL_TAC]\r
14584    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
14585    THEN DISCH_THEN (X_CHOOSE_THEN `a:num` (X_CHOOSE_THEN `b:num` (CONJUNCTS_THEN2 (LABEL_TAC "T2") (CONJUNCTS_THEN2 (LABEL_TAC "T3") (CONJUNCTS_THEN2 (LABEL_TAC "T4") (CONJUNCTS_THEN2 (LABEL_TAC "T5") (LABEL_TAC "T6")))))))\r
14586    THEN USE_THEN "T3" ((X_CHOOSE_THEN `d:num` (LABEL_TAC "T7")) o REWRITE_RULE[LE_EXISTS])\r
14587    THEN EXISTS_TAC `(ny:num) + ((ind (H:(A)hypermap) z d) + b)`\r
14588    THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
14589    THEN USE_THEN "T5" (MP_TAC)\r
14590    THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
14591    THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
14592    THEN USE_THEN "T7" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ONCE_REWRITE_RULE[ADD_SYM] th])\r
14593    THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[GSYM (CONJUNCT2 ADD); lemma_add_exponent_function]\r
14594    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]\r
14595    THEN DISCH_THEN (SUBST1_TAC)\r
14596    THEN DISCH_THEN (LABEL_TAC "T8")\r
14597    THEN SUBGOAL_THEN `(ind (H:(A)hypermap) z d) + b <= ind H z m` (LABEL_TAC "T9")\r
14598    THENL[MATCH_MP_TAC LE_TRANS\r
14599        THEN EXISTS_TAC `ind (H:(A)hypermap) z (SUC d)`\r
14600        THEN USE_THEN "T7" MP_TAC\r
14601        THEN USE_THEN "T2" (fun th-> ONCE_REWRITE_TAC[SYM(MATCH_MP LE_SUC_PRE th)])\r
14602        THEN REWRITE_TAC[CONJUNCT2 ADD; GSYM ADD_SUC]\r
14603        THEN DISCH_THEN (fun th-> MP_TAC (REWRITE_RULE[SYM th] (SPECL[`PRE a`; `SUC d`] LE_ADDR)))\r
14604        THEN DISCH_TAC\r
14605        THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14606        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14607        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14608        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_increasing_index_one)\r
14609        THEN POP_ASSUM (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[REWRITE_RULE[th] (SPECL[`SUC d`; `m:num`] (MATCH_MP lemma_inc_not_decreasing th1))]))\r
14610        THEN REWRITE_TAC[ind]\r
14611        THEN REWRITE_TAC[LE_ADD_LCANCEL; GSYM LT_SUC_LE]\r
14612        THEN MP_TAC (SPECL[`H:(A)hypermap`; `(inverse (face_map (H:(A)hypermap)) POWER (SUC d)) z`] NODE_NOT_EMPTY)\r
14613        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th])\r
14614        THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
14615    THEN USE_THEN "T9" (fun th-> REWRITE_TAC[th])\r
14616    THEN USE_THEN "B4" (fun th-> USE_THEN "T9" (MP_TAC o MATCH_MP th))\r
14617    THEN DISCH_THEN (SUBST1_TAC)\r
14618    THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14619    THEN USE_THEN "F3"(MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14620    THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14621    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14622    THEN DISCH_THEN (MP_TAC o SPECL[`d:num`; `b:num`] o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_complement_path)\r
14623    THEN USE_THEN "T8" (fun th-> USE_THEN "T4" (fun th1-> REWRITE_TAC[th; th1]))\r
14624    THEN DISCH_THEN (SUBST1_TAC)\r
14625    THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
14626    THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
14627    THEN DISCH_THEN SUBST1_TAC\r
14628    THEN USE_THEN "T7" (fun th-> (MP_TAC (REWRITE_RULE[SYM th] (SPECL[`a:num`; `d:num`] LE_ADDR))))\r
14629    THEN ONCE_REWRITE_TAC[GSYM LE_SUC]\r
14630    THEN DISCH_THEN (fun th-> MP_TAC (SPEC `y:A` (MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) th))))\r
14631    THEN REWRITE_TAC[SUB_SUC]\r
14632    THEN USE_THEN "T7" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [th;  ADD_SUB])\r
14633    THEN DISCH_THEN (SUBST1_TAC) THEN USE_THEN "T6" (fun th-> REWRITE_TAC[th]));;\r
14634 \r
14635 let lemma_in_dnay1 = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A y:A i:num. is_marked H NF L x /\ ~(L IN canon H NF) /\ i <= index L (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x)) /\ y = (next L POWER i) (inverse (node_map H) (heading H NF L x)) ==> y belong dnay H NF L x`,\r
14636    MESON_TAC[lemma_in_dnay]);;\r
14637 \r
14638 let lemma_in_dnay2 = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A y:A i:num j:num. is_marked H NF L x /\ ~(L IN canon H NF) /\ 1 <= i /\ i <= mAdd H NF L x /\ 1 <= j /\ j < CARD (node H ((face_map H POWER i) (heading H NF L x))) /\ y = (inverse (node_map H) POWER j) ((face_map H POWER i) (heading H NF L x)) ==> y belong dnay H NF L x`,\r
14639    MESON_TAC[lemma_in_dnay]);;\r
14640 \r
14641 let lemma_disjoint_new_loops = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==> ( (index L (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x))) + (SUC (index L (attach H NF L x) (heading H NF L x)))  = top L) /\ (!u:A. u belong dnax H NF L x ==> ~(u belong dnay H NF L x)) /\ (!u:A. u belong dnay H NF L x ==> ~(u belong dnax H NF L x)) /\ ~(dnax H NF L x IN NF) /\ ~(dnay H NF L x IN NF) /\ (!u:A. u belong L ==> u belong dnax H NF L x \/ u belong dnay H NF L x)`,\r
14642    REPEAT GEN_TAC\r
14643    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
14644    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
14645    THEN USE_THEN "F5" (fun th->(USE_THEN "F4" (LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
14646    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14647    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14648    THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
14649    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14650    THEN POP_ASSUM (LABEL_TAC "YEL")\r
14651    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14652    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
14653    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14654    THEN POP_ASSUM (LABEL_TAC "MN")\r
14655    THEN USE_THEN "YEL" (fun th->  USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_on_heading))\r
14656    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12" o CONJUNCT1))\r
14657    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1)))))\r
14658    THEN USE_THEN "ZEL" (fun th-> REWRITE_TAC[th])\r
14659    THEN DISCH_THEN (LABEL_TAC "F15")\r
14660    THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> REWRITE_TAC[GSYM th; GSYM th1]))\r
14661    THEN USE_THEN "F9" (fun th-> USE_THEN "F10" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th)))))\r
14662    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A1") (LABEL_TAC "A2"))\r
14663    THEN USE_THEN "F9" (fun th-> USE_THEN "F10" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th)))))\r
14664    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A1") (LABEL_TAC "A2"))\r
14665    THEN USE_THEN "F9" (LABEL_TAC "A3" o MATCH_MP lemma_next_in_loop)\r
14666    THEN USE_THEN "F10" (LABEL_TAC "A4" o MATCH_MP lemma_back_in_loop)\r
14667    THEN USE_THEN "A4" (fun th-> USE_THEN "A3" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th)))))\r
14668    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A5") (LABEL_TAC "A6"))\r
14669    THEN ABBREV_TAC `nz = index (L:(A)loop) z y` THEN POP_ASSUM (LABEL_TAC "A7")\r
14670    THEN ABBREV_TAC `ny = index (L:(A)loop) (next L y) (back L z)` THEN POP_ASSUM (LABEL_TAC "A8")\r
14671    THEN SUBGOAL_THEN `(ny:num) + (SUC nz) = top (L:(A)loop)`  (LABEL_TAC "F16")\r
14672    THENL[ASM_CASES_TAC `nz:num = top (L:(A)loop)`\r
14673        THENL[USE_THEN "A2" (MP_TAC o REWRITE_RULE[COM_POWER_FUNCTION] o  AP_TERM `next (L:(A)loop)`)\r
14674            THEN POP_ASSUM (LABEL_TAC "B1")\r
14675            THEN USE_THEN "B1" (fun th-> REWRITE_TAC[th; GSYM lemma_size; lemma_order_next; I_THM])\r
14676            THEN USE_THEN "F12" (fun th-> DISCH_THEN (ASSUME_TAC o REWRITE_RULE[th]))\r
14677            THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `y:A`; `1`] lemma_power_inverse_in_node2))\r
14678            THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity)\r
14679            THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_on_attach)\r
14680            THEN USE_THEN "YEL"(fun th-> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[th; th1]))\r
14681            THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
14682        THEN USE_THEN "A1" (fun th-> POP_ASSUM(fun th1 -> LABEL_TAC "B2" (REWRITE_RULE[GSYM LT_LE] (CONJ th th1))))\r
14683        THEN USE_THEN "A6" (MP_TAC o AP_TERM `next (L:(A)loop)`)\r
14684        THEN REWRITE_TAC[lemma_inverse_evaluation; POWER_FUNCTION; COM_POWER_FUNCTION]\r
14685        THEN USE_THEN "A2" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th])\r
14686        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
14687        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2 ADD]\r
14688        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM ADD_SUC]\r
14689        THEN DISCH_THEN (LABEL_TAC "B3" o SYM)\r
14690        THEN SUBGOAL_THEN `(next L POWER 0) z = (next (L:(A)loop) POWER ((SUC ny) + (SUC nz))) z` MP_TAC\r
14691        THENL[USE_THEN "B3" (fun th-> REWRITE_TAC[POWER_0; I_THM; th]); ALL_TAC]\r
14692        THEN SUBGOAL_THEN `0 < CARD (orbit_map (next (L:(A)loop)) z)` MP_TAC\r
14693        THENL[USE_THEN "F10" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_transitive_permutation th); GSYM size; lemma_size; LT_0]); ALL_TAC]\r
14694        THEN MP_TAC (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop))\r
14695        THEN MP_TAC (CONJUNCT1(SPEC `L:(A)loop` loop_lemma))\r
14696        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14697        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_congruence_on_orbit)\r
14698        THEN USE_THEN "F10" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_transitive_permutation th); GSYM size; ADD_0])\r
14699        THEN DISCH_THEN (X_CHOOSE_THEN `q:num` (LABEL_TAC "B4"))\r
14700        THEN ASM_CASES_TAC `q:num = 0`\r
14701        THENL[USE_THEN "B4" MP_TAC THEN POP_ASSUM (SUBST1_TAC) THEN REWRITE_TAC[CONJUNCT1 MULT] THEN ARITH_TAC; ALL_TAC]\r
14702        THEN POP_ASSUM (LABEL_TAC "B5")\r
14703        THEN ASM_CASES_TAC `1 < q:num`\r
14704        THENL[USE_THEN "B2" (MP_TAC o ONCE_REWRITE_RULE[GSYM LT_SUC])\r
14705            THEN USE_THEN "A5" (MP_TAC o ONCE_REWRITE_RULE[GSYM LE_SUC])\r
14706            THEN REWRITE_TAC[GSYM lemma_size; IMP_IMP]\r
14707            THEN DISCH_THEN (MP_TAC o MATCH_MP LET_ADD2)\r
14708            THEN USE_THEN "B4" SUBST1_TAC\r
14709            THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` SUBST1_TAC) o REWRITE_RULE[GSYM ADD1] o ONCE_REWRITE_RULE[ADD_SYM] o  REWRITE_RULE[LT_EXISTS])\r
14710            THEN REWRITE_TAC[MULT] THEN REWRITE_TAC[LT_ADD_RCANCEL] THEN ARITH_TAC; ALL_TAC]\r
14711        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LT]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
14712        THEN REWRITE_TAC[IMP_IMP; LE_ANTISYM]\r
14713        THEN DISCH_TAC THEN USE_THEN "B4" MP_TAC THEN POP_ASSUM (SUBST1_TAC o SYM)\r
14714        THEN REWRITE_TAC[MULT_CLAUSES; lemma_size; CONJUNCT2 ADD; EQ_SUC]; ALL_TAC]\r
14715    THEN USE_THEN "F16" (fun th-> REWRITE_TAC[th])\r
14716    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnax (CONJ th th1)))))\r
14717    THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1->  REWRITE_TAC[tpx; th; th1]))\r
14718    THEN USE_THEN "MN" (fun th-> USE_THEN "A7" (fun th1-> REWRITE_TAC[th; th1]))\r
14719    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4"))))\r
14720    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnay (CONJ th th1)))))\r
14721    THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1->  REWRITE_TAC[tpy; th; th1]))\r
14722    THEN USE_THEN "F12" (fun th2->USE_THEN "F15" (fun th3-> REWRITE_TAC[GSYM th2; GSYM th3]))\r
14723    THEN USE_THEN "MN" (fun th-> USE_THEN "A8" (fun th1-> REWRITE_TAC[tpy; th; th1]))\r
14724    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G5") (CONJUNCTS_THEN2 (LABEL_TAC "G6") (CONJUNCTS_THEN2 (LABEL_TAC "G7") (LABEL_TAC "G8"))))\r
14725    THEN SUBGOAL_THEN `!u:A. u belong dnax (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A) ==> ~(u belong dnay H NF L x)` (LABEL_TAC "F17")\r
14726    THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1")\r
14727        THEN USE_THEN "F6" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM]\r
14728        THEN DISCH_THEN (fun th1-> USE_THEN "G5" (fun th-> MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1))))\r
14729        THEN USE_THEN "G6" (fun th-> REWRITE_TAC[th])\r
14730        THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3")))\r
14731        THEN REMOVE_THEN "H1" (fun th1-> USE_THEN "G1" (fun th-> MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1))))\r
14732        THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th])\r
14733        THEN DISCH_THEN (X_CHOOSE_THEN `t:num` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5")))\r
14734        THEN ASM_CASES_TAC `t:num <= nz`\r
14735        THENL[POP_ASSUM (LABEL_TAC "H6")\r
14736            THEN REMOVE_THEN "H5" (MP_TAC)\r
14737            THEN USE_THEN "H6" (fun th-> USE_THEN "G3" (fun th1 -> REWRITE_TAC[MATCH_MP th1 th]))\r
14738            THEN DISCH_THEN (LABEL_TAC "H7")\r
14739            THEN ASM_CASES_TAC `k:num <= ny`\r
14740            THENL[POP_ASSUM (LABEL_TAC "H8")\r
14741                THEN REMOVE_THEN "H3" MP_TAC\r
14742                THEN USE_THEN "H8" (fun th-> USE_THEN "G7" (fun th1-> REWRITE_TAC[MATCH_MP th1 th]))\r
14743                THEN USE_THEN "A2" (SUBST1_TAC o AP_TERM `next (L:(A)loop)`)\r
14744                THEN REWRITE_TAC[COM_POWER_FUNCTION; GSYM lemma_add_exponent_function]\r
14745                THEN USE_THEN "H7" SUBST1_TAC\r
14746                THEN DISCH_THEN (LABEL_TAC "H9")\r
14747                THEN USE_THEN "F8" (fun th-> USE_THEN "F10" (MP_TAC o CONJUNCT1 o MATCH_MP let_order_for_loop o CONJ th))\r
14748                THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list])\r
14749                THEN DISCH_THEN (MP_TAC o SPECL[`(k:num) +(SUC nz)`; `t:num`] o REWRITE_RULE[lemma_inj_list])\r
14750                THEN USE_THEN "H8" (fun th-> USE_THEN "A5" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)]))\r
14751                THEN USE_THEN "H6" (fun th-> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ (REWRITE_RULE[GSYM LT_SUC_LE] th) (SPECL[`k:num`; `SUC nz`] LE_ADDR))])\r
14752                THEN USE_THEN "F16" (SUBST1_TAC o SYM)\r
14753                THEN USE_THEN "H8" (fun th-> REWRITE_TAC[LE_ADD_RCANCEL; th; loop_path])\r
14754                THEN USE_THEN "H9" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
14755            THEN USE_THEN "H2" MP_TAC\r
14756            THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H10")) o  REWRITE_RULE[NOT_LE; LT_EXISTS])\r
14757            THEN USE_THEN "H10" SUBST1_TAC THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
14758            THEN DISCH_THEN (LABEL_TAC "H11") THEN USE_THEN "H3" MP_TAC\r
14759            THEN USE_THEN "H10" SUBST1_TAC\r
14760            THEN USE_THEN "H11" (fun th-> USE_THEN "G8" (fun th1-> REWRITE_TAC[MATCH_MP th1 th]))\r
14761            THEN DISCH_THEN (LABEL_TAC "H12") THEN USE_THEN "H11" MP_TAC\r
14762            THEN MP_TAC (SPEC `d:num` GE_1)\r
14763            THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14764            THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14765            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14766            THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index)\r
14767            THEN DISCH_THEN (X_CHOOSE_THEN `a:num` (X_CHOOSE_THEN `b:num` (CONJUNCTS_THEN2 (LABEL_TAC "H14") (CONJUNCTS_THEN2 (LABEL_TAC "H15") (CONJUNCTS_THEN2 (LABEL_TAC "H16") (LABEL_TAC "H17"))))))\r
14768            THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14769            THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14770            THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14771            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14772            THEN DISCH_THEN (MP_TAC o SPECL[`a:num`; `b:num`] o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_complement_path)\r
14773            THEN USE_THEN "H15" (fun th-> USE_THEN "H16" (fun th1-> USE_THEN "H17" (fun th2-> REWRITE_TAC[th; th1; SYM th2])))\r
14774            THEN USE_THEN "H12" (SUBST1_TAC o SYM)\r
14775            THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
14776            THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
14777            THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th])\r
14778            THEN USE_THEN "H14" (fun th-> MP_TAC (SPEC `y:A` (MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) (MATCH_MP LT_IMP_LE (ONCE_REWRITE_RULE[GSYM LT_SUC] th))))))\r
14779            THEN REWRITE_TAC[SUB_SUC]\r
14780            THEN DISCH_THEN SUBST1_TAC\r
14781            THEN USE_THEN "H14" ((X_CHOOSE_THEN `s:num` (LABEL_TAC "H18") o REWRITE_RULE[LT_EXISTS]))\r
14782            THEN USE_THEN "H18" (fun th-> REWRITE_TAC[th; ADD_SUB2])\r
14783            THEN DISCH_THEN (LABEL_TAC "H19")\r
14784            THEN MP_TAC (SPECL[`H:(A)hypermap`; `(face_map (H:(A)hypermap) POWER (SUC s)) (y:A)`; `b:num`] lemma_power_inverse_in_node2)\r
14785            THEN POP_ASSUM (SUBST1_TAC o SYM)\r
14786            THEN DISCH_THEN (LABEL_TAC "H19")\r
14787            THEN MP_TAC(SPECL[`a:num`; `SUC s`] LE_ADDR)\r
14788            THEN USE_THEN "H18" (SUBST1_TAC o SYM)\r
14789            THEN MP_TAC (SPEC `s:num` GE_1)\r
14790            THEN USE_THEN "F1" MP_TAC\r
14791            THEN EXPAND_TAC "m"\r
14792            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14793            THEN DISCH_THEN (MP_TAC o SPEC `u:A` o MATCH_MP lemma_node_outside_support_darts)\r
14794            THEN USE_THEN "YEL" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[th; th1]))\r
14795            THEN USE_THEN "H7" (fun th-> USE_THEN "F10" (MP_TAC o REWRITE_RULE[SYM th] o SPEC `t:num` o MATCH_MP lemma_power_next_in_loop))\r
14796            THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC]\r
14797        THEN USE_THEN "H4" MP_TAC\r
14798        THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "K1")) o  REWRITE_RULE[NOT_LE; LT_EXISTS])\r
14799        THEN USE_THEN "K1" SUBST1_TAC\r
14800        THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
14801        THEN DISCH_THEN (LABEL_TAC "K2")\r
14802        THEN USE_THEN "K2" (fun th-> USE_THEN "G4" (fun th1-> MP_TAC (MATCH_MP th1 th)))\r
14803        THEN USE_THEN "K1" (SUBST1_TAC o SYM)\r
14804        THEN USE_THEN "H5" (SUBST1_TAC o SYM)\r
14805        THEN DISCH_THEN (LABEL_TAC "K3")\r
14806        THEN ASM_CASES_TAC `k:num <= ny`\r
14807        THENL[POP_ASSUM (LABEL_TAC "K4")\r
14808            THEN REMOVE_THEN "H3" MP_TAC\r
14809            THEN USE_THEN "K4" (fun th-> USE_THEN "G7" (fun th1-> REWRITE_TAC[MATCH_MP th1 th]))\r
14810            THEN REWRITE_TAC[POWER_FUNCTION]\r
14811            THEN DISCH_THEN (fun th-> USE_THEN "F9" (MP_TAC o REWRITE_RULE[SYM th] o SPEC `SUC k` o MATCH_MP lemma_power_next_in_loop))\r
14812            THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> (ASSUME_TAC (MATCH_MP lemma_in_support2 (CONJ th th1)))))\r
14813            THEN USE_THEN "K2" MP_TAC\r
14814            THEN MP_TAC (SPEC `d:num` GE_1)\r
14815            THEN USE_THEN "F1" MP_TAC\r
14816            THEN EXPAND_TAC "m"\r
14817            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14818            THEN DISCH_THEN (MP_TAC o SPEC `u:A` o MATCH_MP lemma_node_outside_support_darts)\r
14819            THEN USE_THEN "K3"(fun th-> USE_THEN "YEL" (fun th1-> REWRITE_TAC[th1; th; node_refl]))\r
14820            THEN USE_THEN "K3" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[SYM th; th1])); ALL_TAC]\r
14821        THEN POP_ASSUM ((X_CHOOSE_THEN `w:num` (LABEL_TAC "K5")) o  REWRITE_RULE[NOT_LE; LT_EXISTS])\r
14822        THEN USE_THEN "H2" MP_TAC\r
14823        THEN USE_THEN "K5" SUBST1_TAC\r
14824        THEN REWRITE_TAC[LE_ADD_LCANCEL]\r
14825        THEN DISCH_THEN (LABEL_TAC "K6")\r
14826        THEN USE_THEN "H3" MP_TAC\r
14827        THEN USE_THEN "K5" SUBST1_TAC\r
14828        THEN USE_THEN "K6" (fun th-> USE_THEN "G8" (fun th1-> REWRITE_TAC[MATCH_MP th1 th]))\r
14829        THEN DISCH_THEN (LABEL_TAC "K7")\r
14830        THEN USE_THEN "K6" MP_TAC\r
14831        THEN MP_TAC (SPEC `w:num` GE_1)\r
14832        THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14833        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14834        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14835        THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index)\r
14836        THEN DISCH_THEN (X_CHOOSE_THEN `a:num` (X_CHOOSE_THEN `b:num` (CONJUNCTS_THEN2 (LABEL_TAC "K8") (CONJUNCTS_THEN2 (LABEL_TAC "K9") (CONJUNCTS_THEN2 (LABEL_TAC "K10") (LABEL_TAC "K11"))))))\r
14837        THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1-> USE_THEN "F10" (fun th2 -> MP_TAC (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14838        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14839        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14840        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14841        THEN DISCH_THEN (MP_TAC o SPECL[`a:num`; `b:num`] o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_complement_path)\r
14842        THEN USE_THEN "K9" (fun th-> USE_THEN "K10" (fun th1-> USE_THEN "K11" (fun th2-> REWRITE_TAC[th; th1; SYM th2])))\r
14843        THEN USE_THEN "K7" (SUBST1_TAC o SYM)\r
14844        THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
14845        THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
14846        THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th])\r
14847        THEN USE_THEN "K8" (fun th-> MP_TAC (SPEC `y:A` (MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) (MATCH_MP LT_IMP_LE (ONCE_REWRITE_RULE[GSYM LT_SUC] th))))))\r
14848        THEN REWRITE_TAC[SUB_SUC]\r
14849        THEN DISCH_THEN SUBST1_TAC\r
14850        THEN USE_THEN "K8" ((X_CHOOSE_THEN `p:num` (LABEL_TAC "K12") o REWRITE_RULE[LT_EXISTS]))\r
14851        THEN USE_THEN "K12" (fun th-> REWRITE_TAC[th; ADD_SUB2])\r
14852        THEN DISCH_THEN (LABEL_TAC "K14")\r
14853        THEN USE_THEN "K3" (fun th-> MP_TAC (REWRITE_RULE[SYM th] (SPECL[`H:(A)hypermap`; `y:A`; `SUC d`] lemma_in_face)))\r
14854        THEN DISCH_THEN (LABEL_TAC "K15" o MATCH_MP lemma_face_identity)\r
14855        THEN USE_THEN "K14" MP_TAC\r
14856        THEN REWRITE_TAC[GSYM (MATCH_MP inverse_power_function (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)))]\r
14857        THEN DISCH_TAC\r
14858        THEN MP_TAC (SPECL[`H:(A)hypermap`; `u:A`; `b:num`] lemma_in_node2)\r
14859        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
14860        THEN DISCH_TAC\r
14861        THEN USE_THEN "K15" (fun th-> MP_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `y:A`; `SUC p`] lemma_in_face)))\r
14862        THEN POP_ASSUM MP_TAC\r
14863        THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER]\r
14864        THEN USE_THEN "F9"(fun th2->USE_THEN "F4"(fun th->USE_THEN "F5" (fun th1-> MP_TAC(MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14865        THEN USE_THEN "K3" (fun th-> DISCH_THEN (ASSUME_TAC o REWRITE_RULE[SYM th] o  SPEC `SUC d` o MATCH_MP lemma_dart_invariant_power_face))\r
14866        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
14867        THEN POP_ASSUM (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th; IN_SING]))\r
14868        THEN USE_THEN "K14" SUBST1_TAC\r
14869        THEN DISCH_THEN (LABEL_TAC "K16")\r
14870        THEN USE_THEN "K10" MP_TAC\r
14871        THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
14872        THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
14873        THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th])\r
14874        THEN USE_THEN "K8" (fun th-> MP_TAC (SPEC `y:A` (MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) (MATCH_MP LT_IMP_LE (ONCE_REWRITE_RULE[GSYM LT_SUC] th))))))\r
14875        THEN REWRITE_TAC[SUB_SUC]\r
14876        THEN USE_THEN "K12" (fun th-> REWRITE_TAC[th; ADD_SUB2])\r
14877        THEN DISCH_THEN (SUBST1_TAC)\r
14878        THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list] o  MATCH_MP lemma_inj_node_contour)\r
14879        THEN DISCH_THEN (MP_TAC o SPECL[`b:num`; `0`] o  REWRITE_RULE[lemma_inj_list2])\r
14880        THEN POP_ASSUM (fun th-> REWRITE_TAC[LE_0; LE_REFL; node_contour; POWER_0; I_THM; SYM th])\r
14881        THEN USE_THEN "K9" (fun th-> REWRITE_TAC[REWRITE_RULE[LT1_NZ; LT_NZ] th]); ALL_TAC]\r
14882    THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th])\r
14883    THEN ONCE_REWRITE_TAC[TAUT `(A ==> ~B) <=> (B ==> ~A)`]\r
14884    THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th])\r
14885    THEN STRIP_TAC\r
14886    THENL[USE_THEN "F17" (MP_TAC o SPEC `next (L:(A)loop) (y:A)`)\r
14887        THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
14888        THEN REWRITE_TAC[NOT_IMP]\r
14889        THEN DISCH_TAC THEN USE_THEN "G5" (fun th-> REWRITE_TAC[th])\r
14890        THEN USE_THEN "G1" MP_TAC THEN USE_THEN "F10" MP_TAC THEN POP_ASSUM MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC\r
14891        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14892        THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP disjoint_loops th)])\r
14893        THEN USE_THEN "A3" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
14894    THEN STRIP_TAC\r
14895    THENL[USE_THEN "F17" (MP_TAC o SPEC `z:A`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
14896        THEN REWRITE_TAC[NOT_IMP]\r
14897        THEN DISCH_TAC\r
14898        THEN USE_THEN "G1" (fun th-> REWRITE_TAC[th])\r
14899        THEN USE_THEN "G5" MP_TAC THEN USE_THEN "A3" MP_TAC THEN POP_ASSUM MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC\r
14900        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
14901        THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP disjoint_loops th)])\r
14902        THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
14903    THEN GEN_TAC\r
14904    THEN USE_THEN "F10" (fun th-> DISCH_THEN (fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1))))\r
14905    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "T1") (LABEL_TAC "T2"))\r
14906    THEN ABBREV_TAC `nu = index (L:(A)loop) (z:A) u`\r
14907    THEN ASM_CASES_TAC `nu:num <= nz`\r
14908    THENL[DISJ1_TAC THEN USE_THEN "T2" SUBST1_TAC\r
14909        THEN POP_ASSUM (fun th-> USE_THEN "G3"(fun th1->REWRITE_TAC[SYM (MATCH_MP th1 th)]))\r
14910        THEN USE_THEN "G1" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC]\r
14911    THEN DISJ2_TAC\r
14912    THEN POP_ASSUM ((X_CHOOSE_THEN `q:num` (LABEL_TAC "T3")) o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
14913    THEN USE_THEN "T3" (fun th-> USE_THEN "T2" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM] o  REWRITE_RULE[th]))\r
14914    THEN USE_THEN "A2" (fun th-> REWRITE_TAC[lemma_add_exponent_function; SYM th])\r
14915    THEN USE_THEN "T1" MP_TAC THEN USE_THEN "T3" SUBST1_TAC\r
14916    THEN USE_THEN "F16" (SUBST1_TAC o SYM o REWRITE_RULE[CONJUNCT2 ADD; GSYM ADD_SUC] o ONCE_REWRITE_RULE[ADD_SYM])\r
14917    THEN REWRITE_TAC[LE_ADD_LCANCEL; LE_SUC]\r
14918    THEN DISCH_TAC THEN REWRITE_TAC[GSYM POWER_FUNCTION]\r
14919    THEN POP_ASSUM (fun th-> USE_THEN "G7"(fun th1->REWRITE_TAC[SYM (MATCH_MP th1 th)]))\r
14920    THEN USE_THEN "G5" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]));;\r
14921 \r
14922 \r
14923 let lemma_normal_genesis = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) \r
14924    ==> is_normal H (genesis H NF L x)`,\r
14925    REPEAT GEN_TAC\r
14926    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
14927    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
14928    THEN USE_THEN "F5" (fun th->(USE_THEN "F4" (LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
14929    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
14930    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
14931    THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
14932    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14933    THEN POP_ASSUM (LABEL_TAC "YEL")\r
14934    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14935    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
14936    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
14937    THEN POP_ASSUM (LABEL_TAC "MN")\r
14938    THEN USE_THEN "YEL" (fun th->  USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_on_heading))\r
14939    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12" o CONJUNCT1))\r
14940    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1)))))\r
14941    THEN USE_THEN "ZEL" (fun th-> REWRITE_TAC[th])\r
14942    THEN DISCH_THEN (LABEL_TAC "F15")\r
14943    THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> REWRITE_TAC[GSYM th; GSYM th1]))\r
14944    THEN USE_THEN "F9" (fun th-> USE_THEN "F10" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th)))))\r
14945    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A1") (LABEL_TAC "A2"))\r
14946    THEN USE_THEN "F9" (LABEL_TAC "A3" o MATCH_MP lemma_next_in_loop)\r
14947    THEN USE_THEN "F10" (LABEL_TAC "A4" o MATCH_MP lemma_back_in_loop)\r
14948    THEN USE_THEN "A4" (fun th-> USE_THEN "A3" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th)))))\r
14949    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A5") (LABEL_TAC "A6"))\r
14950    THEN ABBREV_TAC `nz = index (L:(A)loop) z y` THEN POP_ASSUM (LABEL_TAC "A7")\r
14951    THEN ABBREV_TAC `ny = index (L:(A)loop) (next L y) (back L z)` THEN POP_ASSUM (LABEL_TAC "A8")\r
14952    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnax (CONJ th th1)))))\r
14953    THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1->  REWRITE_TAC[tpx; th; th1]))\r
14954    THEN USE_THEN "MN" (fun th-> USE_THEN "A7" (fun th1-> REWRITE_TAC[th; th1]))\r
14955    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4"))))\r
14956    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnay (CONJ th th1)))))\r
14957    THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1->  REWRITE_TAC[tpy; th; th1]))\r
14958    THEN USE_THEN "F12" (fun th2->USE_THEN "F15" (fun th3-> REWRITE_TAC[GSYM th2; GSYM th3]))\r
14959    THEN USE_THEN "MN" (fun th-> USE_THEN "A8" (fun th1-> REWRITE_TAC[tpy; th; th1]))\r
14960    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G5") (CONJUNCTS_THEN2 (LABEL_TAC "G6") (CONJUNCTS_THEN2 (LABEL_TAC "G7") (LABEL_TAC "G8"))))\r
14961    THEN USE_THEN "F4" (fun th-> USE_THEN "F5"(fun th1-> USE_THEN "F9" (fun th2-> LABEL_TAC "F16" (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14962    THEN USE_THEN "F4" (fun th-> USE_THEN "F5"(fun th1-> USE_THEN "F10" (fun th2-> LABEL_TAC "F17" (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14963    THEN USE_THEN "F4" (fun th-> USE_THEN "F5"(fun th1-> USE_THEN "A3" (fun th2-> LABEL_TAC "F18" (MATCH_MP lemma_in_dart (CONJ th (CONJ th1 th2))))))\r
14964    THEN USE_THEN "G7" (fun th-> (MP_TAC(MATCH_MP th (SPEC `ny:num` LE_REFL))))\r
14965    THEN USE_THEN "A6" (SUBST1_TAC o SYM)\r
14966    THEN DISCH_TAC\r
14967    THEN USE_THEN "G5" (MP_TAC o SPEC `ny:num` o MATCH_MP lemma_power_next_in_loop)\r
14968    THEN POP_ASSUM (SUBST1_TAC)\r
14969    THEN DISCH_THEN (LABEL_TAC "F19")\r
14970    THEN USE_THEN "G3" (fun th-> (MP_TAC(MATCH_MP th (SPEC `nz:num` LE_REFL))))\r
14971    THEN USE_THEN "A2" (SUBST1_TAC o SYM)\r
14972    THEN DISCH_TAC\r
14973    THEN USE_THEN "G1" (MP_TAC o SPEC `nz:num` o MATCH_MP lemma_power_next_in_loop)\r
14974    THEN POP_ASSUM (SUBST1_TAC)\r
14975    THEN DISCH_THEN (LABEL_TAC "F20")\r
14976    THEN USE_THEN "ZEL"(fun th->USE_THEN "YEL"(fun th1->USE_THEN "MN"(fun th2->USE_THEN "F1" (MP_TAC o REWRITE_RULE[th; th1; th2] o MATCH_MP lemma_on_attach))))\r
14977    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F21") (LABEL_TAC "F22"))\r
14978    THEN SUBGOAL_THEN `!el:A nm:num. node (H:(A)hypermap) ((inverse (node_map H) POWER nm) el) = node H el` (LABEL_TAC "F22E")\r
14979    THENL[REPEAT GEN_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `el:A`; `nm:num`] lemma_power_inverse_in_node2)\r
14980        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity  th]); ALL_TAC]\r
14981    THEN REWRITE_TAC[is_normal]\r
14982    THEN STRIP_TAC\r
14983    THENL[GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple]\r
14984        THEN STRIP_TAC\r
14985        THENL[USE_THEN "F4" (MP_TAC o SPEC `L':(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal])\r
14986            THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `L':(A)loop IN NF`;\r
14987            POP_ASSUM SUBST1_TAC\r
14988            THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dnax]\r
14989            THEN SUBGOAL_THEN `is_inj_contour (H:(A)hypermap) (genex H NF L x)  (tpx H NF L x) /\ one_step_contour H (genex H NF L x (tpx H NF L x)) (genex H NF L x 0)` MP_TAC\r
14990            THENL[REWRITE_TAC[one_step_contour]\r
14991                THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MESON_TAC[MATCH_MP lemma_genex_loop (CONJ th th1)])); ALL_TAC]\r
14992            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_make_contour_loop th])\r
14993            THEN EXISTS_TAC `z:A`\r
14994            THEN USE_THEN "F17" (fun th-> USE_THEN "G1" (fun th1-> REWRITE_TAC[th; th1]));\r
14995            POP_ASSUM SUBST1_TAC\r
14996            THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dnay]\r
14997            THEN SUBGOAL_THEN `is_inj_contour (H:(A)hypermap) (geney H NF L x)  (tpy H NF L x) /\ one_step_contour H (geney H NF L x (tpy H NF L x)) (geney H NF L x 0)` MP_TAC\r
14998            THENL[REWRITE_TAC[one_step_contour]\r
14999                THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MESON_TAC[MATCH_MP lemma_geney_loop (CONJ th th1)])); ALL_TAC]\r
15000            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_make_contour_loop th])\r
15001            THEN EXISTS_TAC `next (L:(A)loop) y`\r
15002            THEN USE_THEN "F18" (fun th-> USE_THEN "G5" (fun th1-> REWRITE_TAC[th; th1]))]; ALL_TAC]\r
15003    THEN STRIP_TAC\r
15004    THENL[GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple]\r
15005        THEN STRIP_TAC\r
15006        THENL[USE_THEN "F4" (MP_TAC o SPEC `L':(A)loop` o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_normal])\r
15007            THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `L':(A)loop IN NF`; \r
15008            POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `y:A` THEN EXISTS_TAC `z:A`\r
15009            THEN USE_THEN "G1" (fun th-> USE_THEN "F20" (fun th1-> USE_THEN "F21" (fun th2-> REWRITE_TAC[th; th1; th2])));\r
15010            POP_ASSUM SUBST1_TAC\r
15011            THEN EXISTS_TAC `next (L:(A)loop) y` THEN EXISTS_TAC `back (L:(A)loop) z`\r
15012            THEN USE_THEN "F19" (fun th-> USE_THEN "G5" (fun th1-> REWRITE_TAC[th; th1]))\r
15013            THEN USE_THEN "F12" (fun th-> MP_TAC (REWRITE_RULE[POWER_1; SYM th] (SPECL[`H:(A)hypermap`; `y:A`; `1`] lemma_power_inverse_in_node2)))\r
15014            THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)])\r
15015            THEN USE_THEN "F15" (fun th-> MP_TAC (REWRITE_RULE[POWER_1; SYM th] (SPECL[`H:(A)hypermap`; `z:A`; `1`] lemma_in_node2)))\r
15016            THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)])\r
15017            THEN USE_THEN "F21" (fun th-> REWRITE_TAC[th])]; ALL_TAC]\r
15018    THEN SUBGOAL_THEN `!M:(A)loop t:A. M IN (NF:(A)loop->bool) /\ ~(M = L) /\ t belong M ==> ~(t belong dnax H NF L x)` (LABEL_TAC "F24")\r
15019    THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "H2")))\r
15020        THEN REWRITE_TAC[CONTRAPOS_THM]\r
15021        THEN USE_THEN "G2" (fun th1-> USE_THEN "G1" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[th1] o  MATCH_MP lemma_loop_index o CONJ th)))\r
15022        THEN ABBREV_TAC `g = index (dnax (H:(A)hypermap) NF L x) (z:A) t` THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4"))\r
15023        THEN ASM_CASES_TAC `g:num <= nz`\r
15024        THENL[POP_ASSUM (fun th-> USE_THEN "G3" (fun th1 -> MP_TAC (MATCH_MP th1 th)))\r
15025            THEN USE_THEN "H4" (SUBST1_TAC o SYM)\r
15026            THEN DISCH_THEN (fun th-> USE_THEN "F10" (MP_TAC o REWRITE_RULE[SYM th] o SPEC `g:num` o MATCH_MP lemma_power_next_in_loop))\r
15027            THEN USE_THEN "H2" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "H1" MP_TAC THEN USE_THEN "F4" MP_TAC \r
15028            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15029            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP disjoint_loops th]); ALL_TAC]\r
15030        THEN USE_THEN "H3" MP_TAC\r
15031        THEN POP_ASSUM ((X_CHOOSE_THEN `a:num` (LABEL_TAC "H5") o REWRITE_RULE[NOT_LE; LT_EXISTS]))\r
15032        THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th; LE_ADD_LCANCEL])\r
15033        THEN DISCH_THEN (LABEL_TAC "H6")\r
15034        THEN USE_THEN "G4" (fun th -> USE_THEN "H6" (MP_TAC o MATCH_MP th))\r
15035        THEN USE_THEN "H5" (fun th-> USE_THEN "H4" (fun th1 -> REWRITE_TAC[GSYM th; SYM th1]))\r
15036        THEN DISCH_THEN (LABEL_TAC "H7")\r
15037        THEN USE_THEN "H6" MP_TAC THEN MP_TAC (SPEC `a:num` GE_1) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15038        THEN EXPAND_TAC "m"\r
15039        THEN DISCH_THEN (MP_TAC o SPEC `t:A` o MATCH_MP lemma_node_outside_support_darts)\r
15040        THEN USE_THEN "YEL" (fun th-> USE_THEN "H7" (fun th1-> REWRITE_TAC[th; th1; node_refl]))\r
15041        THEN USE_THEN "H7" (SUBST1_TAC o SYM)\r
15042        THEN USE_THEN "H2" (fun th-> USE_THEN "H1" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC]\r
15043    THEN SUBGOAL_THEN `!M:(A)loop t:A. M IN (NF:(A)loop->bool) /\ ~(M = L) /\ t belong M ==> ~(t belong dnay H NF L x)` (LABEL_TAC "F25")\r
15044    THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "H2")))\r
15045        THEN REWRITE_TAC[CONTRAPOS_THM]\r
15046        THEN USE_THEN "G6" (fun th1-> USE_THEN "G5" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[th1] o  MATCH_MP lemma_loop_index o CONJ th)))\r
15047        THEN ABBREV_TAC `g = index (dnay (H:(A)hypermap) NF L x) (next L y) t`\r
15048        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4"))\r
15049        THEN ASM_CASES_TAC `g:num <= ny`\r
15050        THENL[POP_ASSUM (fun th-> USE_THEN "G7" (fun th1 -> MP_TAC (MATCH_MP th1 th)))\r
15051            THEN USE_THEN "H4" (SUBST1_TAC o SYM) THEN DISCH_TAC\r
15052            THEN POP_ASSUM (fun th-> USE_THEN "A3" (MP_TAC o REWRITE_RULE[SYM th] o SPEC `g:num` o MATCH_MP lemma_power_next_in_loop))\r
15053            THEN USE_THEN "H2" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "H1" MP_TAC THEN USE_THEN "F4" MP_TAC \r
15054            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15055            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP disjoint_loops th]); ALL_TAC]\r
15056        THEN USE_THEN "H3" MP_TAC\r
15057        THEN POP_ASSUM ((X_CHOOSE_THEN `a:num` (LABEL_TAC "H5") o REWRITE_RULE[NOT_LE; LT_EXISTS]))\r
15058        THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th; LE_ADD_LCANCEL])\r
15059        THEN DISCH_THEN (LABEL_TAC "H6")\r
15060        THEN USE_THEN "G8" (fun th -> USE_THEN "H6" (MP_TAC o MATCH_MP th))\r
15061        THEN USE_THEN "H5" (fun th-> USE_THEN "H4" (fun th1 -> REWRITE_TAC[GSYM th; SYM th1]))\r
15062        THEN DISCH_THEN (LABEL_TAC "H7")\r
15063        THEN USE_THEN "H6" MP_TAC THEN MP_TAC (SPEC `a:num` GE_1) THEN USE_THEN "F17" MP_TAC\r
15064        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
15065        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15066        THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index)\r
15067        THEN DISCH_THEN (X_CHOOSE_THEN `u:num`(X_CHOOSE_THEN `v:num` (CONJUNCTS_THEN2 (LABEL_TAC "H8") (CONJUNCTS_THEN2 (LABEL_TAC "H9") (CONJUNCTS_THEN2 (LABEL_TAC "H10") (LABEL_TAC "H11"))))))\r
15068        THEN USE_THEN "F17" MP_TAC\r
15069        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
15070        THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted])\r
15071        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15072        THEN DISCH_THEN (MP_TAC o SPECL[`u:num`; `v:num`] o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_complement_path)\r
15073        THEN USE_THEN "H9" (fun th-> USE_THEN "H10" (fun th1-> USE_THEN "H11" (fun th2-> REWRITE_TAC[th; th1; SYM th2])))\r
15074        THEN USE_THEN "H7" (SUBST1_TAC o SYM)\r
15075        THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
15076        THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
15077        THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th])\r
15078        THEN USE_THEN "H8" (fun th-> MP_TAC (SPEC `y:A` (MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) (MATCH_MP LT_IMP_LE (ONCE_REWRITE_RULE[GSYM LT_SUC] th))))))\r
15079        THEN REWRITE_TAC[SUB_SUC] THEN DISCH_THEN SUBST1_TAC\r
15080        THEN USE_THEN "H8" ((X_CHOOSE_THEN `p:num` (LABEL_TAC "H12") o REWRITE_RULE[LT_EXISTS]))\r
15081        THEN USE_THEN "H12" (fun th-> REWRITE_TAC[th; ADD_SUB2])\r
15082        THEN DISCH_TAC\r
15083        THEN MP_TAC (SPECL[`H:(A)hypermap`; `(face_map (H:(A)hypermap) POWER (SUC p)) y`;`v:num`]  lemma_power_inverse_in_node2)\r
15084        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
15085        THEN DISCH_TAC THEN MP_TAC (SPECL[`u:num`; `SUC p`] LE_ADDR)\r
15086        THEN USE_THEN "H12" (SUBST1_TAC o SYM) THEN EXPAND_TAC "m"\r
15087        THEN MP_TAC (SPEC `p:num` GE_1) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15088        THEN DISCH_THEN (MP_TAC o SPEC `t:A` o MATCH_MP lemma_node_outside_support_darts)\r
15089        THEN USE_THEN "YEL" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[th; th1]))\r
15090        THEN USE_THEN "H2" (fun th-> USE_THEN "H1" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC]\r
15091    THEN STRIP_TAC\r
15092    THENL[REPEAT GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple]\r
15093        THEN ASM_CASES_TAC `(L':(A)loop IN NF) /\ ~(L' = L)`\r
15094        THENL[POP_ASSUM (LABEL_TAC "H1")\r
15095            THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th])\r
15096            THEN ASM_CASES_TAC `(L'':(A)loop IN NF) /\ ~(L'' = L)`\r
15097            THENL[POP_ASSUM (LABEL_TAC "H2")\r
15098                THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th])\r
15099                THEN POP_ASSUM (MP_TAC o CONJUNCT1)\r
15100                THEN POP_ASSUM (MP_TAC o CONJUNCT1)\r
15101                THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15102                THEN REWRITE_TAC[disjoint_loops]; ALL_TAC]\r
15103            THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15104            THEN POP_ASSUM (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4"))\r
15105            THEN ASM_CASES_TAC `L'':(A)loop = dnax (H:(A)hypermap) NF L x`\r
15106            THENL[POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15107                THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)\r
15108                THEN USE_THEN "H4" MP_TAC THEN USE_THEN "H3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15109                THEN USE_THEN "F24" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th))\r
15110                THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15111            THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15112            THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15113            THEN POP_ASSUM SUBST1_TAC\r
15114            THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)\r
15115            THEN USE_THEN "H4" MP_TAC THEN USE_THEN "H3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15116            THEN USE_THEN "F25" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th))\r
15117            THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15118        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15119        THEN ASM_CASES_TAC `(L'':(A)loop IN NF) /\ ~(L'' = L)`\r
15120        THENL[POP_ASSUM (LABEL_TAC "H1")\r
15121            THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th])\r
15122            THEN ASM_CASES_TAC `L':(A)loop = dnax (H:(A)hypermap) NF L x`\r
15123            THENL[POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15124                THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15125                THEN USE_THEN "H1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15126                THEN USE_THEN "F24" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th))\r
15127                THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15128            THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15129            THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15130            THEN POP_ASSUM SUBST1_TAC\r
15131            THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15132            THEN USE_THEN "H1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15133            THEN USE_THEN "F25" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th))\r
15134            THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15135        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15136        THEN ASM_CASES_TAC `L':(A)loop = dnax (H:(A)hypermap) (NF:(A)loop->bool) L x`\r
15137        THENL[POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15138            THEN ASM_CASES_TAC `L'':(A)loop = dnax (H:(A)hypermap) NF L x`\r
15139            THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15140            THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
15141            THEN REWRITE_TAC[]\r
15142            THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15143            THEN POP_ASSUM SUBST1_TAC\r
15144            THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
15145            THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o SPEC `x':A` o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_disjoint_new_loops o CONJ th))\r
15146            THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[th; th1])); ALL_TAC]\r
15147        THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15148        THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15149        THEN POP_ASSUM (SUBST1_TAC)\r
15150        THEN ASM_CASES_TAC `L'':(A)loop = dnay (H:(A)hypermap) (NF:(A)loop->bool) L x`\r
15151        THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15152        THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
15153        THEN REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15154        THEN POP_ASSUM SUBST1_TAC\r
15155        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
15156        THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o SPEC `x':A` o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_disjoint_new_loops o CONJ th))\r
15157        THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[th; th1])); ALL_TAC]\r
15158    THEN REPEAT GEN_TAC\r
15159    THEN REWRITE_TAC[genesis; IN_ELIM_THM; IN_DELETE; IN_UNION; lemma_in_couple]\r
15160    THEN ASM_CASES_TAC `(L':(A)loop IN (NF:(A)loop->bool)) /\ ~(L' = L)`\r
15161    THENL[POP_ASSUM (fun th -> REWRITE_TAC[th] THEN LABEL_TAC "H1" (CONJUNCT1 th))\r
15162        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3"))\r
15163        THEN USE_THEN "F4" (MP_TAC o SPECL[`L':(A)loop`; `x':A`; `y':A`] o  CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_normal])\r
15164        THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> USE_THEN "H3" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
15165        THEN DISCH_THEN (X_CHOOSE_THEN `M:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5")))\r
15166        THEN ASM_CASES_TAC `~(M = L:(A)loop)`\r
15167        THENL[EXISTS_TAC `M:(A)loop`\r
15168            THEN POP_ASSUM (fun th-> POP_ASSUM (fun th2 -> POP_ASSUM (fun th1-> REWRITE_TAC[CONJ th1 th; th2]))); ALL_TAC]\r
15169        THEN USE_THEN "H5" MP_TAC\r
15170        THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[])\r
15171        THEN DISCH_THEN (fun th1-> USE_THEN "FC"(fun th-> USE_THEN "F6"(MP_TAC o REWRITE_RULE[th1] o SPEC `y':A` o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_disjoint_new_loops o CONJ th)))\r
15172        THEN STRIP_TAC\r
15173        THENL[EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
15174        THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x`\r
15175        THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
15176    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15177    THEN ASM_CASES_TAC `L' = dnax (H:(A)hypermap) NF L x`\r
15178    THENL[POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15179        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
15180        THEN USE_THEN "H1" MP_TAC\r
15181        THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_dnax (CONJ th th1)]))\r
15182        THEN USE_THEN "YEL"(fun th->USE_THEN "ZEL"(fun th1->USE_THEN "MN"(fun th2->USE_THEN "A7" (fun th3-> REWRITE_TAC[th; th1; th2; th3]))))\r
15183        THEN STRIP_TAC\r
15184        THENL[POP_ASSUM (fun th-> USE_THEN "F10" (MP_TAC o REWRITE_RULE[GSYM th] o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop))\r
15185            THEN DISCH_THEN (LABEL_TAC "H3")\r
15186            THEN USE_THEN "F4" (MP_TAC o SPECL[`L:(A)loop`; `x':A`; `y':A`] o  CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_normal])\r
15187            THEN USE_THEN "F5" (fun th-> USE_THEN "H2" (fun th1-> USE_THEN "H3" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
15188            THEN DISCH_THEN (X_CHOOSE_THEN `M:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5")))\r
15189            THEN ASM_CASES_TAC `~(M = L:(A)loop)`\r
15190            THENL[EXISTS_TAC `M:(A)loop`\r
15191                THEN POP_ASSUM (fun th-> POP_ASSUM (fun th2 -> POP_ASSUM (fun th1-> REWRITE_TAC[CONJ th1 th; th2]))); ALL_TAC]\r
15192            THEN USE_THEN "H5" MP_TAC\r
15193            THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[])\r
15194            THEN DISCH_THEN (fun th1-> USE_THEN "FC"(fun th-> USE_THEN "F6"(MP_TAC o REWRITE_RULE[th1] o SPEC `y':A` o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_disjoint_new_loops o CONJ th)))\r
15195            THEN STRIP_TAC\r
15196            THENL[EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
15197            THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x`\r
15198            THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
15199        THEN USE_THEN "H2" MP_TAC\r
15200        THEN POP_ASSUM (fun th -> LABEL_TAC "H3" th THEN SUBST1_TAC th)\r
15201        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_via_inverse_node_map)\r
15202        THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5")))\r
15203        THEN ASM_CASES_TAC `j:num = 0`\r
15204        THENL[USE_THEN "H5" MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th; POWER_0; I_THM])\r
15205            THEN USE_THEN "H3" (SUBST1_TAC o SYM) THEN DISCH_THEN SUBST1_TAC\r
15206            THEN EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15207        THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ])\r
15208        THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x` THEN REWRITE_TAC[]\r
15209        THEN REMOVE_THEN "H5" MP_TAC  THEN REMOVE_THEN "H4" MP_TAC THEN POP_ASSUM MP_TAC\r
15210        THEN UNDISCH_TAC `i:num <= m` THEN UNDISCH_TAC `1 <= i:num`\r
15211        THEN USE_THEN "F6" MP_TAC THEN USE_THEN "FC" MP_TAC THEN EXPAND_TAC "m" THEN EXPAND_TAC "y" THEN  REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15212        THEN REWRITE_TAC[lemma_in_dnay2]; ALL_TAC]\r
15213    THEN POP_ASSUM (fun th-> REWRITE_TAC[th])\r
15214    THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)\r
15215    THEN POP_ASSUM SUBST1_TAC\r
15216    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
15217    THEN USE_THEN "H1" MP_TAC\r
15218    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_dnay (CONJ th th1)]))\r
15219    THEN USE_THEN "YEL"(fun th->USE_THEN "ZEL"(fun th1->USE_THEN "MN"(fun th2->USE_THEN "A7" (fun th3-> REWRITE_TAC[th; th1; th2; th3]))))\r
15220    THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> USE_THEN "A8" (fun th2-> REWRITE_TAC[SYM th; SYM th1; th2])))\r
15221    THEN STRIP_TAC\r
15222    THENL[POP_ASSUM (fun th-> USE_THEN "A3" (MP_TAC o REWRITE_RULE[GSYM th] o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop))\r
15223        THEN DISCH_THEN (LABEL_TAC "H3")\r
15224        THEN USE_THEN "F4" (MP_TAC o SPECL[`L:(A)loop`; `x':A`; `y':A`] o  CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_normal])\r
15225        THEN USE_THEN "F5" (fun th-> USE_THEN "H2" (fun th1-> USE_THEN "H3" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
15226        THEN DISCH_THEN (X_CHOOSE_THEN `M:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5")))\r
15227        THEN ASM_CASES_TAC `~(M = L:(A)loop)`\r
15228        THENL[EXISTS_TAC `M:(A)loop`\r
15229            THEN POP_ASSUM (fun th-> POP_ASSUM (fun th2 -> POP_ASSUM (fun th1-> REWRITE_TAC[CONJ th1 th; th2]))); ALL_TAC]\r
15230        THEN USE_THEN "H5" MP_TAC THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[])\r
15231        THEN DISCH_THEN (fun th1-> USE_THEN "FC"(fun th-> USE_THEN "F6"(MP_TAC o REWRITE_RULE[th1] o SPEC `y':A` o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_disjoint_new_loops o CONJ th)))\r
15232        THEN STRIP_TAC\r
15233        THENL[EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
15234        THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC]\r
15235    THEN USE_THEN "H2" MP_TAC\r
15236    THEN POP_ASSUM (fun th -> LABEL_TAC "H3" th THEN SUBST1_TAC th)\r
15237    THEN USE_THEN "F22E" (fun th-> REWRITE_TAC[th])\r
15238    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_via_inverse_node_map)\r
15239    THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5")))\r
15240    THEN ASM_CASES_TAC `u:num = 0`\r
15241    THENL[USE_THEN "H5" MP_TAC\r
15242        THEN POP_ASSUM (fun th-> REWRITE_TAC[th; POWER_0; I_THM]) THEN DISCH_TAC\r
15243        THEN EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REWRITE_TAC[]\r
15244        THEN POP_ASSUM MP_TAC THEN UNDISCH_TAC `i:num <= m` THEN UNDISCH_TAC `1 <= i:num`\r
15245        THEN USE_THEN "F6" MP_TAC THEN USE_THEN "FC" MP_TAC THEN EXPAND_TAC "m" THEN EXPAND_TAC "y" \r
15246        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; lemma_in_dnax2]; ALL_TAC]\r
15247    THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x`\r
15248    THEN REWRITE_TAC[]\r
15249    THEN USE_THEN "H5" MP_TAC THEN USE_THEN "H4" MP_TAC THEN (POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]))\r
15250    THEN UNDISCH_TAC `i:num <= m` THEN UNDISCH_TAC `1 <= i` THEN USE_THEN "F6" MP_TAC THEN USE_THEN "FC" MP_TAC\r
15251    THEN EXPAND_TAC "m" THEN EXPAND_TAC "y" THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; lemma_in_dnay2]);;\r
15252 \r
15253 \r
15254 (* Atoms of dnax *)\r
15255 \r
15256 let lemma_separation_on_loop = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A y:A z:A. is_restricted H /\ is_normal H NF /\ L IN NF /\ z belong L /\ x belong L /\ y belong L /\ head H NF x = x /\ index L z (head H NF z) < index L z y /\ index L z y <= index L z x ==> index L z (head H NF z) < index L z (tail H NF y) /\ index L z (tail H NF y) <= index L z y /\ index L z y <=  index L z (head H NF y) /\ index L z (head H NF y) <= index L z x`,\r
15257    REPEAT GEN_TAC\r
15258    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9")))))))))\r
15259    THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2-> MP_TAC (MATCH_MP head_on_loop (CONJ th (CONJ th1 th2))))))\r
15260    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F10") (LABEL_TAC "F11"))\r
15261    THEN USE_THEN "F4"(fun th->USE_THEN "F10"(fun th1-> LABEL_TAC "F12"(MATCH_MP lemma_in_loop (CONJ th th1))))\r
15262    THEN USE_THEN "F4"(fun th-> USE_THEN "F5" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1))))\r
15263    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "XB") (LABEL_TAC "F14"))\r
15264    THEN USE_THEN "F4"(fun th-> USE_THEN "F6" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1))))\r
15265    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "YB") (LABEL_TAC "F15"))\r
15266    THEN USE_THEN "F4"(fun th-> USE_THEN "F12" (fun th1-> LABEL_TAC "F16" (CONJUNCT2(MATCH_MP lemma_loop_index (CONJ th th1)))))\r
15267    THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F6" (fun th2-> MP_TAC (MATCH_MP margin_in_loop (CONJ th (CONJ th1 th2))))))\r
15268    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F17") (LABEL_TAC "F18"))\r
15269    THEN ABBREV_TAC `nz = index (L:(A)loop) z (head (H:(A)hypermap) NF z)`\r
15270    THEN POP_ASSUM (LABEL_TAC "NZ")\r
15271    THEN ABBREV_TAC `n1 = index (L:(A)loop) z (tail (H:(A)hypermap) NF y)`\r
15272    THEN POP_ASSUM (LABEL_TAC "N1")\r
15273    THEN ABBREV_TAC `ny = index (L:(A)loop) z y`\r
15274    THEN POP_ASSUM (LABEL_TAC "NY")\r
15275    THEN ABBREV_TAC `n2 = index (L:(A)loop) z (head (H:(A)hypermap) NF y)`\r
15276    THEN POP_ASSUM (LABEL_TAC "N2") \r
15277    THEN ABBREV_TAC `nx = index (L:(A)loop) z x`\r
15278    THEN POP_ASSUM (LABEL_TAC "NX")\r
15279    THEN SUBGOAL_THEN `(?n:num. nz < n /\ n <= ny:num /\ (next L POWER n) z = face_map (H:(A)hypermap) (back L ((next L POWER n) z))) /\ (?M:num. !n:num. nz < n /\ n <= ny:num  /\ (next L POWER n) z = face_map H (back L ((next L POWER n) z)) ==> n <= M)` MP_TAC\r
15280    THENL[STRIP_TAC\r
15281        THENL[EXISTS_TAC `SUC nz`\r
15282           THEN USE_THEN "F8" (fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LE_SUC_LT] th; LT_PLUS])\r
15283           THEN USE_THEN "F16" (fun th-> REWRITE_TAC[GSYM COM_POWER_FUNCTION; GSYM th; lemma_inverse_evaluation])\r
15284           THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F4"(fun th2-> REWRITE_TAC[MATCH_MP value_next_of_head (CONJ th (CONJ th1 th2))]))); ALL_TAC]\r
15285        THEN EXISTS_TAC `ny:num`\r
15286        THEN GEN_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[CONJUNCT1 (CONJUNCT2 th)]); ALL_TAC]\r
15287    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [num_MAX]\r
15288    THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3"))) (LABEL_TAC "H4")))\r
15289    THEN SUBGOAL_THEN `m:num = n1:num` (LABEL_TAC "H5")\r
15290    THENL[REMOVE_THEN "H2" ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H2") o REWRITE_RULE[LE_EXISTS]))\r
15291        THEN USE_THEN "F4" (LABEL_TAC "H6" o SPEC `m:num` o MATCH_MP lemma_power_next_in_loop)\r
15292        THEN ABBREV_TAC `u = (next (L:(A)loop) POWER m) z` THEN POP_ASSUM (LABEL_TAC "UL")\r
15293        THEN SUBGOAL_THEN `!i:num. i <= d:num ==> (next (L:(A)loop) POWER i) u = (inverse (node_map (H:(A)hypermap)) POWER i) u` MP_TAC\r
15294        THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC]\r
15295            THEN DISCH_THEN (LABEL_TAC "H7")\r
15296            THEN REWRITE_TAC [GSYM COM_POWER_FUNCTION]\r
15297            THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))\r
15298            THEN USE_THEN "H7"(fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)])\r
15299            THEN DISCH_THEN (SUBST1_TAC o SYM)\r
15300            THEN USE_THEN "H6" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop)\r
15301            THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15302            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_next_exclusive2 th])\r
15303            THEN STRIP_TAC\r
15304            THEN USE_THEN "H4" (MP_TAC o SPEC `(SUC i) + (m:num)`)\r
15305            THEN USE_THEN "H1" (fun th-> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ th (SPECL[`SUC i`; `m:num`] LE_ADDR))])\r
15306            THEN USE_THEN "H2" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM])\r
15307            THEN USE_THEN "H7"(fun th-> REWRITE_TAC[LE_ADD_RCANCEL; th])\r
15308            THEN USE_THEN "UL" (fun th-> REWRITE_TAC[lemma_add_exponent_function; th])\r
15309            THEN POP_ASSUM (fun th-> REWRITE_TAC[GSYM COM_POWER_FUNCTION; lemma_inverse_evaluation; SYM th])\r
15310            THEN REWRITE_TAC[NOT_LE; LT_ADDR; GSYM LT1_NZ; GE_1]; ALL_TAC]\r
15311        THEN USE_THEN "F3"(fun th-> USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]))\r
15312        THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom)\r
15313        THEN USE_THEN "UL" (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
15314        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15315        THEN USE_THEN "H2" (fun th-> USE_THEN "F15" (fun th1-> REWRITE_TAC[GSYM (ONCE_REWRITE_RULE[ADD_SYM] th); GSYM th1]))\r
15316        THEN DISCH_TAC\r
15317        THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `u:A`] atom_reflect)\r
15318        THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_identity_atom th])\r
15319        THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15320        THEN USE_THEN "H3" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[SYM th] o MATCH_MP lemma_tail))\r
15321        THEN DISCH_TAC THEN USE_THEN "UL" (MP_TAC o SYM)\r
15322        THEN USE_THEN "H2" (MP_TAC o MATCH_MP compare_left o SYM)\r
15323        THEN DISCH_THEN (fun th-> USE_THEN "YB" (fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1))))\r
15324        THEN USE_THEN "F4" MP_TAC\r
15325        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15326        THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP determine_loop_index)\r
15327        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
15328        THEN USE_THEN "N1"(fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15329    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
15330    THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[th; th1]))\r
15331    THEN SUBGOAL_THEN `(?n:num. ny:num <= n /\ n <= nx:num /\ next (L:(A)loop) ((next L POWER n) z) = face_map (H:(A)hypermap) ((next L POWER n) z))` MP_TAC\r
15332    THENL[EXISTS_TAC `nx:num`\r
15333        THEN USE_THEN "F9"(fun th-> USE_THEN "F14"(fun th1-> REWRITE_TAC[th; GSYM th1; LE_REFL]))\r
15334        THEN USE_THEN "F7" (fun th-> ONCE_REWRITE_TAC[SYM th])\r
15335        THEN USE_THEN "F2"(fun th->USE_THEN "F3"(fun th1->USE_THEN "F5"(fun th2-> REWRITE_TAC[MATCH_MP value_next_of_head (CONJ th (CONJ th1 th2))]))); ALL_TAC]\r
15336    THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [num_WOP]\r
15337    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "G2") (LABEL_TAC "G3"))) (LABEL_TAC "G4")))\r
15338    THEN SUBGOAL_THEN `n:num = n2:num` (LABEL_TAC "FG")\r
15339    THENL[REMOVE_THEN "G1" ((X_CHOOSE_THEN `d:num` (LABEL_TAC "G1") o REWRITE_RULE[LE_EXISTS]))\r
15340        THEN ABBREV_TAC `v = (next (L:(A)loop) POWER n) z` THEN POP_ASSUM (LABEL_TAC "VL")\r
15341        THEN SUBGOAL_THEN `!i:num. i <= d:num ==> (next (L:(A)loop) POWER i) y = (inverse (node_map (H:(A)hypermap)) POWER i) y` MP_TAC\r
15342        THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC]\r
15343            THEN DISCH_THEN (LABEL_TAC "G6")\r
15344            THEN REWRITE_TAC [GSYM COM_POWER_FUNCTION]\r
15345            THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))\r
15346            THEN USE_THEN "G6"(fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)])\r
15347            THEN DISCH_THEN (SUBST1_TAC o SYM)\r
15348            THEN USE_THEN "F6" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop)\r
15349            THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15350            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_next_exclusive2 th])\r
15351            THEN STRIP_TAC\r
15352            THEN USE_THEN "G4" (MP_TAC o SPEC `(i:num) + (ny:num)`)\r
15353            THEN USE_THEN "G1" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM])\r
15354            THEN USE_THEN "G6"(fun th-> REWRITE_TAC[LT_ADD_RCANCEL; REWRITE_RULE[LE_SUC_LT] th; LE_ADDR])\r
15355            THEN USE_THEN "G6" (MP_TAC o MATCH_MP LE_TRANS o CONJ (SPEC `i:num` LE_PLUS))\r
15356            THEN DISCH_THEN (fun th-> (MP_TAC (ONCE_REWRITE_RULE[GSYM (SPECL[`i:num`; `d:num`; `ny:num`] LE_ADD_RCANCEL)] th)))\r
15357            THEN USE_THEN "G1" (fun th-> REWRITE_TAC[GSYM (ONCE_REWRITE_RULE[ADD_SYM] th)])\r
15358            THEN DISCH_THEN (fun th -> USE_THEN "G2" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)]))\r
15359            THEN USE_THEN "F15" (fun th-> REWRITE_TAC[lemma_add_exponent_function; SYM th])\r
15360            THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15361        THEN USE_THEN "F3"(fun th-> USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]))\r
15362        THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom)\r
15363        THEN USE_THEN "F15" (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th])\r
15364        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15365        THEN USE_THEN "G1" (fun th-> USE_THEN "VL" (fun th1-> REWRITE_TAC[GSYM (ONCE_REWRITE_RULE[ADD_SYM] th); th1]))\r
15366        THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15367        THEN USE_THEN "G3" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[SYM th] o MATCH_MP lemma_head))\r
15368        THEN DISCH_TAC THEN USE_THEN "VL" (MP_TAC o SYM)\r
15369        THEN USE_THEN "G2" (fun th-> USE_THEN "XB" (MP_TAC o MATCH_MP LE_TRANS o CONJ th))\r
15370        THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15371        THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP determine_loop_index)\r
15372        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
15373        THEN USE_THEN "N2"(fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15374    THEN POP_ASSUM (SUBST1_TAC o SYM)\r
15375    THEN USE_THEN "G1" (fun th-> USE_THEN "G2" (fun th1-> REWRITE_TAC[th; th1])));;\r
15376 \r
15377 let atom_eq = prove(`!H:(A)hypermap N1:(A)loop->bool N2:(A)loop->bool L1:(A)loop L2:(A)loop x:A y:A m:num n:num. is_restricted H /\ is_normal H N1 /\ is_normal H N2 /\ L1 IN N1 /\ L2 IN N2 /\ x belong L1 /\ x belong L2 /\ y belong L1 /\ n <= top L1 /\ n <= top L2 /\ m < index L1 x (tail H N1 y) /\ index L1 x (tail H N1 y) <= index L1 x (head H N1 y) /\ index L1 x (head H N1 y) < n /\ (!i:num. m <= i /\ i <= n ==> (next L2 POWER i) x = (next L1 POWER i) x) ==> tail H N2 y = tail H N1 y /\ head H N2 y = head H N1 y /\ atom H L2 y = atom H L1 y`,\r
15378    REPEAT GEN_TAC\r
15379    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2(LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (CONJUNCTS_THEN2 (LABEL_TAC "F8") (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 (LABEL_TAC "F10") (CONJUNCTS_THEN2 (LABEL_TAC "F11") (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (LABEL_TAC "F15"))))))))))))))\r
15380    THEN USE_THEN "F2"(fun th->USE_THEN "F4"(fun th1->USE_THEN "F8"(fun th2->MP_TAC(MATCH_MP margin_in_loop (CONJ th (CONJ th1 th2))))))\r
15381    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F16") (LABEL_TAC "F17"))\r
15382    THEN USE_THEN "F6"(fun th-> USE_THEN "F16" (fun th1->MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1))))\r
15383    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19"))\r
15384    THEN USE_THEN "F6"(fun th-> USE_THEN "F17" (fun th1->MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1))))\r
15385    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F20") (LABEL_TAC "F21"))\r
15386    THEN USE_THEN "F2"(fun th-> USE_THEN "F4"(fun th1->USE_THEN "F8"(fun th2-> MP_TAC(MATCH_MP atomic_particles (CONJ th (CONJ th1 th2))))))\r
15387    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F22") (LABEL_TAC "F23" o CONJUNCT1))\r
15388    THEN USE_THEN "F2"(fun th-> USE_THEN "F4"(fun th1->USE_THEN "F8"(fun th2-> LABEL_TAC "F24"(MATCH_MP value_next_of_head (CONJ th (CONJ th1 th2))))))\r
15389    THEN USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1->USE_THEN "F4"(fun th2->USE_THEN "F17"(fun th3-> MP_TAC(MATCH_MP lemma_tail_via_restricted (CONJ4 th th1 th2 th3))))))\r
15390    THEN USE_THEN "F2"(fun th->USE_THEN "F4"(fun th1->USE_THEN "F8"(fun th2->MP_TAC(CONJUNCT1(MATCH_MP tail_on_loop (CONJ3 th th1 th2))))))\r
15391    THEN USE_THEN "F2"(fun th->USE_THEN "F4"(fun th1->USE_THEN "F8"(fun th2->DISCH_THEN(fun th3-> REWRITE_TAC[CONJUNCT2(MATCH_MP change_parameters (CONJ4 th th1 th2 th3))]))))\r
15392    THEN DISCH_THEN (LABEL_TAC "F25")\r
15393    THEN USE_THEN "F2"(fun th->USE_THEN "F4"(fun th1->USE_THEN "F8"(fun th2->MP_TAC(CONJUNCT1(MATCH_MP tail_on_loop (CONJ3 th th1 th2))))))\r
15394    THEN LABEL_TAC "F26" (SPECL[`H:(A)hypermap`; `L1:(A)loop`; `y:A`] atom_reflect)\r
15395    THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP lemma_identity_atom)\r
15396    THEN ABBREV_TAC `u = tail (H:(A)hypermap) N1 y`\r
15397    THEN ABBREV_TAC `v = head (H:(A)hypermap) N1 y`\r
15398    THEN ABBREV_TAC `a = index (L1:(A)loop) x u`\r
15399    THEN ABBREV_TAC `b = index (L1:(A)loop) x v`\r
15400    THEN USE_THEN "F12" (MP_TAC o REWRITE_RULE[LE_EXISTS])\r
15401    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "F27"))\r
15402    THEN USE_THEN "F27" (fun th-> USE_THEN "F19" (MP_TAC o REWRITE_RULE[ONCE_REWRITE_RULE[ADD_SYM] th; lemma_add_exponent_function]))\r
15403    THEN USE_THEN "F21" (SUBST1_TAC o SYM)\r
15404    THEN DISCH_THEN (fun th-> LABEL_TAC "F28" th THEN MP_TAC th)\r
15405    THEN USE_THEN "F18"(fun th-> USE_THEN "F27"(fun th1-> MP_TAC(MATCH_MP LE_TRANS (CONJ (MATCH_MP compare_right (SYM th1)) th))))\r
15406    THEN USE_THEN "F17" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15407    THEN DISCH_THEN (MP_TAC o MATCH_MP determine_loop_index)\r
15408    THEN DISCH_THEN SUBST_ALL_TAC\r
15409    THEN USE_THEN "F22" (fun th-> USE_THEN "F26"(MP_TAC o REWRITE_RULE[th; IN_ELIM_THM]))\r
15410    THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F29") (LABEL_TAC "F30")))\r
15411    THEN USE_THEN "F15" (MP_TAC o SPEC `a:num`)\r
15412    THEN USE_THEN "F11" (fun th-> REWRITE_TAC[MATCH_MP LT_IMP_LE th])\r
15413    THEN USE_THEN "F12"(fun th-> USE_THEN "F14" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (MATCH_MP LT_IMP_LE th1))]))\r
15414    THEN USE_THEN "F21" (SUBST1_TAC o SYM)\r
15415    THEN DISCH_THEN (LABEL_TAC "F31")\r
15416    THEN USE_THEN "F31"(fun th-> USE_THEN "F7" (LABEL_TAC "F32" o REWRITE_RULE[th] o SPEC `a:num` o MATCH_MP lemma_power_next_in_loop))\r
15417    THEN SUBGOAL_THEN `!i:num. i <= d:num ==> (next (L2:(A)loop) POWER i) u = (inverse (node_map (H:(A)hypermap)) POWER i) u` (LABEL_TAC "F33")\r
15418    THENL[GEN_TAC\r
15419        THEN DISCH_THEN (LABEL_TAC "H1")\r
15420        THEN USE_THEN "F21" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
15421        THEN REWRITE_TAC[lemma_add_exponent_function]\r
15422        THEN USE_THEN "F21" (SUBST1_TAC o SYM)\r
15423        THEN USE_THEN "F31" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
15424        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15425        THEN USE_THEN "F15" (MP_TAC o SPEC `(i:num) + (a:num)`)\r
15426        THEN USE_THEN "F11" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (MATCH_MP LT_IMP_LE th) (SPECL[`i:num`; `a:num`] LE_ADDR))])\r
15427        THEN USE_THEN "F27" (fun th->USE_THEN "H1" (MP_TAC o ONCE_REWRITE_RULE[GSYM(SPECL[`a:num`; `i:num`; `d:num`] LE_ADD_LCANCEL)]))\r
15428        THEN USE_THEN "F27" (fun th-> DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[ADD_SYM] o REWRITE_RULE[SYM th]))\r
15429        THEN DISCH_THEN (fun th-> USE_THEN "F14" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (MATCH_MP LT_IMP_LE th1))]))\r
15430        THEN DISCH_THEN SUBST1_TAC\r
15431        THEN REWRITE_TAC[lemma_add_exponent_function]\r
15432        THEN USE_THEN "F21" (SUBST1_TAC o SYM)\r
15433        THEN POP_ASSUM MP_TAC THEN USE_THEN "F23" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15434    THEN USE_THEN "F33"(fun th-> USE_THEN "F29" (fun th1 -> MP_TAC (MATCH_MP lemma_sub_part (CONJ th th1))))\r
15435    THEN USE_THEN "F5"(fun th->USE_THEN "F3"(MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `L2:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]))\r
15436    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom)\r
15437    THEN USE_THEN "F29" (fun th-> USE_THEN "F33"(fun th1-> REWRITE_TAC[MATCH_MP th1 th]))\r
15438    THEN REMOVE_THEN "F29" (fun th-> USE_THEN "F23"(fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)]))\r
15439    THEN REMOVE_THEN "F30" (SUBST1_TAC o SYM)\r
15440    THEN DISCH_THEN (LABEL_TAC "F30")\r
15441    THEN USE_THEN "F3"(fun th->USE_THEN "F5"(fun th1->USE_THEN "F32"(fun th2->USE_THEN "F30"(fun th3->REWRITE_TAC[MATCH_MP change_parameters (CONJ4 th th1 th2 th3)]))))\r
15442    THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(MATCH_MP lemma_identity_atom th)])\r
15443    THEN USE_THEN "F33" MP_TAC\r
15444    THEN USE_THEN "F5"(fun th->USE_THEN "F3"(MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `L2:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]))\r
15445    THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom)\r
15446    THEN USE_THEN "F33"(fun th1-> REWRITE_TAC[MATCH_MP th1 (SPEC `d:num` LE_REFL)])\r
15447    THEN USE_THEN "F23"(fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 (SPEC `d:num` LE_REFL))])\r
15448    THEN USE_THEN "F28" (SUBST1_TAC o SYM)\r
15449    THEN DISCH_THEN (LABEL_TAC "F34")\r
15450    THEN USE_THEN "F32" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15451    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_tail_via_restricted)\r
15452    THEN SUBGOAL_THEN `back (L2:(A)loop) u = back (L1:(A)loop) u` SUBST1_TAC\r
15453    THENL[USE_THEN "F31" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
15454        THEN USE_THEN "F21" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])\r
15455        THEN USE_THEN "F11" (fun th -> MP_TAC(MATCH_MP LET_TRANS (CONJ (SPEC `m:num` LE_0) th)))\r
15456        THEN DISCH_THEN ((X_CHOOSE_THEN `t:num` (LABEL_TAC "H1" o  REWRITE_RULE[CONJUNCT1 ADD])) o REWRITE_RULE[LT_EXISTS])\r
15457        THEN USE_THEN "H1" SUBST1_TAC\r
15458        THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION; lemma_inverse_evaluation]\r
15459        THEN USE_THEN "F15" MATCH_MP_TAC\r
15460        THEN ONCE_REWRITE_TAC[GSYM LE_SUC]\r
15461        THEN USE_THEN "H1" (SUBST1_TAC o SYM)\r
15462        THEN USE_THEN "F11" (fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LE_SUC_LT] th])\r
15463        THEN USE_THEN "F12" (fun th-> USE_THEN "F14" (fun th1-> (MP_TAC(MATCH_MP LET_TRANS (CONJ th th1)))))\r
15464        THEN ARITH_TAC; ALL_TAC]\r
15465    THEN USE_THEN "F25" (fun th-> REWRITE_TAC[SYM th])\r
15466    THEN DISCH_THEN (fun th-> LABEL_TAC "F35" th THEN REWRITE_TAC[th])\r
15467    THEN USE_THEN "F33" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `d:num`)\r
15468    THEN USE_THEN "F23" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `d:num`)\r
15469    THEN USE_THEN "F28" (SUBST1_TAC o SYM)\r
15470    THEN DISCH_THEN (LABEL_TAC "F36")\r
15471    THEN USE_THEN "F34" MP_TAC THEN USE_THEN "F32" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F3" MP_TAC\r
15472    THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_head)\r
15473    THEN SUBGOAL_THEN `next (L2:(A)loop) v = next (L1:(A)loop) v` SUBST1_TAC\r
15474    THENL[USE_THEN "F36" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
15475        THEN USE_THEN "F28" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])\r
15476        THEN REWRITE_TAC[COM_POWER_FUNCTION]\r
15477        THEN USE_THEN "F31" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th])\r
15478        THEN USE_THEN "F21" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])\r
15479        THEN REWRITE_TAC[GSYM lemma_add_exponent_function; CONJUNCT2 ADD]\r
15480        THEN USE_THEN "F15" MATCH_MP_TAC\r
15481        THEN REWRITE_TAC[LE_SUC_LT]\r
15482        THEN USE_THEN "F27" (SUBST1_TAC o SYM o ONCE_REWRITE_RULE[ADD_SYM])\r
15483        THEN USE_THEN "F14"(fun th-> REWRITE_TAC[th])\r
15484        THEN USE_THEN "F11" (fun th-> USE_THEN "F12" (fun th1-> MP_TAC(MATCH_MP LTE_TRANS (CONJ th th1))))\r
15485        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (MATCH_MP LT_IMP_LE th) (SPEC `b:num` LE_PLUS))]); ALL_TAC]\r
15486    THEN USE_THEN "F24" (fun th-> REWRITE_TAC[th])\r
15487    THEN DISCH_THEN (fun th-> REWRITE_TAC[th] THEN LABEL_TAC "F37" th)\r
15488    THEN USE_THEN "F36" (MP_TAC o SYM)\r
15489    THEN USE_THEN "F14"(fun th->USE_THEN "F27"(fun th1->MP_TAC(MATCH_MP LE_TRANS (CONJ (MATCH_MP compare_right (SYM th1)) (MATCH_MP LT_IMP_LE th)))))\r
15490    THEN DISCH_THEN (fun th->USE_THEN "F10" (MP_TAC o MATCH_MP LE_TRANS o CONJ th))\r
15491    THEN USE_THEN "F32" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15492    THEN DISCH_THEN (MP_TAC o MATCH_MP determine_loop_index)\r
15493    THEN DISCH_THEN (LABEL_TAC "F38") THEN CONV_TAC SYM_CONV\r
15494    THEN USE_THEN "F3"(fun th->USE_THEN "F5"(fun th1->USE_THEN "F32"(fun th2->SUBST1_TAC(CONJUNCT2(CONJUNCT2(MATCH_MP atomic_particles (CONJ th (CONJ th1 th2))))))))\r
15495    THEN USE_THEN "F37"(fun th-> USE_THEN "F35"(fun th1-> USE_THEN "F38"(fun th2-> REWRITE_TAC[th; th1; th2])))\r
15496    THEN USE_THEN "F22" SUBST1_TAC THEN USE_THEN "F23"(fun th-> REWRITE_TAC[MATCH_MP lemma_two_series_eq th]));;\r
15497 \r
15498 let lemma_dnax_atomic_structure = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x /\ ~(L IN canon H NF) ==>\r
15499 index L (attach H NF L x) (head H NF (attach H NF L x)) <= index L (attach H NF L x) x /\\r
15500 index L (attach H NF L x) x + (SUC (mInside H NF L x)) = index L (attach H NF L x) (heading H NF L x) /\\r
15501 dnax H NF L x IN genesis H NF L x /\\r
15502 head H (genesis H NF L x) (attach H NF L x) = head H NF (attach H NF L x) /\\r
15503 tail H (genesis H NF L x) (attach H NF L x) = attach H NF L x /\\r
15504 (!i:num. i <= index L (attach H NF L x) (head H NF (attach H NF L x)) \r
15505   ==> atom H (dnax H NF L x) ((next L POWER i) (attach H NF L x)) = atom H (dnax H NF L x) (attach H NF L x)) /\\r
15506 (!i:num. index L (attach H NF L x) (head H NF (attach H NF L x)) < i /\ i <= index L (attach H NF L x) x\r
15507   ==> tail H (genesis H NF L x) ((next L POWER i) (attach H NF L x)) = tail H NF ((next L POWER i) (attach H NF L x)) /\\r
15508       head  H (genesis H NF L x) ((next L POWER i) (attach H NF L x)) = head H NF ((next L POWER i) (attach H NF L x)) /\\r
15509       atom H (dnax H NF L x) ((next L POWER i) (attach H NF L x)) = atom H L ((next L POWER i) (attach H NF L x))) /\\r
15510 (!i:num. index L (attach H NF L x) x < i /\ i <= index L (attach H NF L x) (heading H NF L x)\r
15511   ==> atom H (dnax H NF L x) ((next L POWER i) (attach H NF L x)) = {(next L POWER i) (attach H NF L x)}) /\\r
15512 (!i:num. 1 <= i /\ i <= mAdd H NF L x\r
15513   ==> atom H (dnax H NF L x) ((face_map H POWER i) (heading H NF L x)) = {(face_map H POWER i) (heading H NF L x)})\r
15514 /\ (!i:num. i <= (SUC (mInside H NF L x)) + (SUC (mAdd H NF L x)) ==> (next (dnax H NF L x) POWER i) x = (face_map H POWER i) x)`,\r
15515    REPEAT GEN_TAC\r
15516    THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th))\r
15517    THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7" o CONJUNCT1))))) o REWRITE_RULE[is_split_condition])\r
15518    THEN USE_THEN "F5" (fun th->(USE_THEN "F4" (LABEL_TAC "F8" o CONJUNCT1 o REWRITE_RULE[th] o  SPEC `L:(A)loop` o  CONJUNCT1 o REWRITE_RULE[is_normal])))\r
15519    THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading)\r
15520    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1)))))\r
15521    THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM]\r
15522    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (LABEL_TAC "F11" o MATCH_MP lemma_normal_genesis o CONJ th))\r
15523    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC  o CONJUNCT2 o MATCH_MP lemma_on_dnax o CONJ th))\r
15524    THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (CONJUNCTS_THEN2 (LABEL_TAC "F15") (LABEL_TAC "F16"))))\r
15525    THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (LABEL_TAC "F17" o MATCH_MP lemma_in_dnax o CONJ th))\r
15526    THEN USE_THEN "F1" (LABEL_TAC "F17i" o CONJUNCT1 o MATCH_MP lemma_mInside)\r
15527    THEN LABEL_TAC "F18" (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach)\r
15528    THEN USE_THEN "F10" (fun th-> USE_THEN "F7" ((CONJUNCTS_THEN2 (LABEL_TAC "F19") (LABEL_TAC "F20")) o MATCH_MP lemma_loop_index o CONJ th))\r
15529    THEN USE_THEN "F10" (fun th-> USE_THEN "F9" ((CONJUNCTS_THEN2 (LABEL_TAC "F21") (LABEL_TAC "F22")) o MATCH_MP lemma_loop_index o CONJ th))\r
15530    THEN USE_THEN "F4" (fun th->USE_THEN "F5"(fun th1-> USE_THEN "F10" (fun th2-> MP_TAC (MATCH_MP head_on_loop (CONJ th (CONJ th1 th2))))))\r
15531    THEN USE_THEN "F10" (fun th->DISCH_THEN (fun th1-> LABEL_TAC "F24" (MATCH_MP lemma_in_loop (CONJ th (CONJUNCT1 th1)))))\r
15532    THEN USE_THEN "F10" (fun th-> USE_THEN "F24" ((CONJUNCTS_THEN2 (LABEL_TAC "F25") (LABEL_TAC "F26")) o MATCH_MP lemma_loop_index o CONJ th))\r
15533    THEN ABBREV_TAC `G = genesis (H:(A)hypermap) NF L x`\r
15534    THEN POP_ASSUM (LABEL_TAC "GL")\r
15535    THEN ABBREV_TAC `Q = dnax (H:(A)hypermap) NF L x` THEN POP_ASSUM (LABEL_TAC "QL")\r
15536    THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
15537    THEN POP_ASSUM (LABEL_TAC "YEL")\r
15538    THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
15539    THEN POP_ASSUM (LABEL_TAC "ZEL")\r
15540    THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
15541    THEN POP_ASSUM (LABEL_TAC "MN")\r
15542    THEN ABBREV_TAC `p = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)`\r
15543    THEN POP_ASSUM (LABEL_TAC "PN")\r
15544    THEN ABBREV_TAC `ny = index (L:(A)loop) z y` THEN POP_ASSUM (LABEL_TAC "YN")\r
15545    THEN ABBREV_TAC `nx = index (L:(A)loop) z x` THEN POP_ASSUM (LABEL_TAC "XN")\r
15546    THEN ABBREV_TAC `nh = index (L:(A)loop) z (head (H:(A)hypermap) NF z)` THEN POP_ASSUM (LABEL_TAC "HN")\r
15547     THEN SUBGOAL_THEN `nh:num <= nx` (LABEL_TAC "F27")\r
15548    THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect)\r
15549        THEN USE_THEN "F10" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15550        THEN USE_THEN "HN" (fun th-> DISCH_THEN (LABEL_TAC "H1" o REWRITE_RULE[th] o  MATCH_MP to_head))\r
15551        THEN ASM_CASES_TAC `nh:num <= nx` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15552        THEN POP_ASSUM (LABEL_TAC "H2" o REWRITE_RULE[NOT_LE; GSYM LE_SUC_LT])\r
15553        THEN USE_THEN "H1" (MP_TAC o SPEC `nx:num`)\r
15554        THEN USE_THEN "H2" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `nx:num` LE_PLUS) th)])\r
15555        THEN DISCH_TAC THEN USE_THEN "H1" (MP_TAC o SPEC `SUC nx`)\r
15556        THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th; GSYM COM_POWER_FUNCTION])\r
15557        THEN POP_ASSUM (SUBST1_TAC o SYM)\r
15558        THEN USE_THEN "F20" (SUBST1_TAC o SYM)\r
15559        THEN DISCH_THEN (LABEL_TAC "H3")\r
15560        THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15561        THEN DISCH_THEN (LABEL_TAC "H4")\r
15562        THEN USE_THEN "H3" (fun th-> (USE_THEN "H4" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_next_exclusive)))\r
15563        THEN USE_THEN "H3" (SUBST1_TAC o SYM)\r
15564        THEN DISCH_THEN (fun th-> (USE_THEN "H4"(MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_head_via_restricted)))\r
15565        THEN USE_THEN "F1"(fun th-> REWRITE_TAC[REWRITE_RULE[is_split_condition] th]); ALL_TAC]\r
15566    THEN USE_THEN "F27" (fun th-> REWRITE_TAC[th])\r
15567    THEN SUBGOAL_THEN `!i:num. i <= SUC p ==> is_inj_list (loop_path (L:(A)loop) (z:A)) ((nx:num) + i)` (LABEL_TAC "F28")\r
15568    THENL[REWRITE_TAC[lemma_loop_path_via_list; GSYM lemma_inj_orbit_via_list]\r
15569        THEN INDUCT_TAC\r
15570        THENL[REWRITE_TAC[LE_0; ADD_0; lemma_inj_orbit_via_list; GSYM lemma_loop_path_via_list]\r
15571            THEN USE_THEN "F19"(fun th->USE_THEN "F10"(fun th1->REWRITE_TAC[REWRITE_RULE[th](SPEC `nx:num`(MATCH_MP lemma_inj_loop_path th1))])); ALL_TAC]\r
15572        THEN POP_ASSUM (LABEL_TAC "H1")\r
15573        THEN DISCH_THEN (LABEL_TAC "H2")\r
15574        THEN REWRITE_TAC[ADD_SUC]\r
15575        THEN MATCH_MP_TAC inj_orbit_step\r
15576        THEN EXISTS_TAC `dart_of (L:(A)loop)`\r
15577        THEN REWRITE_TAC[loop_lemma]\r
15578        THEN USE_THEN "H1" MP_TAC\r
15579        THEN USE_THEN "H2" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)])\r
15580        THEN DISCH_THEN (fun th-> REWRITE_TAC[th])\r
15581        THEN REWRITE_TAC[GSYM ADD_SUC]\r
15582        THEN ONCE_REWRITE_TAC[ADD_SYM]\r
15583        THEN USE_THEN "F20" (fun th-> REWRITE_TAC[lemma_add_exponent_function; GSYM th])\r
15584        THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o SPEC `SUC i` o CONJUNCT2 o MATCH_MP lemmaHQYMRTX o CONJ th))\r
15585        THEN USE_THEN "PN" (fun th-> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[th; th1]))\r
15586        THEN USE_THEN "H2" (fun th-> REWRITE_TAC[GE_1; th])\r
15587        THEN USE_THEN "PN" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o SPEC `SUC i` o CONJUNCT1 o MATCH_MP lemma_mInside))\r
15588        THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th])\r
15589        THEN DISCH_THEN SUBST1_TAC\r
15590        THEN DISCH_THEN (fun th-> REWRITE_TAC[GSYM th]); ALL_TAC]\r
15591    THEN SUBGOAL_THEN `(nx:num) + (SUC p) = ny` (LABEL_TAC "F29")\r
15592    THENL[USE_THEN "F28" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `SUC p`)\r
15593        THEN USE_THEN "F10" (fun th-> REWRITE_TAC[GSYM(SPEC `(nx:num) + (SUC p)` (MATCH_MP lemma_inj_loop_path th))])\r
15594        THEN DISCH_TAC\r
15595        THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`]  heading)\r
15596        THEN USE_THEN "F1" (MP_TAC o SPEC `SUC (mInside (H:(A)hypermap) NF L x)` o CONJUNCT1 o MATCH_MP lemma_mInside)\r
15597        THEN USE_THEN "YEL" (fun th-> USE_THEN "PN" (fun th1-> REWRITE_TAC[th; th1; LE_REFL]))\r
15598        THEN DISCH_THEN (SUBST1_TAC o SYM)\r
15599        THEN USE_THEN "F20" SUBST1_TAC\r
15600        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15601        THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM]\r
15602        THEN POP_ASSUM MP_TAC\r
15603        THEN USE_THEN "F10" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15604        THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP determine_loop_index)\r
15605        THEN USE_THEN "YN" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15606    THEN USE_THEN "F29" (fun th-> REWRITE_TAC[th])\r
15607    THEN SUBGOAL_THEN `Q IN (G:(A)loop-> bool)` (LABEL_TAC "F30")\r
15608    THENL[EXPAND_TAC "Q" THEN EXPAND_TAC "G" THEN REWRITE_TAC[genesis; IN_ELIM_THM; IN_DELETE; IN_UNION; lemma_in_couple]; ALL_TAC]\r
15609    THEN USE_THEN "F30" (fun th-> REWRITE_TAC[th])\r
15610    THEN SUBGOAL_THEN `tail (H:(A)hypermap) G z = z` (LABEL_TAC "F31")\r
15611    THENL[USE_THEN "F12" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC\r
15612        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15613        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_tail_via_restricted th])\r
15614        THEN MP_TAC (AP_THM (SPEC `Q:(A)loop` lemma_order_next) `z:A`)\r
15615        THEN USE_THEN "F14" (fun th-> REWRITE_TAC[I_THM; lemma_size; GSYM COM_POWER_FUNCTION; th])\r
15616        THEN DISCH_THEN (MP_TAC o REWRITE_RULE[lemma_inverse_evaluation] o SYM o AP_TERM `back (Q:(A)loop)`)\r
15617        THEN USE_THEN "YEL"(fun th-> USE_THEN "ZEL"(fun th1->USE_THEN "MN"(fun th2->USE_THEN "YN" (fun th3->(REWRITE_TAC[tpx; th; th1; th2; th3])))))\r
15618        THEN USE_THEN "F16" (fun th-> REWRITE_TAC[REWRITE_RULE[LE_REFL] (SPEC `m:num` th)])\r
15619        THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F18" (fun th-> REWRITE_TAC[COM_POWER_FUNCTION; th]); ALL_TAC]\r
15620    THEN USE_THEN "F31" (fun th-> REWRITE_TAC[th])\r
15621    THEN SUBGOAL_THEN `!i:num. i <= nh ==> (next (Q:(A)loop) POWER i) (z:A) = (inverse (node_map (H:(A)hypermap)) POWER i) z` (LABEL_TAC "F32")\r
15622    THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1")\r
15623        THEN USE_THEN "F15" (MP_TAC o SPEC `i:num`)\r
15624        THEN USE_THEN "F29" (fun th-> MP_TAC (REWRITE_RULE[th] (SPECL[`nx:num`; `SUC p`] LE_ADD)))\r
15625        THEN USE_THEN "H1" (fun th-> USE_THEN "F27" (fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1))))\r
15626        THEN DISCH_THEN (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)]))\r
15627        THEN DISCH_THEN SUBST1_TAC\r
15628        THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect)\r
15629        THEN USE_THEN "F10" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15630        THEN DISCH_THEN (MP_TAC o SPEC `i:num` o MATCH_MP to_head)\r
15631        THEN USE_THEN "H1"(fun th1-> USE_THEN "HN" (fun th-> REWRITE_TAC[th; th1])); ALL_TAC]\r
15632    THEN USE_THEN "F30"(fun th->(USE_THEN "F11" (LABEL_TAC "F33" o CONJUNCT1 o REWRITE_RULE[th] o SPEC `Q:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal])))\r
15633    THEN SUBGOAL_THEN `head (H:(A)hypermap) (G:(A)loop->bool) z = head (H:(A)hypermap) NF z` (LABEL_TAC "F34")\r
15634    THENL[USE_THEN "F33"(fun th->USE_THEN "F32" (MP_TAC o MATCH_MP lemma_in_atom o CONJ th))\r
15635        THEN DISCH_TAC THEN USE_THEN "F15" (MP_TAC o SPEC `SUC nh`)\r
15636        THEN USE_THEN "F27"(fun th->USE_THEN "F29"(fun th1->(REWRITE_TAC[REWRITE_RULE[th1; GSYM ADD1] (MATCH_MP LE_ADD2 (CONJ th (SPEC `p:num` GE_1)))])))\r
15637        THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN POP_ASSUM MP_TAC\r
15638        THEN USE_THEN "F15" (MP_TAC o SPEC `nh:num`)\r
15639        THEN USE_THEN "F29" (fun th-> MP_TAC (REWRITE_RULE[th] (SPECL[`nx:num`; `SUC p`] LE_ADD)))\r
15640        THEN DISCH_THEN (fun th1 -> USE_THEN "F27" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP LE_TRANS (CONJ th th1)]))\r
15641        THEN USE_THEN "F26" (fun th-> REWRITE_TAC[SYM th])\r
15642        THEN DISCH_THEN SUBST1_TAC\r
15643        THEN USE_THEN "F4"(fun th->USE_THEN "F5"(fun th1-> USE_THEN "F10"(fun th2-> REWRITE_TAC[MATCH_MP value_next_of_head (CONJ th (CONJ th1 th2))])))\r
15644        THEN DISCH_THEN (LABEL_TAC "H1") THEN DISCH_TAC\r
15645        THEN USE_THEN "H1" MP_TAC THEN USE_THEN "F12" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC\r
15646        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15647        THEN POP_ASSUM (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[REWRITE_RULE[th] (SYM(MATCH_MP lemma_head th1))])); ALL_TAC]\r
15648    THEN USE_THEN "F34"(fun th-> REWRITE_TAC[th])\r
15649    THEN STRIP_TAC\r
15650    THENL[GEN_TAC\r
15651        THEN DISCH_THEN (LABEL_TAC "H1")\r
15652        THEN USE_THEN "H1"(fun th-> USE_THEN "F32"(fun th1-> MP_TAC(MATCH_MP lemma_sub_part (CONJ th1 th))))\r
15653        THEN USE_THEN "F33"(fun th-> DISCH_THEN (fun th1-> MP_TAC(MATCH_MP lemma_in_atom (CONJ th th1))))\r
15654        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_identity_atom th])\r
15655        THEN USE_THEN "F15" (MP_TAC o SPEC `i:num`)\r
15656        THEN USE_THEN "F29"(fun th-> MP_TAC(REWRITE_RULE[th] (SPECL[`nx:num`; `SUC p`] LE_ADD)))\r
15657        THEN DISCH_THEN (fun th1-> USE_THEN "F27" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1))))\r
15658        THEN USE_THEN "H1" (fun th-> DISCH_THEN(fun th1-> REWRITE_TAC [MATCH_MP LE_TRANS (CONJ th th1)]))\r
15659        THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15660    THEN STRIP_TAC\r
15661    THENL[GEN_TAC\r
15662        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
15663        THEN ABBREV_TAC `u = (next (L:(A)loop) POWER (i:num)) (z:A)`\r
15664        THEN POP_ASSUM (LABEL_TAC "UL")\r
15665        THEN USE_THEN "UL" (MP_TAC o SYM)\r
15666        THEN USE_THEN "H2"(fun th-> USE_THEN "F19"(fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1))))\r
15667        THEN USE_THEN "F10" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15668        THEN DISCH_THEN (LABEL_TAC "H3" o MATCH_MP determine_loop_index)\r
15669        THEN USE_THEN "H2" MP_TAC THEN USE_THEN "H1" MP_TAC THEN USE_THEN "H3" (SUBST1_TAC o SYM)\r
15670        THEN EXPAND_TAC "nh" THEN EXPAND_TAC "nx"\r
15671        THEN USE_THEN "FC" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_marked_dart)\r
15672        THEN USE_THEN "UL" (fun th-> USE_THEN "F10" (MP_TAC o REWRITE_RULE[th] o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop))\r
15673        THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F10" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN  "F4" MP_TAC THEN USE_THEN "F3" MP_TAC\r
15674        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15675        THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_separation_on_loop)\r
15676        THEN USE_THEN "H3" SUBST1_TAC\r
15677        THEN USE_THEN "H3" (fun th-> USE_THEN "XN"(fun th1-> USE_THEN "HN" (fun th2-> REWRITE_TAC[th; th1; th2])))\r
15678        THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H4") (CONJUNCTS_THEN2 (LABEL_TAC "H5") (CONJUNCTS_THEN2 (LABEL_TAC "H6") (LABEL_TAC "H7"))))\r
15679        THEN SUBGOAL_THEN `!i:num. 0 <= i /\ i <= ny:num ==> (next (Q:(A)loop) POWER i) z = (next (L:(A)loop) POWER i) z` MP_TAC\r
15680        THENL[USE_THEN "F15"(fun th-> REWRITE_TAC[LE_0; th]); ALL_TAC]\r
15681        THEN USE_THEN "F29" ((fun th-> MP_TAC (MATCH_MP compare_left th)) o REWRITE_RULE[ADD_SUC; GSYM(CONJUNCT2 ADD)])\r
15682        THEN DISCH_THEN (MP_TAC o MATCH_MP LTE_TRANS o CONJ (SPEC `nx:num` LT_PLUS))\r
15683        THEN USE_THEN "H7" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP LET_TRANS o CONJ th))\r
15684        THEN USE_THEN "H5"(fun th-> USE_THEN "H6"(MP_TAC o MATCH_MP LE_TRANS o CONJ th))\r
15685        THEN USE_THEN "H4" (MP_TAC o MATCH_MP LET_TRANS o CONJ (SPEC `nh:num` LE_0))\r
15686        THEN USE_THEN "F14" (MP_TAC o MATCH_MP compare_left o SYM o  REWRITE_RULE[tpx])\r
15687        THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "YN"(fun th2-> REWRITE_TAC[th; th1; th2])))\r
15688        THEN USE_THEN "F21" MP_TAC\r
15689        THEN USE_THEN "UL" (fun th-> USE_THEN "F10"(MP_TAC o REWRITE_RULE[th] o SPEC `i:num` o  MATCH_MP lemma_power_next_in_loop))\r
15690        THEN USE_THEN "F12" MP_TAC THEN USE_THEN "F10" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F5" MP_TAC\r
15691        THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F4" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15692        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP atom_eq th]); ALL_TAC]\r
15693    THEN SUBGOAL_THEN `!i:num. i <= (SUC p) + (SUC m) ==> (next (Q:(A)loop) POWER i) (x:A) = (face_map (H:(A)hypermap) POWER i) x` (LABEL_TAC "F35")\r
15694    THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1")\r
15695        THEN ASM_CASES_TAC `i:num <= SUC p`\r
15696        THENL[POP_ASSUM (LABEL_TAC "H2")\r
15697            THEN USE_THEN "F20" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
15698            THEN USE_THEN "F15" (fun th-> USE_THEN "F29" (SUBST1_TAC o SYM o MATCH_MP th o (MATCH_MP compare_left)))\r
15699            THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15700            THEN CONV_TAC (ONCE_DEPTH_CONV(LAND_CONV(REWR_CONV ADD_SYM)))\r
15701            THEN USE_THEN "F29"(fun th->USE_THEN "H2"(fun th1->MP_TAC(REWRITE_RULE[GSYM (SPECL[`nx:num`; `i:num`; `SUC p`] LE_ADD_LCANCEL); th] th1)))\r
15702            THEN USE_THEN "F15" (fun th-> DISCH_THEN (SUBST1_TAC o MATCH_MP th))\r
15703            THEN CONV_TAC (ONCE_DEPTH_CONV(LAND_CONV (REWR_CONV ADD_SYM)))\r
15704            THEN USE_THEN "F20"(fun th->  REWRITE_TAC[lemma_add_exponent_function; SYM th])\r
15705            THEN USE_THEN "F17i" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC]\r
15706        THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H2")) o REWRITE_RULE[NOT_LE; LT_EXISTS])\r
15707        THEN USE_THEN "H2" (fun th-> USE_THEN "H1" (LABEL_TAC "H3" o REWRITE_RULE[th; LE_ADD_LCANCEL]))\r
15708        THEN USE_THEN "H2" SUBST1_TAC\r
15709        THEN ONCE_REWRITE_TAC[ADD_SYM]\r
15710        THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [lemma_add_exponent_function]\r
15711        THEN USE_THEN "F17i" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `SUC p`)\r
15712        THEN SUBGOAL_THEN `(next (L:(A)loop) POWER (SUC p)) x = y` SUBST1_TAC\r
15713        THENL[USE_THEN "F20" SUBST1_TAC\r
15714            THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15715            THEN ONCE_REWRITE_TAC[ADD_SYM]\r
15716            THEN USE_THEN "F29" (fun th-> USE_THEN "F22" (fun th1-> REWRITE_TAC[th; th1])); ALL_TAC]\r
15717        THEN USE_THEN "F20" SUBST1_TAC\r
15718        THEN USE_THEN "F15" (fun th-> USE_THEN "F29" (SUBST1_TAC o SYM o MATCH_MP th o (MATCH_MP compare_left)))\r
15719        THEN REWRITE_TAC[GSYM lemma_add_exponent_function; GSYM ADD_ASSOC]\r
15720        THEN USE_THEN "F29" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM])\r
15721        THEN ONCE_REWRITE_TAC[ADD_SYM]\r
15722        THEN ASM_CASES_TAC `SUC d < SUC m`\r
15723        THENL[POP_ASSUM (fun th-> USE_THEN "F16"(fun th1-> REWRITE_TAC[MATCH_MP th1 (REWRITE_RULE[LT_SUC_LE] th)])); ALL_TAC]\r
15724        THEN POP_ASSUM (fun th-> USE_THEN "H3"(fun th1-> REWRITE_TAC [REWRITE_RULE[LE_ANTISYM] (CONJ th1 (REWRITE_RULE[NOT_LT] th))]))\r
15725        THEN REWRITE_TAC[ADD_SUC]\r
15726        THEN USE_THEN "F18" (SUBST1_TAC o SYM)\r
15727        THEN USE_THEN "F14" (MP_TAC o REWRITE_RULE[tpx])\r
15728        THEN USE_THEN "ZEL"(fun th->USE_THEN "YEL"(fun th1->USE_THEN "MN"(fun th2-> USE_THEN "YN"(fun th3->REWRITE_TAC[th; th1; th2; th3]))))\r
15729        THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th; GSYM lemma_size; lemma_order_next; I_THM]); ALL_TAC]\r
15730    THEN USE_THEN "F35"(fun th-> REWRITE_TAC[th])\r
15731    THEN STRIP_TAC\r
15732    THENL[GEN_TAC\r
15733        THEN DISCH_THEN (CONJUNCTS_THEN2 ((X_CHOOSE_THEN `d:num`  ASSUME_TAC) o REWRITE_RULE[LT_EXISTS]) MP_TAC)\r
15734        THEN DISCH_THEN (fun th-> (USE_THEN "F15"(fun th1-> (SUBST1_TAC (SYM (MATCH_MP th1 th))))) THEN MP_TAC th)\r
15735        THEN POP_ASSUM SUBST1_TAC\r
15736        THEN USE_THEN "F29" (SUBST1_TAC o SYM)\r
15737        THEN DISCH_THEN (LABEL_TAC "H1" o REWRITE_RULE[LE_ADD_LCANCEL])\r
15738        THEN ONCE_REWRITE_TAC[ADD_SYM]\r
15739        THEN REWRITE_TAC[lemma_add_exponent_function]\r
15740        THEN USE_THEN "F29" (MP_TAC o MATCH_MP compare_left)\r
15741        THEN USE_THEN "F15"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP th))\r
15742        THEN DISCH_THEN SUBST1_TAC\r
15743        THEN USE_THEN "F20" (SUBST1_TAC o SYM)\r
15744        THEN SUBGOAL_THEN `!i:num. i <= SUC (SUC p) ==> (next (Q:(A)loop) POWER i) x = (face_map (H:(A)hypermap) POWER i) x` MP_TAC\r
15745        THENL[MP_TAC (REWRITE_RULE[GE_1; GSYM ADD1] (SYM(SPECL[`SUC p`; `1`; `SUC m`] LE_ADD_LCANCEL)))\r
15746            THEN USE_THEN "F35"(fun th -> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP lemma_sub_part (CONJ th th1)])); ALL_TAC]\r
15747        THEN SUBGOAL_THEN `x:A belong (Q:(A)loop)` (LABEL_TAC "H2")\r
15748        THENL[USE_THEN  "F17" (fun th-> REWRITE_TAC[th])\r
15749            THEN DISJ1_TAC THEN EXISTS_TAC `nx:num`\r
15750            THEN USE_THEN "F29" (fun th-> REWRITE_TAC[MATCH_MP compare_left th])\r
15751            THEN USE_THEN "F20" (fun th-> REWRITE_TAC[th]); ALL_TAC]\r
15752        THEN SUBGOAL_THEN `head (H:(A)hypermap) G x = x` MP_TAC\r
15753        THENL[USE_THEN "H2" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC \r
15754            THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15755            THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_head_via_restricted th])\r
15756            THEN USE_THEN "F35" (MP_TAC o REWRITE_RULE[POWER_1; ADD_SUC; GE_1] o SPEC `1`) THEN SIMP_TAC[]; ALL_TAC]\r
15757        THEN USE_THEN "H2" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC \r
15758        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15759        THEN DISCH_THEN (MP_TAC o SPEC `SUC d` o CONJUNCT1 o MATCH_MP lemma_face_contour_on_loop)\r
15760        THEN USE_THEN "H1"(fun th-> REWRITE_TAC[th; GE_1])\r
15761        THEN DISCH_THEN SUBST1_TAC\r
15762        THEN MP_TAC(SPECL[`SUC p`; `SUC m`] LE_ADD)\r
15763        THEN USE_THEN "H1"(fun th-> DISCH_THEN (fun th1-> MP_TAC(MATCH_MP LE_TRANS (CONJ th th1))))\r
15764        THEN DISCH_THEN (fun th-> USE_THEN "F35"(fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)])); ALL_TAC]\r
15765    THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))\r
15766    THEN SUBGOAL_THEN `(face_map (H:(A)hypermap) POWER (i:num)) (y:A) = (next (Q:(A)loop) POWER i) y` MP_TAC\r
15767    THENL[USE_THEN "F22" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])\r
15768        THEN USE_THEN "F15" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `ny:num`)\r
15769        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15770        THEN CONV_TAC (RAND_CONV (LAND_CONV (ONCE_DEPTH_CONV (REWR_CONV ADD_SYM))))\r
15771        THEN USE_THEN "F16" (fun th-> USE_THEN "H2"(fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC]\r
15772    THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
15773    THEN SUBGOAL_THEN `!i:num. i <= SUC m ==> (next (Q:(A)loop) POWER i) y = (face_map (H:(A)hypermap) POWER i) y` MP_TAC\r
15774    THENL[X_GEN_TAC `j:num` THEN DISCH_THEN (LABEL_TAC "H3")\r
15775        THEN USE_THEN "F22" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])\r
15776        THEN USE_THEN "F15" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `ny:num`)\r
15777        THEN REWRITE_TAC[GSYM lemma_add_exponent_function]\r
15778        THEN CONV_TAC (LAND_CONV (LAND_CONV (ONCE_DEPTH_CONV (REWR_CONV ADD_SYM))))\r
15779        THEN ASM_CASES_TAC `j:num <= m`\r
15780        THENL[USE_THEN "F16" (fun th-> POP_ASSUM(fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC]\r
15781        THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; GSYM LE_SUC_LT])\r
15782        THEN USE_THEN "H3"(fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[LE_ANTISYM] o CONJ th))\r
15783        THEN DISCH_THEN (SUBST1_TAC)\r
15784        THEN USE_THEN "F18" (SUBST1_TAC o SYM)\r
15785        THEN USE_THEN "F14"(MP_TAC o REWRITE_RULE[tpx])\r
15786        THEN USE_THEN "ZEL"(fun th->USE_THEN "YEL"(fun th1->USE_THEN "MN"(fun th2->USE_THEN "YN"(fun th3->REWRITE_TAC[th; th1; th2; th3]))))\r
15787        THEN DISCH_THEN (fun th-> REWRITE_TAC[ADD_SUC; SYM th; GSYM lemma_size; lemma_order_next; I_THM]); ALL_TAC]\r
15788    THEN SUBGOAL_THEN `y:A belong (Q:(A)loop)` (LABEL_TAC "H4")\r
15789    THENL[USE_THEN  "F17" (fun th-> REWRITE_TAC[th])\r
15790        THEN DISJ1_TAC THEN EXISTS_TAC `ny:num`\r
15791        THEN USE_THEN "F22" (fun th-> REWRITE_TAC[th; LE_REFL]); ALL_TAC]\r
15792    THEN SUBGOAL_THEN `head (H:(A)hypermap) G y = y` MP_TAC\r
15793    THENL[USE_THEN "H4" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC\r
15794        THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15795        THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_head_via_restricted th]) \r
15796        THEN MP_TAC (REWRITE_RULE[GE_1; GSYM ADD1] (SYM(SPECL[`SUC p`; `1`; `SUC m`] LE_ADD_LCANCEL)))\r
15797        THEN USE_THEN "F35"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP th))\r
15798        THEN ONCE_REWRITE_TAC[GSYM COM_POWER_FUNCTION]\r
15799        THEN MP_TAC (SPECL[`SUC p`; `SUC m`] LE_ADD)\r
15800        THEN USE_THEN "F35"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP th))\r
15801        THEN DISCH_THEN SUBST1_TAC\r
15802        THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] heading)\r
15803        THEN USE_THEN "YEL"(fun th-> USE_THEN "PN"(fun th1-> REWRITE_TAC[th; th1]))\r
15804        THEN DISCH_THEN (SUBST1_TAC o SYM) THEN SIMP_TAC[]; ALL_TAC]\r
15805    THEN USE_THEN "H4" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC\r
15806    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15807    THEN DISCH_THEN (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_face_contour_on_loop)\r
15808    THEN USE_THEN "H1"(fun th-> USE_THEN "H2"(fun th1->REWRITE_TAC[th; th1])));;\r
15809 \r
15810 let go_into_atom = prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A y:A. is_normal H NF /\ L IN NF /\ x belong L /\ y belong L /\ ~(y IN atom H L x) ==>index L y (tail H NF x) <= index L y x`,\r
15811  REPEAT GEN_TAC\r
15812    THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))))\r
15813    THEN USE_THEN "F4"(fun th->USE_THEN "F3"(fun th1-> (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")) (MATCH_MP lemma_loop_index (CONJ th th1))))\r
15814    THEN SUBGOAL_THEN `?n:num. n <= top (L:(A)loop) /\ ((next (L:(A)loop)) POWER n) (y:A) IN atom (H:(A)hypermap) L x` MP_TAC\r
15815    THENL[EXISTS_TAC `index (L:(A)loop) (y:A) (x:A)`\r
15816        THEN USE_THEN "F6"(fun th-> USE_THEN "F7" (fun th1-> REWRITE_TAC[th; SYM th1; atom_reflect])); ALL_TAC]\r
15817    THEN DISCH_THEN (MP_TAC o ONCE_REWRITE_RULE[num_WOP])\r
15818    THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9")) (LABEL_TAC "F10")))\r
15819    THEN SUBGOAL_THEN `0 < n:num` MP_TAC\r
15820    THENL[REMOVE_THEN "F5" MP_TAC\r
15821        THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]\r
15822        THEN REWRITE_TAC[NOT_LT; CONJUNCT1 LE]\r
15823        THEN DISCH_TAC THEN USE_THEN "F9" MP_TAC THEN POP_ASSUM SUBST1_TAC\r
15824        THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC]\r
15825    THEN DISCH_THEN (MP_TAC o REWRITE_RULE[LT_EXISTS; CONJUNCT1 ADD])\r
15826    THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)\r
15827    THEN ABBREV_TAC `z = (next (L:(A)loop) POWER (SUC d)) y`\r
15828    THEN POP_ASSUM (LABEL_TAC "F11")\r
15829    THEN SUBGOAL_THEN `~(z:A = inverse (node_map (H:(A)hypermap)) (back (L:(A)loop) z))` (LABEL_TAC "F12")\r
15830    THENL[USE_THEN "F10" (MP_TAC o REWRITE_RULE[LT_PLUS] o SPEC `d:num`)\r
15831        THEN REWRITE_TAC[CONTRAPOS_THM]\r
15832        THEN DISCH_THEN ASSUME_TAC\r
15833        THEN USE_THEN "F8"(fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `d:num` LE_PLUS) th)])\r
15834        THEN USE_THEN "F11" (MP_TAC o REWRITE_RULE[GSYM COM_POWER_FUNCTION])\r
15835        THEN DISCH_THEN (MP_TAC o AP_TERM `back (L:(A)loop)`)\r
15836        THEN DISCH_THEN (SUBST1_TAC o REWRITE_RULE[lemma_inverse_evaluation])\r
15837        THEN USE_THEN "F9"(fun th->POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP lemma_second_absorb_quark (CONJ th th1)])); ALL_TAC]\r
15838    THEN USE_THEN "F12" MP_TAC THEN USE_THEN "F9" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC\r
15839    THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]\r
15840    THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_unique_tail)\r
15841    THEN DISCH_THEN SUBST1_TAC\r
15842    THEN USE_THEN "F4"(fun th-> USE_THEN "F8"(fun th1-> USE_THEN "F11" (fun th2-> MP_TAC (MATCH_MP determine_loop_index (CONJ th (CONJ th1 (SYM th2)))))))\r
15843    THEN DISCH_THEN SUBST1_TAC\r
15844    THEN USE_THEN "F10" (MP_TAC o SPEC `index (L:(A)loop) y x`)\r
15845    THEN USE_THEN "F7"(fun th-> USE_THEN "F6"(fun th1-> REWRITE_TAC[th1; SYM th; atom_reflect; NOT_LT])));;\r
15846 \r
15847 let square_edge_convolution = prove(`!(H:(A)hypermap). plain_hypermap H ==> !x:A. node_map H (face_map H (node_map H (face_map H x))) = x`,\r
15848     REPEAT GEN_TAC\r
15849     THEN REWRITE_TAC[plain_hypermap]\r
15850     THEN REWRITE_TAC[MATCH_MP convolution_inv (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts))]\r
15851     THEN ONCE_REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)]\r
15852     THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (fun th-> MP_TAC (AP_THM th `x:A`))\r
15853     THEN REWRITE_TAC[o_THM; I_THM]);;\r
15854 \r
15855 let square_edge_convolution2 = prove(`!(H:(A)hypermap). plain_hypermap H ==> !x:A. face_map H (node_map H (face_map H (node_map H x))) = x`,\r
15856    REPEAT STRIP_TAC\r
15857    THEN ONCE_REWRITE_TAC[GSYM node_map_injective]\r
15858    THEN ABBREV_TAC `y = node_map (H:(A)hypermap) x`\r
15859    THEN ASM_MESON_TAC[square_edge_convolution]);;\r
15860 \r
15861 \r
15862 (* deprecated *)\r
15863 let lemma_card_inverse_map_eq = lemma_orbit_inverse_map_eq;;\r
15864 \r
15865 \r
15866 prioritize_real();;\r
15867 \r
15868 end;;\r