1 (* ========================================================================== *)
\r
2 (* FLYSPECK - BOOK FORMALIZATION *)
\r
4 (* Chapter: Hypermap *)
\r
5 (* Author: Tran Nam Trung *)
\r
6 (* Date: 2010-02-09 *)
\r
7 (* ========================================================================== *)
\r
10 module type Hypermap_type = sig
\r
14 (* needs "Library/permutations.ml";; *)
\r
16 module Hypermap (* : Hypermap_type *) = struct
\r
21 parse_as_infix("POWER",(24,"right"));;
\r
23 parse_as_infix("belong",(11,"right"));;
\r
25 parse_as_infix("iso",(24,"right"));;
\r
27 (* The definition of the nth exponent of a map *)
\r
29 let EQ_SUC = SUC_INJ;; (* Harrison eliminated EQ_SUC because it duplicates SUC_INJ *)
\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
36 let POWER_0 = prove(`!f:A->A. f POWER 0 = I`,
\r
37 REWRITE_TAC[POWER]);;
\r
39 let POWER_1 = prove(`!f:A->A. f POWER 1 = f`,
\r
40 REWRITE_TAC[POWER; ONE; I_O_ID]);;
\r
42 let POWER_2 = prove(`!f:A->A. f POWER 2 = f o f`,
\r
43 REWRITE_TAC[POWER; TWO; POWER_1]);;
\r
45 let orbit_map = new_definition `orbit_map (f:A->A) (x:A) = {(f POWER n) x | n >= 0}`;;
\r
48 let ASM_ASM_SET_TAC = ASSUM_LIST (MP_TAC o end_itlist CONJ) THEN SET_TAC[];;
\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
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
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
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
71 THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num` o check (is_forall o concl))
\r
72 THEN ASM_REWRITE_TAC[]);;
\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
78 (* the definition of hypermap *)
\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
83 let hypermap_tybij = (new_type_definition "hypermap" ("hypermap", "tuple_hypermap")exist_hypermap);;
\r
85 let dart = new_definition `dart (H:(A)hypermap) = FST (tuple_hypermap H)`;;
\r
87 let edge_map = new_definition `edge_map (H:(A)hypermap) = FST(SND(tuple_hypermap H))`;;
\r
89 let node_map = new_definition `node_map (H:(A)hypermap) = FST(SND(SND(tuple_hypermap H)))`;;
\r
91 let face_map = new_definition `face_map (H:(A)hypermap) = SND(SND(SND(tuple_hypermap H)))`;;
\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
97 ASM_REWRITE_TAC[hypermap_tybij;dart;edge_map; node_map; face_map]);;
\r
99 (* some technical lemmas *)
\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
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
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
110 (* edges, nodes and faces of a hypermap *)
\r
112 let edge = new_definition `edge (H:(A)hypermap) (x:A) = orbit_map (edge_map H) x`;;
\r
114 let node = new_definition `node (H:(A)hypermap) (x:A) = orbit_map (node_map H) x`;;
\r
116 let face = new_definition `face (H:(A)hypermap) (x:A) = orbit_map (face_map H) x`;;
\r
119 (* We define the combinatorial component *)
\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
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
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
128 let comb_component = new_definition `comb_component (H:(A)hypermap) (x:A) = {y:A| is_in_component H x y}`;;
\r
131 (* some definitions on orbits *)
\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
135 let number_of_orbits = new_definition `number_of_orbits (D:A->bool) (f:A->A) = CARD(set_of_orbits D f)`;;
\r
138 (* the orbits on hypermaps*)
\r
140 let edge_set = new_definition `edge_set (H:(A)hypermap) = set_of_orbits (dart H) (edge_map H)`;;
\r
142 let node_set = new_definition `node_set (H:(A)hypermap) = set_of_orbits (dart H) (node_map H)`;;
\r
144 let face_set = new_definition `face_set (H:(A)hypermap) = set_of_orbits (dart H) (face_map H)`;;
\r
147 let set_components = new_definition `set_components (H:(A)hypermap) (D:A->bool) = {comb_component H (x:A) | x IN D}`;;
\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
151 let set_of_components = new_definition `set_of_components (H:(A)hypermap) = set_part_components H (dart H)`;;
\r
154 (* counting the numbers of edges, nodes, faces and combinatorial components *)
\r
156 let number_of_edges = new_definition `number_of_edges (H:(A)hypermap) = CARD (edge_set H)`;;
\r
158 let number_of_nodes = new_definition `number_of_nodes (H:(A)hypermap) = CARD (node_set H)`;;
\r
160 let number_of_faces = new_definition `number_of_faces (H:(A)hypermap) = CARD (face_set H)`;;
\r
162 let number_of_components = new_definition `number_of_components (H:(A)hypermap) = CARD (set_of_components H)`;;
\r
164 (* some special kinds of hypergraphs *)
\r
166 let plain_hypermap = new_definition `plain_hypermap (H:(A)hypermap) <=> edge_map H o edge_map H = I`;;
\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
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
176 (* a dart x is degenerate or nondegenerate *)
\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
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
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
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
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
191 (* some relationships of maps and orbits of maps *)
\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
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
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
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
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
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
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
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
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
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
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
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
235 let multiplication_exponents = prove(`!m n (f:A->A). f POWER (m * n) = (f POWER n) POWER m`,
\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
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
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
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
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
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
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
269 let lemma_in_orbit = prove(`!f:A->A n:num x:A. (f POWER n) x IN orbit_map f x`,
\r
271 THEN REWRITE_TAC[orbit_map;IN_ELIM_THM]
\r
272 THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_0; GE]);;
\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
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
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
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
309 (* Some obviuos facts about common hypermap maps *)
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
378 let edge_map_injective = prove(`!(H:(A)hypermap) (x:A) (y:A). edge_map H x = edge_map H y <=> x = y`,
\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
383 let node_map_injective = prove(`!(H:(A)hypermap) (x:A) (y:A). node_map H x = node_map H y <=> x = y`,
\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
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
392 (* Some label_TAC *)
\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
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
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
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
402 let label_strip3A_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "A1") (CONJUNCTS_THEN2(LABEL_TAC "A2")(LABEL_TAC "A3")) th;;
\r
404 (* Darts and its images under edge_map, node_map and face_map *)
\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
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
412 THEN REWRITE_TAC[MATCH_MP iterate_orbit (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))]);;
\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
416 THEN REWRITE_TAC[MATCH_MP iterate_orbit (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]);;
\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
428 (* Some lemmas on the cardinality of finite series *)
\r
430 let IMAGE_SEG = prove(`!(n:num) (f:num->A). IMAGE f {i:num | i < n:num} = {f (i:num) | i < n}`,
\r
432 THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN SET_TAC[]);;
\r
434 let FINITE_SERIES = prove(`!(n:num) (f:num->A). FINITE {f(i) | i < n}`,
\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
440 let CARD_FINITE_SERIES_LE = prove(`!(n:num) (f:num->A). CARD {f(i) | i < n} <= n`,
\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
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
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
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
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
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
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
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
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
484 let lemma_sub_two_numbers = prove(`!m:num n:num p:num. m - n - p = m - (n + p)`, ARITH_TAC);;
\r
486 let NON_ZERO = prove(`!n:num. ~(SUC n = 0)`, REWRITE_TAC[GSYM LT_NZ; LT_0]);;
\r
488 let LT1_NZ = prove(`!n:num. 1 <= n <=> 0 < n`, ARITH_TAC);;
\r
490 let GE_1 = prove(`!n:num. 1 <= SUC n`, REWRITE_TAC[LT1_NZ; LT_NZ; NON_ZERO]);;
\r
492 let LT_PLUS = prove(`!n:num. n < SUC n`, ARITH_TAC);;
\r
494 let LE_PLUS = prove(`!n:num. n <= SUC n`, ARITH_TAC);;
\r
496 let LT_SUC_PRE = prove(`!n:num. 0 < n ==> n = SUC(PRE n)`, ARITH_TAC);;
\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
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
503 let SUC_PRE_2 = prove(`!n:num. 2 <= n ==> SUC (SUC (PRE (PRE n))) = n`, ARITH_TAC);;
\r
505 let LE_MOD_SUC = prove(`!n m. m MOD (SUC n) <= n`,
\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
510 let LT0_LE1 = prove(`!n:num. 0 < n <=> 1 <= n`, ARITH_TAC);;
\r
512 let ZR_LT_1 = prove(`0 < 1`, ARITH_TAC);;
\r
514 let LT_RIGHT_SUC = prove(`!i:num n:num. i < n ==> i < SUC n`, ARITH_TAC);;
\r
516 let LE_RIGHT_SUC = prove(`!i:num n:num. i <= n ==> i <= SUC n`, ARITH_TAC);;
\r
518 let LT_PRE_LE = prove(`!i:num n:num. i < n ==> i <= PRE n`, ARITH_TAC);;
\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
527 let compare_right = prove(`!m:num n p. m + n = p ==> n <= p`, ARITH_TAC);;
\r
529 let le_compare_left = prove(`!m:num n p. m + n <= p ==> m <= p`, ARITH_TAC);;
\r
531 let le_compare_right = prove(`!m:num n p. m + n <= p ==> n <= p`, ARITH_TAC);;
\r
533 let THREE = num_CONV `3`;;
\r
535 let SEGMENT_TO_ONE = prove(`!n:num. n <= 1 <=> n = 0 \/ n = 1`, ARITH_TAC);;
\r
537 let SEGMENT_TO_TWO = prove(`!n:num. n <= 2 <=> n = 0 \/ n = 1 \/ n = 2`, ARITH_TAC);;
\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
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
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
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
553 (***********************************************************************)
\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
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
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
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
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
572 THENL[DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\r
573 THEN REPEAT GEN_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
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
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
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
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
602 let support_list = new_definition `support_list (p:num->A) (n:num) = {p (i:num) | i <= n}`;;
\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
607 let lemma_size_list = prove(`!(p:num->A) (n:num). is_inj_list p n ==> CARD (support_list p n) = SUC n`,
\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
614 let in_list = new_definition `in_list (p:num->A) (n:num) (x:A) <=> x IN support_list p n`;;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
694 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FC") (LABEL_TAC "GC"))
\r
695 THEN REWRITE_TAC[is_glueing; lemma_not_in_list]
\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
700 THEN DISCH_THEN (LABEL_TAC "F3")
\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
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
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
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
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
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
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
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
802 (******************************************************************************)
\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
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
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
833 (* finite order theorem on every element in arbitrary finite group *)
\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
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
859 let lemma_order_permutation = new_specification["order_permutation"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_order_permutation_exists);;
\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
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
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
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
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
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
894 THEN EXISTS_TAC `0`
\r
895 THEN REWRITE_TAC[POWER_0]; ALL_TAC]
\r
897 THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl))
\r
898 THEN ASM_REWRITE_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
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
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
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
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
931 (* some properties of orbits *)
\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
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
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
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
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
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
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
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
986 (* some properties of hypermap *)
\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
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
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
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
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
1019 let edge_refl = prove(`!H:(A)hypermap x:A. x IN edge H x`, REWRITE_TAC[edge; orbit_reflect]);;
\r
1021 let node_refl = prove(`!H:(A)hypermap x:A. x IN node H x`, REWRITE_TAC[node; orbit_reflect]);;
\r
1023 let face_refl = prove(`!H:(A)hypermap x:A. x IN face H x`, REWRITE_TAC[face; orbit_reflect]);;
\r
1026 (* Hypermap cycle *)
\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
1034 (* INVERSES HYPERMAP MAPS *)
\r
1036 let label_cyclic_maps_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "H6") (LABEL_TAC "H7") (SPEC th hypermap_cyclic);;
\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
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
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
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
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
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
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
1113 (* Definition of connected hypermap *)
\r
1115 let connected_hypermap = new_definition `connected_hypermap (H:(A)hypermap) <=> number_of_components H = 1`;;
\r
1118 (* Some facts on sets with one element or two elements *)
\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
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
1129 let CARD_TWO_ELEMENTS = prove(`!x:A y:A. ~(x = y) ==> CARD {x ,y} = 2`,
\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
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
1141 let CARD_ATLEAST_1 = prove(`!s:A->bool x:A. FINITE s /\ x IN s ==> 1 <= CARD s`,
\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
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
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
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
1166 (* Some lemmas about counting the orbits of a permutation *)
\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
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
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
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
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
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
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
1216 THENL[REWRITE_TAC[IN_UNIONS]
\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
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
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
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
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
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
1271 THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]
\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
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
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
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
1291 THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]
\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
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
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
1309 THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]
\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
1320 let lemma_orbit_convolution_map = prove(`!p:A->A. p o p = I ==> (!x:A. orbit_map p x = {x, p x})`,
\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
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
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
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
1368 THEN REMOVE_THEN "F2" MP_TAC
\r
1369 THEN POP_ASSUM MP_TAC
\r
1370 THEN REMOVE_THEN "F4" SUBST1_TAC
\r
1373 (* We set up some lemmas on combinatorial commponents *)
\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
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
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
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
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
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
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
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
1407 (* The definition of path is exactly here *)
\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
1415 (* Three special paths *)
\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
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
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
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
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
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
1441 (* Some lemmas on concatenate paths *)
\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
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
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
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
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
1477 THEN DISCH_THEN (MP_TAC o MATCH_MP concatenate_two_paths) THEN MESON_TAC[]);;
\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
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
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
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
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
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
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
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
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
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
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
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
1567 (* We define the CONTOUR PATHS *)
\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
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
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
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
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
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
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
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
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
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
1620 (* face contour is exactly: face_path *)
\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
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
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
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
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
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
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
1711 (* the definition of injectve contours *)
\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
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
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
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
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
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
1752 THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2)
\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
1761 (* The theory of walkup in detail here with many trial facts *)
\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
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
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
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
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
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
1801 let lemma_category_darts = prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x \/ dart_degenerate H x`,
\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
1810 (* Some trivial lemmas on PAIRS *)
\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
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
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
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
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
1837 let shift = new_definition `shift (H:(A)hypermap) = hypermap(dart H, node_map H, face_map H, edge_map H)`;;
\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
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
1850 (* the definition of walkups *)
\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
1854 let node_walkup = new_definition `node_walkup (H:(A)hypermap) (x:A) = shift(shift(edge_walkup (shift H) x))`;;
\r
1856 let face_walkup = new_definition `face_walkup (H:(A)hypermap) (x:A) = shift(edge_walkup (shift (shift H)) x)`;;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
2110 (* About orbits of permutations *)
\r
2112 let power_list = new_definition `!p:A->A x:A. power_list p x = (\i:num. (p POWER i) x)`;;
\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
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
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
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
2132 THEN REWRITE_TAC[lemma_inj_orbit_via_list; lemma_inj_list2; power_list]);;
\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
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
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
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
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
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
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
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
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
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
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
2234 (*******************************************)
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
2308 let lemma_in_disjoint = prove(`!s:A->bool t:A->bool x:A. s INTER t = {} /\ x IN s ==> ~(x IN t)`,
\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
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
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
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
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
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
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
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
2337 THEN REWRITE_TAC[simple_hypermap; dart_nondegenerate; is_face_merge; is_node_merge; node; face; o_THM]
\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
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
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
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
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
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
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
2398 (* some trivial lemmas *)
\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
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
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
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
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
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
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
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
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
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
2533 THEN REWRITE_TAC[IN_DELETE]
\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
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
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
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
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
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
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
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
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
2644 THEN REWRITE_TAC[IN_DELETE]
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
2970 let lemma_in_subset = prove(`!s t x. s SUBSET t /\ x IN s ==> x IN t`, SET_TAC[]);;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
3093 (* SPLITTING CASE FOR EDGES *)
\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
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
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
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
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
3199 (* MERGE CASE - FOR EDGES *)
\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
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
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
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
3274 THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_shift_non_degenerate]
\r
3275 THEN ASM_REWRITE_TAC[]; ALL_TAC]
\r
3277 THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_shift_non_degenerate]
\r
3278 THEN ASM_REWRITE_TAC[]);;
\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
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
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
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
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
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
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
3330 THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_double_shift_non_degenerate]
\r
3331 THEN ASM_REWRITE_TAC[]; ALL_TAC]
\r
3333 THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_double_shift_non_degenerate]
\r
3334 THEN ASM_REWRITE_TAC[]);;
\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
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
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
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
3373 (* A SOME FACTS ON COMPONETS *)
\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
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
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
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
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
3404 let lemma_edge_subset_component = prove(`!(H:(A)hypermap) (x:A). edge H x SUBSET comb_component H x`,
\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
3411 let lemma_node_subset_component = prove(`!(H:(A)hypermap) (x:A). node H x SUBSET comb_component H x`,
\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
3418 let lemma_face_subset_component = prove(`!(H:(A)hypermap) (x:A). face H x SUBSET comb_component H x`,
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
3853 (* walkup at an edge-degenerate point *)
\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
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
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
3881 (* walkup at a node-degenerate point *)
\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
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
3893 THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] node_map_walkup)))
\r
3894 THEN ASM_REWRITE_TAC[]);;
\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
3898 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\r
3899 THEN REWRITE_TAC[edge_map_walkup]
\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
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
3929 (* walkup at a face-degenerate point *)
\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
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
3941 THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] face_map_walkup)))
\r
3942 THEN ASM_REWRITE_TAC[]);;
\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
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
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
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
3995 (* WALKUP AT A DEGENERATE DART: THREE WALKUPS ARE EQUAL *)
\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
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
4012 THENL[REWRITE_TAC[lemma_edge_walkup]
\r
4013 THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th]); ALL_TAC]
\r
4015 THENL[ REWRITE_TAC[FUN_EQ_THM]
\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
4023 THENL[REWRITE_TAC[FUN_EQ_THM]
\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
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
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
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
4080 THENL[REWRITE_TAC[lemma_edge_walkup]
\r
4081 THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th]); ALL_TAC]
\r
4083 THENL[REWRITE_TAC[FUN_EQ_THM]
\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
4091 THENL[REWRITE_TAC[FUN_EQ_THM]
\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
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
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
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
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
4150 let lemma_shift_cycle = prove(`!(H:(A)hypermap). shift (shift (shift H)) = H`,
\r
4152 THEN ONCE_REWRITE_TAC[lemma_hypermap_eq]
\r
4153 THEN REWRITE_TAC[GSYM shift_lemma]);;
\r
4155 let lemma_eq_iff_shift_eq = prove(`!(H:(A)hypermap) (H':(A)hypermap). H = H' <=> shift H = shift H'`,
\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
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
4164 THEN REWRITE_TAC[dart_degenerate]
\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
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
4197 THEN REWRITE_TAC[dart_degenerate]
\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
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
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
4233 (* I prove that walkup at a degenerate dart do not change the plannar indices *)
\r
4236 let component_at_isolated_dart = prove(`!(H:(A)hypermap) x:A. isolated_dart H x ==> comb_component H x = {x}`,
\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
4242 THEN REWRITE_TAC[lemma_def_path]
\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
4261 THEN EXISTS_TAC `(\k:num. x:A)`
\r
4262 THEN EXISTS_TAC `0`
\r
4263 THEN ASM_REWRITE_TAC[]
\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
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
4272 let CARD_MINUS_ONE = prove(`!(s:B -> bool) (x:B). FINITE s /\ x IN s ==> CARD s = CARD (s DELETE x) + 1`,
\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
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
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
4287 THEN MATCH_MP_TAC LEMMA_CARD_DIFF
\r
4288 THEN ASM_ASM_SET_TAC);;
\r
4290 let EDGE_FINITE = prove(`!(H:(A)hypermap) (x:A). FINITE (edge H x)`,
\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
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
4303 let NODE_FINITE = prove(`!(H:(A)hypermap) (x:A). FINITE (node H x)`,
\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
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
4316 let FACE_FINITE = prove(`!(H:(A)hypermap) (x:A). FINITE (face H x)`,
\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
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
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
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
4348 let WALKUP_EXCEPTION_COMPONENT = prove(`!(H:(A)hypermap) x:A. x IN dart H ==> comb_component (edge_walkup H x) x = {x}`,
\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
4360 (* SOME TRIVIAL LEMMAS ON INCIDENT RELATIONSHIPS *)
\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
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
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
4376 let lemma_card_eq_reflect = prove(`!s t. s = t ==> CARD s = CARD t`,MESON_TAC[]);;
\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
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
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
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
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
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
4409 (* WALKUP AT AN ISOLATED DART *)
\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
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
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
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
4585 (* Walkup at an edge-degenerate dart *)
\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
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
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
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
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
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
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
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
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
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
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
4787 (* COMPUTE the numbers on edge-walkup at a non-degerate dart *)
\r
4789 (* Trivial for darts *)
\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
4797 (* Compute number of edges acording to then splitting cas *)
\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
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
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
4848 (* Compute number of edges acording to then splitting cas *)
\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
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
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
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
4897 (* NODES and FACES IN all cases are invariant*)
\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
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
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
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
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
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
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
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
4945 (* For components, we have two cases: component splitting and not splitting *)
\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
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
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
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
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
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
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
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
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
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
5063 (* LEMMA IUCLZYI *)
\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
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
5077 THEN DISCH_THEN (LABEL_TAC "F1")
\r
5078 THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] lemma_category_darts)
\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
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
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
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
5111 let lemmaFOAGLPA = prove(`!(H:(A)hypermap). planar_ind H <= &0`,
\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
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
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
5143 THEN REWRITE_TAC[lemma_planar_hypermap]
\r
5144 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
5160 (* double walkups *)
\r
5163 let convolution_rep = prove(`!s:A->bool p:A->A. p permutes s ==> (p o p = I <=> p = inverse p)`,
\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
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
5173 THEN DISCH_THEN (LABEL_TAC "F1")
\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
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
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
5193 THEN REWRITE_TAC[FUN_EQ_THM]
\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
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
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
5213 let edge_map_convolution = prove(`!(H:(A)hypermap). plain_hypermap H <=> edge_map H = node_map H o face_map H`,
\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
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
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
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
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
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
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
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
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
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
5307 THEN EXISTS_TAC `u:A->bool`
\r
5308 THEN ASM_REWRITE_TAC[]; ALL_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
5316 THEN EXISTS_TAC `u:A->bool`
\r
5317 THEN ASM_REWRITE_TAC[]);;
\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
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
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
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
5346 THEN REMOVE_THEN "F3" (MP_TAC o SPECL[`u:A->bool`; `u':A->bool`])
\r
5347 THEN ASM_REWRITE_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
5355 THEN USE_THEN "F4" SUBST1_TAC
\r
5356 THEN MATCH_MP_TAC CARD_UNION
\r
5357 THEN ASM_REWRITE_TAC[]);;
\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
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
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
5385 THEN MATCH_MP_TAC CARD_UNION_LE
\r
5386 THEN REWRITE_TAC[EDGE_FINITE]);;
\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
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
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
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
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
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
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
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
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
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
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
5443 THEN SPEC_TAC(`n:num`, `n:num`)
\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
5451 let lemma_edge_exception = prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> edge H x = {x}`,
\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
5457 let lemma_node_exception = prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> node H x = {x}`,
\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
5463 let lemma_face_exception = prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> face H x = {x}`,
\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
5469 let lemma_simple_hypermap = prove(`simple_hypermap (H:(A)hypermap) ==> !x:A. (node H x) INTER (face H x) = {x}`,
\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
5478 (* DOUBLE EDGE WALKUP ALONG A NODE OF SIZE 2 CARRING A PLAIN HYPERMAP TO A PLAIN ONE *)
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
5859 (* WE DEFINE THE MOEBIUS CONTOUR HERE *)
\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
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
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
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
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
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
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
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
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
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
5946 THEN MATCH_MP_TAC CARD_SUBSET
\r
5947 THEN POP_ASSUM (fun th -> REWRITE_TAC[th; hypermap_lemma]));;
\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
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
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
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
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
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
5977 THEN REWRITE_TAC[lemma_point_in_list]
\r
5978 THEN MESON_TAC[]);;
\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
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
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
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
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
6093 let shift_path = new_definition `shift_path (p:num->A) (l:num) = \i:num. p (l + i)`;;
\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
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
6099 THEN REWRITE_TAC[lemma_def_path]
\r
6100 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
6113 THEN REWRITE_TAC[lemma_def_contour]
\r
6114 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
6210 (* Lemma on reducing darts from a contour to make an injective contour *)
\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
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
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
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
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
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
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
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
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
6301 THENL[REWRITE_TAC[SUBSET; IN_SING]
\r
6303 THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM]
\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
6313 THEN EXISTS_TAC `x:A`
\r
6314 THEN ASM_REWRITE_TAC[]);;
\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
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
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
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
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
6353 THENL[REWRITE_TAC[SUBSET; IN_SING]
\r
6355 THEN REWRITE_TAC[set_of_components; set_part_components;IN_ELIM_THM]
\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
6365 THEN EXISTS_TAC `x:A`
\r
6366 THEN REMOVE_THEN "F1" (SUBST1_TAC o SYM)
\r
6367 THEN ASM_REWRITE_TAC[]);;
\r
6370 (* THE MINIMUM HYPERMAP WHICH HAS A MOEBIUS CONTOUR - THE HYPERMAP OF ORDER 3 *)
\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
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
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
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
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
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
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
6485 THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`)
\r
6486 THEN POP_ASSUM(fun th -> REWRITE_TAC[th])
\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
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
6509 THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`)
\r
6510 THEN POP_ASSUM(fun th -> REWRITE_TAC[th])
\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
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
6543 THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`)
\r
6544 THEN POP_ASSUM(fun th -> REWRITE_TAC[th])
\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
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
6588 let dart_face_walkup = prove(`!(H:(A)hypermap) (x:A). dart (face_walkup H x) = (dart H) DELETE x`,
\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
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
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
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
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
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
6621 let dart_node_walkup = prove(`!(H:(A)hypermap) (x:A). dart (node_walkup H x) = (dart H) DELETE x`,
\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
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
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
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
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
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
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
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
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
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
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
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
6736 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))
\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
6742 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))
\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
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
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
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
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
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
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
6845 (* FORMULATE THIS LEMMA FOR f STEP *)
\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
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
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
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
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
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
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
6931 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))))
\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
6937 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))
\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
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
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
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
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
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
7034 (* THE COMBINATORIAL JORDAN CURVE THEOREM *)
\r
7036 let lemmaLIPYTUI = prove(`!(H:(A)hypermap). planar_hypermap H ==> ~(?(p:num->A) k:num. is_Moebius_contour H p k)`,
\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
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
7050 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
7649 (* HERE I DEFINE THE NOTION OF THE LOOP. THIS DEFINITION DOES NOT DEPEND ON THE ORDER OF ITS VERTICES *)
\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
7661 let loop_tybij = new_type_definition "loop"("loop", "tuple_loop") exist_loop;;
\r
7663 let dart_of = new_definition `!L:(A)loop. dart_of L = FST (tuple_loop L)`;;
\r
7665 let next = new_definition `!L:(A)loop. next L = SND (tuple_loop L)`;;
\r
7667 let back = new_definition `!L:(A)loop. back L = inverse (SND (tuple_loop L))`;;
\r
7669 let belong = new_definition `!(L:(A)loop) x:A. x belong L <=> x IN (dart_of L)`;;
\r
7671 let size = new_definition `size (L:(A)loop) = CARD (dart_of L)`;;
\r
7673 let top = new_definition `top (L:(A)loop) = PRE (CARD (dart_of L))`;;
\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
7677 let loop_path = new_definition `!(L:(A)loop) x:A k:num. loop_path L x k = ((next L) POWER k) x`;;
\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
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
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
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
7703 THENL[MESON_TAC[]; ALL_TAC]
\r
7704 THEN REWRITE_TAC[dart_of; next]
\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
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
7721 let lemma_transitive_permutation = prove(`!(L:(A)loop) x:A. x belong L ==> dart_of L = orbit_map (next L) x`,
\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
7731 let lemma_size = prove(`!(L:(A)loop). ~(dart_of L = {}) /\ 0 < size L /\ size L = SUC(top L)`,
\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
7748 let lemma_order_next = prove(`!L:(A)loop. (next L) POWER (size L) = I`,
\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
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
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
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
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
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
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
7791 let lemma_inverse_on_loop = prove(`!L:(A)loop. next L = inverse (back L) /\ back L = inverse (next L)`,
\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
7798 let lemma_inverse_evaluation = prove(`!L:(A)loop x:A. back L (next L x) = x /\ next L (back L x) = x`,
\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
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
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
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
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
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
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
7830 let lemma_loop_index = new_specification["index"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_next_power_representation);;
\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
7834 THEN REWRITE_TAC[belong]
\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
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
7842 let lemma_next_in_loop = prove(`!L:(A)loop x:A. x belong L ==> next L x belong L`,
\r
7844 THEN DISCH_THEN(fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1](SPEC `1` (MATCH_MP lemma_power_next_in_loop th))]));;
\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
7848 THEN REWRITE_TAC[belong]
\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
7853 let lemma_back_in_loop = prove(`!L:(A)loop x:A. x belong L ==> back L x belong L`,
\r
7855 THEN DISCH_THEN(fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1](SPEC `1` (MATCH_MP lemma_power_back_in_loop th))]));;
\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
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
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
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
7890 THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (SUBST1_TAC o CONJUNCT2))
\r
7891 THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
\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
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
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
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
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
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
7927 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
7940 THEN REWRITE_TAC[GSYM SKOLEM_THM]
\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
7951 let lemma_samsara = new_specification["samsara"] (REWRITE_RULE[SKOLEM_THM] lemma_list_next);;
\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
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
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
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
7968 THEN DISCH_THEN (ASSUME_TAC o MATCH_MP samsara_formula)
\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
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
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
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
7997 THEN REWRITE_TAC[EXISTS_UNIQUE_THM]
\r
7998 THEN ASM_CASES_TAC `~(y:A IN s:A->bool)`
\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
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
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
8056 let lemma_back_index = prove(`!n:num i:num. 0 < i /\ i <= n ==> (i + n) MOD (SUC n) = PRE i`,
\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
8065 let lemma_suc_mod = prove(`!m:num n:num. ~(n = 0) ==> SUC (m MOD n) MOD n = SUC m MOD n`,
\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
8074 let lemma_from_index = prove(`!n:num j:num. j <= n ==> SUC ((j + n) MOD SUC n) MOD SUC n = j`,
\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
8082 let lemma_from_index2 = prove(`!n:num i:num. i <= n ==> (((SUC i MOD SUC n) + n) MOD SUC n) = i`,
\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
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
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
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
8112 THEN POP_ASSUM(fun th-> REWRITE_TAC[MATCH_MP lemma_from_index th]));;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
8198 (*******************************************************************************************************************************)
\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
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
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
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
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
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
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
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
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
8429 (* Some facts about face_loop, node_loop and their injective contours *)
\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
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
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
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
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
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
8449 THEN DISCH_THEN (LABEL_TAC "F1")
\r
8450 THEN REWRITE_TAC[orbit_map;GE; LE_0; EXTENSION; IN_ELIM_THM]
\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
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
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
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
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
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
8485 let lemma_node_inverse_cycle = prove(`!(H:(A)hypermap) (x:A). ((inverse (node_map H)) POWER (CARD (node H x))) x = x`,
\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
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
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
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
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
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
8520 THEN DISCH_THEN (MP_TAC o REWRITE_RULE[node_contour] o MATCH_MP lemma_node_contour_connection) THEN MESON_TAC[]);;
\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
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
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
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
8612 THEN POP_ASSUM MP_TAC
\r
8613 THEN POP_ASSUM (SUBST1_TAC o SYM)
\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
8627 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G20") (LABEL_TAC "G21"))
\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
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
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
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
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
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
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
8759 THENL[POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[GSYM node_map_inverse_representation])
\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
8770 THENL[POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[GSYM node_map_inverse_representation])
\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
8791 (************ GENERATION PART *****************)
\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
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
8799 (* Intuitively, a loop is partitioned by atoms *)
\r
8801 let atom_reflect = prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). x IN atom H L x`,
\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
8807 THEN DISCH_THEN SUBST1_TAC
\r
8808 THEN REWRITE_TAC[POWER_0; I_THM]);;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
8925 THEN REWRITE_TAC[atom; IN_ELIM_THM]
\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
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
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
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
8947 THEN MATCH_MP_TAC SUBSET_ANTISYM
\r
8949 THENL[REWRITE_TAC[atom; SUBSET; IN_ELIM_THM; IN_SING]
\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
8961 THEN DISCH_THEN SUBST1_TAC
\r
8962 THEN REWRITE_TAC[atom_reflect]);;
\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
8966 THEN REWRITE_TAC[atom; SUBSET; IN_ELIM_THM]
\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
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
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
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
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
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
9003 THEN MATCH_MP_TAC SUBSET_ANTISYM
\r
9005 THENL[REWRITE_TAC[SUBSET; IN_ELIM_THM]
\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
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
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
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
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
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
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
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
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
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
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
9066 THEN REWRITE_TAC [GSYM SKOLEM_THM]
\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
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
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
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
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
9137 (* The definition of quotient hypermaps *)
\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
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
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
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
9155 let support_darts = new_definition `!(NF:(A)loop->bool). support_darts NF = UNIONS {dart_of (L:(A)loop) | L IN NF}`;;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
9234 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") MP_TAC)
\r
9235 THEN SPEC_TAC (`n:num`, `n:num`)
\r
9237 THENL[REWRITE_TAC[POWER_0; I_THM] THEN SIMP_TAC[]; ALL_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
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
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
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
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
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
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
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
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
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
9293 THEN REWRITE_TAC[GSYM SKOLEM_THM]
\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
9318 let lemma_choice = new_specification ["choice"] (REWRITE_RULE[SKOLEM_THM] lemma_choice_function);;
\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
9323 THEN DISCH_THEN (LABEL_TAC "F1")
\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
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
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
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
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
9348 let lemma_finite_quotient_darts = prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> FINITE (quotient_darts H NF)`,
\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
9354 THEN REWRITE_TAC[GSYM EXTENSION]
\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
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
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
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
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
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
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
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
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
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
9445 let lemma_head_tail = new_specification ["head"; "tail"] (REWRITE_RULE[SKOLEM_THM] lemma_border_of_atom2);;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
9674 THEN MATCH_MP_TAC lemma_map_next
\r
9675 THEN EXISTS_TAC `NF:(A)loop->bool`
\r
9676 THEN ASM_REWRITE_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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
9990 THEN REWRITE_TAC[is_node_going]
\r
9991 THEN EXISTS_TAC `m:num`
\r
9992 THEN ASM_SIMP_TAC[]);;
\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
9997 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
10189 THEN REWRITE_TAC[GSYM SKOLEM_THM]
\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
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
10212 THEN REWRITE_TAC[GSYM SKOLEM_THM]
\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
10234 let lemma_face_map = new_specification ["fmap"] (REWRITE_RULE[SKOLEM_THM] lemma_fmap);;
\r
10236 let lemma_node_map = new_specification ["nmap"] (REWRITE_RULE[SKOLEM_THM] lemma_nmap);;
\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
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
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
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
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
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
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
10285 THEN DISCH_THEN (LABEL_TAC "F1")
\r
10286 THEN REWRITE_TAC[permutes]
\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
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
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
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
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
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
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
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
10362 THEN DISCH_THEN (LABEL_TAC "F1")
\r
10363 THEN REWRITE_TAC[permutes]
\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
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
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
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
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
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
10481 (* THE DEFINITION OF THE QUOTION HYPERMAP *)
\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
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
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
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
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
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
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
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
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
10549 THEN DISCH_THEN (LABEL_TAC "F1")
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
10687 (* The definition of isomorphic hypermaps *)
\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
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
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
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
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
10716 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\r
10717 THEN REWRITE_TAC[SURJ; o_THM]
\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
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
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
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
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
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
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
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
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
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
10791 let iso_sym = prove(`!(H:(A)hypermap) (G:(B)hypermap). H iso G ==> G iso H`,
\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
10800 THEN DISCH_THEN (LABEL_TAC "F5")
\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
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
10834 let iso_trans = prove(`!(H:(A)hypermap) (G:(B)hypermap) (W:(C)hypermap). H iso G /\ G iso W ==> H iso W`,
\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
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
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
10859 (* DESCRIBE FACES OF QUOTIENT HYPERMAPS - This is definition of F(L) in the blueprint *)
\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
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
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
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
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
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
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
10931 THENL[REPEAT STRIP_TAC THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[POWER_0; I_THM]; ALL_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
10944 THEN REWRITE_TAC[cycle; orbit_map; IN_ELIM_THM; GE; LE_0]
\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
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
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
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
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
10966 THEN DISCH_THEN (LABEL_TAC "F1")
\r
10967 THEN REWRITE_TAC[EXTENSION; face_set; set_of_orbits; IN_ELIM_THM]
\r
10969 THEN REWRITE_TAC[GSYM EXTENSION]
\r
10970 THEN USE_THEN "F1"(fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th])
\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
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
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
10990 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\r
10991 THEN REWRITE_TAC[EXTENSION; IN_UNIONS; GSYM belong]
\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
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
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
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
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
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
11020 let lemma_sub_support = prove(`!s:(A->bool)->bool t:A->bool. t IN s ==> t SUBSET (UNIONS s)`, SET_TAC[]);;
\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
11025 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
11050 (* DESCRIBE NODES OF QUOTIENT HYPERMAPS *)
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
11178 THEN REWRITE_TAC[GSYM EXTENSION]
\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
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
11206 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
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
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
11229 (* The definition of face collections *)
\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
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
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
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
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
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
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
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
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
11278 THEN REWRITE_TAC[COM_POWER; o_THM]
\r
11279 THEN ASM_REWRITE_TAC[res]);;
\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
11283 let face_collection = new_definition `!H:(A)hypermap. face_collection H = {face_loop H x |x:A| x IN dart H}`;;
\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
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
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
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
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
11324 let face_loop_lemma = prove(`!(H:(A)hypermap) x:A. is_loop H (face_loop H x)`,
\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
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
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
11337 THEN REWRITE_TAC[is_normal]
\r
11338 THEN DISCH_THEN (LABEL_TAC "F2")
\r
11341 THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong]
\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
11349 THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong]
\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
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
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
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
11388 let lemma_support_face_collection = prove(`!(H:(A)hypermap). support_darts (face_collection H) = dart H`,
\r
11390 THEN REWRITE_TAC[EXTENSION]
\r
11392 THEN REWRITE_TAC[lemma_in_support]
\r
11393 THEN REWRITE_TAC[face_collection; IN_ELIM_THM]
\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
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
11407 let lemma_card_face_collection = prove(`!(H:(A)hypermap). FINITE (face_collection H) /\ CARD (face_collection H) = number_of_faces H`,
\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
11412 THEN REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]
\r
11413 THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_face_representation)
\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
11424 THENL[REWRITE_TAC[set_of_orbits; IN_ELIM_THM]
\r
11425 THEN REWRITE_TAC[GSYM face]
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
11504 let SING_EQ = prove(`!x:A y:A. {x} = {y} <=> x = y`, SET_TAC[]);;
\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
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
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
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
11575 THENL[REWRITE_TAC[BIJ]
\r
11577 THENL[REWRITE_TAC[INJ]
\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
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
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
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
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
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
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
11640 let set_one_point = prove(`!s:A->bool x:A. FINITE s /\ CARD s = 1 /\ x IN s ==> s = {x}`,
\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
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
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
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
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
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
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
11715 THEN REWRITE_TAC[cycle; IN_ELIM_THM]
\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
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
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
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
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
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
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
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
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
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
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
11868 (* Cyclic hypermaps *)
\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
11873 THEN REWRITE_TAC[GSYM SKOLEM_THM]
\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
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
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
11900 THEN REWRITE_TAC[GSYM SKOLEM_THM]
\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
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
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
11927 THEN REWRITE_TAC[GSYM SKOLEM_THM]
\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
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
11951 let lemma_cyclic_edge_map = new_specification ["cyc_emap"] (REWRITE_RULE[SKOLEM_THM] edge_cyclic_map_lemma);;
\r
11953 let lemma_cyclic_node_map = new_specification ["cyc_nmap"] (REWRITE_RULE[SKOLEM_THM] node_cyclic_map_lemma);;
\r
11955 let lemma_cyclic_face_map = new_specification ["cyc_fmap"] (REWRITE_RULE[SKOLEM_THM] face_cyclic_map_lemma);;
\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
11960 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))
\r
11962 THEN DISCH_THEN (LABEL_TAC "F4")
\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
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
11991 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))
\r
11993 THEN DISCH_THEN (LABEL_TAC "F4")
\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
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
12022 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))
\r
12024 THEN DISCH_THEN (LABEL_TAC "F4")
\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
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
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
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
12065 THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]
\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
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
12083 THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]
\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
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
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
12107 THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]
\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
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
12123 THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]
\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
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
12138 THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]
\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
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
12156 THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM]
\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
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
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
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
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
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
12197 THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_from_index th]));;
\r
12200 (* no double joints *)
\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
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
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
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
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
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
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
12279 THEN DISCH_THEN (LABEL_TAC "F1")
\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
12302 THEN MATCH_MP_TAC SUBSET_ANTISYM
\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
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
12327 THEN DISCH_THEN SUBST1_TAC
\r
12328 THEN REWRITE_TAC[IN_INTER; node_refl; face_refl]
\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
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
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
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
12404 (* Complementary contours and complementary contour loops - name: complement. Only for face contours *)
\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
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
12412 let complement = new_definition `!H:(A)hypermap x:A n:num. complement H x n = mirror H x n n`;;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
12570 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
12748 THENL[DISJ1_TAC THEN POP_ASSUM SUBST1_TAC
\r
12749 THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]); ALL_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
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
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
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
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
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
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
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
12922 (* Restricted hypermap *)
\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
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
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
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
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
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
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
12959 let GET_EDGE_NONDEGENERATE hpmap = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap))))))));;
\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
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
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
12974 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2" o GET_EDGE_NONDEGENERATE) (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F3")))
\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
13007 let GET_SIMPLE_PROPERTY hpmap = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap))))));;
\r
13009 let GET_NODE_NONDEGENERATE hpmap
\r
13010 = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap)))))))));;
\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
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
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
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
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
13055 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")))
\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
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
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
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
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
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
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
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
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
13123 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
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
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
13144 THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))
\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
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
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
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
13179 THEN DISCH_THEN (LABEL_TAC "F1")
\r
13180 THEN USE_THEN "F1" (LABEL_TAC "F2" o CONJUNCT2)
\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
13203 (* the condition which neeeds to split a loop into two other special loops *)
\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
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
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
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
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
13239 let lemma_mInside = new_specification["mInside"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_mInside_Exists);;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
13339 let CONJ3 th1 th2 th3 = (CONJ th1 (CONJ th2 th3));;
\r
13341 let CONJ4 th1 th2 th3 th4 = (CONJ th1 (CONJ th2 (CONJ th3 th4)));;
\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
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
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
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
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
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
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
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
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
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
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
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
13526 let lemma_mAdd = new_specification["mAdd"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_mAdd_Exists);;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
13991 let lemma_route = new_specification["mRoute"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_route_exists);;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
14315 let lemma_in_couple = prove(`!x:A a:A b:A. x IN {a, b} <=> x = a \/ x = b`, SET_TAC[]);;
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
14983 THENL[GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple]
\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
15004 THENL[GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple]
\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
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
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
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
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
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
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
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
15254 (* Atoms of dnax *)
\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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
15863 let lemma_card_inverse_map_eq = lemma_orbit_inverse_map_eq;;
\r
15866 prioritize_real();;
\r