(* ========================================================================== *)
(* FLYSPECK - BOOK FORMALIZATION                                              *)
(*                                                                            *)
(* Chapter: Hypermap                                                          *)
(* Author: Tran Nam Trung                                                     *)
(* Date: 2010-02-09                                                           *)
(* ========================================================================== *)


module type Hypermap_type = sig

end;;

(* needs "Library/permutations.ml";; *)

module Hypermap (* : Hypermap_type *) = struct

prioritize_num();;


parse_as_infix("POWER",(24,"right"));;

parse_as_infix("belong",(11,"right"));;

parse_as_infix("iso",(24,"right"));;
 
(* The definition of the nth exponent of a map *)

  let EQ_SUC = SUC_INJ;; (* Harrison eliminated EQ_SUC because it duplicates SUC_INJ *)


let POWER = new_recursive_definition num_RECURSION 
  `(!(f:A->A). f POWER 0  = I) /\  
   (!(f:A->A) (n:num). f POWER (SUC n) = (f POWER n) o f)`;;
let POWER_0 = 
prove(`!f:A->A. f POWER 0 = I`,
REWRITE_TAC[POWER]);;
let POWER_1 = 
prove(`!f:A->A. f POWER 1 = f`,
REWRITE_TAC[POWER; ONE; I_O_ID]);;
let POWER_2 = 
prove(`!f:A->A. f POWER 2 = f o f`,
REWRITE_TAC[POWER; TWO; POWER_1]);;
let orbit_map = new_definition `orbit_map (f:A->A)  (x:A) = {(f POWER n) x | n >= 0}`;;
let ASM_ASM_SET_TAC = ASSUM_LIST (MP_TAC o end_itlist CONJ) THEN SET_TAC[];;
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}`,
REPEAT STRIP_TAC THEN ASM_ASM_SET_TAC);;
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)`,
REPEAT GEN_TAC THEN EQ_TAC THENL[STRIP_TAC THEN STRIP_TAC THENL[REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num`) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= n:num ==> i <= SUC n`) th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `SUC n`) THEN SIMP_TAC[]; ALL_TAC] THEN STRIP_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `i:num = SUC n` THENL[POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE; LT_SUC_LE] THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `i:num` o check (is_forall o concl)) THEN ASM_REWRITE_TAC[]);;
let lemma_sub_part = 
prove(`!P. !n:num m:num. (!i:num. i <= n ==> P i) /\ m <= n ==> (!i:num. i <= m ==> P i)`,
REPEAT STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `i:num`) THEN POP_ASSUM (fun th1-> POP_ASSUM (fun th2-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th1 th2)])));;
(* the definition of hypermap *)
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 `({},I,I,I):(A->bool)#(A->A)#(A->A)#(A->A)` THEN REWRITE_TAC[FINITE_RULES; PERMUTES_I; I_O_ID]);;
let hypermap_tybij = (new_type_definition "hypermap" ("hypermap", "tuple_hypermap")exist_hypermap);;
let dart = new_definition `dart (H:(A)hypermap) = FST (tuple_hypermap H)`;;
let edge_map = new_definition `edge_map (H:(A)hypermap) = FST(SND(tuple_hypermap H))`;;
let node_map = new_definition `node_map (H:(A)hypermap) = FST(SND(SND(tuple_hypermap H)))`;;
let face_map = new_definition `face_map (H:(A)hypermap) = SND(SND(SND(tuple_hypermap H)))`;;
let hypermap_lemma = 
prove(`!H:(A)hypermap. FINITE (dart H) /\ edge_map H permutes dart H /\ node_map H permutes dart H /\ face_map H permutes dart H /\ edge_map H o node_map H o face_map H = I`,
ASM_REWRITE_TAC[hypermap_tybij;dart;edge_map; node_map; face_map]);;
(* some technical lemmas *)
let edge_map_and_darts = 
prove(`!(H:(A)hypermap). FINITE (dart H) /\ edge_map H permutes (dart H)`,
REWRITE_TAC[hypermap_lemma]);;
let node_map_and_darts = 
prove(`!(H:(A)hypermap). FINITE (dart H) /\ node_map H permutes (dart H)`,
REWRITE_TAC[hypermap_lemma]);;
let face_map_and_darts = 
prove(`!(H:(A)hypermap). FINITE (dart H) /\ face_map H permutes (dart H)`,
REWRITE_TAC[hypermap_lemma]);;
(* edges, nodes and faces of a hypermap *)
let edge = new_definition `edge (H:(A)hypermap) (x:A) = orbit_map (edge_map H) x`;;
let node = new_definition `node (H:(A)hypermap) (x:A) = orbit_map (node_map H) x`;;
let face = new_definition `face (H:(A)hypermap) (x:A) = orbit_map (face_map H) x`;;
(* We define the combinatorial component *)
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)`;;
let is_path = new_recursive_definition num_RECURSION  `(is_path (H:(A)hypermap) (p:num->A) 0 <=> T)/\
(is_path (H:(A)hypermap) (p:num->A) (SUC n) <=> ((is_path H p n) /\ go_one_step H (p n) (p (SUC n))))`;;
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`;;
let comb_component = new_definition `comb_component (H:(A)hypermap) (x:A) = {y:A| is_in_component H x y}`;;
(* some definitions on orbits *)
let set_of_orbits = new_definition `set_of_orbits (D:A->bool) (f:A->A) = {orbit_map f x | x IN D}`;;
let number_of_orbits = new_definition `number_of_orbits (D:A->bool) (f:A->A) = CARD(set_of_orbits D f)`;;
(* the orbits on hypermaps*)
let edge_set = new_definition `edge_set (H:(A)hypermap) = set_of_orbits (dart H) (edge_map H)`;;
let node_set = new_definition `node_set  (H:(A)hypermap) = set_of_orbits (dart H) (node_map H)`;;
let face_set = new_definition `face_set (H:(A)hypermap) = set_of_orbits (dart H) (face_map H)`;;
let set_components = new_definition `set_components (H:(A)hypermap) (D:A->bool) = {comb_component H (x:A) | x IN D}`;;
let set_part_components = new_definition `set_part_components (H:(A)hypermap) (D:A->bool) = {(comb_component H (x:A)) | x IN D}`;;
let set_of_components = new_definition `set_of_components (H:(A)hypermap) = set_part_components H (dart H)`;;
(* counting the numbers of edges, nodes, faces and combinatorial components *)
let number_of_edges = new_definition `number_of_edges (H:(A)hypermap) = CARD (edge_set H)`;;
let number_of_nodes = new_definition `number_of_nodes (H:(A)hypermap) = CARD (node_set H)`;;
let number_of_faces = new_definition `number_of_faces (H:(A)hypermap) = CARD (face_set H)`;;
let number_of_components = new_definition `number_of_components (H:(A)hypermap) = CARD (set_of_components H)`;;
(* some special kinds of hypergraphs *)
let plain_hypermap = new_definition `plain_hypermap (H:(A)hypermap) <=> edge_map H o edge_map H = I`;;
let planar_hypermap = new_definition `planar_hypermap (H:(A)hypermap) <=>
    number_of_nodes H + number_of_edges H + number_of_faces H 
    = (CARD (dart H)) + 2 * number_of_components H`;;
let simple_hypermap = new_definition `simple_hypermap (H:(A)hypermap) <=>
    (!x:A. x IN dart H ==> (node H x) INTER (face H x) = {x})`;;
(* a dart x is degenerate or nondegenerate *)
let dart_degenerate = new_definition `dart_degenerate (H:(A)hypermap) (x:A)  
   <=> (edge_map H x = x \/ node_map H x = x \/ face_map H x = x)`;;
let dart_nondegenerate = new_definition `dart_nondegenerate (H:(A)hypermap) (x:A) 
   <=> ~(edge_map H x = x) /\ ~(node_map H x = x) /\ ~(face_map H x = x)`;;
let is_edge_nondegenerate = new_definition `is_edge_nondegenerate (H:(A)hypermap) <=> (!x:A. x IN dart H ==> ~(edge_map H x = x))`;;
let is_node_nondegenerate = new_definition `is_node_nondegenerate (H:(A)hypermap) <=> (!x:A. x IN dart H ==> ~(node_map H x = x))`;;
let is_face_nondegenerate = new_definition `is_face_nondegenerate (H:(A)hypermap) <=> (!x:A. x IN dart H ==> ~(face_map H x = x))`;;
(* some relationships of maps and orbits of maps *)
let LEFT_MULT_MAP = 
prove(`!u:A->A v:A->A w:A->A. v = w ==> u o v = u o w`,
MESON_TAC[]);;
let RIGHT_MULT_MAP = 
prove(`!u:A->A v:A->A w:A->A. u = v ==> u o w = v o w`,
MESON_TAC[]);;
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`,
REPEAT STRIP_TAC THEN SUBGOAL_THEN `inverse (u:A->A) o u o (v:A->A) = inverse u o (w:A->A)` MP_TAC THENL[ ASM_MESON_TAC[]; REWRITE_TAC[o_ASSOC] THEN ASM_MESON_TAC[PERMUTES_INVERSES_o; I_O_ID]]);;
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`,
REPEAT STRIP_TAC THEN SUBGOAL_THEN `(u:A->A) o (v:A->A) o inverse v = (w:A->A) o inverse v` MP_TAC THENL [ASM_MESON_TAC[o_ASSOC]; ASM_MESON_TAC[PERMUTES_INVERSES_o;I_O_ID]]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP PERMUTES_IN_IMAGE) THEN INDUCT_TAC THENL[GEN_TAC THEN REWRITE_TAC[POWER; I_THM]; REPEAT GEN_TAC THEN REWRITE_TAC[POWER; o_DEF] THEN ASM_MESON_TAC[]]);;
let orbit_subset = 
prove(`!(s:A->bool) (u:A->A). u permutes s ==> !(x:A). x IN s ==> (orbit_map u x) SUBSET s`,
REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; orbit_map; IN_ELIM_THM] THEN ASM_MESON_TAC[iterate_orbit]);;
let COM_POWER = 
prove(`!(n:num) (f:A->A). f POWER (SUC n) = f o (f POWER n)`,
INDUCT_TAC THENL[REWRITE_TAC [ONE; POWER;I_O_ID]; ALL_TAC] THEN REPEAT STRIP_TAC THEN POP_ASSUM(ASSUME_TAC o GSYM o (ISPEC `f:A->A`)) THEN ASM_REWRITE_TAC[POWER; o_ASSOC]);;
let COM_POWER_FUNCTION = 
prove(`!f:A->A x:A n:num. f ((f POWER n) x) = (f POWER (SUC n)) x`,
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]);;
let POWER_FUNCTION = 
prove(`!f:A->A x:A n:num. (f POWER n) (f x) = (f POWER (SUC n)) x`,
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]);;
let addition_exponents = 
prove(`!m n (f:A->A). f POWER (m + n) = (f POWER m) o (f POWER n)`,
INDUCT_TAC THENL [STRIP_TAC THEN REWRITE_TAC[ADD; POWER; I_O_ID]; ALL_TAC] THEN POP_ASSUM(ASSUME_TAC o GSYM o (ISPECL[`n:num`;`f:A->A`])) THEN REWRITE_TAC[COM_POWER; GSYM o_ASSOC] THEN ASM_REWRITE_TAC[COM_POWER; GSYM o_ASSOC; ADD]);;
let multiplication_exponents = 
prove(`!m n (f:A->A). f POWER (m * n) = (f POWER n) POWER m`,
INDUCT_TAC THENL [STRIP_TAC THEN REWRITE_TAC[MULT; POWER; I_O_ID]; ALL_TAC] THEN REPEAT GEN_TAC THEN POP_ASSUM(ASSUME_TAC o (SPECL[`n:num`; `f:A->A`])) THEN ASM_REWRITE_TAC[MULT; addition_exponents; POWER]);;
let power_unit_map = 
prove(`!n f:A->A. f POWER n = I ==> !m. f POWER (m * n) = I`,
REPLICATE_TAC 3 STRIP_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[MULT; POWER]; REWRITE_TAC[MULT; addition_exponents] THEN ASM_REWRITE_TAC[I_O_ID]]);;
let power_map_fix_point = 
prove(`!n f:A->A x:A. (f POWER n) x = x ==> !m. (f POWER (m * n)) x = x`,
REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [REWRITE_TAC[MULT; POWER; I_THM]; REWRITE_TAC[MULT; addition_exponents; o_DEF] THEN ASM_REWRITE_TAC[]]);;
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)`,
REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL[`m:num`;`n:num`; `p:A->A`] addition_exponents) THEN POP_ASSUM (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN REWRITE_TAC[o_THM]);;
let iterate_map_valuation = 
prove(`!(p:A->A) (n:num) (x:A). p ((p POWER n) x) = (p POWER (SUC n)) x`,
REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL[`n:num`; `p:A->A`] (GSYM COM_POWER)) THEN POP_ASSUM (fun th -> (MP_TAC (AP_THM th `x:A`))) THEN REWRITE_TAC[o_THM]);;
let iterate_map_valuation2 = 
prove(`!(p:A->A) (n:num) (x:A). (p POWER n) (p x) = (p POWER (SUC n)) x`,
REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL[`p:A->A`; `n:num`] (CONJUNCT2 POWER)) THEN POP_ASSUM (fun th -> (MP_TAC (AP_THM th `x:A`))) THEN REWRITE_TAC[o_THM; EQ_SYM]);;
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`,
REPEAT STRIP_TAC THEN REWRITE_TAC[orbit_map;IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[ARITH_RULE `n:num >= 0`]);;
let lemma_in_orbit = 
prove(`!f:A->A n:num x:A. (f POWER n) x IN orbit_map f x`,
REPEAT STRIP_TAC THEN REWRITE_TAC[orbit_map;IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_0; GE]);;
let orbit_one_point = 
prove(`!f:A->A x:A. f x = x <=> orbit_map f x = {x}`,
REPEAT GEN_TAC THEN EQ_TAC THENL[STRIP_TAC THEN REWRITE_TAC[EXTENSION;IN_SING] THEN GEN_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN EQ_TAC THENL[STRIP_TAC THEN MP_TAC(SPECL[`1`; `f:A->A`; `x:A`] power_map_fix_point) THEN ASM_REWRITE_TAC[POWER_1;MULT_CLAUSES] THEN DISCH_THEN (ASSUME_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC [ARITH_RULE `0 >= 0`; POWER; I_THM]; ALL_TAC] THEN STRIP_TAC THEN MP_TAC (SPECL[`f:A->A`; `1`; `(x:A)`; `(f:A->A) (x:A)`] in_orbit_lemma) THEN ASM_REWRITE_TAC[POWER_1; IN_SING]);;
let lemma_orbit_finite = 
prove(`!(s:A->bool) (p:A->A) (x:A). FINITE s /\ p permutes s ==> FINITE (orbit_map p x)`,
REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:A IN s:A->bool` THENL[REPEAT STRIP_TAC THEN UNDISCH_THEN `(p:A->A) permutes (s:A->bool)` (MP_TAC o SPEC `x:A` o MATCH_MP orbit_subset) THEN ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN SUBGOAL_THEN `(p:A->A) x:A = x:A` MP_TAC THENL[ASM_MESON_TAC[permutes]; ALL_TAC] THEN ONCE_REWRITE_TAC[orbit_one_point] THEN DISCH_THEN SUBST1_TAC THEN ASSUME_TAC (CONJUNCT1 CARD_CLAUSES) THEN ASSUME_TAC (CONJUNCT1 FINITE_RULES) THEN MP_TAC(SPECL[`x:A`;`{}:A->bool`] (CONJUNCT2 FINITE_RULES)) THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ARITH_TAC);;
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}`,
REPEAT STRIP_TAC THEN REWRITE_TAC[orbit_map; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIND_ASSUM (MP_TAC o (SPEC `n:num`) o MATCH_MP DIVMOD_EXIST) `~(m:num = 0)` THEN REPEAT STRIP_TAC 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) THEN ASM_REWRITE_TAC[ADD_SYM; addition_exponents; o_DEF] THEN EXISTS_TAC `r:num` THEN ASM_SIMP_TAC[]; REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `k:num` THEN SIMP_TAC[LE_0; GE]]);;
(* Some obviuos facts about common hypermap maps *)
let power_permutation = 
prove(`!(s:A->bool) (p:A->A). p permutes s ==> !(n:num). (p POWER n) permutes s`,
REPLICATE_TAC 3 STRIP_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[POWER; PERMUTES_I]; REWRITE_TAC[POWER] THEN ASM_MESON_TAC[PERMUTES_COMPOSE]]);;
let inverse_function = 
prove( `!s:A->bool p:A->A x:A y:A. p permutes s /\ p x = y ==> x = (inverse p) y`,
REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o AP_TERM `inverse (p:A->A)`) THEN STRIP_TAC THEN MP_TAC (ISPECL[`inverse(p:A->A)`; `p:A->A`; `x:A`] o_THM) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (ASSUME_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[I_THM]);;
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]);;
let lemma_power_inverse_map = 
prove(`!s:A->bool p:A->A n:num. p permutes s ==> ((inverse p) POWER n) o (p POWER n) = I /\ (p POWER n) o ((inverse p) POWER n) = I`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN SUBGOAL_THEN `((p:A->A) POWER (n:num)) o ((inverse p) POWER n) = I` (LABEL_TAC "F2") THENL[SPEC_TAC(`n:num`, `n:num`) THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_O_ID]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [COM_POWER] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [POWER] THEN REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[lemma_4functions] THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[I_O_ID] THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th]); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "F1" (LABEL_TAC "F1" o SPEC `n:num` o MATCH_MP power_permutation) THEN USE_THEN "F1" (fun th -> (REMOVE_THEN "F2" (fun th2 -> (MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ th th2)))))) THEN DISCH_THEN (SUBST1_TAC o REWRITE_RULE[I_O_ID]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th]));;
let lemma_power_inverse = 
prove(`!s:A->bool p:A->A n:num. p permutes s ==> (inverse p) POWER n = inverse (p POWER n) /\ inverse ((inverse p) POWER n) = p POWER n`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (LABEL_TAC "F2" o SPEC `n:num` o MATCH_MP power_permutation) THEN SUBGOAL_THEN `(inverse (p:A->A)) POWER (n:num) = inverse (p POWER n)` ASSUME_TAC THENL[REMOVE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `n:num` o MATCH_MP lemma_power_inverse_map) THEN DISCH_THEN (fun th1 -> (POP_ASSUM (fun th -> MP_TAC (MATCH_MP RIGHT_INVERSE_EQUATION (CONJ th th1))))) THEN REWRITE_TAC[I_O_ID]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN USE_THEN "F2" (fun th ->REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_INVERSE th]));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (ASSUME_TAC o SPEC `n:num` o MATCH_MP power_permutation) THEN POP_ASSUM (MP_TAC o SPECL[`x:A`; `y:A`] o MATCH_MP PERMUTES_INVERSE_EQ) THEN POP_ASSUM (SUBST1_TAC o SYM o CONJUNCT1 o SPEC `n:num` o MATCH_MP lemma_power_inverse) THEN MESON_TAC[]);;
let edge_map_inverse_representation = 
prove(`!(H:(A)hypermap) (x:A) (y:A). y = edge_map H x <=> x = inverse (edge_map H) y`,
REPEAT GEN_TAC THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INVERSE_EQ (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))) THEN MESON_TAC[EQ_SYM]);;
let node_map_inverse_representation = 
prove(`!(H:(A)hypermap) (x:A) (y:A). y = node_map H x <=> x = inverse (node_map H) y`,
REPEAT GEN_TAC THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INVERSE_EQ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))))) THEN MESON_TAC[EQ_SYM]);;
let face_map_inverse_representation = 
prove(`!(H:(A)hypermap) (x:A) (y:A). y = face_map H x <=> x = inverse (face_map H) y`,
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)))))))) THEN MESON_TAC[EQ_SYM]);;
let edge_map_injective = 
prove(`!(H:(A)hypermap) (x:A) (y:A). edge_map H x = edge_map H y <=> x = y`,
REPEAT GEN_TAC THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INJECTIVE (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))) THEN MESON_TAC[EQ_SYM]);;
let node_map_injective = 
prove(`!(H:(A)hypermap) (x:A) (y:A). node_map H x = node_map H y <=> x = y`,
REPEAT GEN_TAC THEN MP_TAC (GSYM(SPECL[`x:A`; `y:A`] (MATCH_MP PERMUTES_INJECTIVE (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))))) THEN MESON_TAC[EQ_SYM]);;
let face_map_injective = 
prove(`!(H:(A)hypermap) (x:A) (y:A). face_map H x = face_map H y <=> x = y`,
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)))))))) THEN MESON_TAC[EQ_SYM]);;
(* Some label_TAC *) let label_4Gs_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2(LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4"))) th;; 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);; 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);; 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);; let label_strip3A_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "A1") (CONJUNCTS_THEN2(LABEL_TAC "A2")(LABEL_TAC "A3")) th;; (* Darts and its images under edge_map, node_map and face_map *)
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`,
REPEAT GEN_TAC THEN label_hypermap4_TAC `H:(A)hypermap` THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[MATCH_MP iterate_orbit (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[MATCH_MP iterate_orbit (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))]);;
let lemma_dart_inveriant_under_inverse_maps = 
prove(`!(H:(A)hypermap) x:A. x IN dart H ==> inverse(edge_map H) x IN dart H /\ inverse(node_map H) x IN dart H /\ inverse(face_map H) x IN dart H`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN MP_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` edge_map_and_darts))) 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)))])) THEN MP_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))) 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)))])) THEN MP_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))) 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)))])));;
(* Some lemmas on the cardinality of finite series *)
let IMAGE_SEG = 
prove(`!(n:num) (f:num->A). IMAGE f {i:num | i < n:num} = {f (i:num) | i < n}`,
REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN SET_TAC[]);;
let FINITE_SERIES = 
prove(`!(n:num) (f:num->A). FINITE {f(i) | i < n}`,
REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SYM(SPECL[`n:num`; `f:num->A`] IMAGE_SEG)] THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT]);;
let CARD_FINITE_SERIES_LE  = 
prove(`!(n:num) (f:num->A). CARD {f(i) | i < n} <= n`,
REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SYM(SPECL[`n:num`; `f:num->A`] IMAGE_SEG)] THEN MP_TAC(ISPEC `f:num ->A` (MATCH_MP CARD_IMAGE_LE (SPEC `n:num` FINITE_NUMSEG_LT))) THEN REWRITE_TAC[CARD_NUMSEG_LT]);;
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)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LT THEN STRIP_TAC THENL[ARITH_TAC; ALL_TAC] THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LT THEN STRIP_TAC THENL[ARITH_TAC; ALL_TAC] THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1" o MATCH_MP LEMMA_INJ) THEN ONCE_REWRITE_TAC[GSYM IMAGE_SEG] THEN GEN_REWRITE_TAC(RAND_CONV o ONCE_DEPTH_CONV) [GSYM (SPEC `n:num` CARD_NUMSEG_LT)] THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN REWRITE_TAC[FINITE_NUMSEG_LT] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]);;
let LM_AUX = 
prove(`!m n. m < n ==> ?k. ~(k = 0) /\ n = m + k`,
REPEAT GEN_TAC THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` ASSUME_TAC) THEN EXISTS_TAC `SUC d` THEN ASM_REWRITE_TAC[ARITH_RULE `~(SUC d = 0)`]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c1") (MP_TAC)) THEN REWRITE_TAC[addition_exponents] THEN DISCH_TAC THEN REMOVE_THEN "c1" (ASSUME_TAC o (SPEC `m:num`) o MATCH_MP power_permutation) 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) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(MP_TAC o CONJUNCT2 o (MATCH_MP PERMUTES_INVERSES_o)) THEN SIMP_TAC[]);;
let lemma_sub_two_numbers = 
prove(`!m:num n:num p:num. m - n - p = m - (n + p)`,
ARITH_TAC);;
let NON_ZERO = 
prove(`!n:num. ~(SUC n = 0)`,
REWRITE_TAC[GSYM LT_NZ; LT_0]);;
let LT1_NZ = 
prove(`!n:num. 1 <= n <=> 0 < n`,
ARITH_TAC);;
let GE_1 = 
prove(`!n:num. 1 <= SUC n`,
REWRITE_TAC[LT1_NZ; LT_NZ; NON_ZERO]);;
let LT_PLUS = 
prove(`!n:num. n < SUC n`,
ARITH_TAC);;
let LE_PLUS = 
prove(`!n:num. n <= SUC n`,
ARITH_TAC);;
let LT_SUC_PRE = 
prove(`!n:num. 0 < n ==> n = SUC(PRE n)`,
ARITH_TAC);;
let LE_SUC_PRE = 
prove(`!n:num. 1 <= n ==> SUC(PRE n) = n`,
REWRITE_TAC[LT1_NZ] THEN MESON_TAC[LT_SUC_PRE]);;
let LT_PRE = 
prove(`!n:num. 0 < n ==> n = (PRE n) + 1`,
GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP LT_SUC_PRE) THEN REWRITE_TAC[ADD1]);;
let SUC_PRE_2 = 
prove(`!n:num. 2 <= n ==> SUC (SUC (PRE (PRE n))) = n`,
ARITH_TAC);;
let LE_MOD_SUC = 
prove(`!n m. m MOD (SUC n) <= n`,
REPEAT GEN_TAC THEN MP_TAC(CONJUNCT2(SPEC `m:num`(MATCH_MP DIVISION (SPEC `n:num` NON_ZERO)))) THEN REWRITE_TAC[LT_SUC_LE]);;
let LT0_LE1 = 
prove(`!n:num. 0 < n <=> 1 <= n`,
ARITH_TAC);;
let ZR_LT_1 = 
prove(`0 < 1`,
ARITH_TAC);;
let LT_RIGHT_SUC = 
prove(`!i:num n:num. i < n ==> i < SUC n`,
ARITH_TAC);;
let LE_RIGHT_SUC = 
prove(`!i:num n:num. i <= n ==> i <= SUC n`,
ARITH_TAC);;
let LT_PRE_LE = 
prove(`!i:num n:num. i < n ==> i <= PRE n`,
ARITH_TAC);;
let MOD_REFL = 
prove(`!m n. ~(n = 0) ==> ((m MOD n) MOD n = m MOD n)`,
(* in file ARITH.ML *) REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`m:num`; `n:num`; `1`] MOD_MOD) THEN ASM_REWRITE_TAC[MULT_CLAUSES; MULT_EQ_0] THEN REWRITE_TAC[ONE; NOT_SUC]);;
let compare_left = 
prove(`!m:num n p. m + n = p ==> m <= p`,
ARITH_TAC);;
let compare_right = 
prove(`!m:num n p. m + n = p ==> n <= p`,
ARITH_TAC);;
let le_compare_left = 
prove(`!m:num n p. m + n <= p ==> m <= p`,
ARITH_TAC);;
let le_compare_right = 
prove(`!m:num n p. m + n <= p ==> n <= p`,
ARITH_TAC);;
let THREE = num_CONV `3`;;
let SEGMENT_TO_ONE = 
prove(`!n:num. n <= 1 <=> n = 0 \/ n = 1`,
ARITH_TAC);;
let SEGMENT_TO_TWO = 
prove(`!n:num. n <= 2 <=> n = 0 \/ n = 1 \/ n = 2`,
ARITH_TAC);;
let EXPAND_SET_TWO_ELEMENTS = 
prove(`!p:num->A. {p (i:num) | i <= 1} = {p 0, p 1}`,
GEN_TAC THEN REWRITE_TAC[SEGMENT_TO_ONE] THEN SET_TAC[]);;
let EXPAND_SET_THREE_ELEMENTS = 
prove(`!p:num->A. {p (i:num) | i <= 2} = {p 0, p 1, p 2}`,
GEN_TAC THEN REWRITE_TAC[SEGMENT_TO_TWO] THEN SET_TAC[]);;
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`,
REPEAT GEN_TAC THEN ASM_CASES_TAC `n:num = 0` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM ONE; CONJUNCT1 LT; ARITH_RULE `!i. i < 1 <=> i = 0`] THEN MESON_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o MATCH_MP LT_SUC_PRE o REWRITE_RULE[GSYM LT_NZ]) THEN DISCH_THEN (fun th-> ONCE_REWRITE_TAC[th]) THEN REWRITE_TAC[LT_SUC_LE; lemma_add_one_assumption]);;
(***********************************************************************)
let is_inj_list = new_recursive_definition num_RECURSION  `(is_inj_list (p:num->A) 0 <=> T) /\ 
   (is_inj_list (p:num->A) (SUC n) <=> ((is_inj_list p n) /\ (!i:num. i <= n ==> ~(p i = p (SUC n)))))`;;
let lemma_sub_list = 
prove(`!p:num->A n:num. is_inj_list p n ==> (!i. i <= n ==> is_inj_list p i)`,
GEN_TAC THEN INDUCT_TAC THENL[SIMP_TAC[is_inj_list; LE]; ALL_TAC] THEN STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[LE] THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN UNDISCH_THEN `is_inj_list (p:num->A) (SUC n)` (MP_TAC o REWRITE_RULE[is_inj_list]) THEN ASM_MESON_TAC[]);;
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))`,
GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_inj_list] THEN ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[is_inj_list] THEN POP_ASSUM (fun th-> REWRITE_TAC[th; LE]) THEN EQ_TAC THENL[DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REPEAT GEN_TAC THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[LT_SUC_LE]; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[RIGHT_OR_DISTRIB] THEN SIMP_TAC[] THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (MP_TAC o SPECL[`SUC n`; `i:num`]) THEN SIMP_TAC[EQ_REFL; ARITH_RULE `~(SUC n <= n)`; LT_SUC_LE]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_list] THEN EQ_TAC THENL[DISCH_TAC THEN MATCH_MP_TAC WLOG_LT THEN STRIP_TAC THENL[ARITH_TAC; ALL_TAC] THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "F1") THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) THEN DISCH_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`]) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F3"(fun th -> USE_THEN "F2" (fun th1 -> (ASSUME_TAC (MATCH_MP LTE_TRANS (CONJ th th1))))) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN REMOVE_THEN "F3" MP_TAC THEN ARITH_TAC);;
let support_list = new_definition `support_list (p:num->A) (n:num) = {p (i:num) | i <= n}`;;
let lemma_finite_list = 
prove(`!(p:num->A) (n:num). FINITE (support_list p n)`,
REWRITE_TAC[support_list; GSYM LT_SUC_LE; FINITE_SERIES]);;
let lemma_size_list = 
prove(`!(p:num->A) (n:num). is_inj_list p n ==> CARD (support_list p n) = SUC n`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_list; support_list] THEN CONV_TAC ((LAND_CONV o ONCE_DEPTH_CONV) SYM_CONV) THEN REWRITE_TAC[GSYM LT_SUC_LE] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP CARD_FINITE_SERIES_EQ th]));;
let in_list = new_definition `in_list (p:num->A) (n:num) (x:A) <=>  x IN support_list p n`;;
let lemma_in_list = 
prove(`!p:num->A n:num x:A. in_list p n x <=> ?j:num. j <= n /\ x = p j`,
REWRITE_TAC[in_list; support_list; IN_ELIM_THM]);;
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]);;
let lemma_element_in_list = 
prove(`!p:num->A n:num i:num. i <= n ==> in_list p n (p i)`,
REWRITE_TAC[lemma_in_list] THEN MESON_TAC[]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_in_list] THEN MESON_TAC[]);;
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)`;;
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]);;
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))`,
REPEAT GEN_TAC THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F1") THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F1" MP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[is_disjoint; lemma_set_disjoint] THEN REWRITE_TAC[GSYM in_list] THEN EXISTS_TAC `(p:num->A) i` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[is_disjoint; GSYM in_list; lemma_set_disjoint] THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[lemma_in_list]) (ASSUME_TAC))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 MP_TAC (SUBST_ALL_TAC))) THEN ASM_MESON_TAC[]);;
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))`,
REPEAT GEN_TAC THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F1") THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F1" MP_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[is_disjoint; lemma_set_disjoint] THEN REWRITE_TAC[GSYM in_list] THEN EXISTS_TAC `(q:num->A) i` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN REWRITE_TAC[is_disjoint; GSYM in_list; lemma_set_disjoint] THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o REWRITE_RULE[lemma_in_list]))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 MP_TAC (SUBST_ALL_TAC))) THEN ASM_MESON_TAC[]);;
let lemma_list_disjoint = 
prove(`!p:num->A q:num->A n:num m:num. is_disjoint p q n m <=> !i:num j:num. i <= n /\ j <= m ==> ~(p i = q j)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_list_disjoint1; lemma_not_in_list] THEN MESON_TAC[]);;
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))`;;
let start_glue_evaluation = 
prove(`!p:num->A q:num->A n:num. glue p q n 0 = p 0`,
REPEAT GEN_TAC THEN REWRITE_TAC[glue; LE_0]);;
let first_glue_evaluation = 
prove(`!p:num->A q:num->A n:num i:num. i <= n ==> glue p q n i = p i`,
REPEAT GEN_TAC THEN REWRITE_TAC[glue] THEN SIMP_TAC[COND_ELIM_THM]);;
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`,
REPEAT STRIP_TAC THEN REWRITE_TAC[glue] THEN ASM_CASES_TAC `i:num = 0` THENL[POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[ADD_0; LE_REFL; COND_ELIM_THM]; ALL_TAC] THEN POP_ASSUM ((X_CHOOSE_THEN `j:num` SUBST1_TAC) o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; CONJUNCT1 ADD]) THEN SIMP_TAC[COND_ELIM_THM; ARITH_RULE `~((n:num) + (SUC j) <= n)`] THEN AP_TERM_TAC THEN REWRITE_TAC[ADD_SUB2]);;
let is_glueing = new_definition `!p:num->A q:num->A n:num m:num. is_glueing p q n m 
   <=> (p n = q 0) /\ (!j:num. 1 <= j /\ j <= m ==> ~(in_list p n (q j)))`;;
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 <=> (p n = q 0) /\ (!i:num. i < n ==> ~(in_list q m (p i))))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FC") (LABEL_TAC "GC")) THEN REWRITE_TAC[is_glueing; lemma_not_in_list] THEN EQ_TAC THENL[DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN ASM_CASES_TAC `j:num = 0` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (SUBST1_TAC o SYM) THEN USE_THEN "FC" (MP_TAC o SPECL[`n:num`; `i:num`] o REWRITE_RULE[lemma_inj_list]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; LE_REFL]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) 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))))))) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP LT_IMP_LE th]); ALL_TAC] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN ASM_CASES_TAC `j':num = n:num` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN USE_THEN "GC" (MP_TAC o GSYM o SPECL[`j:num`; `0`] o REWRITE_RULE[lemma_inj_list]) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[REWRITE_RULE[LT1_NZ] th]); ALL_TAC] THEN POP_ASSUM (fun th-> (POP_ASSUM(fun th1-> ASSUME_TAC (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th))))) THEN USE_THEN "F2" (fun th-> POP_ASSUM (MP_TAC o GSYM o SPEC `j:num`o MATCH_MP th)) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]));;
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 ==> is_inj_list (glue p q n) (n + m)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_list; is_glueing] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) THEN ASM_CASES_TAC `i:num <= n` THENL[POP_ASSUM (LABEL_TAC "F7") THEN USE_THEN "F6"(fun th-> USE_THEN "F7" (fun th1 -> (MP_TAC (MATCH_MP LTE_TRANS (CONJ th th1))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation (MATCH_MP LT_IMP_LE th)]) THEN USE_THEN "F7" (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th]) THEN USE_THEN "F1" (MATCH_MP_TAC) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC)) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN REMOVE_THEN "F5" (LABEL_TAC "F5" o REWRITE_RULE[GSYM ADD1; LE_ADD_LCANCEL; LE_SUC]) THEN ASM_CASES_TAC `j:num <= n` THENL[POP_ASSUM (LABEL_TAC "F6") THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th]) THEN USE_THEN "F4" (MP_TAC o SPEC `SUC d`) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th; GE_1]) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP lemma_element_in_list th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `e:num` (SUBST_ALL_TAC)) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN USE_THEN "F6"(MP_TAC o REWRITE_RULE[LT_ADD_LCANCEL]) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]));;
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)))`;;
let first_join_evaluation = 
prove(`!p:num->A q:num->A n:num i:num. i <= n ==> join p q n i = p i`,
REPEAT GEN_TAC THEN REWRITE_TAC[join] THEN SIMP_TAC[COND_ELIM_THM]);;
let second_join_evaluation = 
prove(`!p:num->A q:num->A n:num i:num. join p q n (n + (SUC i)) = q i`,
REPEAT GEN_TAC THEN REWRITE_TAC[join] THEN SIMP_TAC[COND_ELIM_THM; ARITH_RULE `~((n:num) + (SUC i) <= n)`] THEN AP_TERM_TAC THEN REWRITE_TAC[ADD_SUB2; PRE]);;
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 ==> is_inj_list (join p q n) (n + m + 1)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_list] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")) THEN ASM_CASES_TAC `i:num <= n` THENL[POP_ASSUM (LABEL_TAC "F6") THEN USE_THEN "F5"(fun th-> USE_THEN "F6" (fun th1 -> (MP_TAC (MATCH_MP LTE_TRANS (CONJ th th1))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation (MATCH_MP LT_IMP_LE th)]) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th]) THEN REMOVE_THEN "F1" (MATCH_MP_TAC) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC)) THEN REWRITE_TAC[second_join_evaluation] THEN REMOVE_THEN "F4" (LABEL_TAC "F4" o REWRITE_RULE[GSYM ADD1; LE_ADD_LCANCEL; LE_SUC]) THEN ASM_CASES_TAC `j:num <= n` THENL[POP_ASSUM (LABEL_TAC "F5") THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th]) THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] 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] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `e:num` (SUBST_ALL_TAC)) THEN REWRITE_TAC[second_join_evaluation] THEN REMOVE_THEN "F5"(MP_TAC o REWRITE_RULE[LT_ADD_LCANCEL; LT_SUC]) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]));;
(******************************************************************************)
let inj_iterate_segment = 
prove(`!s:A->bool p:A->A (n:num). p permutes s /\ ~(n = 0) ==> (!m:num. ~(m = 0) /\ (m < n) ==> ~(p POWER m = I)) ==> (!i:num j:num. (i < n) /\ (j < i) ==> ~(p POWER i = p POWER j))`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c2") (ASSUME_TAC)) THEN DISCH_THEN (LABEL_TAC "c3") THEN REPLICATE_TAC 3 STRIP_TAC THEN DISCH_THEN (LABEL_TAC "c4") THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LM_AUX) THEN REPEAT STRIP_TAC THEN REMOVE_THEN "c3" MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN EXISTS_TAC `k:num` THEN MP_TAC (ARITH_RULE `(i:num < n:num) /\ (i = (j:num) + (k:num)) ==> k < n`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "c4" MP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC (ISPECL[`s:A->bool`; `p:A->A`; `k:num`; `j:num`] LM1) THEN ASM_REWRITE_TAC[]);;
let inj_iterate_lemma = 
prove(`!s:A->bool p:A->A. p permutes s /\ (!(n:num). ~(n = 0) ==> ~(p POWER n = I)) ==> (!m. CARD({p POWER k | k < m}) = m)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "c1") (LABEL_TAC "c2")) THEN GEN_TAC THEN SUBGOAL_THEN `!i:num j:num. i < (m:num) /\ j < i ==> ~((p:A->A) POWER i = p POWER j)` ASSUME_TAC THENL[REPEAT GEN_TAC THEN STRIP_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP LM_AUX) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC (ISPECL[`s:A->bool`; `p:A->A`; `k:num`; `j:num`] LM1) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REMOVE_THEN "c2" (MP_TAC o SPEC(`k:num`)) THEN REWRITE_TAC[NOT_IMP] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_SERIES_EQ) THEN SIMP_TAC[]);;
(* finite order theorem on every element in arbitrary finite group *)
let finite_order = 
prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> ?(n:num). ~(n = 0) /\ p POWER n = I`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN ASM_CASES_TAC `?(n:num). ~(n = 0) /\ (p:A->A) POWER n = I` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_EXISTS_THM; DE_MORGAN_THM; TAUT `!a b. ~(a /\ b) = (a ==> ~b)`]) THEN DISCH_TAC THEN MP_TAC (ISPECL[`s:A->bool`; `p:A->A`] inj_iterate_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ABBREV_TAC `md = SUC(CARD({p | p permutes (s:A->bool)}))` THEN MP_TAC (ISPECL[`{(p:A->A) POWER (k:num) | k < (md:num)}` ;`{p | p permutes (s:A->bool)}`] CARD_SUBSET) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP FINITE_PERMUTATIONS th]) THEN SUBGOAL_THEN `{(p:A->A) POWER (k:num) | k < (md:num)} SUBSET {p | p permutes (s:A->bool)}` (fun th-> REWRITE_TAC[th]) THENL[REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP power_permutation th]); ALL_TAC] THEN FIRST_X_ASSUM (SUBST1_TAC o SPEC `md:num` o check (is_forall o concl)) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN ARITH_TAC);;
let lemma_order_permutation_exists = 
prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> ?n:num. ~(n = 0) /\ (p POWER n = I) /\ (!m:num. ~(m = 0) /\ (m < n) ==> ~(p POWER m = I))`,
REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP finite_order) THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP] THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [TAUT `(A ==> ~(~B /\ C)) <=> (~B /\ A ==> ~C)`] THEN MESON_TAC[]);;
let lemma_order_permutation = new_specification["order_permutation"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_order_permutation_exists);;
let inverse_element_lemma = 
prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==> ?j:num. inverse p = p POWER j`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC (MATCH_MP finite_order th) THEN ASSUME_TAC(CONJUNCT2 th)) THEN REWRITE_TAC[GSYM LT_NZ] THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (MP_TAC) (ASSUME_TAC))) THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP LT_SUC_PRE) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[POWER] THEN POP_ASSUM (fun th -> (DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP RIGHT_INVERSE_EQUATION (CONJ th th1))))) THEN REWRITE_TAC[I_O_ID] THEN DISCH_THEN (ASSUME_TAC o SYM) THEN EXISTS_TAC `PRE n` THEN ASM_REWRITE_TAC[]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_order_permutation) THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; CONJUNCT1 ADD]) (LABEL_TAC "F2" o CONJUNCT1)) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[PRE] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[COM_POWER]) THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 th) th1)))) THEN DISCH_THEN (fun th-> REWRITE_TAC[REWRITE_RULE[I_O_ID] (SYM th)]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F2" (ASSUME_TAC o MATCH_MP PERMUTES_INVERSE) THEN POP_ASSUM (fun th -> (REMOVE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP inverse_element_lemma (CONJ th2 th)))))) THEN POP_ASSUM (SUBST1_TAC o MATCH_MP PERMUTES_INVERSE_INVERSE) THEN SIMP_TAC[]);;
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`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[STRIP_TAC THEN EXISTS_TAC `0` THEN REWRITE_TAC[POWER_0]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o MATCH_MP inverse_element_lemma) THEN DISCH_THEN (X_CHOOSE_THEN `i:num` ASSUME_TAC) THEN EXISTS_TAC `(j:num) + (i:num)` THEN REWRITE_TAC[POWER] THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN ASM_REWRITE_TAC[addition_exponents]);;
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)`,
REPEAT STRIP_TAC THEN MP_TAC(SPECL[`s:A->bool`; `p:A->A`] inverse_element_lemma) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `j:num` THEN POP_ASSUM(fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[GSYM(ISPECL[`(inverse (p:A->A)):(A->A)`; `p:A->A`; `(x:A)`] o_THM)] THEN UNDISCH_THEN `p:A->A permutes s`(fun th-> REWRITE_TAC[CONJUNCT2 (MATCH_MP PERMUTES_INVERSES_o th);I_THM]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F1") MP_TAC)) THEN USE_THEN "F1" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[MATCH_MP inverse_power_function th] o SYM)) THEN POP_ASSUM (fun th1 -> POP_ASSUM (fun th-> MP_TAC (SPEC `n:num` (MATCH_MP power_inverse_element_lemma (CONJ th th1))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[]);;
let elim_power_function = 
prove( `!s:A->bool p:A->A x:A n:num m:num. p permutes s /\ (p POWER (m+n)) x = (p POWER m) x ==> (p POWER n) x = x`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c1") (MP_TAC)) THEN REWRITE_TAC[addition_exponents; o_THM] THEN DISCH_TAC THEN REMOVE_THEN "c1" (ASSUME_TAC o (SPEC `m:num`) o MATCH_MP power_permutation) THEN POP_ASSUM (MP_TAC o ISPECL[`((p:A->A) POWER (n:num)) (x:A)`; `x:A` ] o MATCH_MP PERMUTES_INJECTIVE) THEN ASM_REWRITE_TAC[]);;
(* some properties of orbits *)
let orbit_reflect = 
prove(`!f:A->A x:A. x IN (orbit_map f x)`,
REPEAT GEN_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN EXISTS_TAC `0` THEN REWRITE_TAC[POWER; ARITH_RULE `0>=0`;I_THM]);;
let orbit_sym = 
prove(`!s:A->bool p:A->A x:A y:A. FINITE s /\ p permutes s ==> (x IN (orbit_map p y) ==> y IN (orbit_map p x))`,
REPLICATE_TAC 5 STRIP_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN STRIP_TAC THEN FIND_ASSUM (ASSUME_TAC o (SPEC `n:num`) o MATCH_MP power_permutation) `p:A->A permutes (s:A->bool)` THEN POP_ASSUM (MP_TAC o (SPECL[`y:A`; `x:A`]) o MATCH_MP PERMUTES_INVERSE_EQ) THEN POP_ASSUM(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN UNDISCH_THEN `p:A->A permutes s` (ASSUME_TAC o (SPEC `n:num`) o MATCH_MP power_permutation) THEN MP_TAC(SPECL[`s:A->bool`; `(p:A->A) POWER (n:num)`] inverse_element_lemma) THEN ASM_REWRITE_TAC[GSYM multiplication_exponents] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `(j:num) * (n:num)` THEN ASM_REWRITE_TAC[ARITH_RULE `(j:num) * (n:num) >= 0`]);;
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 ==> x IN orbit_map f z`,
REPEAT GEN_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN UNDISCH_THEN `x:A = ((f:A->A) POWER (n:num)) (y:A)` MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (ASSUME_TAC o SYM) THEN MP_TAC (SPECL[`n:num`; `n':num`; `f:A->A`] addition_exponents) THEN DISCH_THEN(fun th -> MP_TAC (AP_THM th `z:A`)) THEN ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN (ASSUME_TAC o SYM) THEN EXISTS_TAC `(n:num) + n'` THEN ASM_REWRITE_TAC[ARITH_RULE `(n:num) + (n':num) >= 0`]);;
let partition_orbit = 
prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s ==>(!x:A y:A. (orbit_map p x INTER orbit_map p y = {}) \/ (orbit_map p x = orbit_map p y))`,
REPEAT STRIP_TAC THEN ASM_CASES_TAC `orbit_map (p:A->A)(x:A) INTER orbit_map (p:A->A) (y:A) = {}` THENL[ASM_REWRITE_TAC[]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REWRITE_TAC[INTER; IN_ELIM_THM] THEN STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `x':A`; `x:A`] orbit_sym) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `x':A`; `y:A`] orbit_sym) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL[STRIP_TAC THEN MP_TAC (SPECL[`p:A->A`; `x'':A`; `x:A`;`x':A`] orbit_trans) THEN ASM_MESON_TAC[orbit_trans]; STRIP_TAC THEN MP_TAC (SPECL[`p:A->A`; `x'':A`; `y:A`;`x':A`] orbit_trans) THEN ASM_MESON_TAC[orbit_trans]]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (fun th -> SUBST1_TAC (MATCH_MP orbit_cyclic th) THEN ASSUME_TAC (CONJUNCT1 th)) THEN MP_TAC (SPECL[`n:num`; `(\k. ((f:A->A) POWER k) (x:A))`] CARD_FINITE_SERIES_LE) THEN MESON_TAC[]);;
(* some properties of hypermap *)
let cyclic_maps = 
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 ==> (n o f o e = I) /\ (f o e o n = I)`,
REPEAT STRIP_TAC THENL[MP_TAC (ISPECL[`D:A->bool`;`e:A->A`; `(n:A->A) o (f:A->A)`; `I:A->A`] LEFT_INVERSE_EQUATION) THEN ASM_REWRITE_TAC[I_O_ID] THEN FIND_ASSUM (ASSUME_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) `e:A->A permutes D:A->bool` THEN DISCH_TAC THEN MP_TAC (ISPECL[`(n:A->A)o(f:A->A)`;`inverse(e:A->A)`;`e:A->A` ] RIGHT_MULT_MAP) THEN ASM_REWRITE_TAC[o_ASSOC]; MP_TAC (ISPECL[`D:A->bool`;`(e:A->A)o(n:A->A)`;`(f:A->A)`; `I:A->A`] RIGHT_INVERSE_EQUATION) THEN ASM_REWRITE_TAC[I_O_ID; GSYM o_ASSOC] 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) THEN ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID] THEN FIND_ASSUM (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) `f:A->A permutes D:A->bool` THEN ASM_SIMP_TAC[]]);;
let cyclic_inverses_maps = 
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 ==> inverse n o inverse e o inverse f = I`,
REPEAT STRIP_TAC THEN MP_TAC (ISPECL[`D:A->bool`; `e:A->A`; `n:A->A`; `f:A->A`] cyclic_maps) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC (ISPECL[`D:A->bool`;`f:A->A`; `(e:A->A) o (n:A->A)`; `I:A->A`] LEFT_INVERSE_EQUATION) THEN ASM_REWRITE_TAC[I_O_ID] THEN STRIP_TAC THEN MP_TAC (ISPECL[`D:A->bool`;`e:A->A`; `(n:A->A)`; `inverse(f:A->A)`] LEFT_INVERSE_EQUATION) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (ISPECL[`inverse(n:A->A)`; `n:A->A`; `inverse(e:A->A) o inverse(f:A->A)`] LEFT_MULT_MAP) THEN FIND_ASSUM (ASSUME_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) `n:A->A permutes D:A->bool` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SYM) THEN REWRITE_TAC[]);;
let edge_refl = 
prove(`!H:(A)hypermap x:A. x IN edge H x`,
REWRITE_TAC[edge; orbit_reflect]);;
let node_refl = 
prove(`!H:(A)hypermap x:A. x IN node H x`,
REWRITE_TAC[node; orbit_reflect]);;
let face_refl = 
prove(`!H:(A)hypermap x:A. x IN face H x`,
REWRITE_TAC[face; orbit_reflect]);;
(* Hypermap cycle *)
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`,
GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` 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) THEN ASM_REWRITE_TAC[]);;
(* INVERSES HYPERMAP MAPS *) let label_cyclic_maps_TAC th = CONJUNCTS_THEN2 (LABEL_TAC "H6") (LABEL_TAC "H7") (SPEC th hypermap_cyclic);;
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)`,
GEN_TAC THEN STRIP_TAC THENL[MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))) THEN DISCH_THEN (fun th-> MP_TAC(SYM(MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts)) th)))) THEN REWRITE_TAC[I_O_ID]; ALL_TAC] THEN STRIP_TAC THENL[MP_TAC (CONJUNCT1(SPEC `H:(A)hypermap` hypermap_cyclic)) THEN DISCH_THEN (fun th-> MP_TAC(SYM(MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)) th)))) THEN REWRITE_TAC[I_O_ID]; ALL_TAC] THEN MP_TAC (CONJUNCT2(SPEC `H:(A)hypermap` hypermap_cyclic)) THEN DISCH_THEN (fun th-> MP_TAC(SYM(MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) th)))) THEN REWRITE_TAC[I_O_ID]);;
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)`,
GEN_TAC THEN STRIP_TAC THENL[MP_TAC (SYM(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))) 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] THEN STRIP_TAC THENL[MP_TAC (SYM(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))) 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] THEN MP_TAC (SYM(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LEFT_INVERSE_EQUATION (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)) th)]));;
let lemmaZHQCZLX = 
prove(`!H:(A)hypermap. (simple_hypermap H /\ plain_hypermap H /\ (!x:A. x IN dart H ==> 3 <= CARD (face H x))) ==> (!x:A. x IN dart H ==> ~(node_map H x = x))`,
GEN_TAC THEN REWRITE_TAC[simple_hypermap; plain_hypermap;face; node; GSYM GE] THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma) 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"))))) THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "c6") (CONJUNCTS_THEN2 (LABEL_TAC "c7") (LABEL_TAC "c8"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "c9") THEN DISCH_THEN (LABEL_TAC "c10") THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN USE_THEN "c2" (MP_TAC o (SPEC `x:A`) o MATCH_MP PERMUTES_IN_IMAGE) THEN USE_THEN "c4" (MP_TAC o (SPEC `x:A`) o MATCH_MP PERMUTES_IN_IMAGE) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ABBREV_TAC `y:A = (f:A->A) (x:A)` THEN ABBREV_TAC `z:A = (e:A->A) (x:A)` THEN USE_THEN "c7" MP_TAC THEN USE_THEN "c2" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LEFT_INVERSE_EQUATION) THEN REWRITE_TAC[I_O_ID] THEN DISCH_THEN(fun th -> (ASSUME_TAC (SYM th)) THEN (ASSUME_TAC (AP_THM (SYM th) `x:A`))) THEN USE_THEN "c3" (MP_TAC o (SPECL[`x:A`;`x:A`]) o MATCH_MP PERMUTES_INVERSE_EQ) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN USE_THEN "c5" MP_TAC THEN USE_THEN "c2" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LEFT_INVERSE_EQUATION) THEN REWRITE_TAC[I_O_ID] THEN DISCH_THEN(fun th -> (ASSUME_TAC (SYM th)) THEN (MP_TAC (AP_THM (SYM th) `x:A`))) THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN (MP_TAC o SYM) THEN MP_TAC (SPECL[`D:A->bool`; `e:A->A`; `n:A->A`; `f:A->A`] cyclic_maps) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> MP_TAC (AP_THM (CONJUNCT2 th) `x:A`)) THEN ASM_REWRITE_TAC[o_THM; I_THM] THEN DISCH_THEN (MP_TAC o AP_TERM `f:A->A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "c11") THEN DISCH_THEN (LABEL_TAC "c12") THEN MP_TAC (SPECL[`f:A->A`; `2`; `z:A`; `y:A`] in_orbit_lemma) THEN ASM_REWRITE_TAC[POWER_2; o_THM] THEN DISCH_TAC THEN MP_TAC (SPECL[`D:A->bool`; `f:A->A`; `y:A`; `z:A`] orbit_sym) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "d1") THEN MP_TAC (SPECL[`n:A->A`; `1`; `y:A`; `z:A`] in_orbit_lemma) THEN ASM_REWRITE_TAC[POWER_1] THEN DISCH_THEN (LABEL_TAC "d2") THEN REMOVE_THEN "c6" (MP_TAC o (SPEC `y:A`)) THEN UNDISCH_TAC `(y:A) IN D` THEN ASM_REWRITE_TAC[IN] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC (SPECL[`orbit_map (n:A->A) (y:A)`;`orbit_map (f:A->A) (y:A)`;`z:A`] IN_INTER) THEN ASM_REWRITE_TAC[IN_SING] THEN STRIP_TAC THEN REMOVE_THEN "c11" MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (SPECL[`f:A->A`; `2`; `y:A`] card_orbit_le) THEN ASM_REWRITE_TAC[ARITH; POWER_2; o_DEF] THEN DISCH_TAC THEN REMOVE_THEN "c8" (MP_TAC o (SPEC `y:A`)) THEN ASM_REWRITE_TAC[IN] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);;
(* Definition of connected hypermap *)
let connected_hypermap = new_definition `connected_hypermap (H:(A)hypermap) <=> number_of_components H = 1`;;
(* Some facts on sets with one element or two elements *)
let CARD_SINGLETON = 
prove(`!x:A. CARD{x} = 1`,
GEN_TAC THEN ASSUME_TAC (CONJUNCT1 CARD_CLAUSES) THEN ASSUME_TAC (CONJUNCT1 FINITE_RULES) THEN MP_TAC(SPECL[`x:A`;`{}:A->bool`] (CONJUNCT2 CARD_CLAUSES)) THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ARITH_TAC);;
let FINITE_SINGLETON = 
prove(`!x:A. FINITE {x}`,
REPEAT STRIP_TAC THEN ASSUME_TAC (CONJUNCT1 FINITE_RULES) THEN MP_TAC (ISPECL[`x:A`; `{}:A->bool`] (CONJUNCT2 FINITE_RULES)) THEN ASM_REWRITE_TAC[]);;
let CARD_TWO_ELEMENTS = 
prove(`!x:A y:A. ~(x = y) ==> CARD {x ,y} = 2`,
REPEAT STRIP_TAC THEN ASSUME_TAC(SPEC `y:A` FINITE_SINGLETON) THEN ASSUME_TAC(SPEC `y:A` CARD_SINGLETON) THEN MP_TAC(SPECL[`x:A`; `{y:A}`] (CONJUNCT2 CARD_CLAUSES)) THEN ASM_REWRITE_TAC[IN_SING; TWO]);;
let FINITE_TWO_ELEMENTS = 
prove(`!x:A y:A. FINITE {x ,y}`,
REPEAT STRIP_TAC THEN ASSUME_TAC(SPEC `y:A` FINITE_SINGLETON) THEN MP_TAC(SPECL[`x:A`; `{y:A}`] (CONJUNCT2 FINITE_RULES)) THEN ASM_REWRITE_TAC[]);;
let CARD_ATLEAST_1 = 
prove(`!s:A->bool x:A. FINITE s /\ x IN s ==> 1 <= CARD s`,
REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x:A} SUBSET s` ASSUME_TAC THENL[ASM_ASM_SET_TAC; ALL_TAC] THEN ASSUME_TAC(SPEC `x:A` CARD_SINGLETON) THEN MP_TAC (SPECL[`{x:A}`; `s:A->bool`] CARD_SUBSET) THEN ASM_REWRITE_TAC[]);;
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`,
REPEAT STRIP_TAC THEN SUBGOAL_THEN `{x:A, y:A} SUBSET s` ASSUME_TAC THENL[ASM_ASM_SET_TAC; ALL_TAC] THEN MP_TAC(SPECL[`x:A`;`y:A`] CARD_TWO_ELEMENTS) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN MP_TAC(SPECL[`{x:A, y:A}`; `s:A->bool`] CARD_SUBSET) THEN ASM_REWRITE_TAC[]);;
let orbit_single_lemma = 
prove(`!f:A->A x:A y:A. orbit_map f y = {x} ==> x = y`,
REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM IN_SING] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN MP_TAC (SPECL[`f:A->A`; `0`; `y:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_0; I_THM]);;
(* Some lemmas about counting the orbits of a permutation *)
let finite_orbits_lemma = 
prove(`!D:A->bool p:A->A. (FINITE D /\ p permutes D) ==> FINITE (set_of_orbits D p)`,
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 THENL[REWRITE_TAC[EXTENSION] THEN STRIP_TAC THEN EQ_TAC THENL[REWRITE_TAC[set_of_orbits;IMAGE;IN;IN_ELIM_THM];ALL_TAC] THEN REWRITE_TAC[set_of_orbits;IMAGE;IN;IN_ELIM_THM];ALL_TAC] THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[]);;
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[]);;
let lemma_partition = 
prove( `!s:A->bool p:A->A. FINITE s /\ p permutes s ==> s = UNIONS (set_of_orbits s p)`,
REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION;IN_UNIONS] THEN GEN_TAC THEN EQ_TAC THENL[MP_TAC (ISPECL[`p:A->A`;`x:A`] orbit_reflect) THEN REWRITE_TAC[set_of_orbits] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(orbit_map p x):A->bool` THEN (ASM_ASM_SET_TAC); DISCH_THEN(X_CHOOSE_THEN `t:A->bool` MP_TAC) THEN REWRITE_TAC[IN_ELIM_THM;set_of_orbits] THEN STRIP_TAC THEN FIRST_ASSUM SUBST_ALL_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP orbit_subset) THEN ASM_ASM_SET_TAC]);;
let lemma_card_of_disjoint_covering = 
prove(`!(t:(A->bool)->bool). (FINITE t /\ (!u:A->bool. u IN t ==> FINITE u) /\ (!(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)`,
GEN_TAC THEN ABBREV_TAC `n = CARD (t:(A->bool)->bool)` THEN POP_ASSUM (MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN SPEC_TAC(`t:(A->bool)->bool`, `t:(A->bool)->bool`) THEN SPEC_TAC(`n:num`, `n:num`) THEN INDUCT_TAC THENL[REPEAT STRIP_TAC THEN UNDISCH_TAC `CARD (t:(A->bool)->bool) = 0` THEN UNDISCH_TAC `FINITE (t:(A->bool)->bool)` THEN REWRITE_TAC[IMP_IMP; GSYM HAS_SIZE; HAS_SIZE_0] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[SET_RULE `UNIONS {} = {}`] THEN REWRITE_TAC[CARD_CLAUSES; NSUM_CLAUSES]; ALL_TAC] THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")))) THEN MP_TAC (SPEC `n:num` NON_ZERO) THEN USE_THEN "F2" (SUBST1_TAC o SYM) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP CARD_EQ_0 th]) THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN (X_CHOOSE_THEN `u:A->bool` (LABEL_TAC "F6")) THEN SUBGOAL_THEN `FINITE (UNIONS (t:(A->bool)->bool))` (LABEL_TAC "F7") THENL[USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP FINITE_FINITE_UNIONS th]) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `UNIONS (t:(A->bool)->bool) = (UNIONS (t DELETE (u:A->bool))) UNION u` (LABEL_TAC "F8") THENL[ASM_ASM_SET_TAC; ALL_TAC] THEN SUBGOAL_THEN `DISJOINT (UNIONS ((t:(A->bool)->bool) DELETE (u:A->bool))) u` (LABEL_TAC "F9") THENL[REWRITE_TAC[DISJOINT; INTER; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[IN_UNIONS] THEN STRIP_TAC THEN SUBGOAL_THEN `~(DISJOINT (u:A->bool) (t':A->bool))` ASSUME_TAC THENL[REWRITE_TAC[IN_DISJOINT] THEN EXISTS_TAC `x:A` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])); ALL_TAC] THEN UNDISCH_TAC `t':A->bool IN (t:(A->bool)->bool) DELETE (u:A->bool)` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN USE_THEN "F5" (MP_TAC o SPECL[`t':A->bool`; `u:A->bool`]) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F6" (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[DISJOINT_SYM] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN MESON_TAC[NOT_IN_EMPTY]; ALL_TAC] THEN USE_THEN "F3" (MP_TAC o ISPEC `u:A->bool` o MATCH_MP CARD_DELETE) THEN USE_THEN "F6" (fun th -> REWRITE_TAC[th]) THEN REMOVE_THEN "F2" SUBST1_TAC THEN REWRITE_TAC[ADD1; ADD_SUB] THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC`(t:(A->bool)->bool) DELETE (u:A->bool)`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP FINITE_DELETE_IMP th]) THEN SUBGOAL_THEN `!(u':A->bool). u' IN ((t:(A->bool)->bool) DELETE (u:A->bool)) ==> FINITE u'` (fun th -> REWRITE_TAC[th]) THENL[REWRITE_TAC[IN_DELETE] THEN USE_THEN "F4" (fun th -> MESON_TAC[SPEC `u':A->bool` th]); ALL_TAC] 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]) THENL[REWRITE_TAC[IN_DELETE] THEN REMOVE_THEN "F5" (fun th -> MESON_TAC[th]); ALL_TAC] THEN DISCH_TAC THEN SUBGOAL_THEN `CARD (UNIONS (t:(A->bool)->bool)) = CARD(UNIONS (t DELETE (u:A->bool))) + CARD (u:A->bool)` ASSUME_TAC THENL[USE_THEN "F8" SUBST1_TAC THEN MATCH_MP_TAC CARD_UNION THEN USE_THEN "F9" (MP_TAC o REWRITE_RULE[DISJOINT]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F6" (fun th -> (USE_THEN "F4" (fun ths -> REWRITE_TAC[MATCH_MP ths th]))) THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F8" SUBST1_TAC THEN REWRITE_TAC[FINITE_UNION] THEN SIMP_TAC[]; ALL_TAC] 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))))))) THEN POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN ARITH_TAC);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP lemma_partition th]) THEN MATCH_MP_TAC lemma_card_of_disjoint_covering THEN USE_THEN "F1" (fun th -> REWRITE_TAC [MATCH_MP finite_orbits_lemma th]) THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_orbit_finite th]); ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[DISJOINT] THEN USE_THEN "F1" (MP_TAC o SPECL[`x:A`; `x':A`] o MATCH_MP partition_orbit) THEN MESON_TAC[]);;
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)) ==> (m * (number_of_orbits s p) <= CARD s)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (LABEL_TAC "F4" (MATCH_MP finite_orbits_lemma (CONJ th1 th2)))))) 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 THENL[GEN_TAC THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REMOVE_THEN "F3" (MP_TAC o SPEC `x':A`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F4" (fun th1 -> (POP_ASSUM (fun th2 -> (MP_TAC (MATCH_MP NSUM_LE (CONJ th1 th2)))))) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[MATCH_MP NSUM_CONST th]) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC [GSYM(MATCH_MP card_partition_formula (CONJ th1 th2))]))) THEN REWRITE_TAC[GSYM number_of_orbits] THEN ARITH_TAC);;
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) ==> CARD s = m * (number_of_orbits s p)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3" o GSYM))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (LABEL_TAC "F4" (MATCH_MP finite_orbits_lemma (CONJ th1 th2)))))) 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 THENL[GEN_TAC THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REMOVE_THEN "F3" (MP_TAC o SPEC `x':A`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th2 -> (MP_TAC (MATCH_MP NSUM_EQ th2))) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[MATCH_MP NSUM_CONST th]) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC [GSYM(MATCH_MP card_partition_formula (CONJ th1 th2))]))) THEN REWRITE_TAC[GSYM number_of_orbits] THEN ARITH_TAC);;
let lemma_orbit_convolution_map = 
prove(`!p:A->A. p o p = I ==> (!x:A. orbit_map p x = {x, p x})`,
REPEAT STRIP_TAC THEN POP_ASSUM (fun th -> MP_TAC (AP_THM th `x:A`)) THEN REWRITE_TAC[GSYM POWER_2; I_THM] THEN MP_TAC (ARITH_RULE `~(2 = 0)`) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP orbit_cyclic th]) THEN REWRITE_TAC[TWO; LT_SUC_LE] THEN REWRITE_TAC[EXPAND_SET_TWO_ELEMENTS; POWER_0; POWER_1; I_THM]);;
let lemma_nondegenerate_convolution = 
prove(`!s:A->bool p:A->A. FINITE s /\ p permutes s /\ p o p = I /\ (!x:A. x IN s ==> ~(p x = x)) ==> (!x:A. x IN s ==> FINITE (orbit_map p x) /\ CARD(orbit_map p x) = 2)`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2")(CONJUNCTS_THEN2 (LABEL_TAC "F3")(LABEL_TAC "F4")))) 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[] THEN DISCH_THEN (LABEL_TAC "F6") THEN USE_THEN "F1"(fun th1 -> (USE_THEN "F6"(fun th2 -> (MP_TAC(MATCH_MP FINITE_SUBSET (CONJ th1 th2)))))) THEN DISCH_THEN(LABEL_TAC "F7") THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`p:A->A`;`2`;`x:A`] card_orbit_le) THEN ASM_REWRITE_TAC[ARITH; SPEC `(p:A->A)` POWER_2;I_THM] THEN DISCH_THEN(LABEL_TAC "F8") THEN MP_TAC(ISPECL[`p:A->A`;`1`; `x:A`; `(p:A->A) (x:A)`] in_orbit_lemma) THEN REWRITE_TAC[POWER_1] THEN DISCH_THEN(LABEL_TAC "F9") THEN LABEL_TAC "F10" (ISPECL[`p:A->A`;`x:A`] orbit_reflect) THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (MP_TAC o REWRITE_RULE[th] o SPEC `x:A`)) 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] THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_ATLEAST_2) THEN USE_THEN "F8" MP_TAC THEN REWRITE_TAC[IMP_IMP; LE_ANTISYM]);;
let lemmaTGJISOK = 
prove(`!H:(A)hypermap. connected_hypermap H /\ plain_hypermap H /\ planar_hypermap H /\ (!x:A. x IN (dart H) ==> ~(edge_map H x = x) /\ (3 <= CARD(node H x))) ==> (CARD (dart H) <= (6*(number_of_faces H)-12))`,
GEN_TAC THEN REWRITE_TAC[connected_hypermap; plain_hypermap; planar_hypermap] THEN DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC) (MP_TAC )) THEN POP_ASSUM SUBST1_TAC THEN SIMP_TAC[ARITH] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==> CARD (edge H x) = 2` MP_TAC THENL[MP_TAC(SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] lemma_nondegenerate_convolution) THEN REWRITE_TAC[edge_map_and_darts; GSYM edge] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[edge] 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))))) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [number_of_orbits] THEN REWRITE_TAC[GSYM edge_set; GSYM number_of_edges] THEN DISCH_THEN (LABEL_TAC "F4") THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==> 3 <= CARD (node H x)` MP_TAC THENL[ASM_SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[node] 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))))) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [number_of_orbits] THEN REWRITE_TAC[GSYM node_set; GSYM number_of_nodes] THEN DISCH_TAC THEN REMOVE_THEN "F2" MP_TAC THEN POP_ASSUM MP_TAC THEN REMOVE_THEN "F4" SUBST1_TAC THEN ARITH_TAC);;
(* We set up some lemmas on combinatorial commponents *)
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)`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[ SIMP_TAC[is_path; CONJUNCT1 LE]; ALL_TAC] THEN STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LE] THEN STRIP_TAC 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[]]);;
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`,
REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL[SIMP_TAC[is_path;go_one_step];ALL_TAC] THEN REWRITE_TAC[is_path] 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)))))) THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]); POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]); ALL_TAC] THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]));;
let lemma_component_subset = 
prove(`!H:(A)hypermap x:A. x IN dart H ==> comb_component H x SUBSET dart H`,
REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC(SPEC `H:(A)hypermap` hypermap_lemma) THEN REWRITE_TAC[SUBSET;IN_ELIM_THM;comb_component] THEN GEN_TAC THEN REWRITE_TAC[is_in_component] THEN ASM_MESON_TAC[lemma_path_subset]);;
let lemma_edge_subset = 
prove(`!(H:(A)hypermap) x:A. x IN dart H ==> edge H x SUBSET dart H`,
REWRITE_TAC[edge] THEN MESON_TAC[edge_map_and_darts; orbit_subset]);;
let lemma_node_subset = 
prove(`!(H:(A)hypermap) x:A. x IN dart H ==> node H x SUBSET dart H`,
REWRITE_TAC[node] THEN MESON_TAC[ node_map_and_darts; orbit_subset]);;
let lemma_face_subset = 
prove(`!(H:(A)hypermap) x:A. x IN dart H ==> face H x SUBSET dart H`,
REWRITE_TAC[face] THEN MESON_TAC[face_map_and_darts; orbit_subset]);;
let lemma_component_reflect = 
prove(`!H:(A)hypermap x:A. x IN comb_component H x`,
REPEAT STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component;is_in_component] THEN EXISTS_TAC `(\k:num. x:A)` THEN EXISTS_TAC `0` THEN MESON_TAC[is_path]);;
(* The definition of path is exactly here *)
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))))`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_path] THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[is_path] THEN REWRITE_TAC[lemma_add_one_assumption_lt]);;
(* Three special paths *)
let edge_path = new_definition `!(H:(A)hypermap) (x:A) (i:num). edge_path H x i  = ((edge_map H) POWER i) x`;;
let node_path = new_definition `!(H:(A)hypermap) (x:A) (i:num). node_path H x i  = ((node_map H) POWER i) x`;;
let face_path = new_definition `!(H:(A)hypermap) (x:A) (i:num). face_path H x i  = ((face_map H) POWER i) x`;;
let lemma_edge_path = 
prove(`!(H:(A)hypermap) (x:A) k:num. is_path H (edge_path H x) k`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC] THEN REWRITE_TAC[is_path] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step] THEN DISJ1_TAC THEN REWRITE_TAC[edge_path; COM_POWER; o_THM]);;
let lemma_node_path = 
prove(`!(H:(A)hypermap) (x:A) k:num. is_path H (node_path H x) k`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC] THEN REWRITE_TAC[is_path] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step] THEN DISJ2_TAC THEN DISJ1_TAC THEN REWRITE_TAC[node_path; COM_POWER; o_THM]);;
let lemma_face_path = 
prove(`!(H:(A)hypermap) (x:A) k:num. is_path H (face_path H x) k`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC] THEN REWRITE_TAC[is_path] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step] THEN DISJ2_TAC THEN DISJ2_TAC THEN REWRITE_TAC[face_path; COM_POWER; o_THM]);;
(* Some lemmas on concatenate paths *)
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) ==> is_path H (glue p q n) (n + m)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_path] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN ASM_CASES_TAC `i:num < n:num` THENL[POP_ASSUM (LABEL_TAC "F5") THEN USE_THEN "F5" (fun th -> (MP_TAC (MATCH_MP LT_IMP_LE th)) THEN ASSUME_TAC (REWRITE_RULE[GSYM LE_SUC_LT] th)) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th]) THEN POP_ASSUM (fun th-> USE_THEN "F1" (fun thm -> REWRITE_TAC[MATCH_MP thm th])); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[NOT_LT]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2(GSYM ADD)] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[GSYM ADD1; LT_ADD_LCANCEL; LT_SUC]) THEN DISCH_THEN(fun th-> USE_THEN "F2" (fun thm -> REWRITE_TAC[MATCH_MP thm th])));;
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) ==> ?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)`,
REPEAT GEN_TAC THEN DISCH_THEN ASSUME_TAC THEN EXISTS_TAC `glue (p:num->A) (q:num->A) (n:num)` THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_glue_paths th] THEN ASSUME_TAC (CONJUNCT2 (CONJUNCT2 th))) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN SIMP_TAC[glue; LE_0; COND_ELIM_THM]);;
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) ==> ?g:num->A. g 0 = p 0 /\ g (n+m) = q m /\ is_path H g (n+m)`,
REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP concatenate_two_paths) THEN MESON_TAC[]);;
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 ==> z IN comb_component H x`,
REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component; is_in_component] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPECL[`H:(A)hypermap`; `p:num->A`;`p':num->A`;`n:num`;`n':num`] concatenate_paths) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);;
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`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_path] THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `0` THEN REWRITE_TAC[is_path]; ALL_TAC] THEN REWRITE_TAC[is_path] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN REMOVE_THEN "F1" (fun th -> REWRITE_TAC[th]) 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"))))) THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[go_one_step] THEN STRIP_TAC THENL[MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma) THEN DISCH_THEN (fun th-> (POP_ASSUM (fun th1 -> (MP_TAC (MATCH_MP inverse_relation (CONJ (CONJUNCT1 th) (CONJ (CONJUNCT1(CONJUNCT2 th)) th1))))))) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC) THEN REWRITE_TAC[GSYM edge_path] THEN USE_THEN "F3" (SUBST1_TAC o SYM) 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)))))))) THEN STRIP_TAC THEN EXISTS_TAC `g':num->A` THEN EXISTS_TAC `(k:num) + (m:num)` THEN ASM_REWRITE_TAC[edge_path; POWER_0; I_THM]; MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma) THEN DISCH_THEN(fun th->(POP_ASSUM(fun th1->(MP_TAC(MATCH_MP inverse_relation (CONJ(CONJUNCT1 th)(CONJ(CONJUNCT1(CONJUNCT2(CONJUNCT2 th))) th1))))))) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC) THEN REWRITE_TAC[GSYM node_path] THEN USE_THEN "F3" (SUBST1_TAC o SYM) 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)))))))) THEN STRIP_TAC THEN EXISTS_TAC `g':num->A` THEN EXISTS_TAC `(k:num) + (m:num)` THEN ASM_REWRITE_TAC[node_path; POWER_0; I_THM]; ALL_TAC] THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma) 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))))))) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC) THEN REWRITE_TAC[GSYM face_path] THEN USE_THEN "F3" (SUBST1_TAC o SYM) 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)))))))) THEN STRIP_TAC THEN EXISTS_TAC `g':num->A` THEN EXISTS_TAC `(k:num) + (m:num)` THEN ASM_REWRITE_TAC[face_path; POWER_0; I_THM]);;
let lemma_component_symmetry = 
prove(`!H:(A)hypermap x:A y:A. y IN comb_component H x ==> x IN comb_component H y`,
REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component; is_in_component] THEN REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_reverse_path) THEN ASM_REWRITE_TAC[]);;
let partition_components = 
prove(`!(H:(A)hypermap) x:A y:A. comb_component H x = comb_component H y \/ comb_component H x INTER comb_component H y ={}`,
REPEAT GEN_TAC THEN ASM_CASES_TAC `comb_component (H:(A)hypermap) (x:A) INTER comb_component H (y:A) ={}` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN (X_CHOOSE_THEN `t:A` MP_TAC) THEN REWRITE_TAC[INTER; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL[USE_THEN "F1" (LABEL_TAC "F3" o MATCH_MP lemma_component_symmetry) THEN DISCH_THEN (LABEL_TAC "F4") THEN REMOVE_THEN "F4"(fun th1 -> REMOVE_THEN "F3" (fun th2 -> MP_TAC (MATCH_MP lemma_component_trans (CONJ th2 th1)))) 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] THEN USE_THEN "F2" (LABEL_TAC "F5" o MATCH_MP lemma_component_symmetry) THEN DISCH_THEN (LABEL_TAC "F6") THEN REMOVE_THEN "F6"(fun th1 -> REMOVE_THEN "F5" (fun th2 -> MP_TAC (MATCH_MP lemma_component_trans (CONJ th2 th1)))) THEN DISCH_THEN(fun th1 -> (REMOVE_THEN "F1" (fun th2 -> MP_TAC (MATCH_MP lemma_component_trans (CONJ th2 th1))))) THEN REWRITE_TAC[]);;
let lemma_partition_by_components = 
prove(`!(H:(A)hypermap). dart H = UNIONS (set_of_components H)`,
GEN_TAC THEN REWRITE_TAC[set_of_components; set_part_components; EXTENSION; IN_UNIONS] THEN GEN_TAC THEN EQ_TAC THENL[STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN MP_TAC (SPECL[`H:(A)hypermap`;`x:A`] lemma_component_reflect) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN EXISTS_TAC `comb_component (H:(A)hypermap) (x:A)` THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_ASSUM (MP_TAC o MATCH_MP lemma_component_subset) THEN ASM_ASM_SET_TAC);;
(* We define the CONTOUR PATHS *)
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)`;;
let is_contour = new_recursive_definition num_RECURSION  `(is_contour (H:(A)hypermap) (p:num->A) 0 <=> T)/\
            (is_contour (H:(A)hypermap) (p:num->A) (SUC n) <=> ((is_contour H p n) /\ one_step_contour H (p n) (p (SUC n))))`;;
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)`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[SIMP_TAC[is_contour; CONJUNCT1 LE]; ALL_TAC] THEN STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LE] THEN STRIP_TAC THENL[ASM_REWRITE_TAC[]; UNDISCH_TAC `is_contour (H:(A)hypermap) (p:num->A) (SUC n)` THEN ASM_REWRITE_TAC[is_contour] THEN ASM_MESON_TAC[]]);;
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))))`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_contour] THEN ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[is_contour] THEN REWRITE_TAC[lemma_add_one_assumption_lt]);;
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) ==> is_contour H (glue p q n) (n + m)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN ASM_CASES_TAC `i:num < n:num` THENL[POP_ASSUM (LABEL_TAC "F5") THEN USE_THEN "F5" (fun th -> (MP_TAC (MATCH_MP LT_IMP_LE th)) THEN ASSUME_TAC (REWRITE_RULE[GSYM LE_SUC_LT] th)) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th]) THEN POP_ASSUM (fun th-> USE_THEN "F1" (fun thm -> REWRITE_TAC[MATCH_MP thm th])); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[NOT_LT]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2(GSYM ADD)] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[GSYM ADD1; LT_ADD_LCANCEL; LT_SUC]) THEN DISCH_THEN(fun th-> USE_THEN "F2" (fun thm -> REWRITE_TAC[MATCH_MP thm th])));;
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) ==> ?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)`,
REPEAT GEN_TAC THEN DISCH_THEN ASSUME_TAC THEN EXISTS_TAC `glue (p:num->A) (q:num->A) (n:num)` THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_glue_contours th] THEN ASSUME_TAC (CONJUNCT2 (CONJUNCT2 th))) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN SIMP_TAC[glue; LE_0; COND_ELIM_THM]);;
let node_contour = new_definition `!(H:(A)hypermap) (x:A) (i:num). node_contour H x i = ((inverse (node_map H)) POWER i) x`;;
(* face contour is exactly: face_path *)
let face_contour = new_definition `!(H:(A)hypermap) (x:A) (i:num). face_contour H x i  = ((face_map H) POWER i) x`;;
let lemma_node_contour = 
prove(`!(H:(A)hypermap) (x:A) (k:num). is_contour H (node_contour H x) k`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_contour]; ALL_TAC] THEN REWRITE_TAC[is_contour] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[one_step_contour] THEN DISJ2_TAC THEN REWRITE_TAC[node_contour; COM_POWER; o_THM]);;
let lemma_face_contour = 
prove(`!(H:(A)hypermap) (x:A) (k:num). is_contour H (face_contour H x) k`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_contour]; ALL_TAC] THEN REWRITE_TAC[is_contour] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[one_step_contour] THEN DISJ1_TAC THEN REWRITE_TAC[face_contour; COM_POWER; o_THM]);;
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`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_path] THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[is_contour]; ALL_TAC] THEN REWRITE_TAC[is_path] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN REMOVE_THEN "F1" (fun th -> REWRITE_TAC[th]) 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"))))) THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[go_one_step] THEN STRIP_TAC THENL[ POP_ASSUM (LABEL_TAC "G1") THEN MP_TAC (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `0`] node_contour) THEN REWRITE_TAC[POWER_0; I_THM] 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))))))) THEN REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN (X_CHOOSE_THEN `g:num->A` (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4" o CONJUNCT1)))) THEN REMOVE_THEN "G3" MP_TAC THEN REWRITE_TAC[node_contour; POWER_1] THEN DISCH_THEN (LABEL_TAC "G2") THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma) THEN DISCH_THEN (fun th -> MP_TAC(MATCH_MP inverse_element_lemma (CONJ (CONJUNCT1 th) (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2 th))))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "G7" o SYM)) THEN MP_TAC (SPECL[`H:(A)hypermap`; `(g:num->A) (SUC m)`; `0:num`] face_contour) THEN REWRITE_TAC[POWER_0; I_THM] 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))))))) THEN REWRITE_TAC[face_contour] THEN DISCH_THEN (X_CHOOSE_THEN `w:num->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `w:num->A` THEN EXISTS_TAC `(SUC m) + (j:num)` THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] THEN REWRITE_TAC[GSYM inverse2_hypermap_maps]; POP_ASSUM (LABEL_TAC "G1") THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma) THEN DISCH_THEN (fun th -> MP_TAC(MATCH_MP inverse_element_lemma (CONJ (CONJUNCT1 th) (CONJUNCT1(CONJUNCT2(CONJUNCT2 th)))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "G7" o SYM)) THEN MP_TAC (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `0:num`] node_contour) THEN REWRITE_TAC[POWER_0; I_THM] 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))))))) THEN REWRITE_TAC[node_contour] THEN DISCH_THEN (X_CHOOSE_THEN `w:num->A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `w:num->A` THEN EXISTS_TAC `(m:num) + (j:num)` THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] THEN REWRITE_TAC[GSYM POWER] THEN REWRITE_TAC[COM_POWER; o_THM] THEN USE_THEN "G7" SUBST1_TAC THEN REWRITE_TAC[node_map_inverse_representation]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G1") THEN MP_TAC (SPECL[`H:(A)hypermap`; `(q:num->A) (m:num)`; `0`] face_contour) THEN REWRITE_TAC[POWER_0; I_THM] 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))))))) THEN REWRITE_TAC[GSYM ADD1] THEN STRIP_TAC THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `(SUC m)` THEN ASM_REWRITE_TAC[face_contour; POWER_1]);;
let lemmaKDAEDEX = 
prove(`!H:(A)hypermap x:A y:A. y IN comb_component H x ==> ?p:num->A n:num. (p 0 = x) /\ (p n = y) /\ (is_contour H p n)`,
REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; comb_component; is_in_component] THEN REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP existence_contour) THEN REPEAT STRIP_TAC THEN EXISTS_TAC `q:num->A` THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]);;
(* the definition of injectve contours *)
let is_inj_contour = new_recursive_definition num_RECURSION  `(is_inj_contour (H:(A)hypermap) (p:num->A) 0 <=> T) /\ 
        (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)) /\ 
                 (!i:num. i <= n ==> ~(p i = p (SUC n))) ))`;;
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)`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[SIMP_TAC[is_inj_contour; CONJUNCT1 LE]; ALL_TAC] THEN SIMP_TAC[lemma_add_one_assumption] THEN POP_ASSUM (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th o CONJUNCT1 o REWRITE_RULE[is_inj_contour])) THEN SIMP_TAC[]);;
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) ==> is_inj_contour H q n`,
REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL[STRIP_TAC THEN REWRITE_TAC[is_inj_contour]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F1") THEN REWRITE_TAC[is_inj_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))) MP_TAC) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[lemma_add_one_assumption]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (SUBST1_TAC o SYM)) THEN REMOVE_THEN "F1" (fun th-> REMOVE_THEN "F2" (fun th1-> USE_THEN "F5" (fun th2-> REWRITE_TAC[MATCH_MP th (CONJ th1 th2)]))) THEN USE_THEN "F5" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `n:num`) THEN REMOVE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC THEN DISCH_THEN (fun th-> (POP_ASSUM (fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)]) THEN MP_TAC th)) THEN ASM_SIMP_TAC[]);;
let lemma_def_inj_contour = 
prove(`!(H:(A)hypermap) p:num->A n:num. is_inj_contour H p n <=> is_contour H p n /\ (!i:num j:num. i <= n /\ j < i ==> ~(p j = p i))`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[is_inj_contour; is_contour] THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (fun th -> REWRITE_TAC[is_contour; is_inj_contour; th]) THEN EQ_TAC THENL[SIMP_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1" o CONJUNCT2) (LABEL_TAC "F2" o CONJUNCT2)) THEN REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LE] THEN STRIP_TAC THENL[FIRST_X_ASSUM SUBST_ALL_TAC THEN USE_THEN "F2" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP th (REWRITE_RULE[LT_SUC_LE] th1)])); ALL_TAC] THEN REMOVE_THEN "F1" (fun th-> (POP_ASSUM (fun th2-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP th (CONJ th1 th2)])))); ALL_TAC] THEN SIMP_TAC[] THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2) THEN STRIP_TAC THENL[REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPECL[`i:num`; `j:num`]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) 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] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL; LT_SUC_LE] o SPEC `SUC n`) THEN SIMP_TAC[]);;
(* The theory of walkup in detail here with many trial facts *)
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)`;;
let is_edge_degenerate = new_definition `is_edge_degenerate (H:(A)hypermap) (x:A) 
   <=>  (edge_map H x = x) /\ ~(node_map H x = x) /\ ~(face_map H x = x)`;;
let is_node_degenerate = new_definition `is_node_degenerate (H:(A)hypermap) (x:A) 
   <=>  ~(edge_map H x = x) /\ (node_map H x = x) /\ ~(face_map H x = x)`;;
let is_face_degenerate = new_definition `is_face_degenerate (H:(A)hypermap) (x:A) 
   <=>  ~(edge_map H x = x) /\ ~(node_map H x = x) /\ (face_map H x = x)`;;
let degenerate_lemma = 
prove(`!(H:(A)hypermap) (x:A). dart_degenerate H x <=> isolated_dart H x \/ is_edge_degenerate H x \/ is_node_degenerate H x \/ is_face_degenerate H x`,
REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` hypermap_lemma) THEN REWRITE_TAC[dart_degenerate;isolated_dart; is_edge_degenerate; is_node_degenerate; is_face_degenerate] THEN POP_ASSUM (LABEL_TAC "F1") THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN MP_TAC(SPECL[`D:A->bool`; `e:A->A`;`n:A->A`;`f:A->A`] cyclic_maps) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) THEN EQ_TAC THENL[STRIP_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(n:A->A) (x:A) = x` THENL[ASM_REWRITE_TAC[] THEN USE_THEN "F3" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]; ASM_REWRITE_TAC[] THEN STRIP_TAC THEN USE_THEN "F2" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]] ; ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(e:A->A) (x:A) = x` THENL[ ASM_REWRITE_TAC[] THEN USE_THEN "F3" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]; ASM_REWRITE_TAC[] THEN STRIP_TAC THEN USE_THEN "F1" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]]; ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(e:A->A) (x:A) = x` THENL[ASM_REWRITE_TAC[] THEN USE_THEN "F2" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]; ASM_REWRITE_TAC[] THEN STRIP_TAC THEN USE_THEN "F1" (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM;I_THM]]]; MESON_TAC[]]);;
let lemma_category_darts = 
prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x \/ dart_degenerate H x`,
REPEAT STRIP_TAC THEN ASM_CASES_TAC `dart_degenerate (H:(A)hypermap) (x:A)` THENL[ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[dart_degenerate; dart_nondegenerate] THEN MESON_TAC[]);;
(* Some trivial lemmas on PAIRS *)
let lemma_pair_representation = 
prove(`!(S:((A->bool)#(A->A)#(A->A)#(A->A))). S = (FST S, FST (SND S), FST(SND(SND S)), SND(SND(SND S)))`,
REWRITE_TAC[PAIR_SURJECTIVE]);;
let lemma_pair_eq = 
prove(`!(S:((A->bool)#(A->A)#(A->A)#(A->A))) (U:((A->bool)#(A->A)#(A->A)#(A->A))). ((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)`,
ASM_MESON_TAC[lemma_pair_representation]);;
let lemma_hypermap_eq = 
prove(`!(H:(A)hypermap) (H':(A)hypermap). H = H' <=> dart H = dart H' /\ edge_map H = edge_map H' /\ node_map H = node_map H' /\ face_map H = face_map H'`,
REPEAT GEN_TAC THEN EQ_TAC THENL[ASM_MESON_TAC[hypermap_tybij; dart; edge_map; node_map; face_map]; ALL_TAC] THEN ASM_REWRITE_TAC[hypermap_tybij; dart; edge_map; node_map; face_map] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN `tuple_hypermap (H:(A)hypermap) = tuple_hypermap (H':(A)hypermap)` ASSUME_TAC THENL[ASM_MESON_TAC[lemma_pair_eq]; ASM_MESON_TAC[CONJUNCT1 hypermap_tybij]]);;
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`,
REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC (SPEC `(D:A->bool, e:A->A, n:A->A, f:A->A)` (CONJUNCT2 hypermap_tybij)) THEN ASM_REWRITE_TAC[dart; edge_map; node_map; face_map] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]);;
let shift = new_definition `shift (H:(A)hypermap) =  hypermap(dart H, node_map H, face_map H, edge_map H)`;;
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)`,
GEN_TAC THEN REWRITE_TAC [shift] THEN label_hypermap4_TAC `H:(A)hypermap` 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)))))))))) THEN MP_TAC (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_cyclic)) THEN POP_ASSUM(fun th->(DISCH_THEN(fun th1-> REWRITE_TAC[MATCH_MP lemma_hypermap_rep (REWRITE_RULE[GSYM CONJ_ASSOC](CONJ th th1))]))));;
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))`,
GEN_TAC THEN STRIP_ASSUME_TAC(SPEC `shift(H:(A)hypermap)` shift_lemma) THEN STRIP_ASSUME_TAC(SPEC `H:(A)hypermap` shift_lemma) THEN ASM_REWRITE_TAC[]);;
(* the definition of walkups *)
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)`;;
let node_walkup = new_definition `node_walkup (H:(A)hypermap) (x:A) = shift(shift(edge_walkup (shift H) x))`;;
let face_walkup = new_definition `face_walkup (H:(A)hypermap) (x:A) = shift(edge_walkup (shift (shift H)) x)`;;
let double_edge_walkup = new_definition `double_edge_walkup (H:(A)hypermap) (x:A) (y:A) = edge_walkup (edge_walkup H x) y`;;
let double_node_walkup = new_definition `double_node_walkup (H:(A)hypermap) (x:A) (y:A) = node_walkup (node_walkup H x) y`;;
let double_face_walkup = new_definition `double_face_walkup (H:(A)hypermap) (x:A) (y:A) = face_walkup (face_walkup H x) y`;;
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)`,
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))) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_CASES_TAC `x:A IN (D:A->bool)` THENL[MP_TAC (SET_RULE `(x:A) IN (D:A->bool) ==> (D = x INSERT (D DELETE x))`) THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC `S = (D:A->bool) DELETE (x:A)` THEN DISCH_THEN SUBST_ALL_TAC THEN MP_TAC(ISPECL[`p:A->A`;`x:A`;`(S:A->bool)`] PERMUTES_INSERT_LEMMA) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC (SET_RULE `~((x:A) IN (D:A->bool)) ==> D DELETE x = D`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_THEN `p:A->A permutes (D:A->bool)` (fun th -> ASSUME_TAC th THEN MP_TAC th) THEN GEN_REWRITE_TAC(LAND_CONV o ONCE_DEPTH_CONV) [permutes] THEN DISCH_THEN (MP_TAC o SPEC `x:A` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> ASM_REWRITE_TAC[th; SWAP_REFL; I_O_ID]));;
let PERMUTES_COMPOSITION = 
prove(`!p q s. p permutes s /\ q permutes s ==> (q o p) permutes s`,
REWRITE_TAC[permutes; o_THM] THEN MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[edge_walkup] THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `n' = swap(x:A, (n:A->A) x) o n` THEN ABBREV_TAC `f' = swap(x:A, (f:A->A) x) o f` THEN ABBREV_TAC `D' = (D:A->bool) DELETE (x:A)` THEN MP_TAC(ISPECL[`D:A->bool`;`n:A->A`; `x:A`] walkup_permutes) THEN ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL[`D:A->bool`;`f:A->A`; `x:A`] walkup_permutes) THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 STRIP_TAC THEN ABBREV_TAC `e' = inverse (f':A->A) o inverse (n':A->A)` THEN SUBGOAL_THEN `(e':A->A) permutes (D':A->bool)` MP_TAC THENL[UNDISCH_THEN `(n':A->A) permutes (D':A->bool)` (MP_TAC o MATCH_MP PERMUTES_INVERSE) THEN UNDISCH_THEN `(f':A->A) permutes (D':A->bool)` (MP_TAC o MATCH_MP PERMUTES_INVERSE) THEN REPEAT STRIP_TAC THEN MP_TAC (ISPECL[`inverse(n':A->A)`; `inverse(f':A->A)`; `D':A->bool`] PERMUTES_COMPOSITION) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `(e':A->A) o (n':A->A) o (f':A->A) = I` ASSUME_TAC THENL[MP_TAC ((ISPECL[`n':A->A`; `D':A->bool`] PERMUTES_INVERSES_o)) THEN ASM_REWRITE_TAC[] THEN MP_TAC ((ISPECL[`f':A->A`; `D':A->bool`] PERMUTES_INVERSES_o)) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN EXPAND_TAC "e'" THEN REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[lemma_4functions] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[I_O_ID]; ALL_TAC] THEN MP_TAC (SPECL[`D':A->bool`; `e':A->A`; `n':A->A`; `f':A->A`] lemma_hypermap_rep) THEN MP_TAC (ISPECL[`D:A->bool`; `x:A`] FINITE_DELETE_IMP) THEN ASM_SIMP_TAC[]);;
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)`,
REPEAT GEN_TAC THEN LABEL_TAC "F1" (CONJUNCT1 (CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))) THEN REWRITE_TAC[CONJUNCT1 (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)))] THEN REWRITE_TAC[o_THM] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN STRIP_TAC 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] THEN STRIP_TAC THENL[SUBGOAL_THEN `(n:A->A)(inverse(n) (x:A)) = x` (fun th-> REWRITE_TAC[th]) THENL[GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] THEN REMOVE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) THEN POP_ASSUM (fun th -> REWRITE_TAC[th; I_THM]); MESON_TAC[swap]];ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN SUBGOAL_THEN `~((n:A->A) (y:A) = n (x:A))` MP_TAC THENL[USE_THEN "F1"(MP_TAC o SPECL[`y:A`;`x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `~((n:A->A) (y:A) = (x:A))` ASSUME_TAC 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] THEN ASM_MESON_TAC[swap]);;
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)`,
REPEAT GEN_TAC THEN LABEL_TAC "F1" (CONJUNCT1 (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))) THEN REWRITE_TAC[CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)))] THEN REWRITE_TAC[o_THM] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN STRIP_TAC 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] THEN STRIP_TAC THENL[SUBGOAL_THEN `(f:A->A)(inverse(f) (x:A)) = x` (fun th-> REWRITE_TAC[th]) THENL[GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] THEN REMOVE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) THEN POP_ASSUM (fun th -> REWRITE_TAC[th; I_THM]); MESON_TAC[swap]];ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[o_THM] THEN SUBGOAL_THEN `~((f:A->A) (y:A) = f (x:A))` MP_TAC THENL[USE_THEN "F1"(MP_TAC o SPECL[`y:A`;`x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN SUBGOAL_THEN `~((f:A->A) (y:A) = (x:A))` ASSUME_TAC 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] THEN ASM_MESON_TAC[swap]);;
let lemma_edge_degenerate = 
prove(`!(H:(A)hypermap) (x:A). (edge_map H x = x) <=> (face_map H x = (inverse (node_map H)) x)`,
REPEAT STRIP_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN MP_TAC(AP_THM (SYM (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))) `x:A`) THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC THENL[DISCH_TAC THEN REMOVE_THEN "F1" MP_TAC THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC] THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ th2 (SYM th1)) ))))) THEN DISCH_TAC THEN USE_THEN "H4" (MP_TAC o ISPECL[`(e:A->A) (x:A)`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
let lemma_node_degenerate = 
prove(`!(H:(A)hypermap) (x:A). (node_map H x = x) <=> (edge_map H x = (inverse (face_map H)) x)`,
REPEAT STRIP_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN MP_TAC(AP_THM (SYM (CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps)))) `x:A`) THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC THENL[DISCH_TAC THEN REMOVE_THEN "F1" MP_TAC THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC] THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ th2 (SYM th1)) ))))) THEN DISCH_TAC THEN USE_THEN "H2" (MP_TAC o ISPECL[`(n:A->A) (x:A)`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
let lemma_face_degenerate = 
prove(`!(H:(A)hypermap) (x:A). (face_map H x = x) <=> (node_map H x = (inverse (edge_map H)) x)`,
REPEAT STRIP_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN MP_TAC(AP_THM (SYM (CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps))) `x:A`) THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC THENL[DISCH_TAC THEN REMOVE_THEN "F1" MP_TAC THEN ASM_REWRITE_TAC[o_THM]; ALL_TAC] THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ th2 (SYM th1)) ))))) THEN DISCH_TAC THEN USE_THEN "H3" (MP_TAC o ISPECL[`(f:A->A) (x:A)`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
let fixed_point_lemma = 
prove(`!(D:A->bool) (p:A->A). p permutes D ==> (!(x:A). p x = x <=> inverse p x = x)`,
REPEAT STRIP_TAC THEN EQ_TAC THENL[POP_ASSUM (fun th1 -> (DISCH_THEN(fun th2 -> (MP_TAC(MATCH_MP inverse_function (CONJ th1 th2)))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]); ALL_TAC] THEN DISCH_THEN (MP_TAC o AP_TERM `p:A->A`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM] THEN (POP_ASSUM (ASSUME_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o)) THEN ASM_REWRITE_TAC[I_THM] THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]));;
let non_fixed_point_lemma = 
prove(`!(s:A->bool) (p:A->A). p permutes s ==> (!(x:A). ~(p x = x) <=> ~(inverse p x = x))`,
REPEAT STRIP_TAC THEN REWRITE_TAC[TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN ASM_MESON_TAC[fixed_point_lemma]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[dart_nondegenerate] THEN MESON_TAC[hypermap_lemma; non_fixed_point_lemma]);;
let aux_permutes_conversion = 
prove(`!(D:A->bool) (p:A->A) (q:A->A) (x:A) (y:A). (p permutes D) /\ (q permutes D) ==> ((inverse p)((inverse q) x) = y <=> q ( p y) = x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (MP_TAC o ISPECL[`y:A`; `inverse(q:A->A) (x:A)`] o MATCH_MP PERMUTES_INVERSE_EQ) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F2" (MP_TAC o ISPECL[`(p:A->A) (y:A)`; `(x:A)`] o MATCH_MP PERMUTES_INVERSE_EQ) THEN MESON_TAC[]);;
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)`,
REPEAT GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN label_hypermapG_TAC `(edge_walkup (H:(A)hypermap) (x:A))` 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) THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN ABBREV_TAC `D' = dart (G:(A)hypermap)` THEN ABBREV_TAC `e' = edge_map (G:(A)hypermap)` THEN ABBREV_TAC `n' = node_map (G:(A)hypermap)` THEN ABBREV_TAC `f' = face_map (G:(A)hypermap)` THEN MP_TAC(CONJUNCT1 (SPEC `G:(A)hypermap` inverse2_hypermap_maps)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THENL[REMOVE_THEN "A1" (MP_TAC o CONJUNCT1 o SPEC `y:A`) THEN DISCH_THEN (fun th -> (USE_THEN "G3" (fun th1 ->MP_TAC (MATCH_MP inverse_function (CONJ th1 th))))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REMOVE_THEN "A2" (MP_TAC o CONJUNCT1 o SPEC `y:A`) THEN DISCH_THEN (fun th -> (USE_THEN "G4" (fun th1 ->MP_TAC (MATCH_MP inverse_function (CONJ th1 th))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN STRIP_TAC 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) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THEN SUBGOAL_THEN `~((e:A->A) (x:A) = inverse (f:A->A) x)` ASSUME_TAC THENL[UNDISCH_THEN `~((n:A->A) (x:A) = x)` (MP_TAC o GSYM) THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "H2" (MP_TAC o SYM o SPECL[`x:A`; `inverse(f:A->A) x:A`] o MATCH_MP PERMUTES_INVERSE_EQ) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM] THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`] inverse2_hypermap_maps))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_THEN (fun th -> MP_TAC (SYM th)) THEN SIMP_TAC[]; ALL_TAC] THEN REMOVE_THEN "A2" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(e:A->A) (x:A)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> MP_TAC(SYM(AP_THM th `x:A`))) THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REMOVE_THEN "A1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC `x:A`) THEN REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC 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) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `~((f:A->A) (x:A) = inverse (n:A->A) x)` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "H4" (MP_TAC o SYM o SPECL[`x:A`; `inverse(n:A->A) x:A`] o MATCH_MP PERMUTES_INVERSE_EQ) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM] THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`] inverse2_hypermap_maps)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN STRIP_TAC THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~((f:A->A) (x:A) = x)` ASSUME_TAC THENL[UNDISCH_TAC `~(inverse (f:A->A) (x:A) = x)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN USE_THEN "H4" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "A1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(f:A->A) (x:A)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM o_THM] THEN MP_TAC(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[SYM th]); ALL_TAC] 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) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN `~((e:A->A) (y:A) = (inverse (f:A->A)) (x:A))` ASSUME_TAC THENL[STRIP_TAC THEN UNDISCH_THEN `~((y:A) = (n:A->A) (x:A))` MP_TAC THEN REWRITE_TAC[] THEN POP_ASSUM (MP_TAC o AP_TERM `inverse (e:A->A)`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM] THEN USE_THEN "H2" (MP_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) THEN DISCH_THEN (fun th-> REWRITE_TAC[th; I_THM]) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM] THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse2_hypermap_maps))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN SUBGOAL_THEN `~((e:A->A) (y:A) = (x:A))` ASSUME_TAC THENL[UNDISCH_TAC `~(y:A = inverse (e:A->A) (x:A))` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (fun th -> (USE_THEN "H2" (fun th1 -> (MP_TAC (MATCH_MP inverse_function (CONJ th1 th)))))) THEN REWRITE_TAC[]; ALL_TAC] THEN REMOVE_THEN "A2" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(e:A->A) (y:A)`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM] THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` inverse_hypermap_maps))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN SUBGOAL_THEN `~(inverse (n:A->A) (y:A) = inverse (n:A->A) (x:A))` ASSUME_TAC THENL[UNDISCH_TAC `~(y:A = x:A)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "H3" (MP_TAC o MATCH_MP PERMUTES_INVERSE) THEN DISCH_THEN (MP_TAC o ISPECL[`y:A`; `x:A`] o MATCH_MP PERMUTES_INJECTIVE) THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(inverse (n:A->A) (y:A) = x:A)` ASSUME_TAC THENL[UNDISCH_TAC `~(y:A = (n:A->A) (x:A))` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (MP_TAC o AP_TERM `n:A->A`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_THM] THEN USE_THEN "H3" (MP_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) THEN DISCH_THEN (fun th -> REWRITE_TAC[th; I_THM]); ALL_TAC] THEN DISCH_TAC THEN REMOVE_THEN "A1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC `(inverse (n:A->A)) (y:A)`) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM] THEN USE_THEN "H3" (MP_TAC o CONJUNCT1 o MATCH_MP PERMUTES_INVERSES_o) THEN DISCH_THEN (fun th -> REWRITE_TAC[th; I_THM]));;
(* About orbits of permutations *)
let power_list = new_definition `!p:A->A x:A. power_list p x = (\i:num. (p POWER i) x)`;;
let inj_orbit = new_recursive_definition num_RECURSION 
   `(inj_orbit (p:A->A) (x:A) 0 <=> T) /\ (inj_orbit (p:A->A) (x:A) (SUC n) 
    <=> (inj_orbit p x n) /\ (!j:num. j <= n ==> ~((p POWER (SUC n)) x =  (p POWER j) x)))`;;
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`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[inj_orbit; is_inj_list]; ALL_TAC] THEN REWRITE_TAC[inj_orbit; is_inj_list] THEN POP_ASSUM (fun th-> REWRITE_TAC[GSYM th; power_list]) THEN MESON_TAC[EQ_SYM]);;
let lemma_def_inj_orbit = 
prove(`!(p:A->A) (x:A) (n:num). (inj_orbit p x n <=> (!i:num j:num. i <= n /\ j < i ==> ~((p POWER i) x = (p POWER j) x)))`,
REWRITE_TAC[lemma_inj_orbit_via_list; lemma_inj_list; power_list] THEN MESON_TAC[EQ_SYM]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_orbit_via_list; lemma_inj_list2; power_list]);;
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`,
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) ==> (inj_orbit p x (SUC n))`,
REPEAT STRIP_TAC THEN REWRITE_TAC[inj_orbit] THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 2 STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[CONTRAPOS_THM] THEN ASM_CASES_TAC `j:num = 0` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN UNDISCH_TAC `j:num <= n:num` THEN REWRITE_TAC[GSYM LT_SUC_LE] THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` (LABEL_TAC "G")) THEN USE_THEN "G" SUBST1_TAC 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)))))) THEN MP_TAC(ARITH_RULE `~(j = 0) /\ SUC (n:num) = j + SUC (d:num) ==> SUC d <= n`) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL[`p:A->A`; `x:A`; `n:num`] lemma_def_inj_orbit) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPECL[`SUC (d:num)`; `0`]) THEN ASM_REWRITE_TAC[LT_NZ; POWER_0; ARITH; I_THM] THEN ARITH_TAC);;
let lemma_subset_orbit = 
prove(`!(p:A->A) x:A n:num. {(p POWER (i:num)) x | i <= n} SUBSET orbit_map p x`,
REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN GEN_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);;
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)`,
REPLICATE_TAC 4 STRIP_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[inj_orbit]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F1") THEN DISCH_THEN (LABEL_TAC "F2") THEN MP_TAC (ARITH_RULE `SUC (m:num) < CARD (orbit_map (p:A->A) (x:A)) ==> m < CARD (orbit_map p x)`) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN REMOVE_THEN "F1" MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THEN MATCH_MP_TAC inj_orbit_step THEN EXISTS_TAC `s:A->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(SPECL[`p:A->A`; `SUC (m:num)`; `x:A`] card_orbit_le) THEN ASM_REWRITE_TAC[ARITH_RULE `~(SUC(d:num) = 0)`] THEN REMOVE_THEN "F2" MP_TAC THEN ARITH_TAC);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect) THEN ABBREV_TAC `m = PRE (CARD (orbit_map (p:A->A) (x:A)))` THEN POP_ASSUM (LABEL_TAC "F3") THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite o CONJ th)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_ATLEAST_1) THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP LE_SUC_PRE) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN ASM_CASES_TAC `~(((p:A->A) POWER (SUC m)) (x:A) = x)` THENL[POP_ASSUM MP_TAC 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)) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; LT_PLUS]) THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP inj_orbit_step) THEN REWRITE_TAC[lemma_inj_orbit_via_list] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; power_list] o MATCH_MP lemma_size_list) THEN DISCH_TAC THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite o CONJ th)) THEN MP_TAC (SPECL[`p:A->A`; `x:A`; `SUC m`] lemma_subset_orbit) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_SUBSET) THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM SUBST1_TAC THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[]) THEN POP_ASSUM SUBST1_TAC THEN SIMP_TAC[]);;
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 ==> ?n:num. n < CARD (orbit_map p x) /\ y = (p POWER n) x`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> LABEL_TAC "FC" (CONJ th th1))) THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect) THEN USE_THEN "FC" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[LT1_NZ; LT_NZ] o MATCH_MP CARD_ATLEAST_1) 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))))))) THEN USE_THEN "F3" (MP_TAC) THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[IN_ELIM_THM]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1")(CONJUNCTS_THEN2 (LABEL_TAC "F2")(CONJUNCTS_THEN2 (LABEL_TAC "F3")(LABEL_TAC "F4")))) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> LABEL_TAC "FC" (CONJ th th1))) THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect) THEN USE_THEN "FC" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (LABEL_TAC "F5" o MATCH_MP CARD_ATLEAST_1) THEN USE_THEN "F5" (MP_TAC o REWRITE_RULE[LT1_NZ; LT_NZ]) THEN DISCH_THEN (MP_TAC o SPEC `m:num` o MATCH_MP DIVMOD_EXIST) THEN DISCH_THEN (X_CHOOSE_THEN `q:num` (X_CHOOSE_THEN `r:num` (CONJUNCTS_THEN2 SUBST_ALL_TAC (LABEL_TAC "F6")))) THEN EXISTS_TAC `q:num` THEN REWRITE_TAC[EQ_ADD_LCANCEL] THEN USE_THEN "F4" (MP_TAC o ONCE_REWRITE_RULE[ADD_SYM]) THEN REWRITE_TAC[lemma_add_exponent_function] THEN USE_THEN "FC" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_cycle_orbit) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP power_map_fix_point th]) THEN DISCH_TAC 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) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th; LE_REFL]) THEN DISCH_THEN (MP_TAC o SPECL[`r:num`; `n:num`] o REWRITE_RULE[GSYM LT_SUC_LE] o REWRITE_RULE[lemma_inj_orbit]) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th; LE_REFL]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM th; EQ_SYM]));;
(*******************************************)
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)`;;
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)`;;
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)`;;
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`;;
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`;;
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`;;
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`,
REPEAT STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`] inverse_element_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (fun th -> (ASSUME_TAC (AP_THM th `x:A`)))) THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[]);;
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 ==> orbit_map p x = orbit_map p y`,
REPEAT STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`] partition_orbit) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `y:A`]) THEN ASSUME_TAC (SPECL[`p:A->A`; `y:A`] orbit_reflect) THEN SUBGOAL_THEN `?z:A.z IN orbit_map (p:A->A) (x:A) INTER orbit_map (p:A->A) (y:A)` MP_TAC THENL[MP_TAC (ISPECL[`orbit_map (p:A->A) (x:A)`; `orbit_map (p:A->A) (y:A)`; `y:A`] IN_INTER) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `y:A` THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REWRITE_TAC[MEMBER_NOT_EMPTY] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]));;
let lemma_edge_identity = 
prove(`!(H:(A)hypermap) x:A y:A. y IN edge H x ==> edge H x = edge H y`,
REPEAT GEN_TAC THEN REWRITE_TAC[edge] THEN MESON_TAC[lemma_orbit_identity; hypermap_lemma]);;
let lemma_node_identity = 
prove(`!(H:(A)hypermap) x:A y:A. y IN node H x ==> node H x = node H y`,
REPEAT GEN_TAC THEN REWRITE_TAC[node] THEN MESON_TAC[lemma_orbit_identity; hypermap_lemma]);;
let lemma_face_identity = 
prove(`!(H:(A)hypermap) x:A y:A. y IN face H x ==> face H x = face H y`,
REPEAT GEN_TAC THEN REWRITE_TAC[face] THEN MESON_TAC[lemma_orbit_identity; hypermap_lemma]);;
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) ==> orbit_map p x INTER orbit_map p y = {}`,
REPEAT STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`] partition_orbit) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `y:A`]) THEN SUBGOAL_THEN `~(orbit_map (p:A->A) (x:A) = orbit_map (p:A->A) (y:A))` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN ASM_REWRITE_TAC[]);;
let INVERSE_POWER_MAP = 
prove(`!s:A->bool p:A->A n:num. FINITE s /\ p permutes s ==> (inverse p) o (p POWER (SUC n)) = p POWER n`,
REPEAT STRIP_TAC THEN REWRITE_TAC[COM_POWER; o_ASSOC] THEN POP_ASSUM (MP_TAC o CONJUNCT2 o MATCH_MP PERMUTES_INVERSES_o) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[I_O_ID]);;
let INVERSE_POWER_EVALUATION = 
prove(`!s:A->bool p:A->A x:A n:num. FINITE s /\ p permutes s ==> (inverse p)((p POWER (SUC n)) x) = (p POWER n) x`,
REPEAT STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `n:num`] INVERSE_POWER_MAP) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> (MP_TAC (AP_THM th `x:A`))) THEN REWRITE_TAC[o_THM]);;
let lemma_in_disjoint = 
prove(`!s:A->bool t:A->bool x:A. s INTER t = {} /\ x IN s ==> ~(x IN t)`,
REPEAT STRIP_TAC THEN MP_TAC(SPECL[`s:A->bool`; `t:A->bool`; `x:A`] IN_INTER) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[NOT_IN_EMPTY]);;
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)`,
REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[GE; LE_0]);;
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))`,
REPEAT STRIP_TAC THEN MP_TAC(SPECL[`p:A->A`; `n:num`; `x:A`; `((p:A->A) POWER (n:num)) (x:A)` ] in_orbit_lemma) THEN SIMP_TAC[] THEN STRIP_TAC THEN MP_TAC (SPECL[`s:A->bool`; `p:A->A`; `x:A`; `((p:A->A) POWER (n:num)) (x:A)`] lemma_orbit_identity) THEN ASM_REWRITE_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (fun th -> (ASSUME_TAC th THEN MP_TAC(SPEC `x:A` (MATCH_MP INVERSE_EVALUATION th)))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN POP_ASSUM (SUBST1_TAC o SPECL[`x:A`; `j:num`] o MATCH_MP lemma_orbit_power) THEN REWRITE_TAC[orbit_reflect]);;
let lemmaFKSNTKR = 
prove(`!(H:(A)hypermap) (x:A). simple_hypermap H /\ x IN dart H /\ ~((edge_map H) x = x) /\ (dart_nondegenerate H x) /\ 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`,
REPEAT GEN_TAC THEN REWRITE_TAC[simple_hypermap; dart_nondegenerate; is_face_merge; is_node_merge; node; face; o_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN FIRST_X_ASSUM (MP_TAC o SPEC `(f:A->A) (x:A)` o check (is_forall o concl)) THEN USE_THEN "H4" (MP_TAC o SYM o SPEC `x:A` o MATCH_MP PERMUTES_IN_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "FF") THEN STRIP_TAC THENL[USE_THEN "H2" (fun th2 -> (DISCH_THEN (fun th3 -> (MP_TAC(MATCH_MP inverse_function (CONJ th2 th3)))))) THEN MP_TAC(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_THM] THEN DISCH_TAC THEN MP_TAC(SPECL[`n:A->A`; `1`;`(f:A->A) (x:A)`; `(e:A->A) (x:A)`] in_orbit_lemma) THEN POP_ASSUM (fun th -> ((ASSUME_TAC (SYM th)) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [POWER_1; th])) THEN SIMP_TAC[] THEN DISCH_THEN (LABEL_TAC "F2") THEN UNDISCH_TAC `~((n:A->A) ((e:A->A) (x:A)) = e x)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (LABEL_TAC "F3") THEN MP_TAC(SPECL[`f:A->A`; `1`;`(x:A)`; `(f:A->A) (x:A)`] in_orbit_lemma) THEN REWRITE_TAC[POWER_1] 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))))))))) THEN DISCH_THEN SUBST_ALL_TAC THEN REMOVE_THEN "F2" (fun th1 -> (REMOVE_THEN "F3" (fun th2 -> MP_TAC (CONJ th1 th2)))) THEN REWRITE_TAC[GSYM IN_INTER] THEN USE_THEN "FF" SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN (MP_TAC o AP_TERM `n:A->A`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN UNDISCH_TAC `~((f:A->A) (x:A) = x)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC 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))))))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F8") THEN MP_TAC(SPECL[`f:A->A`; `1`; `x:A`;`(f:A->A) (x:A)`] in_orbit_lemma) THEN REWRITE_TAC[POWER_1] THEN DISCH_TAC 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))))))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F9") THEN REMOVE_THEN "F8" (fun th1 -> (REMOVE_THEN "F9" (fun th2 -> MP_TAC (CONJ th1 th2)))) THEN REWRITE_TAC[GSYM IN_INTER] THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]));;
(* PLANARITY *)
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))))`;;
(* some trivial lemmas *)
let lemma_planar_hypermap = 
prove(`!(H:(A)hypermap). planar_hypermap H <=> planar_ind H = &0`,
REWRITE_TAC[planar_hypermap; planar_ind;GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC);;
let lemma_null_hypermap_planar_index = 
prove(`!(H:(A)hypermap). CARD (dart H) = 0 ==> planar_ind H = &0`,
GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN USE_THEN "H1"(fun th -> REWRITE_TAC[MATCH_MP CARD_EQ_0 th]) THEN REWRITE_TAC[planar_ind; number_of_edges; number_of_nodes; number_of_faces; number_of_components] THEN REWRITE_TAC[edge_set; node_set; face_set; set_of_components; set_part_components] THEN DISCH_THEN (LABEL_TAC "F1") THEN REMOVE_THEN "F1" (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) 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] THEN SUBGOAL_THEN `{comb_component (H:(A)hypermap) (x:A)| x IN {}} = {}` SUBST1_TAC THENL[SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[CARD_CLAUSES] THEN REAL_ARITH_TAC);;
let lemma_shift_component_invariant = 
prove(`!(H:(A)hypermap). set_of_components H = set_of_components (shift H)`,
GEN_TAC THEN REWRITE_TAC[set_of_components] THEN REWRITE_TAC[GSYM shift_lemma] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN REWRITE_TAC[set_part_components] THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[comb_component; EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_in_component] THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A` THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[is_path; lemma_def_path] THEN DISCH_THEN (LABEL_TAC "F1") THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step] THEN DISCH_TAC THEN REWRITE_TAC [GSYM shift_lemma] THEN POP_ASSUM MP_TAC THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[is_in_component] THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A` THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[is_path; lemma_def_path] THEN DISCH_THEN (LABEL_TAC "F1") THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step] THEN DISCH_TAC THEN ONCE_REWRITE_TAC [shift_lemma] THEN POP_ASSUM MP_TAC THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[comb_component; IN_ELIM_THM; is_in_component] THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A` THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[is_path; lemma_def_path] THEN DISCH_THEN (LABEL_TAC "F2") THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F2" (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step] THEN DISCH_TAC THEN ONCE_REWRITE_TAC [shift_lemma] THEN POP_ASSUM MP_TAC THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[comb_component; is_in_component; IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `p:num -> A` THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[is_path; lemma_def_path] THEN DISCH_THEN (LABEL_TAC "F2") THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F2" (MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[go_one_step] THEN DISCH_TAC THEN REWRITE_TAC[GSYM shift_lemma] THEN POP_ASSUM MP_TAC THEN MESON_TAC[]);;
let lemma_planar_invariant_shift = 
prove(`!(H:(A)hypermap). planar_ind H = planar_ind (shift H)`,
GEN_TAC THEN REWRITE_TAC[planar_ind; number_of_edges; number_of_nodes; number_of_faces; number_of_components] THEN ONCE_REWRITE_TAC[GSYM lemma_shift_component_invariant] THEN REWRITE_TAC[edge_set; node_set; face_set] THEN ONCE_REWRITE_TAC[GSYM shift_lemma] THEN REAL_ARITH_TAC);;
let in_orbit_map1 = 
prove(`!p:A->A x:A. p x IN orbit_map p x`,
REPEAT GEN_TAC THEN MP_TAC (SPECL[`p:A->A`; `1`; `x:A`; `(p:A->A) (x:A)`] in_orbit_lemma) THEN REWRITE_TAC[POWER_1]);;
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`,
REPEAT STRIP_TAC THEN REWRITE_TAC[orbit_map; EXTENSION; IN_ELIM_THM] THEN STRIP_TAC THEN EQ_TAC THENL[STRIP_TAC THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[ARITH_RULE `n:num >= 0`] THEN FIRST_X_ASSUM (MP_TAC o SPEC `n:num` o check (is_forall o concl)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[ARITH_RULE `n:num >= 0`] THEN FIRST_X_ASSUM (MP_TAC o SYM o SPEC `n:num` o check (is_forall o concl)) THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN MP_TAC(SPECL[`p:A->A`; `m:num`; `x:A`; `((p:A->A) POWER (m:num)) (x:A)`] in_orbit_lemma) THEN SIMP_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_TAC THEN MP_TAC(SPECL[`p:A->A`; `y:A`] orbit_reflect) THEN MP_TAC(SPECL[`s:A->bool`; `p:A->A`; `y:A`; `n:num`] lemma_orbit_power) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN STRIP_TAC THEN MP_TAC(SPECL[`p:A->A`; `y:A`; `((p:A->A) POWER (n:num)) (y:A)`; `x:A` ] orbit_trans) THEN ASM_REWRITE_TAC[]);;
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))`,
REPEAT GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))` THEN LABEL_TAC "F1" (SPECL[`n:A->A`; `x:A`] orbit_reflect) THEN DISCH_THEN (LABEL_TAC "F2") THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> MP_TAC(SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F3")) THEN USE_THEN "F3" ((LABEL_TAC "F4") o MATCH_MP in_orbit_lemma) THEN ASM_REWRITE_TAC[node_set; node] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[set_of_orbits] THEN REWRITE_TAC[EXTENSION] THEN STRIP_TAC THEN REWRITE_TAC[IN_DELETE] THEN EQ_TAC THENL[REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) (LABEL_TAC "F7")) THEN REMOVE_THEN "F6" SUBST_ALL_TAC THEN SUBGOAL_THEN `~(y:A IN orbit_map (n:A->A) (x:A))` (LABEL_TAC "F8") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN SUBGOAL_THEN `!m:num. ((n:A->A) POWER (m:num)) (y:A) = ((n':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9") THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F9" o SYM) THEN MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `y:A`; `m:num`; `j:num`] lemma_not_in_orbit_powers) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `y:A`; `m:num`; `0`] lemma_not_in_orbit_powers) THEN ASM_REWRITE_TAC[POWER_0; I_THM] THEN STRIP_TAC THEN REWRITE_TAC[GSYM iterate_map_valuation] THEN REMOVE_THEN "F9" SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((n:A->A) POWER (m:num)) (y:A)`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN SUBGOAL_THEN `~(((n:A->A) POWER (j:num)) (x:A) IN orbit_map n (y:A))` (LABEL_TAC "F10") THENL[ REMOVE_THEN "F8" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `j:num`] lemma_orbit_power) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq) THEN DISCH_THEN SUBST_ALL_TAC THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN MP_TAC(SPECL[`D:A->bool`; `n:A->A`; `x:A`; `y:A`; `0`; `0`] lemma_not_in_orbit_powers) THEN ASM_REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] 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")) THEN REMOVE_THEN "F6" SUBST_ALL_TAC THEN SUBGOAL_THEN `y:A IN (D:A->bool) DELETE (x:A)` (LABEL_TAC "F8") THENL[FIND_ASSUM SUBST1_TAC `D':A->bool = (D:A->bool) DELETE x:A` THEN ASM_ASM_SET_TAC; ALL_TAC] THEN SUBGOAL_THEN `!k:num. ~(((n':A->A) POWER k) (y:A) = x:A)` (LABEL_TAC "FG") THENL[GEN_TAC THEN MP_TAC (MESON[hypermap_lemma] `node_map (edge_walkup (H:(A)hypermap) (x:A)) permutes dart(edge_walkup H x)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPECL[`k:num`; `y:A`] o MATCH_MP iterate_orbit) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[IN_DELETE] THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2" o CONJUNCT1 o CONJUNCT2)) THEN SUBGOAL_THEN `~(((n:A->A) POWER (j:num)) (x:A) IN orbit_map (n':A->A) (y:A))` (LABEL_TAC "FH") THENL[ USE_THEN "F7" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m:num. ((n:A->A) POWER (m:num)) (y:A) = ((n':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9") THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F9" o SYM) THEN REMOVE_THEN "FG" (LABEL_TAC "F10" o SPEC `m:num`) 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) THEN ASM_REWRITE_TAC[POWER_0; I_THM] THEN DISCH_THEN (LABEL_TAC "F11" o GSYM) THEN REWRITE_TAC[GSYM iterate_map_valuation] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((n:A->A) POWER (m:num)) (y:A)`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F9" (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [SYM th]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq) THEN DISCH_THEN (SUBST_ALL_TAC o SYM) THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN EXISTS_TAC `j:num` THEN ARITH_TAC);;
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))`,
REPEAT GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))` THEN LABEL_TAC "F1" (SPECL[`f:A->A`; `x:A`] orbit_reflect) THEN DISCH_THEN (LABEL_TAC "F2") THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> MP_TAC(SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2)))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F3")) THEN USE_THEN "F3" ((LABEL_TAC "F4") o MATCH_MP in_orbit_lemma) THEN ASM_REWRITE_TAC[face_set; face] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[set_of_orbits] THEN REWRITE_TAC[EXTENSION] THEN STRIP_TAC THEN REWRITE_TAC[IN_DELETE] THEN EQ_TAC THENL[REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) (LABEL_TAC "F7")) THEN REMOVE_THEN "F6" SUBST_ALL_TAC THEN SUBGOAL_THEN `~(y:A IN orbit_map (f:A->A) (x:A))` (LABEL_TAC "F8") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN SUBGOAL_THEN `!m:num. ((f:A->A) POWER (m:num)) (y:A) = ((f':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9") THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F9" o SYM) THEN MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `y:A`; `m:num`; `j:num`] lemma_not_in_orbit_powers) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `y:A`; `m:num`; `0`] lemma_not_in_orbit_powers) THEN ASM_REWRITE_TAC[POWER_0; I_THM] THEN STRIP_TAC THEN REWRITE_TAC[GSYM iterate_map_valuation] THEN REMOVE_THEN "F9" SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((f:A->A) POWER (m:num)) (y:A)`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN SUBGOAL_THEN `~(((f:A->A) POWER (j:num)) (x:A) IN orbit_map f (y:A))` (LABEL_TAC "F10") THENL[ REMOVE_THEN "F8" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `j:num`] lemma_orbit_power) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq) THEN DISCH_THEN SUBST_ALL_TAC THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN MP_TAC(SPECL[`D:A->bool`; `f:A->A`; `x:A`; `y:A`; `0`; `0`] lemma_not_in_orbit_powers) THEN ASM_REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] 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")) THEN REMOVE_THEN "F6" SUBST_ALL_TAC THEN SUBGOAL_THEN `y:A IN (D:A->bool) DELETE (x:A)` (LABEL_TAC "F8") THENL[FIND_ASSUM SUBST1_TAC `D':A->bool = (D:A->bool) DELETE x:A` THEN ASM_ASM_SET_TAC; ALL_TAC] THEN SUBGOAL_THEN `!k:num. ~(((f':A->A) POWER k) (y:A) = x:A)` (LABEL_TAC "FG") THENL[GEN_TAC THEN MP_TAC (MESON[hypermap_lemma] `face_map (edge_walkup (H:(A)hypermap) (x:A)) permutes dart(edge_walkup H x)`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SPECL[`k:num`; `y:A`] o MATCH_MP iterate_orbit) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[IN_DELETE] THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2" o CONJUNCT1 o CONJUNCT2 o CONJUNCT2)) THEN SUBGOAL_THEN `~(((f:A->A) POWER (j:num)) (x:A) IN orbit_map (f':A->A) (y:A))` (LABEL_TAC "FH") THENL[ USE_THEN "F7" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!m:num. ((f:A->A) POWER (m:num)) (y:A) = ((f':A->A) POWER (m:num)) (y:A)` (LABEL_TAC "F9") THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F9" o SYM) THEN REMOVE_THEN "FG" (LABEL_TAC "F10" o SPEC `m:num`) 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) THEN ASM_REWRITE_TAC[POWER_0; I_THM] THEN DISCH_THEN (LABEL_TAC "F11" o GSYM) THEN REWRITE_TAC[GSYM iterate_map_valuation] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((f:A->A) POWER (m:num)) (y:A)`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F9" (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [SYM th]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN REMOVE_THEN "F9" (MP_TAC o MATCH_MP lemma_orbit_eq) THEN DISCH_THEN (SUBST_ALL_TAC o SYM) THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_map; IN_ELIM_THM] THEN EXISTS_TAC `j:num` THEN ARITH_TAC);;
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)`,
REPEAT GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))` THEN REWRITE_TAC[edge] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F4"))) THEN SUBGOAL_THEN `!m:num. ((e:A->A) POWER m) (y:A) = ((e':A->A) POWER m) (y:A)` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN REWRITE_TAC[GSYM iterate_map_valuation] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN SUBGOAL_THEN `~(((e:A->A) POWER (m:num)) (y:A) = x:A)` (LABEL_TAC "F5") THENL[USE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC] THEN SUBGOAL_THEN `~(((e:A->A) POWER (m:num)) (y:A) = (inverse e) (x:A))` (LABEL_TAC "F6") THENL[USE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN DISCH_THEN (MP_TAC o AP_TERM `e:A->A`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV)[GSYM o_THM] THEN USE_THEN "H2" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_THM; iterate_map_valuation]) THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC] THEN SUBGOAL_THEN `~(((e:A->A) POWER (m:num)) (y:A) = (n:A->A) (x:A))` (LABEL_TAC "F7") THENL[USE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((e:A->A) POWER (m:num)) (y:A)`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o MATCH_MP lemma_orbit_eq) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN SIMP_TAC[]; ALL_TAC] THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN POP_ASSUM SUBST1_TAC 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)))))) THEN MATCH_MP_TAC orbit_sym THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))` THEN REWRITE_TAC[edge] THEN ASM_REWRITE_TAC[] 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"))))) THEN SUBGOAL_THEN `!m:num. ((e:A->A) POWER m) (y:A) = ((e':A->A) POWER m) (y:A)` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN REWRITE_TAC[GSYM iterate_map_valuation] THEN POP_ASSUM (SUBST1_TAC) THEN MP_TAC (SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2" o CONJUNCT1)) THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ASSUME_TAC THEN SUBGOAL_THEN `y:A IN D':A->bool` ASSUME_TAC THENL[POP_ASSUM SUBST1_TAC THEN ASM_ASM_SET_TAC; ALL_TAC] THEN USE_THEN "G2" (MP_TAC o MATCH_MP iterate_orbit) THEN DISCH_THEN (MP_TAC o SPECL[`m:num`; `y:A`]) THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2) THEN SUBGOAL_THEN `~(((e':A->A) POWER (m:num)) (y:A) = (inverse e) (x:A))` ASSUME_TAC THENL[USE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC] THEN SUBGOAL_THEN `~(((e':A->A) POWER (m:num)) (y:A) = (n:A->A) (x:A))` ASSUME_TAC THENL[USE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[in_orbit_lemma]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `((e':A->A) POWER (m:num)) (y:A)`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "FF" o MATCH_MP lemma_orbit_eq) THEN USE_THEN "FF" (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (SUBST_ALL_TAC o SYM) THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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))))))))) THEN POP_ASSUM SUBST1_TAC THEN MATCH_MP_TAC lemma_inverse_in_orbit THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]));;
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)}`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[edge_set; edge] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN REWRITE_TAC[set_of_orbits; SET_RULE `s DIFF {a, b} = (s DELETE a) DELETE b`] THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))` THEN MP_TAC (SPEC `H:(A)hypermap` hypermap_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2" o CONJUNCT1)) THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "G1") THEN EQ_TAC THENL[REWRITE_TAC[IN_ELIM_THM; IN_DELETE] 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")) THEN REMOVE_THEN "F3" SUBST_ALL_TAC THEN SUBGOAL_THEN `~(x:A IN orbit_map (e:A->A) (y:A))` (LABEL_TAC "F6") THENL[USE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma_orbit_identity THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(node_map (H:(A)hypermap) x:A IN orbit_map (e:A->A) (y:A))` (LABEL_TAC "F6") THENL[USE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma_orbit_identity THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_first_edge_eq) THEN ASM_REWRITE_TAC[edge] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")) THEN STRIP_TAC THENL[STRIP_TAC THENL[EXISTS_TAC `y:A` THEN USE_THEN "F7" (fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN `~(y:A = x:A)` MP_TAC THENL[USE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ASM_ASM_SET_TAC; ALL_TAC] THEN USE_THEN "F6" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN USE_THEN "F8" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM; IN_DELETE] 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")) THEN REMOVE_THEN "F3" SUBST_ALL_TAC THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN MP_TAC (SPEC `G:(A)hypermap` hypermap_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "GA") (LABEL_TAC "GB" o CONJUNCT1)) THEN SUBGOAL_THEN `(y:A IN D:A->bool) /\ ~(y:A = x:A)` ASSUME_TAC THENL[USE_THEN "F2" MP_TAC THEN USE_THEN "G1" SUBST1_TAC THEN REWRITE_TAC[IN_DELETE]; ALL_TAC] THEN SUBGOAL_THEN `~(node_map (H:(A)hypermap) (x:A) IN orbit_map (e':A->A) (y:A))` (LABEL_TAC "F6") THENL[ USE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma_orbit_identity THEN EXISTS_TAC `D':A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((inverse(e:A->A)) (x:A) IN orbit_map (e':A->A) (y:A))` (LABEL_TAC "F7") THENL[USE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma_orbit_identity THEN EXISTS_TAC `D':A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_second_edge_eq) THEN ASM_REWRITE_TAC[edge] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F8") (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10"))) THEN STRIP_TAC THENL[STRIP_TAC THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F7" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC lemma_inverse_in_orbit THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F8" (SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]);;
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)`,
REPEAT STRIP_TAC THEN EQ_TAC THENL[STRIP_TAC THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN STRIP_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `x':A` o MATCH_MP orbit_subset) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN MESON_TAC[orbit_reflect; SUBSET]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[edge; node;face; edge_set;node_set;face_set] THEN ASM_MESON_TAC[in_set_of_orbits; CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)]);;
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]);;
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]);;
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]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[edge_set; set_of_orbits; IN_ELIM_THM] THEN REWRITE_TAC[GSYM edge]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[node_set; set_of_orbits; IN_ELIM_THM] THEN REWRITE_TAC[GSYM node]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[face_set; set_of_orbits; IN_ELIM_THM] THEN REWRITE_TAC[GSYM face]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[set_of_components; set_part_components; IN_ELIM_THM] THEN REWRITE_TAC[GSYM comb_component]);;
let lemma_in_subset = 
prove(`!s t x. s SUBSET t /\ x IN s ==> x IN t`,
SET_TAC[]);;
let lemma_complement_two_edges = 
prove(`!(H:(A)hypermap) (x:A) (y:A). x IN dart H /\ y IN dart H ==> edge H x UNION edge H y = (dart H) DIFF (UNIONS (edge_set H DIFF {edge H x, edge H y}))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL[POP_ASSUM (LABEL_TAC "F3") THEN REWRITE_TAC[IN_DIFF; IN_UNIONS; IN_DELETE] THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_edge_subset) THEN DISCH_THEN (fun th-> USE_THEN "F3"(fun th1-> LABEL_TAC "F4" (MATCH_MP lemma_in_subset (CONJ th th1)))) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; GSYM DISJ_ASSOC] THEN GEN_TAC THEN ASM_CASES_TAC `t:A->bool IN edge_set (H:(A)hypermap)` THENL[DISJ2_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_edge_representation) THEN DISCH_THEN (X_CHOOSE_THEN `u:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") SUBST1_TAC)) THEN ASM_CASES_TAC `x':A IN edge (H:(A)hypermap) (u:A)` THENL[POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th]) THEN DISJ1_TAC THEN SET_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F6") THEN REWRITE_TAC[IN_DIFF; IN_UNIONS; IN_DELETE] THEN USE_THEN "F2" (MP_TAC o MATCH_MP lemma_edge_subset) THEN DISCH_THEN (fun th-> USE_THEN "F6"(fun th1-> LABEL_TAC "F7" (MATCH_MP lemma_in_subset (CONJ th th1)))) THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; GSYM DISJ_ASSOC] THEN GEN_TAC THEN ASM_CASES_TAC `t:A->bool IN edge_set (H:(A)hypermap)` THENL[DISJ2_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_edge_representation) THEN DISCH_THEN (X_CHOOSE_THEN `v:A` (CONJUNCTS_THEN2 (LABEL_TAC "F8") SUBST1_TAC)) THEN ASM_CASES_TAC `x':A IN edge (H:(A)hypermap) (v:A)` THENL[POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th]) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th]) THEN DISJ1_TAC THEN SET_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC] THEN REWRITE_TAC[UNIONS; IN_DIFF; IN_ELIM_THM; IN_DIFF; NOT_EXISTS_THM; DE_MORGAN_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `edge (H:(A)hypermap) (x':A)`)) 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`]) THEN STRIP_TAC THENL[REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[edge_refl]; ALL_TAC] THEN REWRITE_TAC[IN_UNION] THEN DISJ2_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[edge_refl]);;
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)`,
REPEAT STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] lemma_complement_two_edges) THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_edge_walkup; IN_DELETE] THEN SIMP_TAC[]);;
let lemma_edge_map_walkup_in_dart = 
prove(`!H:(A)hypermap x:A. x IN dart H /\ ~(edge_map H x = x) ==> (edge_map H x IN dart (edge_walkup H x)) /\ (inverse (edge_map H) x IN dart (edge_walkup H x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[lemma_edge_walkup] THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o MATCH_MP lemma_dart_inveriant_under_inverse_maps) THEN MP_TAC (SPEC `x:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts)))) THEN ASM_REWRITE_TAC[IN_DELETE]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[lemma_edge_walkup] THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps) THEN MP_TAC (SPEC `x:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT2((SPEC `H:(A)hypermap` node_map_and_darts))))) THEN ASM_REWRITE_TAC[IN_DELETE]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[lemma_edge_walkup] THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps) THEN MP_TAC (SPEC `x:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts)))) THEN ASM_REWRITE_TAC[IN_DELETE]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP lemma_complement_two_edges (CONJ th th1)])) THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[dart_nondegenerate]) THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> MP_TAC(CONJUNCT2(MATCH_MP lemma_edge_map_walkup_in_dart (CONJ th th1))))) THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[dart_nondegenerate]) THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> MP_TAC(CONJUNCT1(MATCH_MP lemma_node_map_walkup_in_dart (CONJ th th1))))) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_complement_two_edges th]) THEN USE_THEN "F1" (SUBST1_TAC o SYM o MATCH_MP lemma_walkup_edges) THEN REWRITE_TAC[lemma_edge_walkup] THEN ABBREV_TAC `t = UNIONS (edge_set (H:(A)hypermap) DIFF {edge H (x:A), edge H (node_map H x)})` THEN SUBGOAL_THEN `~(x:A IN t:A->bool)` ASSUME_TAC THENL[EXPAND_TAC "t" THEN REWRITE_TAC[IN_UNIONS; DIFF; IN_ELIM_THM; NOT_EXISTS_THM; DE_MORGAN_THM; GSYM DISJ_ASSOC] THEN GEN_TAC THEN ASM_CASES_TAC `t':A->bool IN edge_set (H:(A)hypermap)` THENL[DISJ2_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_edge_representation) THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G1") SUBST1_TAC)) THEN ASM_CASES_TAC `x:A IN edge (H:(A)hypermap) (y:A)` THENL[DISJ1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th]) THEN SET_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN REWRITE_TAC[SET_RULE `{u} UNION v = u INSERT v`] THEN MP_TAC(SPECL[`dart (H:(A)hypermap) DELETE (x:A)`; `t:A->bool`; `x:A`] INSERT_DIFF) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP INSERT_DELETE th]));;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[edge; orbit_map; IN_ELIM_THM] THEN REWRITE_TAC[ARITH_RULE `(n:num) >= 0`]);;
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]);;
let lemma_edge_cycle = 
prove(`!(H:(A)hypermap) (x:A). ((edge_map H) POWER (CARD (edge H x))) x = x`,
REWRITE_TAC[edge] THEN MESON_TAC[hypermap_lemma; lemma_cycle_orbit]);;
(* SPLITTING CASE FOR EDGES *)
let lemma_edge_split = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_edge_split H x ==> (~((inverse(face_map H)) x IN edge (edge_walkup H x) (node_map H x))) /\ (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)))`,
REPEAT GEN_TAC THEN REWRITE_TAC[is_edge_split] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN STRIP_TAC THENL[USE_THEN "F3" MP_TAC THEN REWRITE_TAC[edge] THEN MP_TAC (SPEC `H:(A)hypermap` edge_map_and_darts) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_index_on_orbit) THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1" o REWRITE_RULE[GSYM edge]) (LABEL_TAC "G2"))) THEN USE_THEN "G2" (MP_TAC o REWRITE_RULE[] o AP_TERM `edge_map (H:(A)hypermap)`) THEN REWRITE_TAC[COM_POWER_FUNCTION] 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)] THEN REWRITE_TAC[GSYM inverse_hypermap_maps] THEN DISCH_THEN (LABEL_TAC "G3") THEN ASM_CASES_TAC `SUC n = CARD (edge (H:(A)hypermap) (x:A))` THENL[POP_ASSUM (fun th-> USE_THEN "G3" (MP_TAC o REWRITE_RULE[th; lemma_edge_cycle])) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th]); ALL_TAC] THEN USE_THEN "G1" (MP_TAC o REWRITE_RULE[GSYM LE_SUC_LT]) THEN ONCE_REWRITE_TAC[LE_LT] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "G4") THEN ASM_CASES_TAC `~(0 < n:num)` THENL[USE_THEN "G2" MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[LT_NZ] th; POWER_0; I_THM]) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS; CONJUNCT1 ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) 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") THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC] THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN POP_ASSUM (LABEL_TAC "G5") THEN DISCH_THEN (LABEL_TAC "G6") THEN USE_THEN "G5" MP_TAC THEN USE_THEN "G6" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)]) THEN DISCH_THEN SUBST1_TAC THEN ABBREV_TAC `y = (edge_map (H:(A)hypermap) POWER (i:num)) (edge_map H x)` THEN SUBGOAL_THEN `~(y:A = node_map (H:(A)hypermap) (x:A))` MP_TAC THENL[USE_THEN "G2" SUBST1_TAC THEN EXPAND_TAC "y" THEN REWRITE_TAC[POWER_FUNCTION] THEN MP_TAC (SPECL[`x:A`; `SUC d`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts))) THEN REWRITE_TAC[GSYM edge] THEN USE_THEN "G4" (fun th-> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ (SPEC `SUC d` LT_PLUS) th)]) THEN DISCH_THEN (MP_TAC o SPECL[`SUC d`; `SUC i`] o REWRITE_RULE[lemma_def_inj_orbit]) THEN USE_THEN "G6" (fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LT_SUC_LE] th; LE_REFL]) THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(y:A = inverse (edge_map (H:(A)hypermap)) (x:A))` MP_TAC THENL[EXPAND_TAC "y" THEN REWRITE_TAC[GSYM edge_map_inverse_representation] THEN REWRITE_TAC[POWER_FUNCTION] THEN REWRITE_TAC[COM_POWER_FUNCTION] THEN MP_TAC (SPECL[`x:A`; `SUC(SUC i)`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts))) THEN REWRITE_TAC[GSYM edge] THEN USE_THEN "G6" (MP_TAC o REWRITE_RULE[GSYM LT_SUC_LE]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LT_SUC] THEN USE_THEN "G4" (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ th1 th)])) THEN DISCH_THEN (MP_TAC o SPECL[`SUC(SUC i)`; `0`] o REWRITE_RULE[lemma_def_inj_orbit]) THEN REWRITE_TAC[LT_0; LE_REFL; POWER_0; I_THM] THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(y:A = (x:A))` MP_TAC THENL[EXPAND_TAC "y" THEN REWRITE_TAC[POWER_FUNCTION] THEN MP_TAC (SPECL[`x:A`; `SUC i`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts))) THEN REWRITE_TAC[GSYM edge] THEN USE_THEN "G6" (MP_TAC o REWRITE_RULE[GSYM LT_SUC_LE]) THEN DISCH_THEN (fun th-> (MP_TAC (MATCH_MP LT_TRANS (CONJ th (SPEC `SUC d` LT_PLUS))))) THEN USE_THEN "G4" (fun th-> (DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ th1 th)]))) THEN DISCH_THEN (MP_TAC o SPECL[`SUC i`; `0`] o REWRITE_RULE[lemma_def_inj_orbit]) THEN REWRITE_TAC[LT_0; LE_REFL; POWER_0; I_THM]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th-> MP_TAC(REWRITE_RULE[th] (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup)))))) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "G5" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `d:num`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [POWER_FUNCTION] THEN USE_THEN "G2" (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o AP_TERM `edge_map (edge_walkup (H:(A)hypermap) (x:A))`) THEN REWRITE_TAC[COM_POWER_FUNCTION] THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup))) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th]) THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN REWRITE_TAC[GSYM edge] THEN DISCH_THEN (fun th -> SUBST1_TAC th THEN ASSUME_TAC th) THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`G:(A)hypermap`; `node_map (H:(A)hypermap) (x:A)`; `1`] lemma_in_edge2)) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_edge_identity th]) THEN DISCH_THEN (fun th-> (MP_TAC (MATCH_MP orbit_cyclic (CONJ (SPEC `d:num` NON_ZERO) th)))) THEN REWRITE_TAC[GSYM edge] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM; DE_MORGAN_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(k:num < SUC d)` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G7" o REWRITE_RULE[LT_SUC_LE]) THEN DISJ2_TAC THEN USE_THEN "G7" (fun th-> USE_THEN "G5" (fun th1-> REWRITE_TAC[MATCH_MP th1 th])) THEN USE_THEN "G3" SUBST1_TAC THEN REWRITE_TAC[POWER_FUNCTION] THEN MP_TAC (SPECL[`x:A`; `SUC(SUC d)`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts))) THEN REWRITE_TAC[GSYM edge] THEN USE_THEN "G4" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (MP_TAC o SPECL[`SUC(SUC d)`; `SUC k`] o REWRITE_RULE[lemma_def_inj_orbit]) THEN USE_THEN "G7" (MP_TAC o REWRITE_RULE[GSYM LT_SUC_LE]) THEN DISCH_THEN (fun th-> REWRITE_TAC[LE_REFL; ONCE_REWRITE_RULE[GSYM LT_SUC] th]); ALL_TAC] THEN MP_TAC(CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup)))) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th]) THEN DISCH_TAC 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)) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (SUBST1_TAC o SYM o MATCH_MP lemma_edge_identity) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[SYM(MATCH_MP lemma_walkup_support_edges (CONJ th th1))])) THEN POP_ASSUM (SUBST1_TAC o SYM o MATCH_MP lemma_edge_identity) THEN SET_TAC[]);;
(* MERGE CASE - FOR EDGES *)
let lemma_edge_merge = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_edge_merge H x ==> {x} UNION (edge (edge_walkup H x) (node_map H x)) = (edge H x) UNION (edge H (node_map H x))`,
REPEAT GEN_TAC THEN REWRITE_TAC[is_edge_merge] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN MP_TAC (SPEC `x:A` (MATCH_MP lemma_inverse_in_orbit (SPEC `H:(A)hypermap` edge_map_and_darts))) THEN MP_TAC (SPEC `H:(A)hypermap` edge_map_and_darts) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_index_on_orbit) THEN REWRITE_TAC[GSYM edge] THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN ASM_CASES_TAC `~(0 < n:num)` THENL[USE_THEN "F5" MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[LT_NZ] th; POWER_0; I_THM]) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th]) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS; CONJUNCT1 ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) 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") THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC] THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN POP_ASSUM (LABEL_TAC "G1") THEN DISCH_THEN (LABEL_TAC "G2") THEN USE_THEN "G1" MP_TAC THEN USE_THEN "G2" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)]) THEN DISCH_THEN SUBST1_TAC THEN ABBREV_TAC `y = (edge_map (H:(A)hypermap) POWER (i:num)) (edge_map H x)` THEN SUBGOAL_THEN `~(y:A = node_map (H:(A)hypermap) (x:A))` MP_TAC THENL[EXPAND_TAC "y" THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM; POWER_FUNCTION] THEN DISCH_TAC THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `(x:A)`; `SUC i`] lemma_in_edge2)) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~(y:A = inverse (edge_map (H:(A)hypermap)) (x:A))` MP_TAC THENL[EXPAND_TAC "y" THEN USE_THEN "F5" SUBST1_TAC THEN REWRITE_TAC[POWER_FUNCTION] THEN REWRITE_TAC[COM_POWER_FUNCTION] THEN MP_TAC (SPECL[`x:A`; `SUC d`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts))) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[GSYM edge; th]) THEN DISCH_THEN (MP_TAC o SPECL[`SUC d`; `SUC i`] o REWRITE_RULE[lemma_def_inj_orbit]) THEN USE_THEN "G2" (fun th-> REWRITE_TAC[LE_REFL; REWRITE_RULE[GSYM LT_SUC_LE] th]) THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(y:A = (x:A))` MP_TAC THENL[EXPAND_TAC "y" THEN REWRITE_TAC[POWER_FUNCTION] THEN MP_TAC (SPECL[`x:A`; `SUC i`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` edge_map_and_darts))) THEN REWRITE_TAC[GSYM edge] 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)])) THEN DISCH_THEN (MP_TAC o SPECL[`SUC i`; `0`] o REWRITE_RULE[lemma_def_inj_orbit]) THEN REWRITE_TAC[LT_0; LE_REFL; POWER_0; I_THM]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th-> MP_TAC(REWRITE_RULE[th] (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup)))))) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F6" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `d:num`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [POWER_FUNCTION] THEN USE_THEN "F5" (SUBST1_TAC o SYM) THEN DISCH_TAC THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup))) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[REWRITE_RULE[dart_nondegenerate] th]) THEN DISCH_THEN (MP_TAC o AP_TERM `(edge_map (edge_walkup (H:(A)hypermap) (x:A))) POWER (d:num)`) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_FUNCTION] THEN DISCH_TAC 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)) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "G7" o MATCH_MP lemma_edge_identity) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP lemma_walkup_support_edges (CONJ th th1)])) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN SET_TAC[]);;
(* Node *)
let lemma_shift_non_degenerate = 
prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x <=> dart_nondegenerate (shift H) x`,
REPEAT GEN_TAC THEN REWRITE_TAC[dart_nondegenerate] THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma)) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);;
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)`,
REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma)) THEN ASM_REWRITE_TAC[is_node_merge; is_edge_merge; is_node_split; is_edge_split; edge; node] THEN STRIP_TAC THENL[STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_shift_non_degenerate] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_shift_non_degenerate] THEN ASM_REWRITE_TAC[]);;
let lemma_node_merge = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_node_merge H x ==> {x} UNION (node (node_walkup H x) (face_map H x)) = (node H x) UNION (node H (face_map H x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC)) THEN REWRITE_TAC[node_walkup] THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_node_walkup)) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F2") THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma)) THEN REMOVE_THEN "F1" MP_TAC THEN USE_THEN "G1" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F3") THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] lemma_edge_merge) THEN ASM_REWRITE_TAC[node; edge] THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(H:(A)hypermap)) (x:A)` double_shift_lemma)) THEN ASM_REWRITE_TAC[]);;
let lemma_node_split = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_node_split H x ==> (~((inverse(edge_map H)) x IN node (node_walkup H x) (face_map H x))) /\ (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)))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC)) THEN REWRITE_TAC[node_walkup] THEN MP_TAC (CONJUNCT2 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_node_walkup)) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F2") THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM shift_lemma)) THEN REMOVE_THEN "F1" MP_TAC THEN USE_THEN "G1" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F3") THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] lemma_edge_split) THEN ASM_REWRITE_TAC[node; edge] THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(H:(A)hypermap)) (x:A)` double_shift_lemma)) THEN ASM_REWRITE_TAC[]);;
(* face *)
let lemma_double_shift_non_degenerate = 
prove(`!(H:(A)hypermap) (x:A). dart_nondegenerate H x <=> dart_nondegenerate (shift(shift H)) x`,
REPEAT GEN_TAC THEN REWRITE_TAC[dart_nondegenerate] THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma)) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);;
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)`,
REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma)) THEN ASM_REWRITE_TAC[is_face_merge; is_edge_merge; is_face_split; is_edge_split; edge; face] THEN STRIP_TAC THENL[STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_double_shift_non_degenerate] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[GSYM lemma_double_shift_non_degenerate] THEN ASM_REWRITE_TAC[]);;
let lemma_face_merge = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_face_merge H x ==> {x} UNION (face (face_walkup H x) (edge_map H x)) = (face H x) UNION (face H (edge_map H x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC)) THEN REWRITE_TAC[face_walkup] THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_face_walkup)) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F2") THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma)) THEN REMOVE_THEN "F1" MP_TAC THEN USE_THEN "G1" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F3") THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] lemma_edge_merge) THEN ASM_REWRITE_TAC[face; edge] THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(shift(H:(A)hypermap))) (x:A)` shift_lemma)) THEN ASM_REWRITE_TAC[]);;
let lemma_face_split = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ is_face_split H x ==> (~((inverse(node_map H)) x IN face (face_walkup H x) (edge_map H x))) /\ (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)))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (ASSUME_TAC)) THEN REWRITE_TAC[face_walkup] THEN MP_TAC (CONJUNCT2 (SPECL[`H:(A)hypermap`; `x:A`] lemma_change_face_walkup)) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F2") THEN label_4Gs_TAC (SPEC `H:(A)hypermap` (GSYM double_shift_lemma)) THEN REMOVE_THEN "F1" MP_TAC THEN USE_THEN "G1" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F3") THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] lemma_edge_split) THEN ASM_REWRITE_TAC[face; edge] THEN STRIP_ASSUME_TAC (GSYM (SPEC `edge_walkup (shift(shift(H:(A)hypermap))) (x:A)` shift_lemma)) THEN ASM_REWRITE_TAC[]);;
(* A SOME FACTS ON COMPONETS *)
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)`,
REWRITE_TAC[comb_component; is_in_component; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THENL[EXISTS_TAC `edge_path (H:(A)hypermap) (x:A)` THEN EXISTS_TAC `j:num` THEN REWRITE_TAC[edge_path; lemma_edge_path; POWER_0; I_THM]; ALL_TAC] THEN STRIP_TAC THENL[EXISTS_TAC `node_path (H:(A)hypermap) (x:A)` THEN EXISTS_TAC `j:num` THEN REWRITE_TAC[node_path; lemma_node_path; POWER_0; I_THM]; ALL_TAC] THEN EXISTS_TAC `face_path (H:(A)hypermap) (x:A)` THEN EXISTS_TAC `j:num` THEN REWRITE_TAC[face_path; lemma_face_path; POWER_0; I_THM]);;
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)`,
REPEAT GEN_TAC THEN label_hypermap_TAC `H:(A)hypermap` THEN REPEAT STRIP_TAC THENL[USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (MP_TAC (SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[ lemma_powers_in_component]; USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (MP_TAC (SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[ lemma_powers_in_component]; USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPEC `x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[ lemma_powers_in_component]]);;
let lemma_edge_subset_component = 
prove(`!(H:(A)hypermap) (x:A). edge H x SUBSET comb_component H x`,
REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; edge; orbit_map; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[lemma_powers_in_component]);;
let lemma_node_subset_component = 
prove(`!(H:(A)hypermap) (x:A). node H x SUBSET comb_component H x`,
REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; node; orbit_map; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[lemma_powers_in_component]);;
let lemma_face_subset_component = 
prove(`!(H:(A)hypermap) (x:A). face H x SUBSET comb_component H x`,
REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; face; orbit_map; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[lemma_powers_in_component]);;
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`,
REPEAT STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `y:A`] partition_components) THEN SUBGOAL_THEN `?z:A. z IN comb_component (H:(A)hypermap) (x:A) INTER comb_component (H:(A)hypermap) (y:A)` MP_TAC THENL[ASSUME_TAC (SPECL[`H:(A)hypermap`; `y:A`] lemma_component_reflect) THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[IN_INTER]; ALL_TAC] THEN REWRITE_TAC[MEMBER_NOT_EMPTY] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))` THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (x:A))` (LABEL_TAC "F3") THENL[ GEN_TAC THEN STRIP_TAC THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (e:A->A) (x:A))` (LABEL_TAC "F4") THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`; `1`] lemma_powers_in_component)) THEN ASM_REWRITE_TAC[POWER_1] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry) THEN POP_ASSUM MP_TAC THEN MESON_TAC[lemma_component_trans]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (n:A->A) (x:A))` (LABEL_TAC "F5") THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN MP_TAC (CONJUNCT1(CONJUNCT2((SPECL[`H:(A)hypermap`; `x:A`; `1`] lemma_powers_in_component)))) THEN ASM_REWRITE_TAC[POWER_1] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry) THEN POP_ASSUM MP_TAC THEN ASM_MESON_TAC[lemma_component_trans]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (f:A->A) (x:A))` (LABEL_TAC "F6") THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `1`] lemma_powers_in_component))) THEN ASM_REWRITE_TAC[POWER_1] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry) THEN POP_ASSUM MP_TAC THEN ASM_MESON_TAC[lemma_component_trans]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (inverse(e:A->A)) (x:A))` (LABEL_TAC "F7") THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H2" (fun th2 -> (MP_TAC (SPEC`x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN STRIP_TAC THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`; `j:num`] lemma_powers_in_component)) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry) THEN POP_ASSUM MP_TAC THEN MESON_TAC[lemma_component_trans]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (inverse(n:A->A)) (x:A))` (LABEL_TAC "F8") THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H3" (fun th2 -> (MP_TAC (SPEC`x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN STRIP_TAC THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `j:num`] lemma_powers_in_component))) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry) THEN POP_ASSUM MP_TAC THEN MESON_TAC[lemma_component_trans]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (H:(A)hypermap) (y:A) ==> ~(z = (inverse(f:A->A)) (x:A))` (LABEL_TAC "F8f") THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "H1" (fun th1 -> (USE_THEN "H4" (fun th2 -> (MP_TAC (SPEC`x:A` (MATCH_MP INVERSE_EVALUATION (CONJ th1 th2))))))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN STRIP_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `j:num`] lemma_powers_in_component))) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_symmetry) THEN POP_ASSUM MP_TAC THEN MESON_TAC[lemma_component_trans]; ALL_TAC] THEN SUBGOAL_THEN `~((n:A->A) (x:A) IN comb_component (H:(A)hypermap) (y:A))` ASSUME_TAC THENL[USE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN USE_THEN "F5" (MP_TAC o SPEC `(n:A->A) (x:A)`) THEN POP_ASSUM(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM(fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN `~((inverse(e:A->A)) (x:A) IN comb_component (H:(A)hypermap) (y:A))` ASSUME_TAC THENL[USE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN USE_THEN "F7" (MP_TAC o SPEC `(inverse(e:A->A)) (x:A)`) THEN POP_ASSUM(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[comb_component; is_in_component; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC 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"))))) THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[lemma_def_path] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F12") THEN USE_THEN "F11" MP_TAC THEN REWRITE_TAC[lemma_def_path] THEN DISCH_THEN (MP_TAC o SPEC `i:num`) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F11" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_subpath) THEN USE_THEN "F12" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])) THEN DISCH_TAC THEN SUBGOAL_THEN `(p:num->A) (i:num) IN comb_component (H:(A)hypermap) (y:A)` (LABEL_TAC "F14") THENL[REWRITE_TAC[comb_component; IN_ELIM_THM] THEN REWRITE_TAC[is_in_component] THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REPLICATE_TAC 7 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (i:num)`) o check(is_forall o concl))) THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 7 STRIP_TAC THEN REWRITE_TAC[go_one_step] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] 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"))))) THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!k:num. k <= m ==> is_path (H:(A)hypermap) (p:num->A) k` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F12") THEN DISCH_THEN (LABEL_TAC "F14") THEN REMOVE_THEN "F12" MP_TAC THEN USE_THEN "F14" (fun th-> (REWRITE_TAC[MP (ARITH_RULE `SUC (k:num) <= m:num ==> k <= m`) th])) THEN REWRITE_TAC[is_path] THEN DISCH_THEN (LABEL_TAC "F15") THEN REWRITE_TAC[is_path] THEN USE_THEN "F15" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F11" (MP_TAC o SPEC `SUC (k:num)` o MATCH_MP lemma_subpath) THEN USE_THEN "F14" (fun th -> (REWRITE_TAC[th])) THEN REWRITE_TAC[is_path] THEN DISCH_THEN (MP_TAC o CONJUNCT2) THEN SUBGOAL_THEN `(p:num->A) (k:num) IN comb_component (H:(A)hypermap) (y:A)` (LABEL_TAC "F16") THENL[REWRITE_TAC[comb_component; IN_ELIM_THM] THEN REWRITE_TAC[is_in_component] THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REPLICATE_TAC 7 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (k:num)`) o check(is_forall o concl))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REPLICATE_TAC 7 STRIP_TAC THEN REWRITE_TAC[go_one_step] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o SPEC `m:num`) THEN REWRITE_TAC[LE_REFL]);;
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)`,
REPEAT GEN_TAC 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"))))) THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F6") THEN MP_TAC (SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "W1") (CONJUNCTS_THEN2 (LABEL_TAC "W2") (CONJUNCTS_THEN2 (LABEL_TAC "W3") (LABEL_TAC "W4" o CONJUNCT1)))) THEN SUBGOAL_THEN `(y:A) IN ((D:A->bool) DELETE (x:A))` (LABEL_TAC "F7") THENL[ASM_ASM_SET_TAC; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (x:A))` (LABEL_TAC "F8") THENL[GEN_TAC THEN STRIP_TAC THEN MP_TAC (SPECL[`G:(A)hypermap`; `y:A`] lemma_component_subset) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN (MP_TAC o SPEC `z:A`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th; IN_DELETE]) THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (n:A->A) (x:A))` (LABEL_TAC "F9") THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (inverse(e:A->A)) (x:A))` (LABEL_TAC "F10") THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (inverse(n:A->A)) (x:A))` (LABEL_TAC "F11") THENL[ GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (MP_TAC o AP_TERM `node_map (edge_walkup (H:(A)hypermap) (x:A))`) THEN EXPAND_TAC "n" THEN REWRITE_TAC[node_map_walkup] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`G:(A)hypermap`; `z:A`; `1`] lemma_powers_in_component))) THEN ASM_REWRITE_TAC[POWER_1] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_component_identity th]); ALL_TAC] THEN SUBGOAL_THEN `!z:A. z IN comb_component (G:(A)hypermap) (y:A) ==> ~(z = (inverse(f:A->A)) (x:A))` (LABEL_TAC "F12") THENL[GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) THEN REMOVE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN ASM_CASES_TAC `(inverse(f:A->A)) (x:A) = x` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F8" (MP_TAC o SPEC `z:A`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN SIMP_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `inverse(e:A->A) (x:A) = x` THENL[USE_THEN "H2" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN EXPAND_TAC "e" THEN REWRITE_TAC[lemma_edge_degenerate] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ASSUME_TAC THEN DISCH_THEN (MP_TAC o AP_TERM `f':A->A`) THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`G:(A)hypermap`; `z:A`; `1`] lemma_powers_in_component))) THEN ASM_REWRITE_TAC[POWER_1] THEN USE_THEN "G1" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_component_trans (CONJ th1 th2)))))) THEN DISCH_TAC THEN USE_THEN "F11" (MP_TAC o SPEC `(inverse (n:A->A)) (x:A)`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN MP_TAC (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th1 -> (USE_THEN "W2" (fun th2 -> (MP_TAC (MATCH_MP inverse_function (CONJ th2 (SYM th1))))))) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(CONJUNCT1(SPECL[`G:(A)hypermap`; `z:A`; `1`] lemma_inverses_in_component)) THEN ASM_REWRITE_TAC[] THEN USE_THEN "G1" MP_TAC THEN MESON_TAC[lemma_component_trans]; ALL_TAC] THEN SUBGOAL_THEN `comb_component (H:(A)hypermap) (y:A) = comb_component (G:(A)hypermap) (y:A)` (LABEL_TAC "FF") THENL[REWRITE_TAC[comb_component; is_in_component; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC 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"))))) THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!k:num. k <= m:num ==> is_path (G:(A)hypermap) (p:num->A) k` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G4") THEN DISCH_THEN (LABEL_TAC "G5") THEN REMOVE_THEN "G4" MP_TAC THEN USE_THEN "G5" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `SUC (k:num) <= m ==> k <= m`) th])) THEN DISCH_THEN (LABEL_TAC "G6") THEN USE_THEN "F16" (MP_TAC o SPEC `SUC (k:num)` o MATCH_MP lemma_subpath) THEN ASM_REWRITE_TAC[is_path] THEN DISCH_THEN (MP_TAC o CONJUNCT2) THEN ABBREV_TAC `z:A = (p:num->A) (k:num)` THEN SUBGOAL_THEN `(z:A) IN comb_component (G:(A)hypermap) (y:A)` (LABEL_TAC "G7") THENL[REWRITE_TAC[comb_component;IN_ELIM_THM] (*NOTE*) THEN REWRITE_TAC[is_in_component] THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REPLICATE_TAC 5 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (k:num)`) o check(is_forall o concl))) THEN ASM_REWRITE_TAC[] THEN REPLICATE_TAC 5 STRIP_TAC THEN REWRITE_TAC[go_one_step] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o SPEC `m:num`) THEN SIMP_TAC[LE_REFL]; ALL_TAC] 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"))))) THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!k:num. k <= m ==> is_path (H:(A)hypermap) (p:num->A) k` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[is_path]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F17") THEN DISCH_THEN (LABEL_TAC "F18") THEN REMOVE_THEN "F17" MP_TAC THEN USE_THEN "F18" (fun th-> (REWRITE_TAC[MP (ARITH_RULE `SUC (k:num) <= m:num ==> k <= m`) th])) THEN REWRITE_TAC[is_path] THEN DISCH_THEN (LABEL_TAC "F19") THEN USE_THEN "F19" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F16" (MP_TAC o SPEC `SUC (k:num)` o MATCH_MP lemma_subpath) THEN ASM_REWRITE_TAC[is_path] THEN DISCH_THEN (fun th -> (LABEL_TAC "F20" (CONJUNCT1 th) THEN (MP_TAC(CONJUNCT2 th)))) THEN SUBGOAL_THEN `(p:num->A) (k:num) IN comb_component (G:(A)hypermap) (y:A)` (LABEL_TAC "F21") THENL[REWRITE_TAC[comb_component; IN_ELIM_THM] THEN REWRITE_TAC[is_in_component] THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN REPLICATE_TAC 5 (FIRST_X_ASSUM(MP_TAC o (SPEC `(p:num->A) (k:num)`) o check(is_forall o concl))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REPLICATE_TAC 5 STRIP_TAC THEN REWRITE_TAC[go_one_step] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (k:num)`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o SPEC `m:num`) THEN REWRITE_TAC[LE_REFL]; ALL_TAC] THEN USE_THEN "FF" (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[TAUT `~pp <=> (pp ==> F)`] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_component_symmetry) THEN USE_THEN "F8" (MP_TAC o SPEC `x:A`) THEN USE_THEN "FF" (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
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)}`,
REPEAT GEN_TAC THEN REWRITE_TAC[set_of_components] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN REWRITE_TAC[set_part_components] THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[SET_RULE `s DIFF {a, b} = (s DELETE a) DELETE b`] THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[IN_DELETE; IN_ELIM_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) (LABEL_TAC "F4")) THEN REMOVE_THEN "F3" SUBST_ALL_TAC THEN SUBGOAL_THEN `~(x:A IN comb_component (H:(A)hypermap) (y:A))` (LABEL_TAC "F5") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MESON_TAC[lemma_component_identity]; ALL_TAC] THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_first_component_eq) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))) THEN SUBGOAL_THEN `~(comb_component (H:(A)hypermap) (y:A) = comb_component (edge_walkup H (x:A)) (inverse (edge_map H) x))` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MP_TAC(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `(inverse (edge_map (H:(A)hypermap))) (x:A)`] lemma_component_reflect) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ASM_ASM_SET_TAC; ALL_TAC] THEN USE_THEN "F7" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MP_TAC(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `node_map (H:(A)hypermap) (x:A)`] lemma_component_reflect) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_DELETE; IN_ELIM_THM] 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")) THEN REMOVE_THEN "F3" SUBST_ALL_TAC 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") THENL[USE_THEN "F4" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MESON_TAC[lemma_component_identity]; ALL_TAC] 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") THENL[USE_THEN "F5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MESON_TAC[lemma_component_identity]; ALL_TAC] THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] lemma_walkup_second_component_eq) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9")) THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN USE_THEN "F8" (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F8" (SUBST1_TAC o SYM) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[lemma_component_reflect]);;
(* walkup at an edge-degenerate point *)
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN ASM_CASES_TAC `y:A = x:A` THENL[ASM_REWRITE_TAC[edge_map_walkup]; ALL_TAC] THEN label_hypermap4_TAC `edge_walkup (H:(A)hypermap) (x:A)` THEN ASM_CASES_TAC `y:A = (node_map (H:(A)hypermap)) (x:A)` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[CONJUNCT1(SPEC `edge_walkup (H:(A)hypermap) (x:A)` inverse2_hypermap_maps); o_THM] THEN GEN_REWRITE_TAC (RAND_CONV o DEPTH_CONV) [GSYM o_THM] THEN REWRITE_TAC[GSYM inverse_hypermap_maps] 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))))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[face_map_walkup] THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[lemma_edge_degenerate] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[node_map_walkup]; ALL_TAC] THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] fixed_point_lemma) THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma] THEN DISCH_THEN (MP_TAC o SPEC `x:A`) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[]);;
(* walkup at a node-degenerate point *)
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN ASM_CASES_TAC `y:A = x:A` THENL[ASM_REWRITE_TAC[node_map_walkup]; ALL_TAC] THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`] fixed_point_lemma) THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma] THEN DISCH_THEN (MP_TAC o SPEC `x:A`) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] node_map_walkup))) THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[edge_map_walkup] THEN STRIP_TAC THENL[label_hypermap4_TAC `edge_walkup (H:(A)hypermap) (x:A)` THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[lemma_node_degenerate] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CONJUNCT1(SPEC `edge_walkup (H:(A)hypermap) (x:A)` inverse2_hypermap_maps); o_THM] 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))))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[face_map_walkup] THEN ASM_CASES_TAC `face_map (H:(A)hypermap) (x:A) = x` THENL[MP_TAC(CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)) THEN DISCH_THEN (fun th -> (MP_TAC (AP_THM th `x:A`))) THEN ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[node_map_walkup]; ALL_TAC] THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`] fixed_point_lemma) THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma] THEN DISCH_THEN (MP_TAC o SPEC `x:A`) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `face_map (H:(A)hypermap) (x:A)`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC(LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] THEN REWRITE_TAC[inverse_hypermap_maps]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[]);;
(* walkup at a face-degenerate point *)
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN ASM_CASES_TAC `y:A = x:A` THENL[ASM_REWRITE_TAC[face_map_walkup]; ALL_TAC] THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `face_map (H:(A)hypermap)`] fixed_point_lemma) THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma] THEN DISCH_THEN (MP_TAC o SPEC `x:A`) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] face_map_walkup))) THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[edge_map_walkup] THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[lemma_face_degenerate] THEN DISCH_THEN (LABEL_TAC "FG") THEN STRIP_TAC THENL[label_hypermap4_TAC `edge_walkup (H:(A)hypermap) (x:A)` THEN USE_THEN "FG" (SUBST1_TAC o SYM) THEN USE_THEN "F2" MP_TAC THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `face_map (H:(A)hypermap)`] fixed_point_lemma) THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma] THEN DISCH_THEN (MP_TAC o SPEC `x:A`) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F3") THEN ASM_CASES_TAC `node_map (H:(A)hypermap) (x:A) = x` THENL[USE_THEN "FG" (MP_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] fixed_point_lemma) THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma] THEN DISCH_THEN (MP_TAC o SPEC `x:A`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[edge_map_walkup]; ALL_TAC] THEN REWRITE_TAC[CONJUNCT1(SPEC `edge_walkup (H:(A)hypermap) (x:A)` inverse2_hypermap_maps); o_THM] 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))))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `~(edge_map (H:(A)hypermap) (x:A) = x)` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN ASSUME_TAC THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] fixed_point_lemma) THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma] THEN DISCH_THEN (MP_TAC o SPEC `x:A`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "FG" (fun th -> REWRITE_TAC[SYM th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `edge_map (H:(A)hypermap) (x:A)`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [GSYM o_THM] THEN REWRITE_TAC[GSYM inverse_hypermap_maps] THEN ASM_REWRITE_TAC[node_map_walkup]; ALL_TAC] THEN REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] edge_map_walkup)))) THEN ASM_REWRITE_TAC[]);;
(* WALKUP AT A DEGENERATE DART: THREE WALKUPS ARE EQUAL *)
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`,
REPEAT GEN_TAC THEN label_4Gs_TAC (SPEC `H:(A)hypermap` shift_lemma) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" MP_TAC THEN USE_THEN "G1" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN USE_THEN "F2" MP_TAC THEN USE_THEN "G2" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN ONCE_REWRITE_TAC[lemma_hypermap_eq] THEN REWRITE_TAC[node_walkup] THEN ONCE_REWRITE_TAC[GSYM double_shift_lemma] THEN STRIP_TAC THENL[REWRITE_TAC[lemma_edge_walkup] THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN STRIP_TAC THENL[ REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x':A`] edge_degenerate_walkup_edge_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (SPECL[`shift (H:(A)hypermap)`; `x:A`; `x':A`] face_degenerate_walkup_face_map) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THENL[REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC THEN ASM_CASES_TAC `x':A = (inverse (node_map (H:(A)hypermap))) (x:A)` THENL[ POP_ASSUM (LABEL_TAC "G1") THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])) THEN REWRITE_TAC[node_map_walkup] THEN POP_ASSUM MP_TAC THEN USE_THEN "G3" SUBST1_TAC THEN DISCH_THEN SUBST1_TAC 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)))))))) THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `x':A = x:A` THENL[ POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[edge_map_walkup; node_map_walkup]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC 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)))))))) THEN DISCH_THEN (MP_TAC o SPEC `x':A`) THEN USE_THEN "G3" (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC THEN ASM_CASES_TAC `x':A = (inverse (face_map (H:(A)hypermap))) (x:A)` THENL[POP_ASSUM (LABEL_TAC "G1") THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])) THEN REWRITE_TAC[face_map_walkup] THEN POP_ASSUM MP_TAC THEN USE_THEN "G4" SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[node_map_walkup]; ALL_TAC] THEN ASM_CASES_TAC `x':A = x:A` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[face_map_walkup; node_map_walkup]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`shift (H:(A)hypermap)`; `x:A`; `x':A`] node_map_walkup))) THEN USE_THEN "G4" (fun th -> REWRITE_TAC[SYM th]) THEN ASM_REWRITE_TAC[]);;
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`,
REPEAT GEN_TAC THEN label_4Gs_TAC (SPEC `H:(A)hypermap` double_shift_lemma) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" MP_TAC THEN USE_THEN "G1" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN USE_THEN "F2" MP_TAC THEN USE_THEN "G2" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN ONCE_REWRITE_TAC[lemma_hypermap_eq] THEN REWRITE_TAC[face_walkup] THEN ONCE_REWRITE_TAC[GSYM shift_lemma] THEN STRIP_TAC THENL[REWRITE_TAC[lemma_edge_walkup] THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN STRIP_TAC THENL[REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x':A`] edge_degenerate_walkup_edge_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (SPECL[`shift(shift (H:(A)hypermap))`; `x:A`; `x':A`] node_degenerate_walkup_node_map) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THENL[REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC THEN ASM_CASES_TAC `x':A = (inverse (node_map (H:(A)hypermap))) (x:A)` THENL[POP_ASSUM (LABEL_TAC "G1") THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])) THEN REWRITE_TAC[node_map_walkup] THEN POP_ASSUM MP_TAC THEN USE_THEN "G3" SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[face_map_walkup]; ALL_TAC] THEN ASM_CASES_TAC `x':A = x:A` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[face_map_walkup; node_map_walkup]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`shift(shift(H:(A)hypermap))`; `x:A`; `x':A`] face_map_walkup))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REMOVE_THEN "G3" (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REWRITE_TAC[FUN_EQ_THM] THEN STRIP_TAC THEN ASM_CASES_TAC `x':A = x:A` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[face_map_walkup; edge_map_walkup]; ALL_TAC] THEN ASM_CASES_TAC `x':A = (inverse (face_map (H:(A)hypermap))) (x:A)` THENL[POP_ASSUM (LABEL_TAC "G1") THEN USE_THEN "G1" (fun th -> (GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])) THEN REWRITE_TAC[face_map_walkup] THEN POP_ASSUM MP_TAC THEN USE_THEN "G4" SUBST1_TAC THEN DISCH_THEN SUBST1_TAC 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)))))))) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN USE_THEN "G4" SUBST1_TAC THEN DISCH_TAC 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)))))))) THEN DISCH_THEN (MP_TAC o SPEC `x':A`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G4" (SUBST1_TAC o SYM) THEN POP_ASSUM MP_TAC THEN USE_THEN "G4" (SUBST1_TAC o SYM) THEN DISCH_TAC THEN MP_TAC(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x':A`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (MP_TAC o MATCH_MP edge_degenerate_walkup_first_eq) THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC edge_degenerate_walkup_second_eq THEN ASM_REWRITE_TAC[]);;
let lemma_shift_cycle = 
prove(`!(H:(A)hypermap). shift (shift (shift H)) = H`,
GEN_TAC THEN ONCE_REWRITE_TAC[lemma_hypermap_eq] THEN REWRITE_TAC[GSYM shift_lemma]);;
let lemma_eq_iff_shift_eq = 
prove(`!(H:(A)hypermap) (H':(A)hypermap). H = H' <=> shift H = shift H'`,
REPEAT GEN_TAC THEN EQ_TAC THENL[DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[lemma_hypermap_eq; GSYM shift_lemma] THEN MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[dart_degenerate] THEN STRIP_TAC THENL[MATCH_MP_TAC edge_degenerate_walkup_first_eq THEN ASM_REWRITE_TAC[]; label_4Gs_TAC (SPEC `H:(A)hypermap` shift_lemma) THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)` THEN UNDISCH_TAC `node_map (H:(A)hypermap) (x:A) = x` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F1") THEN DISCH_THEN (LABEL_TAC "F2") THEN REWRITE_TAC[node_walkup] THEN ONCE_REWRITE_TAC[lemma_eq_iff_shift_eq] THEN REWRITE_TAC[lemma_shift_cycle] THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] edge_degenerate_walkup_second_eq) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[face_walkup] THEN REWRITE_TAC[lemma_shift_cycle]; ALL_TAC] THEN label_4Gs_TAC (SPEC `H:(A)hypermap` double_shift_lemma) THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)` THEN UNDISCH_TAC `face_map (H:(A)hypermap) (x:A) = x` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F1") THEN DISCH_THEN (LABEL_TAC "F2") THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] edge_degenerate_walkup_third_eq) THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[face_walkup; node_walkup] THEN REWRITE_TAC[lemma_shift_cycle] THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `shift:((A)hypermap) -> ((A)hypermap)`) THEN REWRITE_TAC[lemma_shift_cycle]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[dart_degenerate] THEN STRIP_TAC THENL[MATCH_MP_TAC edge_degenerate_walkup_second_eq THEN ASM_REWRITE_TAC[]; label_4Gs_TAC (SPEC `H:(A)hypermap` shift_lemma) THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)` THEN UNDISCH_TAC `node_map (H:(A)hypermap) (x:A) = x` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F1") THEN DISCH_THEN (LABEL_TAC "F2") THEN REWRITE_TAC[face_walkup] THEN MP_TAC(SPECL[`shift (H:(A)hypermap)`; `x:A`] edge_degenerate_walkup_third_eq) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[node_walkup; face_walkup] THEN REWRITE_TAC[GSYM lemma_eq_iff_shift_eq; lemma_shift_cycle]; ALL_TAC] THEN label_4Gs_TAC (SPEC `H:(A)hypermap` double_shift_lemma) THEN UNDISCH_TAC `x:A IN dart (H:(A)hypermap)` THEN UNDISCH_TAC `face_map (H:(A)hypermap) (x:A) = x` THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F1") THEN DISCH_THEN (LABEL_TAC "F2") THEN REWRITE_TAC[face_walkup] THEN MP_TAC(SPECL[`shift(shift (H:(A)hypermap))`; `x:A`] edge_degenerate_walkup_first_eq) THEN ASM_REWRITE_TAC[node_walkup; lemma_shift_cycle] THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `shift:((A)hypermap) -> ((A)hypermap)`) THEN REWRITE_TAC[lemma_shift_cycle]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_degenerate_walkup_first_eq) THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_degenerate_walkup_second_eq THEN ASM_REWRITE_TAC[]);;
(* I prove that walkup at a degenerate dart do not change the plannar indices *)
let component_at_isolated_dart = 
prove(`!(H:(A)hypermap) x:A. isolated_dart H x ==> comb_component H x = {x}`,
REPEAT GEN_TAC THEN REWRITE_TAC[isolated_dart] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[comb_component; EXTENSION; IN_ELIM_THM; IN_SING; is_in_component] THEN GEN_TAC THEN REWRITE_TAC[lemma_def_path] THEN EQ_TAC THENL[STRIP_TAC THEN SUBGOAL_THEN `!j:num. j <= n:num ==> (p:num->A) j = x:A` (LABEL_TAC "F1") THENL[INDUCT_TAC THENL[ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "F1") THEN FIRST_ASSUM (MP_TAC o SPEC `j:num` o check (is_forall o concl)) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (j:num) <= n:num ==> j < n`) th]) THEN REWRITE_TAC[go_one_step] THEN FIRST_ASSUM (MP_TAC o check (is_imp o concl)) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (j:num) <= n:num ==> j <= n`) th]) THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[LE_REFL] THEN FIRST_ASSUM SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `(\k:num. x:A)` THEN EXISTS_TAC `0` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);;
let LEMMA_CARD_DIFF = 
prove(`!(s:A->bool) (t:A->bool). FINITE s /\ t SUBSET s ==> CARD s = CARD (s DIFF t) + CARD t`,
REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[] THEN ASM_ASM_SET_TAC);;
let CARD_MINUS_ONE = 
prove(`!(s:B -> bool) (x:B). FINITE s /\ x IN s ==> CARD s = CARD (s DELETE x) + 1`,
REPEAT STRIP_TAC THEN ASSUME_TAC (ISPECL[`x:B`; `s:B->bool`] DELETE_SUBSET) THEN MP_TAC (ISPECL[`(s:B->bool) DELETE (x:B)`; `s:B->bool`] FINITE_SUBSET) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL[`x:B`; `(s:B->bool) DELETE (x:B)`] (CONJUNCT2 CARD_CLAUSES)) THEN ASM_REWRITE_TAC[IN_DELETE] THEN MP_TAC(ISPECL[`x:B`; `s:B->bool`] INSERT_DELETE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ARITH_TAC);;
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}`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC LEMMA_CARD_DIFF THEN ASM_ASM_SET_TAC);;
let EDGE_FINITE = 
prove(`!(H:(A)hypermap) (x:A). FINITE (edge H x)`,
REPEAT GEN_TAC THEN REWRITE_TAC[edge] THEN MATCH_MP_TAC lemma_orbit_finite THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[hypermap_lemma]);;
let EDGE_NOT_EMPTY = 
prove(`!(H:(A)hypermap) (x:A). 1 <= CARD (edge H x)`,
REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_ATLEAST_1 THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[EDGE_FINITE; edge] THEN REWRITE_TAC[orbit_reflect]);;
let NODE_FINITE = 
prove(`!(H:(A)hypermap) (x:A). FINITE (node H x)`,
REPEAT GEN_TAC THEN REWRITE_TAC[node] THEN MATCH_MP_TAC lemma_orbit_finite THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[hypermap_lemma]);;
let NODE_NOT_EMPTY = 
prove(`!(H:(A)hypermap) (x:A). 1 <= CARD (node H x)`,
REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_ATLEAST_1 THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[NODE_FINITE; node] THEN REWRITE_TAC[orbit_reflect]);;
let FACE_FINITE = 
prove(`!(H:(A)hypermap) (x:A). FINITE (face H x)`,
REPEAT GEN_TAC THEN REWRITE_TAC[face] THEN MATCH_MP_TAC lemma_orbit_finite THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[hypermap_lemma]);;
let FACE_NOT_EMPTY = 
prove(`!(H:(A)hypermap) (x:A). 1 <= CARD (face H x)`,
REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_ATLEAST_1 THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[FACE_FINITE; face] THEN REWRITE_TAC[orbit_reflect]);;
let FINITE_HYPERMAP_ORBITS = 
prove(`!(H:(A)hypermap). FINITE (edge_set H) /\ FINITE (node_set H) /\ FINITE (face_set H)`,
GEN_TAC THEN REWRITE_TAC[edge_set; node_set; face_set] THEN REPEAT STRIP_TAC THENL[MATCH_MP_TAC finite_orbits_lemma THEN REWRITE_TAC[hypermap_lemma]; MATCH_MP_TAC finite_orbits_lemma THEN REWRITE_TAC[hypermap_lemma]; MATCH_MP_TAC finite_orbits_lemma THEN REWRITE_TAC[hypermap_lemma]]);;
let FINITE_HYPERMAP_COMPONENTS = 
prove(`!H:(A)hypermap. FINITE (set_of_components H)`,
GEN_TAC THEN REWRITE_TAC[set_of_components] THEN label_hypermap4_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN SUBGOAL_THEN `IMAGE (\x:A. comb_component (H:(A)hypermap) (x:A)) (D:A->bool) = set_part_components H D` ASSUME_TAC THENL[REWRITE_TAC[EXTENSION] THEN STRIP_TAC THEN EQ_TAC THENL[REWRITE_TAC[set_part_components;IMAGE;IN;IN_ELIM_THM]; REWRITE_TAC[set_part_components;IMAGE;IN;IN_ELIM_THM]]; ALL_TAC] THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[]);;
let WALKUP_EXCEPTION_COMPONENT = 
prove(`!(H:(A)hypermap) x:A. x IN dart H ==> comb_component (edge_walkup H x) x = {x}`,
REPEAT STRIP_TAC THEN ASSUME_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup)) THEN ASSUME_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] node_map_walkup)) THEN ASSUME_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] face_map_walkup)) THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN MP_TAC(SPECL[`G:(A)hypermap`; `x:A`] isolated_dart) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o MATCH_MP component_at_isolated_dart) THEN SIMP_TAC[]);;
(* SOME TRIVIAL LEMMAS ON INCIDENT RELATIONSHIPS *)
let lemma_in_components = 
prove(`!(H:(A)hypermap) x:A. x IN dart H <=> comb_component H x IN set_of_components H`,
REPEAT GEN_TAC THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[set_of_components] THEN REWRITE_TAC[set_part_components] THEN EQ_TAC THENL[STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x':A`] lemma_component_subset) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN MESON_TAC[lemma_component_reflect; SUBSET]);;
let lemma_card_eq_reflect = 
prove(`!s t. s = t ==> CARD s = CARD t`,
MESON_TAC[]);;
let lemma_different_edges = 
prove(`!(H:(A)hypermap) (x:A) (y:A). ~(x IN edge H y) ==> ~(edge H x = edge H y)`,
REPEAT GEN_TAC THEN REWRITE_TAC[edge] THEN ASSUME_TAC(CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))) THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[orbit_reflect]);;
let lemma_different_nodes = 
prove(`!(H:(A)hypermap) (x:A) (y:A). ~(x IN node H y) ==> ~(node H x = node H y)`,
REPEAT GEN_TAC THEN REWRITE_TAC[node] THEN ASSUME_TAC(CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))) THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = node_map (H:(A)hypermap)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[orbit_reflect]);;
let lemma_different_faces = 
prove(`!(H:(A)hypermap) (x:A) (y:A). ~(x IN face H y) ==> ~(face H x = face H y)`,
REPEAT GEN_TAC THEN REWRITE_TAC[face] THEN ASSUME_TAC(CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))) THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = face_map (H:(A)hypermap)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[orbit_reflect]);;
(* WALKUP AT AN ISOLATED DART *)
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[isolated_dart] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN LABEL_TAC "F6" (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN label_hypermap_TAC `H:(A)hypermap` THEN label_hypermapG_TAC `edge_walkup (H:(A)hypermap) (x:A)` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))` THEN SUBGOAL_THEN `number_of_edges (H:(A)hypermap) = number_of_edges (edge_walkup H (x:A)) + 1` (LABEL_TAC "X1") THENL[REWRITE_TAC[number_of_edges] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges) THEN REWRITE_TAC[edge] THEN ASM_REWRITE_TAC[] THEN USE_THEN "F3" MP_TAC THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`e:A->A`; `x:A`] orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup)) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`e':A->A`; `x:A`] orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[SET_RULE `{x, x} = {x}`] THEN SUBGOAL_THEN `{x:A} IN edge_set (H:(A)hypermap)` ASSUME_TAC THENL[REWRITE_TAC[edge_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN USE_THEN "F3" MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV) [orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~({x:A} IN edge_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC THENL[REWRITE_TAC[edge_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM] THEN REWRITE_TAC[IN_DELETE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[] THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th))) THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma) THEN SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `((edge_set (H:(A)hypermap)):((A->bool)->bool)) DIFF {{x:A}} = (edge_set (H:(A)hypermap)) DELETE {x:A}`] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN MP_TAC(ISPECL[`edge_set (H:(A)hypermap)`; `{x:A}`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC] THEN SUBGOAL_THEN `number_of_nodes (H:(A)hypermap) = number_of_nodes (edge_walkup H (x:A)) + 1` (LABEL_TAC "X2") THENL[REWRITE_TAC[number_of_nodes] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_nodes) THEN REWRITE_TAC[node] THEN ASM_REWRITE_TAC[] THEN USE_THEN "F4" MP_TAC THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`n:A->A`; `x:A`] orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "H3" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] node_map_walkup)) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`n':A->A`; `x:A`] orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN `{x:A} IN node_set (H:(A)hypermap)` ASSUME_TAC THENL[REWRITE_TAC[node_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN USE_THEN "F4" MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV) [orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~({x:A} IN node_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC THENL[REWRITE_TAC[node_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM] THEN REWRITE_TAC[IN_DELETE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[] THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th))) THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN MP_TAC(ISPECL[`node_set (H:(A)hypermap)`; `{x:A}`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC] THEN SUBGOAL_THEN `number_of_faces (H:(A)hypermap) = number_of_faces (edge_walkup H (x:A)) + 1` (LABEL_TAC "X3") THENL[REWRITE_TAC[number_of_faces] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_faces) THEN REWRITE_TAC[face] THEN ASM_REWRITE_TAC[] THEN USE_THEN "F5" MP_TAC THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`n:A->A`; `x:A`] orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "H4" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] face_map_walkup)) THEN ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC(LAND_CONV) [SPECL[`f':A->A`; `x:A`] orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN SUBGOAL_THEN `{x:A} IN face_set (H:(A)hypermap)` ASSUME_TAC THENL[REWRITE_TAC[face_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN USE_THEN "F5" MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV) [orbit_one_point] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~({x:A} IN face_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC THENL[REWRITE_TAC[face_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM] THEN REWRITE_TAC[IN_DELETE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[] THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th))) THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN MP_TAC(ISPECL[`face_set (H:(A)hypermap)`; `{x:A}`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC] THEN SUBGOAL_THEN `number_of_components (H:(A)hypermap) = number_of_components (edge_walkup H (x:A)) + 1` (LABEL_TAC "X4") THENL[REWRITE_TAC[number_of_components] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_components) THEN ASM_REWRITE_TAC[] THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[SET_RULE `{x, x} = {x}`] 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 )`] THEN SUBGOAL_THEN `comb_component (H:(A)hypermap) (x:A) IN set_of_components H` ASSUME_TAC THENL[REWRITE_TAC[set_of_components] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_part_components; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~(comb_component (edge_walkup (H:(A)hypermap) (x:A)) x IN set_of_components (edge_walkup H x))` ASSUME_TAC THENL[REWRITE_TAC[set_of_components] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_part_components; IN_ELIM_THM; IN_DELETE] THEN STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] WALKUP_EXCEPTION_COMPONENT) THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN MP_TAC (SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `x':A`] lemma_component_reflect) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_SING]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN MP_TAC(ISPECL[`set_of_components (H:(A)hypermap)`; `comb_component (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[FINITE_HYPERMAP_COMPONENTS]; ALL_TAC] THEN SUBGOAL_THEN `CARD (dart (H:(A)hypermap)) = CARD(dart (edge_walkup H (x:A))) + 1` (LABEL_TAC "X5") THENL[MP_TAC(CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[planar_ind] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC);;
(* Walkup at an edge-degenerate dart *)
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[is_edge_degenerate] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN LABEL_TAC "F6" (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN label_hypermap_TAC `H:(A)hypermap` THEN label_hypermapG_TAC `edge_walkup (H:(A)hypermap) (x:A)` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `e' = edge_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `n' = node_map (edge_walkup (H:(A)hypermap) (x:A))` THEN ABBREV_TAC `f' = face_map (edge_walkup (H:(A)hypermap) (x:A))` THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] lemma_in_hypermap_orbits) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9"))) THEN SUBGOAL_THEN `number_of_edges (H:(A)hypermap) = number_of_edges (edge_walkup H (x:A)) + 1` (LABEL_TAC "X1") THENL[REWRITE_TAC[number_of_edges] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges) THEN ASM_REWRITE_TAC[] THEN LABEL_TAC "F10" (CONJUNCT1(SPEC `H:(A)hypermap` FINITE_HYPERMAP_ORBITS)) THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> (LABEL_TAC "F11" (CONJUNCT1 th))) THEN MP_TAC(SPECL[`H:(A)hypermap`; `(n:A->A) (x:A)`] lemma_in_hypermap_orbits) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ((LABEL_TAC "F11") o CONJUNCT1) THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_card_eq_reflect) 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) THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN ASSUME_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`;`x:A`] edge_map_walkup)) THEN MP_TAC(SPECL[`edge_map (edge_walkup (H:(A)hypermap) (x:A))`; `x:A`] orbit_one_point) THEN POP_ASSUM(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM edge] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(SPECL[`e:A->A`; `x:A`] orbit_one_point) THEN USE_THEN "F3"(fun th -> REWRITE_TAC[th]) THEN EXPAND_TAC "e" THEN REWRITE_TAC[GSYM edge] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `~({x:A} IN edge_set (edge_walkup (H:(A)hypermap) (x:A)))` ASSUME_TAC THENL[REWRITE_TAC[edge_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[GSYM FORALL_NOT_THM] THEN REWRITE_TAC[IN_DELETE] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN REWRITE_TAC[] THEN POP_ASSUM (fun th -> (ASSUME_TAC (SYM th))) THEN POP_ASSUM (MP_TAC o MATCH_MP orbit_single_lemma) THEN SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE b) DELETE a`] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `(n:A->A) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))` MP_TAC THENL[ASM_REWRITE_TAC[IN_DELETE]; ALL_TAC] THEN REWRITE_TAC[CONJUNCT1(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `(n:A->A) (x:A)`] lemma_in_hypermap_orbits)] THEN DISCH_TAC 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) THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `((l:num) + 1) + 1 = l + 2`] THEN REWRITE_TAC[ARITH_RULE `(k:num)+ a = k + b <=> a = b`] THEN ASM_CASES_TAC `~({x:A} = edge (H:(A)hypermap) ((n:A->A) (x:A)))` THENL[POP_ASSUM (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[TAUT `~ ~p = p`] THEN REWRITE_TAC[edge] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (ASSUME_TAC o SYM) THEN MP_TAC (SPECL[`e:A->A`; `(n:A->A) (x:A)`] orbit_reflect) THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[IN_SING]; ALL_TAC] THEN SUBGOAL_THEN `number_of_nodes (H:(A)hypermap) = number_of_nodes (edge_walkup H (x:A))` (LABEL_TAC "X2") THENL[REWRITE_TAC[number_of_nodes] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_nodes) THEN ASM_REWRITE_TAC[] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> (LABEL_TAC "G11" (CONJUNCT1 th))) THEN MP_TAC (ISPECL[`node_set (H:(A)hypermap)`; `node (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE) THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN SUBGOAL_THEN `(inverse (n:A->A)) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))` ASSUME_TAC THENL[ASM_REWRITE_TAC[IN_DELETE] THEN USE_THEN "H3" (MP_TAC o SPEC `x:A` o MATCH_MP non_fixed_point_lemma) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" MP_TAC THEN EXPAND_TAC "D" THEN DISCH_THEN (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `inverse (n:A->A) (x:A)`]lemma_in_hypermap_orbits))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC 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) THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC] THEN SUBGOAL_THEN `number_of_faces (H:(A)hypermap) = number_of_faces (edge_walkup H (x:A))` (LABEL_TAC "X4") THENL[REWRITE_TAC[number_of_faces] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_faces) THEN ASM_REWRITE_TAC[] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> (LABEL_TAC "J11" (CONJUNCT2 th))) THEN MP_TAC (ISPECL[`face_set (H:(A)hypermap)`; `face (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE) THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN SUBGOAL_THEN `(inverse (f:A->A)) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))` ASSUME_TAC THENL[ASM_REWRITE_TAC[IN_DELETE] THEN USE_THEN "H4" (MP_TAC o SPEC `x:A` o MATCH_MP non_fixed_point_lemma) THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" MP_TAC THEN EXPAND_TAC "D" THEN DISCH_THEN (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`edge_walkup (H:(A)hypermap) (x:A)`; `inverse (f:A->A) (x:A)`]lemma_in_hypermap_orbits))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC 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) THEN ASM_REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC] THEN SUBGOAL_THEN `number_of_components (H:(A)hypermap) = number_of_components (edge_walkup H (x:A))` (LABEL_TAC "X5") THENL[REWRITE_TAC[number_of_components] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_components) THEN ASM_REWRITE_TAC[] THEN USE_THEN "H2" (MP_TAC o SPEC `x:A` o MATCH_MP fixed_point_lemma) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN ASM_CASES_TAC `(comb_component (edge_walkup (H:(A)hypermap) (x:A)) x) IN set_of_components (edge_walkup H x)` THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM lemma_in_components] THEN ASM_REWRITE_TAC[IN_DELETE]; ALL_TAC] THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE b) DELETE a`] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DELETE_NON_ELEMENT] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F1" MP_TAC THEN EXPAND_TAC "D" THEN REWRITE_TAC[lemma_in_components] THEN DISCH_TAC THEN MP_TAC (ISPECL[`set_of_components (H:(A)hypermap)`; `comb_component (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th -> REWRITE_TAC[th; FINITE_HYPERMAP_COMPONENTS]) THEN DISCH_THEN SUBST1_TAC THEN ASM_CASES_TAC `(n:A->A) (x:A) IN dart (edge_walkup (H:(A)hypermap) (x:A))` THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[lemma_in_components] THEN DISCH_TAC 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) THEN POP_ASSUM (fun th -> REWRITE_TAC[th; FINITE_HYPERMAP_COMPONENTS]) THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] lemma_dart_invariant) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `CARD (dart (H:(A)hypermap)) = CARD(dart (edge_walkup H (x:A))) + 1` (LABEL_TAC "X6") THENL[MP_TAC(CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[planar_ind] THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[degenerate_lemma] THEN STRIP_TAC THENL[MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_planar_index_on_walkup_at_isolated_dart) THEN ASM_REWRITE_TAC[]; MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_planar_index_on_walkup_at_edge_degenerate_dart) 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) THEN REWRITE_TAC[node_walkup] THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift] THEN REWRITE_TAC[lemma_shift_cycle] THEN SUBGOAL_THEN `is_edge_degenerate (shift (H:(A)hypermap)) (x:A)` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[is_edge_degenerate] THEN REWRITE_TAC[GSYM shift_lemma; is_node_degenerate] THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC (SPECL[`shift(H:(A)hypermap)`; `x:A`] lemma_planar_index_on_walkup_at_edge_degenerate_dart) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV ) [GSYM shift_lemma] 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) THEN REWRITE_TAC[face_walkup] THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[lemma_planar_invariant_shift]) THEN REWRITE_TAC[lemma_shift_cycle] THEN SUBGOAL_THEN `is_edge_degenerate (shift(shift (H:(A)hypermap))) (x:A)` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[is_edge_degenerate] THEN REWRITE_TAC[GSYM shift_lemma; is_face_degenerate] THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC (SPECL[`shift(shift(H:(A)hypermap))`; `x:A`] lemma_planar_index_on_walkup_at_edge_degenerate_dart) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV ) [GSYM double_shift_lemma] THEN ASM_REWRITE_TAC[]]);;
(* COMPUTE the numbers on edge-walkup at a non-degerate dart *) (* Trivial for darts *)
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`,
REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE THEN ASM_REWRITE_TAC[hypermap_lemma]);;
(* Compute number of edges acording to then splitting cas *)
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[number_of_edges] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[is_edge_split] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) THEN USE_THEN "F4" (MP_TAC o MATCH_MP lemma_edge_identity) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`] THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `x:A`] lemma_in_hypermap_orbits)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ASSUME_TAC THEN MP_TAC (ISPECL[`edge_set (H:(A)hypermap)`; `edge (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS]) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[ARITH_RULE `((k:num)+1)+1 = k + 2`] THEN MP_TAC (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `x:A`] edge_map_walkup)))) THEN USE_THEN "F3" (MP_TAC o MATCH_MP lemma_inverse_maps_at_nondegenerate_dart) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC 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) THEN REWRITE_TAC[POWER_1] THEN POP_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[lemma_edge_identity; GSYM edge] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_edge_identity) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_edge_split (CONJ th1 th2))))))) THEN DISCH_THEN (MP_TAC o GSYM o MATCH_MP lemma_different_edges) THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS) THEN DISCH_THEN (fun th -> REWRITE_TAC[GSYM th]) THEN MATCH_MP_TAC CARD_MINUS_DIFF_TWO_SET THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS] THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_edge_split (CONJ th1 th2))))))) THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[dart_nondegenerate] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "G3"))) 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))))))) THEN REWRITE_TAC[lemma_in_edge_set] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) 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))))))) THEN REWRITE_TAC[lemma_in_edge_set] THEN SIMP_TAC[]);;
(* Compute number of edges acording to then splitting cas *)
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[number_of_edges] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_edges) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[is_edge_merge] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[dart_nondegenerate] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))) THEN USE_THEN "F4" (ASSUME_TAC o GSYM o MATCH_MP lemma_different_edges) 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) THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS] THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_in_edge_set] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN REWRITE_TAC[lemma_in_edge_set] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (SUBST1_TAC o MATCH_MP CARD_TWO_ELEMENTS) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (LABEL_TAC "F8" (SYM(MATCH_MP lemma_edge_merge (CONJ th1 th2))))))) THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`; `x:A`] lemma_inverse_in_orbit) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [hypermap_lemma] THEN REWRITE_TAC[GSYM edge] THEN DISCH_TAC 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)))`) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_UNION; IN_SING] THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th]) THEN REWRITE_TAC[lemma_edge_identity] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_edge_identity) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`] 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))))))) THEN REWRITE_TAC[lemma_in_edge_set] THEN DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `(m:num) + 2 = (n:num) + 1 <=> m + 1 = n`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_MINUS_ONE THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]);;
(* NODES and FACES IN all cases are invariant*)
let lemma_walkup_count_nodes = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_nondegenerate H x ==> number_of_nodes H = number_of_nodes (edge_walkup H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC)) THEN REWRITE_TAC[dart_nondegenerate] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))) THEN REWRITE_TAC[number_of_nodes] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_nodes) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_in_node_set] THEN DISCH_TAC THEN MP_TAC (ISPECL[`node_set (H:(A)hypermap)`; `node (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS]) THEN REPLICATE_TAC 2 (DISCH_THEN SUBST1_TAC) 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))))))) THEN REWRITE_TAC[lemma_in_node_set] THEN DISCH_TAC 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) THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS]) THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
let lemma_walkup_count_faces = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_nondegenerate H x ==> number_of_faces H = number_of_faces (edge_walkup H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC)) THEN REWRITE_TAC[dart_nondegenerate] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))) THEN REWRITE_TAC[number_of_faces] THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_walkup_faces) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_in_face_set] THEN DISCH_TAC THEN MP_TAC (ISPECL[`face_set (H:(A)hypermap)`; `face (H:(A)hypermap) (x:A)`] CARD_MINUS_ONE) THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS]) THEN REPLICATE_TAC 2 (DISCH_THEN SUBST1_TAC) 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))))))) THEN REWRITE_TAC[lemma_in_face_set] THEN DISCH_TAC 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) THEN POP_ASSUM (fun th ->REWRITE_TAC[th; FINITE_HYPERMAP_ORBITS]) THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
(* For components, we have two cases: component splitting and not splitting *)
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN REWRITE_TAC[number_of_components] THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_components) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_in_components] THEN DISCH_TAC THEN POP_ASSUM (fun th -> (MP_TAC (MATCH_MP CARD_MINUS_ONE (CONJ (SPEC `H:(A)hypermap` FINITE_HYPERMAP_COMPONENTS) th)))) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `((m:num) + 1) + 1 = m + 2`] THEN POP_ASSUM (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_MINUS_DIFF_TWO_SET THEN REWRITE_TAC[FINITE_HYPERMAP_COMPONENTS] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[dart_nondegenerate] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G2") (LABEL_TAC "G3" o CONJUNCT1)) 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))))))) THEN REWRITE_TAC[lemma_in_components] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) 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))))))) THEN REWRITE_TAC[lemma_in_components]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN REWRITE_TAC[number_of_components] THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_components) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_in_components] THEN DISCH_TAC THEN POP_ASSUM (fun th -> (MP_TAC (MATCH_MP CARD_MINUS_ONE (CONJ (SPEC `H:(A)hypermap` FINITE_HYPERMAP_COMPONENTS) th)))) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_MINUS_ONE THEN REWRITE_TAC[FINITE_HYPERMAP_COMPONENTS] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[dart_nondegenerate] THEN DISCH_THEN (LABEL_TAC "G2" o CONJUNCT1 o CONJUNCT2) 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))))))) THEN REWRITE_TAC[lemma_in_components]);;
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))`;;
let lemma_planar_index_on_nondegenerate = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H /\ dart_nondegenerate 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))`,
REPEAT GEN_TAC THEN REWRITE_TAC[is_splitting_component] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN STRIP_TAC THENL[DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")) THEN REWRITE_TAC[planar_ind] THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_nodes (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_faces (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "G1" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_splitting_case_count_edges (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (SUBST1_TAC (MATCH_MP lemma_card_walkup_dart th1))) 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))))))))) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[DE_MORGAN_THM] THEN ASM_CASES_TAC `~(is_edge_split (H:(A)hypermap) (x:A))` THENL[ ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[is_edge_split] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F3") THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] is_edge_merge) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F4") 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") THENL[USE_THEN "F1" (fun th1 -> (USE_THEN "F4" (fun th2 -> (LABEL_TAC "F8" (SYM(MATCH_MP lemma_edge_merge (CONJ th1 th2))))))) THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`; `x:A`] lemma_inverse_in_orbit) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [hypermap_lemma] THEN REWRITE_TAC[GSYM edge] THEN DISCH_TAC 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)))`) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_UNION; IN_SING] THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP lemma_inverse_maps_at_nondegenerate_dart th]) THEN REWRITE_TAC[lemma_in_edge] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` ASSUME_TAC) 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)) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_identity) THEN SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[planar_ind] THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_nodes (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_faces (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F4" (fun th2 -> (SUBST1_TAC (MATCH_MP lemma_merge_case_count_edges (CONJ th1 th2)))))) THEN USE_THEN "F1" (fun th1 -> (SUBST1_TAC (MATCH_MP lemma_card_walkup_dart th1))) 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))))))))) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[TAUT `~ ~P = P`] THEN DISCH_THEN (LABEL_TAC "K1") THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "K2") THEN REWRITE_TAC[planar_ind] THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_nodes (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_walkup_count_faces (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "K1" (fun th2 -> (SUBST1_TAC (SYM(MATCH_MP lemma_splitting_case_count_edges (CONJ th1 th2))))))) THEN USE_THEN "F1" (fun th1 -> (SUBST1_TAC (MATCH_MP lemma_card_walkup_dart th1))) 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))))))))) THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC);;
(* LEMMA IUCLZYI *)
let lemmaIUCLZYI = 
prove(`!(H:(A)hypermap) x:A. (x IN dart H /\ dart_nondegenerate H x ==> (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)) /\ (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))`,
let lemma_desc_planar_index = 
prove(`!(H:(A)hypermap) (x:A). x IN dart H ==> planar_ind H <= planar_ind (edge_walkup H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] lemma_category_darts) THEN STRIP_TAC THENL[POP_ASSUM (LABEL_TAC "F2") THEN ASM_CASES_TAC `is_edge_split (H:(A)hypermap) (x:A) /\ ~is_splitting_component H x` THENL[USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT1(MATCH_MP lemma_planar_index_on_nondegenerate (CONJ th1 th2))))))) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_planar_index_on_nondegenerate (CONJ th1 th2))))))) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] 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)))))) THEN REAL_ARITH_TAC);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_desc_planar_index th]) THEN STRIP_TAC THENL[REWRITE_TAC[node_walkup] THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift] THEN REWRITE_TAC[lemma_shift_cycle] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[shift_lemma] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_desc_planar_index th]); ALL_TAC] THEN REWRITE_TAC[face_walkup] THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift] THEN ONCE_REWRITE_TAC[lemma_planar_invariant_shift] THEN REWRITE_TAC[lemma_shift_cycle] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[double_shift_lemma] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_desc_planar_index th]));;
let lemmaFOAGLPA = 
prove(`!(H:(A)hypermap). planar_ind H <= &0`,
GEN_TAC THEN ABBREV_TAC `n = CARD(dart (H:(A)hypermap))` THEN POP_ASSUM (MP_TAC) THEN SPEC_TAC(`H:(A)hypermap`, `H:(A)hypermap`) THEN SPEC_TAC(`n:num`, `n:num`) THEN INDUCT_TAC THENL[REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_null_hypermap_planar_index) THEN REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN POP_ASSUM (LABEL_TAC "F2") THEN ASM_CASES_TAC `dart (H:(A)hypermap) = {}` THENL[POP_ASSUM (MP_TAC o MATCH_MP lemma_card_eq_reflect) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[CARD_CLAUSES] THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (MP_TAC o MATCH_MP CHOICE_DEF) THEN ABBREV_TAC `(x:A) = CHOICE (dart (H:(A)hypermap))` THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (ASSUME_TAC o MATCH_MP lemma_desc_planar_index) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_card_walkup_dart) THEN REMOVE_THEN "F2" SUBST1_TAC THEN REWRITE_TAC[GSYM ADD1; EQ_SUC] THEN DISCH_THEN (LABEL_TAC "F3" o SYM) THEN FIRST_ASSUM (MP_TAC o SPEC `edge_walkup (H:(A)hypermap) (x:A)`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_planar_hypermap] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN STRIP_TAC THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemmaBISHKQW) THEN POP_ASSUM SUBST1_TAC THEN MP_TAC (SPEC `edge_walkup (H:(A)hypermap) (x:A)` lemmaFOAGLPA) THEN REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemmaBISHKQW) THEN POP_ASSUM SUBST1_TAC THEN MP_TAC (SPEC `node_walkup (H:(A)hypermap) (x:A)` lemmaFOAGLPA) THEN REAL_ARITH_TAC; ALL_TAC] THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemmaBISHKQW) THEN POP_ASSUM SUBST1_TAC THEN MP_TAC (SPEC `face_walkup (H:(A)hypermap) (x:A)` lemmaFOAGLPA) THEN REAL_ARITH_TAC);;
(* double walkups *)
let convolution_rep = 
prove(`!s:A->bool p:A->A. p permutes s ==> (p o p = I <=> p = inverse p)`,
REPEAT STRIP_TAC THEN EQ_TAC THENL[POP_ASSUM (fun th-> (DISCH_THEN (fun th1->(MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ th th1)))))) THEN REWRITE_TAC[I_O_ID]; ALL_TAC] THEN DISCH_THEN (MP_TAC o SPEC `p:A->A` o MATCH_MP RIGHT_MULT_MAP) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th]));;
let convolution_inv = 
prove(`!s:A->bool p:A->A. p permutes s ==> (p o p = I <=> inverse p o inverse p = I)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC THENL[DISCH_THEN (fun th -> LABEL_TAC "F2" th THEN MP_TAC th) THEN USE_THEN "F1" (fun th->(DISCH_THEN (fun th1->(MP_TAC (MATCH_MP LEFT_INVERSE_EQUATION (CONJ th th1)))))) THEN REWRITE_TAC[I_O_ID] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN (MP_TAC o SPEC `p:A->A` o MATCH_MP RIGHT_MULT_MAP) THEN REWRITE_TAC[GSYM o_ASSOC] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID]) THEN DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID]));;
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))`,
REPEAT STRIP_TAC THEN EQ_TAC THENL[REPEAT STRIP_TAC THEN FIRST_X_ASSUM (fun th -> (MP_TAC(AP_THM th `x:A`))) THEN REWRITE_TAC[o_THM; I_THM]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[o_THM; I_THM] THEN ASM_CASES_TAC `~(x:A IN s:A->bool)` THENL[POP_ASSUM MP_TAC THEN UNDISCH_TAC `p:A->A permutes s:A->bool` THEN REWRITE_TAC[permutes] THEN DISCH_THEN (MP_TAC o CONJUNCT1) THEN MESON_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[plain_hypermap] THEN REWRITE_TAC[MATCH_MP convolution_inv (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts))] THEN ASSUME_TAC (MATCH_MP PERMUTES_INVERSE (CONJUNCT2(SPEC `H:(A)hypermap` edge_map_and_darts))) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP convolution_belong th]) THEN ONCE_REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)] THEN REWRITE_TAC[inverse_hypermap_maps; o_THM]);;
let edge_map_convolution = 
prove(`!(H:(A)hypermap). plain_hypermap H <=> edge_map H = node_map H o face_map H`,
REPEAT GEN_TAC THEN REWRITE_TAC[plain_hypermap] THEN REWRITE_TAC[MATCH_MP convolution_rep (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts))] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)] THEN SIMP_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL[STRIP_TAC THEN MP_TAC (SPECL[`p:A->A`; `2`; `x:A`] card_orbit_le) THEN REWRITE_TAC[POWER_2; o_THM; ARITH_RULE `~(2 = 0)`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(p:A->A) (x:A) = x` THENL[REWRITE_TAC[POWER_2; o_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `(p:A->A) (p (x:A)) = x` THENL[ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `x:A` o MATCH_MP lemma_cycle_orbit) THEN ASM_REWRITE_TAC[] THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect) THEN FIRST_ASSUM (MP_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP CARD_ATLEAST_1) THEN ABBREV_TAC `n = CARD(orbit_map (p:A->A) (x:A))` THEN MP_TAC (SPEC `n:num` SEGMENT_TO_TWO) THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) (`n:num <= 2`) THEN FIND_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[LT1_NZ; LT_NZ] th]) (`1 <= n:num`) THEN STRIP_TAC THENL[POP_ASSUM (fun th-> ASM_REWRITE_TAC[th; POWER_1]); ALL_TAC] THEN POP_ASSUM (fun th-> ASM_REWRITE_TAC[th; POWER_2; o_THM]));;
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)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F1") THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F1" (fun th -> (MP_TAC (AP_THM th `x:A`))) THEN REWRITE_TAC[GSYM POWER_2; I_THM] THEN MP_TAC (SPECL[`p:A->A`; `2`; `x:A`] card_orbit_le) THEN REWRITE_TAC[ARITH_RULE `~(2 = 0)`]; ALL_TAC] THEN STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN GEN_TAC THEN ASM_CASES_TAC `x:A IN (s:A->bool)` THENL[FIRST_ASSUM (MP_TAC o SPEC `x:A` o check (is_forall o concl)) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM (MP_TAC o MATCH_MP lemma_convolution_evaluation) THEN MESON_TAC[]; ALL_TAC] THEN FIND_ASSUM (MP_TAC o CONJUNCT2) `FINITE (s:A->bool) /\ (p:A->A) permutes s` THEN REWRITE_TAC[permutes] THEN DISCH_THEN (MP_TAC o SPEC `x:A` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ASSUME_TAC THEN ASM_REWRITE_TAC[]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F2") THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_convolution_evaluation) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num = 2 ==> m <= 2`) th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[orbit_one_point] THEN POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CARD_SINGLETON] THEN ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_convolution_evaluation) THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect) THEN MP_TAC (SPECL[`p:A->A`; `1`; `x:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_1] THEN USE_THEN "F1" (ASSUME_TAC o SPEC `x:A` o MATCH_MP lemma_orbit_finite) THEN REPEAT STRIP_TAC THEN MP_TAC (SPECL[`orbit_map (p:A->A) (x:A)`; `x:A`; `(p:A->A) (x:A)`] CARD_ATLEAST_2) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);;
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))`,
REPEAT STRIP_TAC THEN REWRITE_TAC[edge] THEN MATCH_MP_TAC lemma_orbit_of_size_2 THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]);;
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))`,
REPEAT STRIP_TAC THEN REWRITE_TAC[node] THEN MATCH_MP_TAC lemma_orbit_of_size_2 THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]);;
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))`,
REPEAT STRIP_TAC THEN REWRITE_TAC[face] THEN MATCH_MP_TAC lemma_orbit_of_size_2 THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN REWRITE_TAC[SPEC `H:(A)hypermap` hypermap_lemma]);;
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)`,
REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS; UNION; DIFF] THEN REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN GEN_TAC THEN EQ_TAC THENL[STRIP_TAC THEN ASM_CASES_TAC `(u:A->bool) IN (t:(A->bool)->bool)` THENL[DISJ2_TAC THEN EXISTS_TAC `u:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISJ1_TAC THEN EXISTS_TAC `u:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THENL[EXISTS_TAC `u:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN UNDISCH_TAC `t:(A->bool)->bool SUBSET s:(A->bool)->bool` THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN (MP_TAC o SPEC `u:A->bool`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `u:A->bool` THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F1" (LABEL_TAC "F4" o MATCH_MP lemma_sub_unions_diff) THEN USE_THEN "F4" (fun th2-> (MP_TAC(MATCH_MP (SET_RULE `u = v UNION w ==> v SUBSET u /\ w SUBSET u`) th2 ))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) THEN USE_THEN "F2" (fun th1 -> (USE_THEN "F5" (fun th2 -> (MP_TAC (MATCH_MP FINITE_SUBSET (CONJ th1 th2)))))) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F2" (fun th1 -> (USE_THEN "F6" (fun th2 -> (MP_TAC (MATCH_MP FINITE_SUBSET (CONJ th1 th2)))))) THEN DISCH_THEN (LABEL_TAC "F8") THEN ASM_CASES_TAC `~(((UNIONS ((s:(A->bool)->bool) DIFF (t:(A->bool)->bool))) INTER (UNIONS t)) = {})` THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN (X_CHOOSE_THEN `el:A` MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [UNIONS; DIFF; IN_INTER] THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN (MP_TAC o (SPEC `u':A->bool`)) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC (SPECL[`u:A->bool`; `u':A->bool`; `el:A`] IN_INTER) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o SIMPLE_EXISTS `el:A`) THEN REWRITE_TAC[MEMBER_NOT_EMPTY] THEN STRIP_TAC THEN REMOVE_THEN "F3" (MP_TAC o SPECL[`u:A->bool`; `u':A->bool`]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN UNDISCH_TAC `u':A->bool IN (t:(A->bool)->bool)` THEN POP_ASSUM (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN USE_THEN "F4" SUBST1_TAC THEN MATCH_MP_TAC CARD_UNION THEN ASM_REWRITE_TAC[]);;
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})`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN SUBGOAL_THEN `dart (H:(A)hypermap) = UNIONS (edge_set H)` (LABEL_TAC "F3") THENL[REWRITE_TAC[edge_set] THEN MATCH_MP_TAC lemma_partition THEN REWRITE_TAC[hypermap_lemma]; ALL_TAC] THEN SUBGOAL_THEN `FINITE (UNIONS (edge_set (H:(A)hypermap)))` ASSUME_TAC THENL[USE_THEN "F3" (SUBST1_TAC o SYM) THEN REWRITE_TAC[hypermap_lemma]; ALL_TAC] THEN REMOVE_THEN "F3" (SUBST1_TAC) THEN MATCH_MP_TAC lemma_card_unions_diff THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[SET_RULE `{u, v} SUBSET w <=> u IN w /\ v IN w`] THEN REWRITE_TAC[GSYM lemma_in_edge_set] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[edge_set; IN_ELIM_THM] THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN REPEAT GEN_TAC THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MP_TAC (MATCH_MP partition_orbit (CONJ (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_lemma)) (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))) THEN MESON_TAC[]);;
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)`,
REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_UNION_LE THEN REWRITE_TAC[EDGE_FINITE]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_card_partion2_unions) THEN REWRITE_TAC[UNIONS_2] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `(m:num) + a <= m + b +c <=> a <= b + c`] THEN MATCH_MP_TAC CARD_UNION_LE THEN REWRITE_TAC[edge] THEN label_hypermap4_TAC `H:(A)hypermap` THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_orbit_finite THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC lemma_orbit_finite THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F2" (fun th2 -> (MP_TAC (MATCH_MP lemma_card_partion2_unions (CONJ th1 th2)))))) THEN REWRITE_TAC[UNIONS_2] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `(m:num) + a = m + b +c <=> a = b + c`] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN REWRITE_TAC[FINITE_UNION] THEN REWRITE_TAC[edge] THEN label_hypermap4_TAC `H:(A)hypermap` THEN STRIP_TAC THENL[STRIP_TAC THENL[MATCH_MP_TAC lemma_orbit_finite THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC lemma_orbit_finite THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[]; ALL_TAC] 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))))))) THEN REWRITE_TAC[GSYM edge] THEN USE_THEN "F3" MP_TAC THEN MESON_TAC[]);;
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)`,
REPEAT STRIP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `x:A`] lemma_card_partion2_unions) THEN ASM_REWRITE_TAC[SET_RULE `{a,a} = {a} /\ (s DIFF {a} = s DELETE a)`; UNIONS_1]);;
let lemma_permutes_exception = 
prove(`!s:A->bool p:A->A x:A. p permutes s /\ ~(x IN s) ==> p x = x`,
REWRITE_TAC[permutes] THEN MESON_TAC[]);;
let map_permutes_outside_domain = 
prove(`!s:A->bool p:A->A. p permutes s ==> (!x:A. ~(x IN s) ==> p x = x)`,
REWRITE_TAC[permutes] THEN MESON_TAC[]);;
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`,
REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`, `n:num`) THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN REWRITE_TAC[COM_POWER; o_THM] THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP map_permutes_outside_domain th]));;
let lemma_edge_exception = 
prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> edge H x = {x}`,
REPEAT STRIP_TAC THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` edge_map_and_darts)))) THEN ASM_REWRITE_TAC[edge] THEN MESON_TAC[orbit_one_point]);;
let lemma_node_exception = 
prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> node H x = {x}`,
REPEAT STRIP_TAC THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))) THEN ASM_REWRITE_TAC[node] THEN MESON_TAC[orbit_one_point]);;
let lemma_face_exception = 
prove(`!(H:(A)hypermap) (x:A). ~(x IN dart H) ==> face H x = {x}`,
REPEAT STRIP_TAC THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts)))) THEN ASM_REWRITE_TAC[face] THEN MESON_TAC[orbit_one_point]);;
let lemma_simple_hypermap = 
prove(`simple_hypermap (H:(A)hypermap) ==> !x:A. (node H x) INTER (face H x) = {x}`,
REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:A IN dart (H:(A)hypermap)` THENL[POP_ASSUM MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[simple_hypermap] th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F1") THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_node_exception th] THEN ASSUME_TAC th) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_face_exception th]) THEN SET_TAC[]);;
(* DOUBLE EDGE WALKUP ALONG A NODE OF SIZE 2 CARRING A PLAIN HYPERMAP TO A PLAIN ONE *)
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))`,
REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [plain_hypermap] THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] lemma_convolution_map) THEN REWRITE_TAC[hypermap_lemma] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[NODE_OF_SIZE_2] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN ABBREV_TAC `y = node_map (H:(A)hypermap) (x:A)` THEN POP_ASSUM (LABEL_TAC "F5") THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`; `x:A`; `y:A`] inverse_function) THEN ASM_REWRITE_TAC[hypermap_lemma] THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F6" o SYM) THEN MP_TAC (SPECL[`dart (H:(A)hypermap)`; `node_map (H:(A)hypermap)`; `y:A`; `x:A`] inverse_function) THEN ASM_REWRITE_TAC[hypermap_lemma] THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F7" o SYM) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_edges) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F8") THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_node_map_walkup_in_dart) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F9") THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `y:A`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F10") THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_walkup_edges) THEN ASM_REWRITE_TAC[SET_RULE `{a,a} = {a} /\ s DIFF {a} = s DELETE a`] THEN ABBREV_TAC `W = edge_walkup (G:(A)hypermap) (y:A)` THEN DISCH_THEN (LABEL_TAC "F11") THEN SUBGOAL_THEN `~(edge (W:(A)hypermap) (y:A) IN edge_set W)` (LABEL_TAC "F12") THENL[REWRITE_TAC[GSYM lemma_in_edge_set] THEN EXPAND_TAC "W" THEN MP_TAC (CONJUNCT1(SPECL[`G:(A)hypermap`; `y:A`] lemma_edge_walkup)) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_DELETE]; ALL_TAC] THEN REMOVE_THEN "F11" MP_TAC THEN REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE a) DELETE b`] THEN USE_THEN "F12" (MP_TAC o MATCH_MP (SET_RULE `~(a IN s) ==> s DELETE a = s`)) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F14") THEN MP_TAC (CONJUNCT1 (SPECL[`G:(A)hypermap`; `y:A`] lemma_edge_walkup)) THEN FIND_ASSUM (fun th -> REWRITE_TAC[th]) `edge_walkup (G:(A)hypermap) (y:A) = W` THEN DISCH_THEN (LABEL_TAC "F15") THEN SUBGOAL_THEN `~(y:A IN dart (W:(A)hypermap))` (LABEL_TAC "F16") THEN USE_THEN "F15" SUBST1_TAC THEN REWRITE_TAC[IN_DELETE] THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F17") 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)` 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 THENL[POP_ASSUM MP_TAC THEN STRIP_TAC THENL[REWRITE_TAC[SET_RULE `s DIFF {a,b} = (s DELETE b) DELETE a`] THEN POP_ASSUM SUBST1_TAC THEN MP_TAC (ISPECL[`edge (G:(A)hypermap) (x:A)`; `edge_set (G:(A)hypermap)`] DELETE_NON_ELEMENT) THEN REWRITE_TAC[GSYM lemma_in_edge_set] THEN REWRITE_TAC[lemma_edge_walkup] THEN MP_TAC (CONJUNCT1 (SPECL[`H:(A)hypermap`; `x:A`] lemma_edge_walkup)) THEN FIND_ASSUM SUBST1_TAC `edge_walkup (H:(A)hypermap) (x:A) = G` THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[SET_RULE `s DIFF {a,a} = s DELETE a`]; ALL_TAC] THEN REMOVE_THEN "F8" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "K1") THEN SUBGOAL_THEN `CARD (edge (G:(A)hypermap) (y:A)) <= 3` (LABEL_TAC "K2") THENL[USE_THEN "F1" (fun th1 -> (USE_THEN "F17" (fun th2 -> (MP_TAC (MATCH_MP lemma_card_partion2_unions (CONJ th1 th2)))))) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_card_walkup_dart) THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (H:(A)hypermap) (x:A) = G` THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "K1" SUBST1_TAC THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `((m:num)+n) +1 = m + k <=> n+1 = k`; UNIONS_2] 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))))) THEN USE_THEN "F2" (MP_TAC o SPEC `x:A`) THEN USE_THEN "F2" (MP_TAC o SPEC `y:A`) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[GSYM edge] THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `(a:num) <= 2 /\ (b:num) <= 2 /\ (c:num) + 1 <= b + a ==> c <= 3`)) THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `CARD (edge (W:(A)hypermap) (inverse (edge_map (G:(A)hypermap)) (y:A))) <= 2` (LABEL_TAC "K3") THENL[ASM_CASES_TAC `inverse (edge_map (G:(A)hypermap)) (y:A) = y` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F16" (MP_TAC o MATCH_MP lemma_edge_exception) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CARD_SINGLETON] THEN ARITH_TAC; ALL_TAC] THEN MP_TAC (SPEC `y:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT1(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma))))) THEN POP_ASSUM (fun th -> ((LABEL_TAC "K4" th) THEN REWRITE_TAC[th])) THEN USE_THEN "F9" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_edge_map_walkup_in_dart (CONJ th1 th2))))))) THEN FIND_ASSUM SUBST1_TAC `edge_walkup (G:(A)hypermap) (y:A) = W` THEN DISCH_THEN (LABEL_TAC "K5") THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq) THEN USE_THEN "F14" SUBST1_TAC THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_walkup_dart) THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (G:(A)hypermap) (y:A) = W` THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "K5" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `((m:num)+n) +1 = m + k <=> n+1 = k`] 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)))))) THEN SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[plain_hypermap; double_edge_walkup] THEN MP_TAC (SPECL[`dart (W:(A)hypermap)`; `edge_map (W:(A)hypermap)`] lemma_convolution_map) THEN REWRITE_TAC[hypermap_lemma] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM edge] THEN GEN_TAC THEN ASM_CASES_TAC `edge (W:(A)hypermap) (x':A) = edge W (inverse (edge_map (G:(A)hypermap)) (y:A))` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "K3" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "K10") THEN DISCH_THEN (fun th -> (LABEL_TAC "K11" th THEN MP_TAC th)) THEN REWRITE_TAC[lemma_in_edge_set] THEN DISCH_THEN (LABEL_TAC "K12") 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) THEN USE_THEN "K12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "K10" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F14" (SUBST1_TAC o SYM) THEN USE_THEN "K1" (SUBST1_TAC o SYM) THEN ABBREV_TAC `E = edge (W:(A)hypermap) (x':A)` THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_edge_representation (CONJUNCT1 th)))) THEN STRIP_TAC THEN USE_THEN "F2" (MP_TAC o SPEC `x'':A`) THEN REWRITE_TAC[GSYM edge] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]);ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J1") (LABEL_TAC "J2")) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_dart_inveriant_under_inverse_maps) 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)))))))) THEN FIND_ASSUM SUBST1_TAC `edge_walkup (H:(A)hypermap) (x:A) = G` THEN DISCH_THEN (fun th -> (MP_TAC th THEN (LABEL_TAC "J3" th))) THEN REWRITE_TAC[lemma_in_edge_set] THEN DISCH_THEN (LABEL_TAC "J4") THEN ABBREV_TAC `u = inverse (edge_map (H:(A)hypermap)) (x:A)` THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F17" (fun th2 -> (MP_TAC (MATCH_MP lemma_card_partion2_unions_approx (CONJ th1 th2)))))) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_card_walkup_dart) THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (H:(A)hypermap) (x:A) = G` THEN DISCH_THEN SUBST1_TAC 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))))))))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F8" (SUBST1_TAC) THEN REWRITE_TAC[ARITH_RULE `((m:num)+n+k) + 1 <= m + a + b <=> n+k+1 <= a+b`] THEN USE_THEN "F2" (MP_TAC o SPEC `x:A`) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F2" (MP_TAC o SPEC `y:A`) THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[GSYM edge] 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))) THEN MP_TAC (SPECL[`G:(A)hypermap`; `y:A`] EDGE_NOT_EMPTY) THEN MP_TAC (SPECL[`G:(A)hypermap`; `u:A`] EDGE_NOT_EMPTY) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `1 <= n:num /\ 1 <= m:num /\ m + n <= 3 ==> m <=2 /\ n <=2`)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J5") (LABEL_TAC "J6")) THEN SUBGOAL_THEN `CARD (edge (W:(A)hypermap) (inverse (edge_map (G:(A)hypermap)) (y:A))) <= 2` (LABEL_TAC "J6a") THENL[ASM_CASES_TAC `inverse (edge_map (G:(A)hypermap)) (y:A) = y` THENL[POP_ASSUM SUBST1_TAC THEN MP_TAC (CONJUNCT1(SPECL[`G:(A)hypermap`; `y:A`; `y:A`] edge_map_walkup)) THEN FIND_ASSUM SUBST1_TAC `edge_walkup (G:(A)hypermap) (y:A) = W` THEN MP_TAC (SPECL[`edge_map (W:(A)hypermap)`; `y:A`] orbit_one_point) THEN REWRITE_TAC[GSYM edge] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CARD_SINGLETON] THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "J7") THEN MP_TAC (SPEC `y:A` (MATCH_MP non_fixed_point_lemma (CONJUNCT1(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma))))) THEN USE_THEN "J7" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F9" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (CONJUNCT2(MATCH_MP lemma_edge_map_walkup_in_dart (CONJ th1 th2))))))) THEN FIND_ASSUM SUBST1_TAC `edge_walkup (G:(A)hypermap) (y:A) = W` THEN DISCH_THEN (LABEL_TAC "J8") THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq) THEN (USE_THEN "F9" (MP_TAC o MATCH_MP lemma_card_walkup_dart)) THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `edge_walkup (G:(A)hypermap) (y:A) = W` THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F14" SUBST1_TAC THEN USE_THEN "J8" (MP_TAC o MATCH_MP lemma_card_partion1_unions_eq) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ARITH_RULE `((m:num)+n) +1 = m + k <=> n+1 = k`] THEN USE_THEN "J5" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `a:num <= 2 /\ (m:num) + 1 = a ==> m <= 2`)) THEN SIMP_TAC[]; ALL_TAC] THEN ABBREV_TAC `v = inverse (edge_map (G:(A)hypermap)) (y:A)` THEN ASM_REWRITE_TAC[plain_hypermap; double_edge_walkup] THEN MP_TAC (SPECL[`dart (W:(A)hypermap)`; `edge_map (W:(A)hypermap)`] lemma_convolution_map) THEN REWRITE_TAC[hypermap_lemma] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM edge] THEN GEN_TAC THEN ASM_CASES_TAC `edge (W:(A)hypermap) (x':A) = edge W (v:A)` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "J6a" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "J16") THEN DISCH_THEN (fun th -> (LABEL_TAC "J17" th THEN MP_TAC th)) THEN REWRITE_TAC[lemma_in_edge_set] THEN DISCH_THEN (LABEL_TAC "J18") THEN MP_TAC (ISPECL[`edge_set (W:(A)hypermap)`; `edge (W:(A)hypermap) (x':A)`; `edge (W:(A)hypermap) (v:A)` ] IN_DELETE) THEN USE_THEN "J18" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J16" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F14" (SUBST1_TAC o SYM) THEN ASM_CASES_TAC `edge (W:(A)hypermap) (x':A) = edge (G:(A)hypermap) (u:A)` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "J6" (fun th -> REWRITE_TAC[th]); ALL_TAC] 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)))))) THEN USE_THEN "F8" (SUBST1_TAC o SYM) THEN ABBREV_TAC `ED = edge (W:(A)hypermap) (x':A)` THEN REWRITE_TAC[IN_DIFF] THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_edge_representation (CONJUNCT1 th)))) THEN STRIP_TAC THEN USE_THEN "F2" (MP_TAC o SPEC `x'':A`) THEN REWRITE_TAC[GSYM edge] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
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))`,
REPEAT GEN_TAC THEN REWRITE_TAC[double_node_walkup; node_walkup; double_edge_walkup] THEN REWRITE_TAC[lemma_shift_cycle]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[double_face_walkup; face_walkup; double_edge_walkup] THEN REWRITE_TAC[lemma_shift_cycle]);;
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))`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_representaion_Wn] THEN REWRITE_TAC[plain_hypermap] THEN ABBREV_TAC `G = shift (H:(A)hypermap)` THEN REWRITE_TAC[GSYM shift_lemma] THEN MP_TAC (CONJUNCT1(SPEC `H:(A)hypermap` shift_lemma)) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[edge] THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` shift_lemma))) THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM face] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN MP_TAC (SPECL[`dart (G:(A)hypermap)`; `face_map (G:(A)hypermap)`] lemma_convolution_map) THEN ASM_REWRITE_TAC[hypermap_lemma; GSYM face] THEN DISCH_THEN (LABEL_TAC "F4") THEN REMOVE_THEN "F3" MP_TAC THEN REWRITE_TAC[FACE_OF_SIZE_2] THEN ABBREV_TAC `y = face_map (G:(A)hypermap) (x:A)` THEN POP_ASSUM (LABEL_TAC "J0") THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_faces) THEN ABBREV_TAC `J = edge_walkup (G:(A)hypermap) (x:A)` THEN POP_ASSUM (LABEL_TAC "J1") THEN USE_THEN "F6" (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma))))) th)))) THEN DISCH_THEN (fun th -> (LABEL_TAC "J2" (SYM th) THEN (SUBST1_TAC (SYM th)))) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J0" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F8") 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))))))))) THEN USE_THEN "J1" (fun th->REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_walkup_faces) THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`G:(A)hypermap`; `x:A`; `x:A`] face_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `J:(A)hypermap` hypermap_lemma))))) th)))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ABBREV_TAC `W = edge_walkup (J:(A)hypermap) (y:A)` THEN SUBGOAL_THEN `~(face (W:(A)hypermap) (y:A) IN face_set W)` ASSUME_TAC THENL[REWRITE_TAC[GSYM lemma_in_face_set] THEN EXPAND_TAC "W" THEN REWRITE_TAC[lemma_edge_walkup] THEN REWRITE_TAC[IN_DELETE]; ALL_TAC] THEN POP_ASSUM (MP_TAC o MATCH_MP (SET_RULE `~(a IN s) ==> (s DELETE a = s)`)) THEN DISCH_THEN SUBST1_TAC THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F10" o SYM) THEN REWRITE_TAC[double_edge_walkup] THEN USE_THEN "J1" (fun th -> REWRITE_TAC[th]) THEN FIND_ASSUM (fun th -> REWRITE_TAC[th]) `edge_walkup (J:(A)hypermap) (y:A) = W` THEN MP_TAC (SPECL[`dart (W:(A)hypermap)`; `face_map (W:(A)hypermap)`] lemma_convolution_map) THEN REWRITE_TAC[hypermap_lemma] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM face] THEN GEN_TAC THEN REWRITE_TAC[lemma_in_face_set] THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_DELETE] THEN ABBREV_TAC `FF = face (W:(A)hypermap) (x':A)` THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_face_representation (CONJUNCT1 th)))) THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F4" (MP_TAC o SPEC `x'':A`) THEN ASM_REWRITE_TAC[]);;
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))`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_representaion_Wf] THEN REWRITE_TAC[plain_hypermap] THEN ABBREV_TAC `G = shift(shift (H:(A)hypermap))` THEN REWRITE_TAC[GSYM shift_lemma] THEN MP_TAC (CONJUNCT1(SPEC `H:(A)hypermap` double_shift_lemma)) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[edge] THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `H:(A)hypermap` double_shift_lemma))) THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM node] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN MP_TAC (SPECL[`dart (G:(A)hypermap)`; `node_map (G:(A)hypermap)`] lemma_convolution_map) THEN ASM_REWRITE_TAC[hypermap_lemma; GSYM node] THEN DISCH_THEN (LABEL_TAC "F4") THEN REMOVE_THEN "F3" MP_TAC THEN REWRITE_TAC[NODE_OF_SIZE_2] THEN ABBREV_TAC `y = node_map (G:(A)hypermap) (x:A)` THEN POP_ASSUM (LABEL_TAC "J0") THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_walkup_nodes) THEN ABBREV_TAC `J = edge_walkup (G:(A)hypermap) (x:A)` THEN POP_ASSUM (LABEL_TAC "J1") THEN USE_THEN "F6" (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `G:(A)hypermap` hypermap_lemma)))) th)))) THEN DISCH_THEN (fun th -> (LABEL_TAC "J2" (SYM th) THEN (SUBST1_TAC (SYM th)))) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J0" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F8") 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))))))))) THEN USE_THEN "J1" (fun th->REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F9" (MP_TAC o MATCH_MP lemma_walkup_nodes) THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`G:(A)hypermap`; `x:A`; `x:A`] node_map_walkup))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP inverse_function (CONJ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `J:(A)hypermap` hypermap_lemma)))) th)))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ABBREV_TAC `W = edge_walkup (J:(A)hypermap) (y:A)` THEN SUBGOAL_THEN `~(node (W:(A)hypermap) (y:A) IN node_set W)` ASSUME_TAC THENL[REWRITE_TAC[GSYM lemma_in_node_set] THEN EXPAND_TAC "W" THEN REWRITE_TAC[lemma_edge_walkup] THEN REWRITE_TAC[IN_DELETE]; ALL_TAC] THEN POP_ASSUM (MP_TAC o MATCH_MP (SET_RULE `~(a IN s) ==> (s DELETE a = s)`)) THEN DISCH_THEN SUBST1_TAC THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F10" o SYM) THEN REWRITE_TAC[double_edge_walkup] THEN USE_THEN "J1" (fun th -> REWRITE_TAC[th]) THEN FIND_ASSUM (fun th -> REWRITE_TAC[th]) `edge_walkup (J:(A)hypermap) (y:A) = W` THEN MP_TAC (SPECL[`dart (W:(A)hypermap)`; `node_map (W:(A)hypermap)`] lemma_convolution_map) THEN REWRITE_TAC[hypermap_lemma] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM node] THEN GEN_TAC THEN REWRITE_TAC[lemma_in_node_set] THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_DELETE] THEN ABBREV_TAC `NN = node (W:(A)hypermap) (x':A)` THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_node_representation (CONJUNCT1 th)))) THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F4" (MP_TAC o SPEC `x'':A`) THEN ASM_REWRITE_TAC[]);;
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)))`,
REPEAT STRIP_TAC THENL[ASM_MESON_TAC[double_face_walkup_plain_hypermap]; ASM_MESON_TAC[double_node_walkup_plain_hypermap]; ASM_MESON_TAC[double_edge_walkup_plain_hypermap]]);;
(* WE DEFINE THE MOEBIUS CONTOUR HERE *)
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))))`;;
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`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F1") THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (MP_TAC)) THEN REWRITE_TAC[is_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) THEN REMOVE_THEN "F1" MP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F5") THEN REMOVE_THEN "F4" MP_TAC THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[USE_THEN "F5" (fun th -> (MP_TAC(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_dart_invariant th))))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F5" (fun th -> (MP_TAC(CONJUNCT1(CONJUNCT2(MATCH_MP lemma_dart_inveriant_under_inverse_maps th))))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN SIMP_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[SUBSET; EXTENSION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN USE_THEN "F2" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_subcontour) THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_contour_in_dart (CONJ th1 th2)))))) THEN SIMP_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN ASM_CASES_TAC `~(((p:num->A) 0) IN dart (H:(A)hypermap))` THENL[SUBGOAL_THEN `!m:num. m <= n ==> (p:num->A) m = p 0` ASSUME_TAC THENL[INDUCT_TAC THENL[ ARITH_TAC; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "J0") THEN DISCH_THEN (LABEL_TAC "J1") THEN REMOVE_THEN "J0" MP_TAC THEN USE_THEN "J1" (ASSUME_TAC o REWRITE_RULE[LE_SUC_LT]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_TAC THEN ABBREV_TAC `x = (p:num->A) 0` THEN USE_THEN "F2" (MP_TAC o SPEC `m:num` o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour; lemma_def_contour]) THEN REWRITE_TAC[GSYM LE_SUC_LT] THEN REMOVE_THEN "J1" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[one_step_contour] THEN ASM_REWRITE_TAC[] THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (SPEC `x:A` (MATCH_MP map_permutes_outside_domain (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (SUBST1_TAC o SYM o ONCE_REWRITE_RULE[node_map_inverse_representation] o SYM) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F2" (MP_TAC o SPECL[`n:num`; `0`] o CONJUNCT2 o REWRITE_RULE[lemma_def_inj_contour]) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th; LE_REFL]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`) THEN MESON_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th -> MESON_TAC[th]));;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[is_Moebius_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FJ") (STRIP_ASSUME_TAC)) THEN MP_TAC (ARITH_RULE `0 < i:num /\ i <= j:num /\ j < k:num ==> 2 <= k`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> (ASSUME_TAC th THEN REWRITE_TAC[th])) THEN MP_TAC (SPECL[`H:(A)hypermap`; `p:num->A`; `k:num`] lemma_first_dart_on_inj_contour) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE`2 <= k:num ==> 0 < k`) th]) THEN USE_THEN "FJ" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "FJ" (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_def_inj_contour]) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [GSYM LT_SUC_LE] THEN REWRITE_TAC[MESON[] `~(a = b) <=> ~(b=a)`] THEN DISCH_THEN (MP_TAC o MATCH_MP CARD_FINITE_SERIES_EQ) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "FJ" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour]) THEN DISCH_THEN (fun th1 -> (USE_THEN "F1" (fun th -> (MP_TAC(MATCH_MP lemma_darts_in_contour (CONJ th th1)))))) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [GSYM LT_SUC_LE] THEN DISCH_TAC THEN MATCH_MP_TAC CARD_SUBSET THEN POP_ASSUM (fun th -> REWRITE_TAC[th; hypermap_lemma]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (LABEL_TAC "F2" o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_darts_on_Moebius_contour) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[is_Moebius_contour] THEN DISCH_THEN (MP_TAC o CONJUNCT1) THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "F3")) THEN REMOVE_THEN "F2" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_darts_in_contour (CONJ th1 th2)))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN MP_TAC (GSYM (SPECL[`SUC (k:num)`; `p:num->A`] CARD_FINITE_SERIES_EQ)) THEN REWRITE_TAC[LT_SUC_LE] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[EQ_SYM]);;
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}`,
REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM (MP_TAC o MATCH_MP lemma_Moebius_contour_points_subset_darts) THEN POP_ASSUM SUBST1_TAC THEN MP_TAC (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_lemma)) THEN REWRITE_TAC[IMP_IMP; CARD_SUBSET_EQ]);;
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]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_point_in_list] THEN MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_point_not_in_list] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN label_hypermap4_TAC `H:(A)hypermap` THEN (LABEL_TAC "G1" (CONJUNCT1(CONJUNCT2(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma)))) THEN (LABEL_TAC "G2" (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma))))) THEN (LABEL_TAC "G3" (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(SPEC `edge_walkup (H:(A)hypermap) (x:A)` hypermap_lemma)))))) THEN ABBREV_TAC `G = edge_walkup (H:(A)hypermap) (x:A)` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN ABBREV_TAC `D' = dart (G:(A)hypermap)` THEN ABBREV_TAC `e' = edge_map (G:(A)hypermap)` THEN ABBREV_TAC `n' = node_map (G:(A)hypermap)` THEN ABBREV_TAC `f' = face_map (G:(A)hypermap)` 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") THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "E3") (CONJUNCTS_THEN2 (LABEL_TAC "E4") (LABEL_TAC "E5"))) THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `i:num`) THEN USE_THEN "E3" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "E6") THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `j:num`) THEN USE_THEN "E4" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "E7") THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (n:A->A) (x:A))` (LABEL_TAC "E8") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (MP_TAC o AP_TERM `n:A->A`) THEN USE_THEN "E5" SUBST1_TAC THEN USE_THEN "H3" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] node_map_walkup))) THEN ASM_REWRITE_TAC[]; ALL_TAC] 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") THENL[USE_THEN "H3" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th]) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th]) THEN POP_ASSUM (fun th -> MESON_TAC[th]); ALL_TAC] 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") THENL[ REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FE3") (CONJUNCTS_THEN2 (LABEL_TAC "FE4") (LABEL_TAC "FE5"))) THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `i:num`) THEN USE_THEN "FE3" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "FE6") THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `j:num`) THEN USE_THEN "FE4" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "FE7") THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (f:A->A) (x:A))` (LABEL_TAC "FE8") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (MP_TAC o AP_TERM `f:A->A`) THEN USE_THEN "FE5" SUBST1_TAC THEN USE_THEN "H4" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `x:A`; `(p:num->A) (i:num)`] face_map_walkup))) THEN ASM_REWRITE_TAC[]; ALL_TAC] 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 THENL[INDUCT_TAC THENL[REWRITE_TAC[is_inj_contour]; ALL_TAC] THEN REWRITE_TAC[is_inj_contour] THEN POP_ASSUM (LABEL_TAC "J1") THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J2") (CONJUNCTS_THEN2 (LABEL_TAC "J3") (CONJUNCTS_THEN2 (LABEL_TAC "J4") (LABEL_TAC "J10")))) THEN USE_THEN "J2" (LABEL_TAC "J5" o MATCH_MP (ARITH_RULE `SUC (i:num) <= (k:num) ==> i <= k`)) THEN REMOVE_THEN "J1" MP_TAC THEN USE_THEN "J5" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J3" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J10" (fun th -> REWRITE_TAC[th]) THEN REMOVE_THEN "J4" MP_TAC THEN REWRITE_TAC[one_step_contour] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL[DISJ1_TAC THEN USE_THEN "F5" (MP_TAC o SPECL[`i:num`; `SUC (i:num)`]) THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J2" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN DISJ2_TAC THEN USE_THEN "F4" (MP_TAC o SPECL[`i:num`; `SUC i`]) THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J2" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN POP_ASSUM (MP_TAC o SPEC `k:num`) THEN REWRITE_TAC[LE_REFL] THEN DISCH_THEN (LABEL_TAC "F6") THEN REMOVE_THEN "F1" (MP_TAC) THEN REWRITE_TAC[is_Moebius_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")) THEN REMOVE_THEN "F6" MP_TAC THEN USE_THEN "F7" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (X_CHOOSE_THEN `i:num` (X_CHOOSE_THEN `j:num` MP_TAC)) THEN FIND_ASSUM SUBST1_TAC `node_map (H:(A)hypermap) = n` THEN FIND_ASSUM SUBST1_TAC `node_map (G:(A)hypermap) = n'` 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"))))) THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `j:num` THEN USE_THEN "F9" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F10" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F11" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F11" (LABEL_TAC "F15" o MATCH_MP (ARITH_RULE `j:num < k:num ==> j <= k`)) THEN USE_THEN "F10" (fun th1 -> (USE_THEN "F15" (fun th2-> (LABEL_TAC "F16" (MATCH_MP LE_TRANS (CONJ th1 th2)))))) THEN USE_THEN "F3" (MP_TAC o SPECL[`0`; `j:num`]) THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th; LE_0]) THEN USE_THEN "F15" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F3" (MP_TAC o SPECL[`i:num`; `k:num`]) THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th; LE_REFL]) THEN USE_THEN "F13" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]);;
let shift_path = new_definition `shift_path (p:num->A) (l:num) = \i:num. p (l + i)`;;
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]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_path] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN REWRITE_TAC[go_one_step] THEN REWRITE_TAC[lemma_shift_path_evaluation; ADD_SUC] THEN USE_THEN "F3" (ASSUME_TAC o MATCH_MP (ARITH_RULE `i:num < (n:num) - (l:num) ==> l +i < n`)) THEN REWRITE_TAC[GSYM go_one_step] THEN USE_THEN "F1" (MP_TAC o SPEC `(l:num) + (i:num)`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN REWRITE_TAC[one_step_contour] THEN REWRITE_TAC[lemma_shift_path_evaluation; ADD_SUC] THEN USE_THEN "F3" (ASSUME_TAC o MATCH_MP (ARITH_RULE `i:num < (n:num) - (l:num) ==> l +i < n`)) THEN REWRITE_TAC[GSYM one_step_contour] THEN USE_THEN "F1" (MP_TAC o SPEC `(l:num) + (i:num)`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
let lemma_shift_inj_contour = 
prove(`!(H:(A)hypermap) (p:num->A) (n:num) (l:num). is_inj_contour H p n /\ l <= n ==> is_inj_contour H (shift_path p l) (n-l)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) (LABEL_TAC "F3")) THEN USE_THEN "F1" (fun th1 -> (USE_THEN "F3" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_shift_contour (CONJ th1 th2)]))) THEN REPEAT GEN_TAC 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`)) THEN DISCH_TAC THEN USE_THEN "F2" (MP_TAC o SPECL[`(l:num) + (i:num)`; `(l:num) + (j:num)`]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
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) ==> is_contour H (join p q n) (n + m + 1)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN ASM_CASES_TAC `i:num < n:num` THENL[POP_ASSUM (LABEL_TAC "F5") THEN USE_THEN "F5" (fun th -> (MP_TAC (MATCH_MP LT_IMP_LE th)) THEN ASSUME_TAC (REWRITE_RULE[GSYM LE_SUC_LT] th)) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th]) THEN POP_ASSUM (fun th-> USE_THEN "F1" (fun thm -> REWRITE_TAC[MATCH_MP thm th])); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[NOT_LT]) THEN ASM_CASES_TAC `i = n:num` THENL[POP_ASSUM (SUBST_ALL_TAC) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_join_evaluation th]) THEN ONCE_REWRITE_TAC[ADD1] THEN REWRITE_TAC[ONE] THEN REWRITE_TAC[second_join_evaluation] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> POP_ASSUM (fun th1 -> ASSUME_TAC (REWRITE_RULE[GSYM LT_LE] (CONJ th1 (GSYM th))))) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2(GSYM ADD)] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN REWRITE_TAC[second_join_evaluation] THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[GSYM ADD1; LT_ADD_LCANCEL; LT_SUC]) THEN DISCH_THEN(fun th-> USE_THEN "F2" (fun thm -> REWRITE_TAC[MATCH_MP thm th])));;
let lemma_inj_contour_via_list = 
prove(`!(H:(A)hypermap) p:num->A n:num. is_inj_contour H p n <=> is_contour H p n /\ is_inj_list p n`,
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F3")))) THEN REWRITE_TAC[lemma_inj_contour_via_list] THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_inj_contour_via_list]) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_inj_contour_via_list]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_join_contours th]) THEN POP_ASSUM MP_TAC THEN REPLICATE_TAC 2 (POP_ASSUM (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list])) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_join_inj_lists th]));;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_contour_via_list; GSYM LT1_NZ; GSYM lemma_not_in_list] 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"))) 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))]))) THEN USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT1 o REWRITE_RULE[is_glueing]) 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))]))));;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LT1_NZ; GSYM lemma_not_in_list; GSYM is_glueing] THEN DISCH_THEN (LABEL_TAC "F1") THEN EXISTS_TAC `glue (p:num->A) (q:num->A) (n:num)` THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_glue_inj_contours th]) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[is_glueing] o CONJUNCT2 o CONJUNCT2) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN REWRITE_TAC[first_glue_evaluation] THEN REWRITE_TAC[glue; LE_0]);;
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)`,
REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MESON[] `~(A = B) <=> ~(B = A)`] THEN REWRITE_TAC[GSYM lemma_list_disjoint] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_join_inj_contours) THEN EXISTS_TAC `join (p:num->A) (q:num->A) (n:num)` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[first_join_evaluation] THEN REWRITE_TAC[GSYM ADD1; second_join_evaluation] THEN REWRITE_TAC[join; LE_0]);;
(* Lemma on reducing darts from a contour to make an injective contour *)
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)))`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC 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] THEN REWRITE_TAC[is_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl)) THEN ASM_REWRITE_TAC[] 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"))))))) THEN ASM_CASES_TAC `?k:num. k <= m:num /\ (q:num->A) k = p (SUC n:num)` THENL[POP_ASSUM (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))) THEN EXISTS_TAC `q:num->A` THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN USE_THEN "G1" (fun th1 -> (USE_THEN "F3" (fun th2 -> MP_TAC(MATCH_MP LE_TRANS (CONJ th1 th2))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `k:num <= n:num ==> k <= SUC n`) th]) THEN USE_THEN "F6" (MP_TAC o (SPEC `k:num`) o MATCH_MP lemma_sub_inj_contour) THEN USE_THEN "G1" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REPEAT STRIP_TAC THEN USE_THEN "F7" (MP_TAC o SPEC `i:num`) THEN POP_ASSUM (fun th -> (USE_THEN "G1" (fun th1 -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ th th1)]))) THEN MESON_TAC[LT_RIGHT_SUC]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN STRIP_TAC THEN ABBREV_TAC `g = (\i:num. (p:num->A) (SUC n))` THEN SUBGOAL_THEN `is_inj_contour (H:(A)hypermap) (g:num->A) 0` ASSUME_TAC THENL[REWRITE_TAC[is_inj_contour]; ALL_TAC] THEN SUBGOAL_THEN `one_step_contour (H:(A)hypermap) ((q:num->A) (m:num)) ((g:num->A) 0)` ASSUME_TAC THENL[USE_THEN "F5" SUBST1_TAC THEN EXPAND_TAC "g" THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `!i:num j:num. i <= m:num /\ j <= 0 ==> ~((g:num->A) j = (q:num->A) i)` ASSUME_TAC THENL[REPEAT GEN_TAC THEN REWRITE_TAC[LE] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN EXPAND_TAC "g" THEN FIRST_ASSUM (MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `i:num` THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] 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)))))))))))) THEN EXPAND_TAC "g" THEN REWRITE_TAC[ADD;GSYM ADD1; ADD_SUC] 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))))) THEN EXISTS_TAC `w:num->A` THEN EXISTS_TAC `SUC m` THEN REWRITE_TAC[LE_SUC] THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [LT_SUC_LE; LE_LT] THEN STRIP_TAC THENL[POP_ASSUM (LABEL_TAC "H5") THEN USE_THEN "F7" (MP_TAC o SPEC `i:num`) THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "H4" (MP_TAC o SPEC `i:num`) THEN USE_THEN "H5" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H4" (MP_TAC o SPEC `SUC i`) THEN REWRITE_TAC[LE_SUC_LT] THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN MESON_TAC[ARITH_RULE `j:num < n:num ==> j < SUC n`]; ALL_TAC] THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LT_PLUS] THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "H2" SUBST1_TAC THEN USE_THEN "H4" (MP_TAC o SPEC `m:num`) THEN REWRITE_TAC[LE_REFL; EQ_SYM] THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]));;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[one_step_contour] THEN REWRITE_TAC[] THEN MP_TAC(SPECL[`y:A`; `x:A`] (MATCH_MP PERMUTES_INVERSE_EQ (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma)))))) THEN MESON_TAC[]);;
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}`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect) THEN USE_THEN "F3" (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN DISCH_THEN (LABEL_TAC "F4") THEN MATCH_MP_TAC SUBSET_ANTISYM THEN STRIP_TAC THENL[REWRITE_TAC[SUBSET; IN_SING] THEN GEN_TAC THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM MP_TAC THEN USE_THEN "F3" (SUBST1_TAC o SYM) 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))))))))) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[set_of_orbits; SUBSET; IN_SING; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);;
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) ==> number_of_orbits s p <=2`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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 THENL[ REWRITE_TAC[set_of_orbits; SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[SUBSET] THEN DISCH_THEN (MP_TAC o SPEC `x'':A`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC 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))))))))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN SET_TAC[]; ALL_TAC] 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))))))))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN SET_TAC[]; ALL_TAC] THEN MP_TAC (ISPECL[`orbit_map (p:A->A) (x:A)`; `orbit_map (p:A->A) (y:A)`] FINITE_TWO_ELEMENTS) THEN POP_ASSUM (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP CARD_SUBSET (CONJ th1 th2)))))) THEN REWRITE_TAC[number_of_orbits] THEN ASM_CASES_TAC `orbit_map (p:A->A) (x:A) = orbit_map p (y:A)` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[SET_RULE `{a,a} = {a}`; CARD_SINGLETON] THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (MP_TAC o MATCH_MP CARD_TWO_ELEMENTS) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]));;
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}`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_component_reflect) THEN DISCH_THEN (LABEL_TAC "F2") THEN MATCH_MP_TAC SUBSET_ANTISYM THEN STRIP_TAC THENL[REWRITE_TAC[SUBSET; IN_SING] THEN GEN_TAC THEN REWRITE_TAC[set_of_components; set_part_components;IN_ELIM_THM] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM MP_TAC THEN USE_THEN "F1" (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_component_identity) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[set_of_components; SUBSET; IN_SING; IN_ELIM_THM; set_part_components] THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `x:A` THEN REMOVE_THEN "F1" (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]);;
(* THE MINIMUM HYPERMAP WHICH HAS A MOEBIUS CONTOUR - THE HYPERMAP OF ORDER 3 *)
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)`,
GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (X_CHOOSE_THEN `p:num->A` (X_CHOOSE_THEN `k:num` (LABEL_TAC "F2")))) THEN USE_THEN "F2" (MP_TAC o MATCH_MP lemma_darts_on_Moebius_contour) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ASSUME_TAC THEN MP_TAC (ARITH_RULE `2 <= k:num /\ SUC k <= 3 ==> k = 2`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST_ALL_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[ARITH_RULE `3 = SUC 2`] THEN USE_THEN "F2" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC(MATCH_MP lemma_darts_is_Moebius_contour (CONJ th1 (SYM th2))))))) THEN DISCH_THEN (LABEL_TAC "F3") THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[is_Moebius_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (X_CHOOSE_THEN `i:num` (X_CHOOSE_THEN `j:num` MP_TAC))) THEN USE_THEN "F3" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "C1") THEN MP_TAC (ARITH_RULE `0 < i:num /\ i <= j:num /\ j < 2 ==> (i = 1) /\ (j = 1)`) THEN USE_THEN "C1" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) THEN REMOVE_THEN "C1" MP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ARITH_RULE `0 < 1 /\ 1 <= 1 /\ 1 < 2`] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")) THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (LABEL_TAC "C2" o CONJUNCT2) THEN USE_THEN "C2" (MP_TAC o SPECL[`1`; `0`]) THEN REWRITE_TAC[ARITH_RULE `1 <= 2 /\ 0 < 1`] THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "C2" (MP_TAC o SPECL[`2`; `1`]) THEN REWRITE_TAC[LE_REFL; ARITH_RULE `1 < 2`] THEN DISCH_THEN (LABEL_TAC "F10") THEN REMOVE_THEN "C2" (MP_TAC o SPECL[`2`; `0`]) THEN REWRITE_TAC[LE_REFL; ARITH_RULE `0 < 2`] THEN DISCH_THEN (LABEL_TAC "F11") THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (MP_TAC o CONJUNCT1) THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (LABEL_TAC "C2") THEN USE_THEN "C2" (MP_TAC o SPEC `0`) THEN REWRITE_TAC[ARITH_RULE `0 < 2`; GSYM ONE; one_step_contour] THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM DISJ_SYM] THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F8" (SUBST1_TAC o SYM) THEN USE_THEN "F11" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F12") THEN REMOVE_THEN "C2" (MP_TAC o SPEC `1`) THEN REWRITE_TAC[ARITH_RULE `1 < 2`; GSYM TWO; one_step_contour] THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM DISJ_SYM] THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F7" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP EQ_TRANS (CONJ (SYM th1) th2)))))) THEN REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPEC `H:(A)hypermap` hypermap_lemma))))] THEN USE_THEN "F11" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F14") 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 THENL[GEN_TAC THEN REWRITE_TAC[SPEC `i:num` SEGMENT_TO_TWO] THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN USE_THEN "F3" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F15") THEN ABBREV_TAC `a = (p:num->A) 0` THEN ABBREV_TAC `b = (p:num->A) 1` THEN ABBREV_TAC `c = (p:num->A) 2` THEN label_hypermap_TAC `H:(A)hypermap` THEN ABBREV_TAC `D = dart (H:(A)hypermap)` THEN POP_ASSUM (LABEL_TAC "AB1") THEN ABBREV_TAC `e = edge_map (H:(A)hypermap)` THEN POP_ASSUM (LABEL_TAC "AB2") THEN ABBREV_TAC `n = node_map (H:(A)hypermap)` THEN POP_ASSUM (LABEL_TAC "AB3") THEN ABBREV_TAC `f = face_map (H:(A)hypermap)` THEN POP_ASSUM (LABEL_TAC "AB4") THEN USE_THEN "F15" (MP_TAC o SPEC `c:A`) THEN REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F16") THEN SUBGOAL_THEN `(f:A->A) (c:A) = a:A` (LABEL_TAC "F17") THENL[USE_THEN "F16" MP_TAC THEN EXPAND_TAC "D" THEN DISCH_THEN (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "AB4" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "AB1" (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN USE_THEN "F15" (MP_TAC o SPEC `(f:A->A) (c:A)`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN STRIP_TAC THENL[POP_ASSUM (fun th1 -> (USE_THEN "F12" (fun th2 -> MP_TAC(MATCH_MP EQ_TRANS (CONJ th1 th2))))) THEN USE_THEN "H4"(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE th]) THEN USE_THEN "F11" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN POP_ASSUM (fun th1 -> (USE_THEN "F14" (fun th2 -> MP_TAC(MATCH_MP EQ_TRANS (CONJ th1 th2))))) THEN USE_THEN "H4"(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE th]) THEN USE_THEN "F10" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN USE_THEN "F15" (MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F18") THEN USE_THEN "F15" (MP_TAC o SPEC `b:A`) THEN REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F19") THEN SUBGOAL_THEN `orbit_map (f:A->A) (a:A) = D:A->bool` (LABEL_TAC "F20") THENL[MATCH_MP_TAC SUBSET_ANTISYM THEN USE_THEN "H4" (MP_TAC o SPEC `a:A` o MATCH_MP orbit_subset) THEN USE_THEN "F18" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[SUBSET] THEN GEN_TAC THEN DISCH_TAC THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`) THEN POP_ASSUM(fun th -> REWRITE_TAC[th]) THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; POP_ASSUM SUBST1_TAC THEN MP_TAC (SPECL[`f:A->A`; `1`; `a:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_1] THEN USE_THEN "F12" (SUBST1_TAC o SYM) THEN SIMP_TAC[]; POP_ASSUM SUBST1_TAC THEN MP_TAC (SPECL[`f:A->A`; `2`; `a:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_2; o_THM] THEN USE_THEN "F12" (SUBST1_TAC o SYM) THEN USE_THEN "F14" (SUBST1_TAC o SYM) THEN SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `orbit_map (n:A->A) (a:A) = D:A->bool` (LABEL_TAC "F21") THENL[MATCH_MP_TAC SUBSET_ANTISYM THEN USE_THEN "H3" (MP_TAC o SPEC `a:A` o MATCH_MP orbit_subset) THEN USE_THEN "F18" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[SUBSET] THEN GEN_TAC THEN DISCH_TAC THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`) THEN POP_ASSUM(fun th -> REWRITE_TAC[th]) THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; POP_ASSUM SUBST1_TAC THEN MP_TAC (SPECL[`n:A->A`; `1`; `a:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_1] THEN USE_THEN "F7" (SUBST1_TAC o SYM) THEN SIMP_TAC[]; POP_ASSUM SUBST1_TAC THEN MP_TAC (SPECL[`n:A->A`; `2`; `a:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_2; o_THM] THEN USE_THEN "F7" (SUBST1_TAC o SYM) THEN USE_THEN "F8" (SUBST1_TAC o SYM) THEN SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `orbit_map (e:A->A) (b:A) = D:A->bool` (LABEL_TAC "F22") THENL[USE_THEN "H5" (fun th -> (MP_TAC (AP_THM th `c:A`))) THEN REWRITE_TAC[o_THM; I_THM] THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F7" (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_THEN (LABEL_TAC "EE1") THEN USE_THEN "H5" (fun th -> (MP_TAC (AP_THM th `a:A`))) THEN REWRITE_TAC[o_THM; I_THM] THEN USE_THEN "F12" (fun th -> REWRITE_TAC[SYM th]) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[SYM th]) THEN DISCH_THEN (LABEL_TAC "EE2") THEN MATCH_MP_TAC SUBSET_ANTISYM THEN USE_THEN "H2" (MP_TAC o SPEC `b:A` o MATCH_MP orbit_subset) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[SUBSET] THEN GEN_TAC THEN DISCH_TAC THEN USE_THEN "F15" (MP_TAC o SPEC `x:A`) THEN POP_ASSUM(fun th -> REWRITE_TAC[th]) THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN MP_TAC (SPECL[`e:A->A`; `2`; `b:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_2; o_THM] THEN USE_THEN "EE1" SUBST1_TAC THEN USE_THEN "EE2" SUBST1_TAC THEN SIMP_TAC[]; POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; POP_ASSUM SUBST1_TAC THEN MP_TAC (SPECL[`e:A->A`; `1`; `b:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_1] THEN USE_THEN "EE1" SUBST1_TAC THEN SIMP_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN `comb_component (H:(A)hypermap) (a:A) = dart (H:(A)hypermap)` (LABEL_TAC "F23") THENL[MATCH_MP_TAC SUBSET_ANTISYM THEN USE_THEN "F18" MP_TAC THEN USE_THEN "AB1" (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th -> (REWRITE_TAC[MATCH_MP lemma_component_subset th])) THEN USE_THEN "AB1" (SUBST1_TAC) THEN USE_THEN "F21" (SUBST1_TAC o SYM) THEN EXPAND_TAC "n" THEN REWRITE_TAC[GSYM node] THEN REWRITE_TAC[lemma_node_subset_component]; ALL_TAC] THEN REWRITE_TAC[planar_hypermap; number_of_components] THEN POP_ASSUM (fun th -> (REWRITE_TAC[MATCH_MP lemma_only_one_component th])) THEN REWRITE_TAC[number_of_nodes; number_of_edges; number_of_faces; node_set; edge_set; face_set] THEN USE_THEN "AB1" SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN USE_THEN "AB2" SUBST1_TAC THEN USE_THEN "AB3" SUBST1_TAC THEN USE_THEN "AB4" SUBST1_TAC 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))))))))) THEN DISCH_THEN SUBST1_TAC 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))))))))) THEN DISCH_THEN SUBST1_TAC 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))))))))) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CARD_SINGLETON] THEN CONV_TAC NUM_REDUCE_CONV);;
(* FACE_WALKUP *)
let dart_face_walkup = 
prove(`!(H:(A)hypermap) (x:A). dart (face_walkup H x) = (dart H) DELETE x`,
REPEAT STRIP_TAC THEN REWRITE_TAC[face_walkup] THEN REWRITE_TAC[GSYM shift_lemma] THEN REWRITE_TAC[lemma_edge_walkup] THEN REWRITE_TAC[GSYM double_shift_lemma]);;
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`,
REPEAT STRIP_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] dart_face_walkup) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE THEN ASM_REWRITE_TAC[hypermap_lemma]);;
let face_map_face_walkup = 
prove(`!(H:(A)hypermap) (x:A) (y:A). face_map (face_walkup H x) x = x /\ (~(edge_map H x = x) /\ ~(face_map H x = x) ==> face_map (face_walkup H x) (edge_map H x) = face_map H x) /\ (~(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) /\ (~(y = x) /\ ~(y = inverse (face_map H) x) /\ ~(y = edge_map H x) ==> face_map (face_walkup H x) y = face_map H y)`,
REPEAT GEN_TAC THEN REWRITE_TAC[face_walkup] THEN ONCE_REWRITE_TAC[double_shift_lemma] THEN REWRITE_TAC[lemma_shift_cycle] THEN ABBREV_TAC `G = shift (shift (H:(A)hypermap))` THEN REWRITE_TAC[edge_map_walkup]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[face_walkup] THEN ONCE_REWRITE_TAC[double_shift_lemma] THEN REWRITE_TAC[lemma_shift_cycle] THEN ABBREV_TAC `G = shift (shift (H:(A)hypermap))` THEN REWRITE_TAC[face_map_walkup]);;
(* NODE_WALKUP *)
let dart_node_walkup = 
prove(`!(H:(A)hypermap) (x:A). dart (node_walkup H x) = (dart H) DELETE x`,
REPEAT STRIP_TAC THEN REWRITE_TAC[node_walkup] THEN REWRITE_TAC[GSYM double_shift_lemma] THEN REWRITE_TAC[lemma_edge_walkup] THEN REWRITE_TAC[GSYM shift_lemma]);;
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`,
REPEAT STRIP_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`] dart_node_walkup) THEN DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC CARD_MINUS_ONE THEN ASM_REWRITE_TAC[hypermap_lemma]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[node_walkup] THEN ONCE_REWRITE_TAC[shift_lemma] THEN REWRITE_TAC[lemma_shift_cycle] THEN ABBREV_TAC `G = shift (H:(A)hypermap)` THEN REWRITE_TAC[edge_map_walkup]);;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[node_walkup] THEN ONCE_REWRITE_TAC[shift_lemma] THEN REWRITE_TAC[lemma_shift_cycle] THEN ABBREV_TAC `G = shift (H:(A)hypermap)` THEN REWRITE_TAC[node_map_walkup]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "J1") (LABEL_TAC "J2")) THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[lemma_sub_two_numbers] THEN DISCH_THEN (LABEL_TAC "J3") THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ARITH_RULE `((m:num) + 1) + (i:num) = m + i + 1 /\ (m+1) + SUC i = SUC (m + i + 1)`] 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)) THEN LABEL_TAC "J5" (ARITH_RULE `m:num < m + (i:num) + 1`) THEN ABBREV_TAC `id = (m:num) + (i:num) + 1` THEN USE_THEN "J1" (MP_TAC o SPEC `id:num`) THEN USE_THEN "J4" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[DISJ1_TAC THEN POP_ASSUM (LABEL_TAC "J6") THEN USE_THEN "J2" (MP_TAC o SPECL[`id:num`; `m:num`]) THEN USE_THEN "J5" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN (LABEL_TAC "J7" o GSYM) THEN SUBGOAL_THEN `~((p:num->A) (id:num) = inverse (face_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "J8") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[GSYM face_map_inverse_representation] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "J2" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`]) THEN USE_THEN "J5" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < id:num ==> m < SUC id`) th]) THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th]) THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) (id:num) = edge_map (H:(A)hypermap) ((p:num->A) (m:num)))` (LABEL_TAC "J9") THENL[USE_THEN "J7" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "F3" (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o AP_TERM `face_map (H:(A)hypermap)`) THEN REPLICATE_TAC 2 (GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM]) THEN REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[hypermap_cyclic; I_THM] THEN USE_THEN "J6" (SUBST1_TAC o SYM) THEN USE_THEN "J2" (MP_TAC o SPECL[`SUC (id:num)`; `(m:num) + 1`]) THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th]) THEN USE_THEN "J5" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < id:num ==> m + 1 < SUC id`) th]) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (id:num)`] face_map_face_walkup)))) THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "J10") THEN USE_THEN "J2" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`]) THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th]) THEN USE_THEN "J5" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < id:num ==> m < SUC id`) th]) THEN DISCH_THEN (LABEL_TAC "J11" o GSYM) THEN SUBGOAL_THEN `~((p:num->A) (SUC (id:num)) = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "J12") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "J2" (MP_TAC o SPECL[`id:num`; `m:num`]) THEN USE_THEN "J5" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "J4" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (SUC (id:num))`] node_map_face_walkup))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REPEAT GEN_TAC THEN REWRITE_TAC[lemma_sub_two_numbers] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K1") (LABEL_TAC "K2")) THEN USE_THEN "J2" (MP_TAC o SPECL[`((m:num) + 1) + (i:num)`; `((m:num)+1)+(j:num)`]) 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)]))) THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MP (ARITH_RULE `j:num < i:num ==> ((m:num) + 1) + j < (m + 1) + i`) th]) );;
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) /\ one_step_contour (face_walkup H (p m)) (p (m-1)) (p (m+1))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN STRIP_TAC THENL[USE_THEN "F1" (MP_TAC o SPEC `(m:num)-1` o MATCH_MP lemma_sub_inj_contour) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> m - 1 <= k`) th]) THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour] THEN SIMP_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")) THEN STRIP_TAC THEN DISCH_THEN (LABEL_TAC "G3") THEN USE_THEN "G1" (MP_TAC o SPEC `i:num`) THEN USE_THEN "G3" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour] THEN DISCH_THEN (LABEL_TAC "G4" o CONJUNCT2) THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `i:num`]) THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) - 1 ==> i < m`) th]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN (LABEL_TAC "G5") THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[DISJ1_TAC THEN POP_ASSUM (LABEL_TAC "G6") THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (face_map H) (p (m:num)))` (LABEL_TAC "G7") THENL[USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `SUC (i:num)`]) THEN USE_THEN "G3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) - 1 ==> SUC i < m`) th])) THEN USE_THEN "F3" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])) THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[GSYM face_map_inverse_representation] THEN USE_THEN "G6" (SUBST1_TAC o SYM) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) (i:num) = (edge_map H) (p (m:num)))` (LABEL_TAC "G8") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN REMOVE_THEN "G6" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`) THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_THM] THEN REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[hypermap_cyclic; I_THM] THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN REWRITE_TAC[node_map_injective; ADD1] THEN DISCH_TAC THEN USE_THEN "G4" (MP_TAC o SPECL[`(m:num) + 1`; `(i:num) + 1`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < k:num ==> m+ 1 <= k:num`) th]) THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> i+ 1 < m+1`) th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (i:num)`] face_map_face_walkup)))) THEN ASM_REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "G10") THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `SUC (i:num)`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> SUC i < m`) th]) THEN DISCH_THEN (LABEL_TAC"G11") THEN SUBGOAL_THEN `~((p:num->A) (SUC (i:num)) = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "G12") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (SUC (i:num))`] node_map_face_walkup))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[lemma_sub_two_numbers] 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))])))))) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "FF")) THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (MP_TAC o SPEC `(m:num) - 1`) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m - 1 < k`) th]) THEN REWRITE_TAC[lemma_one_step_contour] THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> SUC (m-1) = m`) th]) THEN STRIP_TAC THENL[DISJ1_TAC THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [face_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "L1") THEN USE_THEN "F4" (MP_TAC o SYM) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "L2") THEN USE_THEN "FF" (MP_TAC o SPECL[`m:num`; `(m:num)-1`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> m - 1 < m`) th]) THEN USE_THEN "L1" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "L3") THEN USE_THEN "FF" (MP_TAC o GSYM o SPECL[`(m:num)+1`; `(m:num)`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m + 1 <= k`) th]) THEN REWRITE_TAC[ARITH_RULE ` m:num < m + 1`] THEN USE_THEN "L2" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "L4") THEN MP_TAC (CONJUNCT1(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (m:num)`] face_map_face_walkup)))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F4" (MP_TAC o SYM) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [node_map_inverse_representation] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[node_map_face_walkup] );;
(* FORMULATE THIS LEMMA FOR f STEP *)
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN REWRITE_TAC[lemma_sub_two_numbers] THEN ASM_CASES_TAC `k:num = ((m:num) + 1)` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[SUB_REFL; is_inj_contour]; ALL_TAC] 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)))))) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "F5")) THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (LABEL_TAC "F6") THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7") THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN USE_THEN "F6" (MP_TAC o SPEC `((m:num)+1) + (i:num)`) 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)))))) THEN ABBREV_TAC `id = ((m:num) + 1) + (i:num)` THEN POP_ASSUM (LABEL_TAC "F9") THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[ADD_SUC] THEN USE_THEN "F9" (SUBST1_TAC) THEN REWRITE_TAC[lemma_one_step_contour] THEN CONV_TAC (ONCE_REWRITE_CONV[DISJ_SYM]) THEN STRIP_TAC THENL[DISJ1_TAC THEN POP_ASSUM (LABEL_TAC "F10") THEN USE_THEN "F5" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`]) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th]) THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m < SUC id`) th]) THEN DISCH_THEN (LABEL_TAC "F11" o GSYM) THEN SUBGOAL_THEN `~((p:num->A) (SUC (id:num)) = face_map (H:(A)hypermap) ((p:num->A) (m:num)))` (LABEL_TAC "F12") THENL[USE_THEN "F11" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "F3" (SUBST1_TAC o SYM) THEN USE_THEN "F5" (MP_TAC o SPECL[`SUC (id:num)`; `(m:num) + 1`]) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th]) THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m + 1 < SUC id`) th]) THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) (SUC (id:num)) = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "F14") THENL[USE_THEN "F12" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F10" (SUBST1_TAC o SYM) THEN USE_THEN "F5" (MP_TAC o SPECL[`(id:num)`; `(m:num)`]) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m < id`) th]) THEN MESON_TAC[]; ALL_TAC] 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)))) THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM (LABEL_TAC "F10") THEN USE_THEN "F5" (MP_TAC o SPECL[`id:num`; `m:num`]) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m < id`) th]) THEN DISCH_TAC THEN SUBGOAL_THEN `~((p:num->A) (id:num) = inverse (face_map (H:(A)hypermap)) ((p:num->A) (m:num)))` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[GSYM face_map_inverse_representation] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F5" (MP_TAC o SPECL[`SUC (id:num)`; `m:num`]) THEN USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `id:num < k:num ==> SUC id <= k`) th]) THEN USE_THEN "F9" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `((m:num) + 1) + (i:num) = id ==> m < SUC id`) th]) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (id:num)`] face_map_node_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REPEAT GEN_TAC THEN REWRITE_TAC[lemma_sub_two_numbers] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K1") (LABEL_TAC "K2")) THEN USE_THEN "F5" (MP_TAC o SPECL[`((m:num) + 1) + (i:num)`; `((m:num)+1)+(j:num)`]) 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)]))) THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MP (ARITH_RULE `j:num < i:num ==> ((m:num) + 1) + j < (m + 1) + i`) th]) );;
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) /\ one_step_contour (node_walkup H (p m)) (p (m-1)) (p (m+1))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN STRIP_TAC THENL[USE_THEN "F1" (MP_TAC o SPEC `(m:num)-1` o MATCH_MP lemma_sub_inj_contour) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> m - 1 <= k`) th]) THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour] THEN SIMP_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")) THEN STRIP_TAC THEN DISCH_THEN (LABEL_TAC "G3") THEN USE_THEN "G1" (MP_TAC o SPEC `i:num`) THEN USE_THEN "G3" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour; lemma_def_contour] THEN DISCH_THEN (LABEL_TAC "G4" o CONJUNCT2) THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `SUC (i:num)`]) 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)]))) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN (LABEL_TAC "G5") THEN REWRITE_TAC[one_step_contour] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [DISJ_SYM] THEN STRIP_TAC THENL[DISJ2_TAC THEN POP_ASSUM (LABEL_TAC "G6") THEN SUBGOAL_THEN `~((p:num->A) (SUC (i:num)) = inverse (node_map H) (p (m:num)))` (LABEL_TAC "G7") THENL[USE_THEN "G5" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `i:num`]) THEN USE_THEN "G3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) - 1 ==> i < m`) th])) THEN USE_THEN "F3" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])) THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) (SUC(i:num)) = (face_map H) (p (m:num)))` (LABEL_TAC "G8") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN DISCH_TAC THEN USE_THEN "G4" (MP_TAC o SPECL[`(m:num) + 1`; `SUC (i:num)`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < k:num ==> m+ 1 <= k:num`) th]) THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> SUC i < m+1`) th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] 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)))) THEN REPLICATE_TAC 2(POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "G5" (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [GSYM node_map_inverse_representation] THEN ASM_REWRITE_TAC[EQ_SYM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM node_map_inverse_representation; EQ_SYM]; ALL_TAC] THEN DISJ1_TAC THEN POP_ASSUM (LABEL_TAC "G10") THEN USE_THEN "G4" (MP_TAC o SPECL[`m:num`; `(i:num)`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "G3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num < (m:num) -1 ==> i < m`) th]) THEN DISCH_THEN (LABEL_TAC"G11") THEN SUBGOAL_THEN `~((p:num->A) (i:num) = inverse (face_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "G12") THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[GSYM face_map_inverse_representation] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (i:num)`] face_map_node_walkup))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[lemma_sub_two_numbers] 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))])))))) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC) (LABEL_TAC "FF")) THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (MP_TAC o SPEC `(m:num) - 1`) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m - 1 < k`) th]) THEN REWRITE_TAC[lemma_one_step_contour] THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> SUC (m-1) = m`) th]) THEN CONV_TAC (ONCE_REWRITE_CONV[DISJ_SYM]) THEN STRIP_TAC THENL[DISJ1_TAC THEN POP_ASSUM MP_TAC THEN DISCH_THEN (LABEL_TAC "L1") THEN USE_THEN "FF" (MP_TAC o SPECL[`m:num`; `(m:num)-1`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < m:num ==> m - 1 < m`) th]) THEN USE_THEN "L1" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "L3") THEN USE_THEN "FF" (MP_TAC o GSYM o SPECL[`(m:num)+1`; `(m:num)`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `m:num < k:num ==> m + 1 <= k`) th]) THEN REWRITE_TAC[ARITH_RULE ` m:num < m + 1`] THEN USE_THEN "F4" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "L4") THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (m:num)`] node_map_node_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [face_map_inverse_representation] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F4" SUBST1_TAC THEN REWRITE_TAC[face_map_node_walkup] );;
(* THE COMBINATORIAL JORDAN CURVE THEOREM *)
let lemmaLIPYTUI = 
prove(`!(H:(A)hypermap). planar_hypermap H ==> ~(?(p:num->A) k:num. is_Moebius_contour H p k)`,
GEN_TAC THEN ABBREV_TAC `n = CARD (dart (H:(A)hypermap))` THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN SPEC_TAC (`H:(A)hypermap`, `H:(A)hypermap`) THEN SPEC_TAC (`n:num`, `n:num`) THEN INDUCT_TAC THENL[REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_darts_on_Moebius_contour) THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `SUC (k:num) <= l:num ==> ~(l = 0)`)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "FI") THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN STRIP_TAC THEN POP_ASSUM (LABEL_TAC "F3") THEN USE_THEN "F3" (MP_TAC o MATCH_MP lemma_Moebius_contour_points_subset_darts) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")) THEN LABEL_TAC "F6" (CONJUNCT1(SPEC `H:(A)hypermap` hypermap_lemma)) THEN ASM_CASES_TAC `~({(p:num->A) (i:num) | i <= (k:num)} = dart (H:(A)hypermap))` THENL[POP_ASSUM MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM PSUBSET] THEN REWRITE_TAC[PSUBSET_MEMBER] THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]) THEN STRIP_TAC THEN POP_ASSUM (fun th1 -> (USE_THEN "F3" (fun th2 -> (MP_TAC (MATCH_MP lemma_eliminate_dart_ouside_Moebius_contour (CONJ th2 th1)))))) THEN FIRST_ASSUM (MP_TAC o (SPEC `edge_walkup (H:(A)hypermap) (y:A)`)) THEN REWRITE_TAC[] THEN POP_ASSUM (fun th -> (MP_TAC (MATCH_MP lemma_card_walkup_dart th) THEN ASSUME_TAC th)) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[th; GSYM ADD1; EQ_SUC]) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN POP_ASSUM (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)]))) THEN REWRITE_TAC[CONTRAPOS_THM] THEN STRIP_TAC THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num` THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[is_Moebius_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")) THEN USE_THEN "F7" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) THEN DISCH_THEN (LABEL_TAC "F11") 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"))))))) THEN USE_THEN "F9" MP_TAC THEN REWRITE_TAC[lemma_def_contour] THEN DISCH_THEN (LABEL_TAC "F17") THEN ASM_CASES_TAC `m:num < t:num` THENL[POP_ASSUM (fun th -> (LABEL_TAC "G1" (MATCH_MP (ARITH_RULE `m:num < t:num ==> SUC m <= t`) th))) THEN USE_THEN "F17" (MP_TAC o SPEC `m:num`) 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)))))) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[POP_ASSUM (fun th -> (LABEL_TAC "G3" th THEN MP_TAC th)) THEN REWRITE_TAC[ADD1] 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)))))))))))) THEN REWRITE_TAC[lemma_sub_two_numbers] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 (LABEL_TAC "G5") (LABEL_TAC "G6"))) THEN ABBREV_TAC `G = node_walkup (H:(A)hypermap) ((p:num->A) (m:num))` THEN POP_ASSUM (LABEL_TAC "G7") THEN SUBGOAL_THEN `one_step_contour G ((p:num->A) ((m:num)-1)) ((shift_path (p:num->A) ((m:num)+1)) 0)` ASSUME_TAC THENL[REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_0] THEN REMOVE_THEN "G6" (fun th -> REWRITE_TAC[th]); ALL_TAC] 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 THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G8") (LABEL_TAC "G9")) THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC] THEN USE_THEN "F10" (MP_TAC o SPECL[`(m:num) + 1 + (j:num)`; `i:num`]) THEN USE_THEN "G8" (fun th1 -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= (m:num) - 1 ==> i < m + 1 + (j:num)`) th1])) 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)])))) THEN REWRITE_TAC[CONTRAPOS_THM; EQ_SYM]; ALL_TAC] 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))))))))))) THEN REWRITE_TAC[lemma_shift_path_evaluation] 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)]))) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < (k:num) ==> (m + 1) + k - (m+1) = k`) th]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < (m:num) ==> m - 1 + (i:num) + 1 = m + i`) th]) 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")))))) THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "G16") THENL[REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "G12" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `m:num` THEN EXISTS_TAC `(t:num) - 1` THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (m:num) <= t:num ==> m <= t - 1`) th]) 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)]))) THEN USE_THEN "G10" (SUBST1_TAC) THEN USE_THEN "G11" (SUBST1_TAC) THEN USE_THEN "G15" (MP_TAC o SPEC `0`) THEN REWRITE_TAC[LE_0; ADD_0] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G1" MP_TAC THEN REWRITE_TAC[LE_EXISTS; ADD1] THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "G16")) 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)))))) THEN USE_THEN "G15" (MP_TAC o SPEC `d:num`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G16" (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [SYM th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `t:num = ((m:num)+1) + (d:num) ==> m + d = t - 1`) th]) THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "G" THEN STRIP_TAC THENL[USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN (LABEL_TAC "G21") THEN SUBGOAL_THEN `~((p:num->A) 0 = face_map (H:(A)hypermap) ((p:num->A) (m:num)))` (LABEL_TAC "G22") THENL[USE_THEN "G21" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "G3" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`SUC (m:num)`; `0`]) THEN USE_THEN "G2" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> SUC m <= k`) th])) THEN REWRITE_TAC[LT_0] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "G23") THENL[ REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "G21" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "F16" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`t:num`; `m:num`]) THEN USE_THEN "F15" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])) THEN USE_THEN "G1" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `SUC (m:num) <= t:num ==> m < t`) th])) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) 0`] node_map_node_walkup)))) THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN USE_THEN "F10" (MP_TAC o SPECL[`(m:num) + 1`; `m:num`]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[ARITH_RULE `m:num < m + 1`]) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `m:num < k:num ==> m+1 <= k`) th]) THEN USE_THEN "G3" MP_TAC THEN REWRITE_TAC[ADD1] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "G3" o GSYM) THEN SUBGOAL_THEN `~(node_map (H:(A)hypermap) ((p:num->A) (m:num)) = p m)` (LABEL_TAC "G25") THENL[USE_THEN "F16k" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`k:num`; `m:num`]) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[LE_REFL; th]) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) (m:num)`] node_map_node_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN SUBGOAL_THEN `(p:num->A) (m:num) IN dart (H:(A)hypermap)` (LABEL_TAC "G26") THENL[USE_THEN "F11" (SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; LE_0] THEN EXISTS_TAC `m:num` THEN USE_THEN "G2" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])); ALL_TAC] THEN USE_THEN "G26" (MP_TAC o MATCH_MP lemma_card_node_walkup_dart) THEN USE_THEN "G7" SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN REWRITE_TAC[GSYM ADD1; EQ_SUC] THEN DISCH_THEN (LABEL_TAC "G21") THEN USE_THEN "FI" (MP_TAC o SPEC `node_walkup (H:(A)hypermap) ((p:num->A) (m:num))`) THEN USE_THEN "G26" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)]))) THEN USE_THEN "G7" SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `(k:num) - 1` THEN USE_THEN "G16" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD1] THEN DISCH_THEN (fun th -> (LABEL_TAC "K3A" th THEN MP_TAC th)) THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "K3B") 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))))))))))))) THEN REWRITE_TAC[lemma_sub_two_numbers] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K4") (CONJUNCTS_THEN2 (LABEL_TAC "K5") (LABEL_TAC "K6"))) THEN ABBREV_TAC `G = face_walkup (H:(A)hypermap) ((p:num->A) (m:num))` THEN POP_ASSUM (LABEL_TAC "K7") THEN SUBGOAL_THEN `one_step_contour G ((p:num->A) ((m:num)-1)) ((shift_path (p:num->A) ((m:num)+1)) 0)` ASSUME_TAC THENL[REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_0] THEN REMOVE_THEN "K6" (fun th -> REWRITE_TAC[th]); ALL_TAC] 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 THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K8") (LABEL_TAC "K9")) THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC] THEN USE_THEN "F10" (MP_TAC o SPECL[`(m:num) + 1 + (j:num)`; `i:num`]) THEN USE_THEN "K8" (fun th1 -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= (m:num) - 1 ==> i < m + 1 + (j:num)`) th1])) 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)])))) THEN REWRITE_TAC[CONTRAPOS_THM; EQ_SYM]; ALL_TAC] 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))))))))))) THEN REWRITE_TAC[lemma_shift_path_evaluation] 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)]))) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `(m:num) < (k:num) ==> (m + 1) + k - (m+1) = k`) th]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < (m:num) ==> m - 1 + (i:num) + 1 = m + i`) th]) 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")))))) THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "K16") THENL[REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "K12" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `m:num` THEN EXISTS_TAC `(t:num) - 1` THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G1" (fun th -> REWRITE_TAC[MP (ARITH_RULE `SUC (m:num) <= t:num ==> m <= t - 1`) th]) 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)]))) THEN USE_THEN "K10" (SUBST1_TAC) THEN USE_THEN "K11" (SUBST1_TAC) THEN USE_THEN "K15" (MP_TAC o SPEC `0`) THEN REWRITE_TAC[LE_0; ADD_0] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G1" MP_TAC THEN REWRITE_TAC[LE_EXISTS; ADD1] THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "K16")) 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)))))) THEN USE_THEN "K15" (MP_TAC o SPEC `d:num`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "K16" (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [SYM th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `t:num = ((m:num)+1) + (d:num) ==> m + d = t - 1`) th]) THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "G" THEN STRIP_TAC THENL[USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN (LABEL_TAC "K21") THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (m:num)))` (LABEL_TAC "K23") THENL[ REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "K21" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "F16" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`t:num`; `m:num`]) THEN USE_THEN "F15" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])) THEN USE_THEN "G1" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `SUC (m:num) <= t:num ==> m < t`) th])) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (m:num)`; `(p:num->A) 0`] node_map_face_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN USE_THEN "K3A" SUBST1_TAC THEN REWRITE_TAC[node_map_face_walkup] THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `(p:num->A) (m:num) IN dart (H:(A)hypermap)` (LABEL_TAC "K17") THENL[USE_THEN "F11" (SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; LE_0] THEN EXISTS_TAC `m:num` THEN USE_THEN "G2" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])); ALL_TAC] THEN USE_THEN "K17" (MP_TAC o MATCH_MP lemma_card_face_walkup_dart) THEN USE_THEN "K7" SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN REWRITE_TAC[GSYM ADD1; EQ_SUC] THEN DISCH_THEN (LABEL_TAC "K18") THEN USE_THEN "FI" (MP_TAC o SPEC `face_walkup (H:(A)hypermap) ((p:num->A) (m:num))`) THEN USE_THEN "K17" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)]))) THEN USE_THEN "K7" SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `(k:num) - 1` THEN USE_THEN "K16" (fun th -> REWRITE_TAC[th]); ALL_TAC] 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)))))) THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_CASES_TAC `1 < m:num` THENL[ POP_ASSUM (fun th -> (LABEL_TAC "B1" th THEN LABEL_TAC "B2" (MATCH_MP (ARITH_RULE `1 < m:num ==> 2 <= m`) th))) THEN USE_THEN "F17" (MP_TAC o SPEC `0:num`) 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)))))) THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> 0 < k`) th]) THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD1] THEN DISCH_THEN (LABEL_TAC "B4") THEN USE_THEN "F15" (fun th -> MP_TAC (MATCH_MP (ARITH_RULE `m:num < k:num ==> 0 < k`) th)) 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))))))))) THEN REWRITE_TAC[ADD] THEN DISCH_THEN (LABEL_TAC "B5") THEN ABBREV_TAC `G = node_walkup (H:(A)hypermap) ((p:num->A) 0)` THEN POP_ASSUM (LABEL_TAC "B6") THEN ABBREV_TAC `g = shift_path (p:num->A) 1` THEN POP_ASSUM (LABEL_TAC "B7") THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "B8") THENL[REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "B5" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `(m:num) - 1` THEN EXISTS_TAC `(m:num) - 1` THEN USE_THEN "B2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= m:num ==> 0 < m - 1`) th; LE_REFL]) 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)]))) THEN EXPAND_TAC "g" THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_SYM; GSYM ADD] THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < m:num ==> m - 1 + 1 = m`) th]) THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> k - 1 + 1 = k`) th]) THEN REWRITE_TAC[ARITH_RULE `1+0 = 1`] THEN POP_ASSUM (LABEL_TAC "B9") THEN EXPAND_TAC "G" THEN STRIP_TAC THENL[USE_THEN "B4" MP_TAC THEN REWRITE_TAC[ADD] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `~(face_map (H:(A)hypermap) ((p:num->A) 0) = p 0)` ASSUME_TAC THENL[ USE_THEN "B4" (SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD] THEN USE_THEN "F10" (MP_TAC o SPECL[`1`; `0`]) THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> 1 <= k`) th]) THEN REWRITE_TAC[ARITH_RULE `0 < 1`] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~(node_map (H:(A)hypermap) ((p:num->A) 0) = p 0)` ASSUME_TAC THENL[USE_THEN "F16" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`]) THEN USE_THEN "F15" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) 0`; `(p:num->A) 0`] node_map_node_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`]) THEN USE_THEN "F15" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN SUBGOAL_THEN `~((p:num->A) (m:num) = face_map (H:(A)hypermap) ((p:num->A) 0))` ASSUME_TAC THENL[USE_THEN "B4" (SUBST1_TAC o SYM) THEN REWRITE_TAC[ADD] THEN USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `1`]) THEN USE_THEN "F15" (fun th -> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])) THEN USE_THEN "B1" (fun th -> (REWRITE_TAC[th])) THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) (m:num) = inverse (node_map (H:(A)hypermap)) ((p:num->A) 0))` ASSUME_TAC THENL[REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F16k" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`k:num`; `0`]) THEN USE_THEN "B3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `2 < k:num ==> 0 < k`) th; LE_REFL])); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) 0`; `(p:num->A) (m:num)`] node_map_node_walkup)))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM th]) THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN SUBGOAL_THEN `(p:num->A) 0 IN dart (H:(A)hypermap)` (LABEL_TAC "B10") THENL[USE_THEN "F11" (SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; LE_0] THEN EXISTS_TAC `0` THEN REWRITE_TAC[LE_0]; ALL_TAC] THEN USE_THEN "B10" (MP_TAC o MATCH_MP lemma_card_node_walkup_dart) THEN USE_THEN "B6" SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN REWRITE_TAC[GSYM ADD1; EQ_SUC] THEN DISCH_THEN (LABEL_TAC "B11") THEN USE_THEN "FI" (MP_TAC o SPEC `node_walkup (H:(A)hypermap) ((p:num->A) 0)`) THEN USE_THEN "B10" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)]))) THEN USE_THEN "B6" SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `(k:num) - 1` THEN USE_THEN "B8" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD1] THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "C4" o GSYM) THEN USE_THEN "F15" (fun th -> MP_TAC (MATCH_MP (ARITH_RULE `m:num < k:num ==> 0 < k`) th)) 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))))))))) THEN REWRITE_TAC[ADD] THEN DISCH_THEN (LABEL_TAC "C5") THEN ABBREV_TAC `G = face_walkup (H:(A)hypermap) ((p:num->A) 0)` THEN POP_ASSUM (LABEL_TAC "C6") THEN ABBREV_TAC `g = shift_path (p:num->A) 1` THEN POP_ASSUM (LABEL_TAC "C7") THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) ((k:num) - 1)` (LABEL_TAC "C8") THENL[REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "C5" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `(m:num) - 1` THEN EXISTS_TAC `(m:num) - 1` THEN USE_THEN "B2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= m:num ==> 0 < m - 1`) th; LE_REFL]) 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)]))) THEN EXPAND_TAC "g" THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_SYM; GSYM ADD] THEN USE_THEN "F12" (fun th -> REWRITE_TAC[MP (ARITH_RULE `0 < m:num ==> m - 1 + 1 = m`) th]) THEN USE_THEN "B3" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 < k:num ==> k - 1 + 1 = k`) th]) THEN REWRITE_TAC[ARITH_RULE `1+0 = 1`] THEN POP_ASSUM (LABEL_TAC "C9") THEN EXPAND_TAC "G" THEN STRIP_TAC THENL[USE_THEN "C4" (MP_TAC o SYM) THEN REWRITE_TAC[ADD] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [node_map_inverse_representation] THEN DISCH_THEN (SUBST1_TAC) THEN REWRITE_TAC[node_map_face_walkup] THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F10" (MP_TAC o SPECL[`m:num`; `0`]) THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F15" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN (ASSUME_TAC o GSYM) THEN SUBGOAL_THEN `~((p:num->A) (m:num) = inverse(node_map (H:(A)hypermap)) ((p:num->A) 0))` ASSUME_TAC THENL[REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F16k" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`k:num`; `0`]) THEN USE_THEN "B3" (fun th -> (REWRITE_TAC[MATCH_MP (ARITH_RULE `2 < k:num ==> 0 < k`) th; LE_REFL])); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2 (SPECL[`H:(A)hypermap`; `(p:num->A) 0`; `(p:num->A) (m:num)`] node_map_face_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN SUBGOAL_THEN `(p:num->A) 0 IN dart (H:(A)hypermap)` (LABEL_TAC "C10") THENL[USE_THEN "F11" (SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; LE_0] THEN EXISTS_TAC `0` THEN REWRITE_TAC[LE_0]; ALL_TAC] THEN USE_THEN "C10" (MP_TAC o MATCH_MP lemma_card_face_walkup_dart) THEN USE_THEN "C6" SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN REWRITE_TAC[GSYM ADD1; EQ_SUC] THEN DISCH_THEN (LABEL_TAC "C11" o GSYM) THEN USE_THEN "FI" (MP_TAC o SPEC `face_walkup (H:(A)hypermap) ((p:num->A) 0)`) THEN USE_THEN "C10" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)]))) THEN USE_THEN "C6" SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SYM th]) THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `(k:num) - 1` THEN USE_THEN "C8" (fun th -> REWRITE_TAC[th]); ALL_TAC] 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))))) THEN POP_ASSUM SUBST_ALL_TAC THEN ASM_CASES_TAC `2 < k:num` THENL[POP_ASSUM (LABEL_TAC "F18") THEN USE_THEN "F15" MP_TAC THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN (X_CHOOSE_THEN `d:num` MP_TAC) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN ABBREV_TAC `s = SUC (d:num)` THEN DISCH_THEN SUBST_ALL_TAC THEN USE_THEN "F18" (fun th -> (LABEL_TAC "F19" (MATCH_MP (ARITH_RULE `2 < (s:num) + 1 ==> 2 <= s`) th))) THEN USE_THEN "F17" (MP_TAC o SPEC `s:num`) THEN REWRITE_TAC[ARITH_RULE `(s:num) < s + 1`] THEN REWRITE_TAC[ADD1] THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[POP_ASSUM (LABEL_TAC "X1") THEN MP_TAC (ARITH_RULE `s:num < s + 1`) THEN USE_THEN "F19" (fun th -> MP_TAC (MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th)) 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)))))))))))) THEN REWRITE_TAC[lemma_sub_two_numbers; SUB_REFL] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "X4") (CONJUNCTS_THEN2 (LABEL_TAC "X5") (LABEL_TAC "X6"))) THEN ABBREV_TAC `G = node_walkup (H:(A)hypermap) ((p:num->A) (s:num))` THEN POP_ASSUM (LABEL_TAC "X7") 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 THENL[REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_0] THEN REMOVE_THEN "X6" (fun th -> REWRITE_TAC[th]); ALL_TAC] 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 THENL[REWRITE_TAC[LE] THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) (SUBST1_TAC)) THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC; ADD_0] THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1 `; `i:num`]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MP (ARITH_RULE `i:num <= (s:num) - 1 ==> i < s + 1`) th; LE_REFL]) THEN MESON_TAC[]; ALL_TAC] 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))))))))))) THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_0] THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> s-1+0+1 = s`) th]) 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))))) THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) (s:num)` (LABEL_TAC "X15") THENL[REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "X12" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `1:num` THEN EXISTS_TAC `1:num` THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `0 < 1 /\ 1 <= 1`]) THEN REMOVE_THEN "X10" SUBST1_TAC THEN REMOVE_THEN "X11" SUBST1_TAC THEN POP_ASSUM (MP_TAC o SPEC `1`) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 <= s - 1`) th]) THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "G" THEN STRIP_TAC THENL[USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `0`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th; ARITH_RULE `s:num <= s + 1`]) THEN DISCH_TAC THEN SUBGOAL_THEN `~((p:num->A) 0 = face_map (H:(A)hypermap) ((p:num->A) (s:num)))` ASSUME_TAC THENL[USE_THEN "X1" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1`; `0`]) THEN REWRITE_TAC[ARITH_RULE `0 < (s:num) + 1`; LE_REFL]; ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC) THENL[REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F16" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)`; `1`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= (s:num) ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`]) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (0:num)`] node_map_node_walkup)))) THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `1`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`]) THEN DISCH_TAC THEN SUBGOAL_THEN `~((p:num->A) 1 = face_map (H:(A)hypermap) ((p:num->A) (s:num)))` ASSUME_TAC THENL[USE_THEN "X1" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1`; `1`]) 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]); ALL_TAC] THEN SUBGOAL_THEN `~((p:num->A) 1 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC) THENL[REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F16k" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)+1`; `s:num`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[ARITH_RULE `s:num < s + 1`; LE_REFL]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (1:num)`] node_map_node_walkup)))) THEN REPLICATE_TAC 3 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN SUBGOAL_THEN `(p:num->A) (s:num) IN dart (H:(A)hypermap)` (LABEL_TAC "X20") THENL[ USE_THEN "F11" (SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; LE_0] THEN EXISTS_TAC `s:num` THEN REWRITE_TAC[ARITH_RULE `s:num <= s + 1`]; ALL_TAC] THEN USE_THEN "X20" (MP_TAC o MATCH_MP lemma_card_node_walkup_dart) THEN USE_THEN "X7" SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN REWRITE_TAC[GSYM ADD1; EQ_SUC] THEN DISCH_THEN (LABEL_TAC "X21") THEN USE_THEN "FI" (MP_TAC o SPEC `node_walkup (H:(A)hypermap) ((p:num->A) (s:num))`) THEN USE_THEN "X20" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)]))) THEN USE_THEN "X7" SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `s:num` THEN USE_THEN "X15" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "Y1") THEN MP_TAC (ARITH_RULE `s:num < s + 1`) THEN USE_THEN "F19" (fun th -> MP_TAC (MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th)) 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))))))))))))) THEN REWRITE_TAC[lemma_sub_two_numbers; SUB_REFL] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "Y4") (CONJUNCTS_THEN2 (LABEL_TAC "Y5") (LABEL_TAC "Y6"))) THEN ABBREV_TAC `G = face_walkup (H:(A)hypermap) ((p:num->A) (s:num))` THEN POP_ASSUM (LABEL_TAC "Y7") 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 THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_0] THEN REMOVE_THEN "Y6" (fun th -> REWRITE_TAC[th]) 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 THENL[REWRITE_TAC[LE] THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) (SUBST1_TAC)) THEN REWRITE_TAC[lemma_shift_path_evaluation; GSYM ADD_ASSOC; ADD_0] THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num) + 1 `; `i:num`]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MP (ARITH_RULE `i:num <= (s:num) - 1 ==> i < s + 1`) th; LE_REFL]) THEN MESON_TAC[]; ALL_TAC] 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))))))))))) THEN REWRITE_TAC[lemma_shift_path_evaluation] THEN REWRITE_TAC[ADD_0] THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> s-1+0+1 = s`) th]) 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))))) THEN SUBGOAL_THEN `is_Moebius_contour (G:(A)hypermap) (g:num->A) (s:num)` (LABEL_TAC "Y15") THENL[REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "Y12" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `1:num` THEN EXISTS_TAC `1:num` THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `0 < 1 /\ 1 <= 1`]) THEN REMOVE_THEN "Y10" SUBST1_TAC THEN REMOVE_THEN "Y11" SUBST1_TAC THEN POP_ASSUM (MP_TAC o SPEC `1`) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= s:num ==> 1 <= s - 1`) th]) THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "G" THEN STRIP_TAC THENL[USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `0`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 0 < s`) th; ARITH_RULE `s:num <= s + 1`]) THEN DISCH_TAC THEN SUBGOAL_THEN `~((p:num->A) 0 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC) THENL[REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F16" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)`; `1`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= (s:num) ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`]) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (0:num)`] node_map_face_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN USE_THEN "F10" (MP_TAC o SPECL[`s:num`; `1`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[MP (ARITH_RULE `2 <= s:num ==> 1 < s`) th; ARITH_RULE `s:num <= s + 1`]) THEN DISCH_TAC THEN SUBGOAL_THEN `~((p:num->A) 1 = inverse (node_map (H:(A)hypermap)) ((p:num->A) (s:num)))` (ASSUME_TAC) THENL[REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F16k" (SUBST1_TAC o SYM) THEN USE_THEN "F10" (MP_TAC o SPECL[`(s:num)+1`; `s:num`]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[ARITH_RULE `s:num < s + 1`; LE_REFL]); ALL_TAC] THEN MP_TAC (CONJUNCT2(CONJUNCT2(SPECL[`H:(A)hypermap`; `(p:num->A) (s:num)`; `(p:num->A) (1:num)`] node_map_face_walkup))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN USE_THEN "F16k" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN SUBGOAL_THEN `(p:num->A) (s:num) IN dart (H:(A)hypermap)` (LABEL_TAC "Y20") THENL[USE_THEN "F11" (SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM; LE_0] THEN EXISTS_TAC `s:num` THEN REWRITE_TAC[ARITH_RULE `s:num <= s + 1`]; ALL_TAC] THEN USE_THEN "Y20" (MP_TAC o MATCH_MP lemma_card_face_walkup_dart) THEN USE_THEN "Y7" SUBST1_TAC THEN USE_THEN "F1" SUBST1_TAC THEN REWRITE_TAC[GSYM ADD1; EQ_SUC] THEN DISCH_THEN (LABEL_TAC "Y21") THEN USE_THEN "FI" (MP_TAC o SPEC `face_walkup (H:(A)hypermap) ((p:num->A) (s:num))`) THEN USE_THEN "Y20" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemmaSGCOSXK (CONJ th1 th2)]))) THEN USE_THEN "Y7" SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `s:num` THEN USE_THEN "Y15" (fun th -> REWRITE_TAC[th]); ALL_TAC] 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)))))) THEN DISCH_THEN (SUBST_ALL_TAC) THEN REMOVE_THEN "F5" MP_TAC THEN USE_THEN "F11" SUBST1_TAC THEN REWRITE_TAC[GSYM THREE] THEN DISCH_TAC THEN MP_TAC (SPEC `H:(A)hypermap` lemma_minimum_Moebius_hypermap) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[NOT_IMP] THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `2` THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]));;
(* HERE I DEFINE THE NOTION OF THE LOOP. THIS DEFINITION DOES NOT DEPEND ON THE ORDER OF ITS VERTICES *)
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`,
MP_TAC(SPEC `UNIV:A->bool` MEMBER_NOT_EMPTY) THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (ASSUME_TAC)) THEN EXISTS_TAC `({x:A}, I:A->A)` THEN REWRITE_TAC[FST; SND] THEN REWRITE_TAC[FINITE_SINGLETON; PERMUTES_I; I_O_ID] THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[IN_SING; GSYM orbit_one_point; I_THM]);;
let loop_tybij = new_type_definition "loop"("loop", "tuple_loop") exist_loop;;
let dart_of = new_definition `!L:(A)loop. dart_of L = FST (tuple_loop L)`;;
let next = new_definition `!L:(A)loop. next L = SND (tuple_loop L)`;;
let back = new_definition `!L:(A)loop. back L = inverse (SND (tuple_loop L))`;;
let belong = new_definition `!(L:(A)loop) x:A. x belong L <=> x IN (dart_of L)`;;
let size = new_definition `size (L:(A)loop) = CARD (dart_of L)`;;
let top = new_definition `top (L:(A)loop) = PRE (CARD (dart_of L))`;;
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))`;;
let loop_path = new_definition `!(L:(A)loop) x:A k:num. loop_path L x k = ((next L) POWER k) x`;;
let lemma_loop_path_via_list = 
prove(`!L:(A)loop x:A. loop_path L x = power_list (next L) x`,
REPEAT GEN_TAC THEN REWRITE_TAC[loop_path; power_list; FUN_EQ_THM]);;
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)`,
GEN_TAC THEN REWRITE_TAC[belong; loop_tybij; dart_of; next] THEN MESON_TAC[loop_tybij]);;
let lemma_loop_representation = 
prove(`!s:A->bool p:A->A x:A. FINITE s /\ p permutes s /\ orbit_map p x = s ==> dart_of (loop (s, p)) = s /\ next (loop (s,p)) = p`,
REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC (SPECL[`p:A->A`; `x:A`] orbit_reflect) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN (ASSUME_TAC o SIMPLE_EXISTS `x:A`) THEN MP_TAC (SPEC `(s:A->bool, p:A->A)` (CONJUNCT2 loop_tybij)) THEN REWRITE_TAC[FST; SND; next; dart_of] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FST; SND]);;
let lemma_loop_identity = 
prove(`!(L:(A)loop) (L':(A)loop). L = L' <=> (dart_of L = dart_of L' /\ next L = next L')`,
REPEAT GEN_TAC THEN EQ_TAC THENL[MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[dart_of; next] THEN STRIP_TAC THEN SUBGOAL_THEN `tuple_loop (L:(A)loop) = tuple_loop (L':(A)loop)` ASSUME_TAC THENL[SUBGOAL_THEN `tuple_loop (L:(A)loop) = FST (tuple_loop (L:(A)loop)), SND (tuple_loop (L:(A)loop))` ASSUME_TAC THENL[MESON_TAC[PAIR]; ALL_TAC] THEN SUBGOAL_THEN `tuple_loop (L':(A)loop) = FST (tuple_loop (L':(A)loop)), SND (tuple_loop (L':(A)loop))` ASSUME_TAC THENL[MESON_TAC[PAIR]; ALL_TAC] THEN REPLICATE_TAC 2 (POP_ASSUM SUBST1_TAC); ALL_TAC] THEN ASM_REWRITE_TAC[PAIR_EQ] THEN POP_ASSUM (fun th -> MESON_TAC[CONJUNCT1 loop_tybij; th]));;
let lemma_permute_loop = 
prove(`!L:(A)loop. next L permutes dart_of L /\ back L permutes dart_of L`,
GEN_TAC THEN REWRITE_TAC[loop_lemma] THEN REWRITE_TAC[back; GSYM next] THEN MATCH_MP_TAC PERMUTES_INVERSE THEN REWRITE_TAC[loop_lemma]);;
let lemma_transitive_permutation = 
prove(`!(L:(A)loop) x:A. x belong L ==> dart_of L = orbit_map (next L) x`,
REPEAT GEN_TAC THEN MP_TAC (SPEC `L:(A)loop` loop_lemma) THEN REWRITE_TAC[belong] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `y:A`(CONJUNCTS_THEN2 ASSUME_TAC(SUBST1_TAC o SYM))))) THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma_orbit_identity THEN EXISTS_TAC `dart_of (L:(A)loop)` THEN ASM_REWRITE_TAC[]);;
let lemma_size = 
prove(`!(L:(A)loop). ~(dart_of L = {}) /\ 0 < size L /\ size L = SUC(top L)`,
REPEAT GEN_TAC THEN MP_TAC (SPEC `L:(A)loop` loop_lemma) 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)))) THEN SUBGOAL_THEN `~(dart_of (L:(A)loop) = {})` (fun th-> REWRITE_TAC[th]) THENL[REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `0 < size (L:(A)loop)` ASSUME_TAC THENL[ REWRITE_TAC[size] THEN USE_THEN "F1"(fun th -> (POP_ASSUM(fun th1-> (MP_TAC (MATCH_MP CARD_ATLEAST_1 (CONJ th th1)))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[REWRITE_RULE[LT1_NZ] th]) THEN REWRITE_TAC[FUN_EQ_THM; I_THM]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[top; GSYM size] THEN MATCH_MP_TAC LT_SUC_PRE THEN ASM_REWRITE_TAC[]);;
let lemma_order_next = 
prove(`!L:(A)loop. (next L) POWER (size L) = I`,
REPEAT GEN_TAC THEN MP_TAC (SPEC `L:(A)loop` loop_lemma) THEN DISCH_THEN(CONJUNCTS_THEN2(LABEL_TAC "F1")(LABEL_TAC "F2" o CONJUNCT1)) THEN REWRITE_TAC[FUN_EQ_THM; I_THM; size] THEN GEN_TAC THEN ASM_CASES_TAC `~((x:A) IN dart_of (L:(A)loop))` THENL[USE_THEN "F2" (fun th->(POP_ASSUM(fun th1->REWRITE_TAC[MATCH_MP power_permutation_outside_domain (CONJ th th1)]))); ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM belong]) THEN MP_TAC (SPECL[`L:(A)loop`; `x:A`] lemma_transitive_permutation) THEN POP_ASSUM(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN REMOVE_THEN "F1"(fun th -> (POP_ASSUM(fun th1-> (MESON_TAC[MATCH_MP lemma_cycle_orbit (CONJ th th1)])))));;
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 ==> ?q:num. m = q * (size L) + n`,
REWRITE_TAC[GSYM LT_SUC_LE; GSYM lemma_size; size] THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP lemma_transitive_permutation) THEN MATCH_MP_TAC lemma_congruence_on_orbit THEN EXISTS_TAC `dart_of (L:(A)loop)` THEN ASM_REWRITE_TAC[loop_lemma]);;
let lemma_back_and_next_outside_loop = 
prove(`!L:(A)loop x:A. ~(x belong L) ==> back L x = x /\ next L x = x`,
REPEAT GEN_TAC THEN REWRITE_TAC[belong] THEN DISCH_THEN (LABEL_TAC "F1") THEN ASSUME_TAC ((CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` loop_lemma)))) 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))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN ASSUME_TAC ((CONJUNCT2(SPEC `L:(A)loop` lemma_permute_loop))) 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))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN SIMP_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[belong] THEN DISCH_THEN (LABEL_TAC "F1") THEN ASSUME_TAC ((CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` loop_lemma)))) THEN USE_THEN "F1"(fun th1->(POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP power_permutation_outside_domain (CONJ th th1)]))) THEN ASSUME_TAC ((CONJUNCT2(SPEC `L:(A)loop` lemma_permute_loop))) THEN REMOVE_THEN "F1"(fun th1->(POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP power_permutation_outside_domain (CONJ th th1)]))));;
let lemma_inverse_on_loop = 
prove(`!L:(A)loop. next L = inverse (back L) /\ back L = inverse (next L)`,
STRIP_TAC THEN REWRITE_TAC[ back; GSYM next] THEN CONV_TAC SYM_CONV THEN ASSUME_TAC ((CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` loop_lemma)))) THEN POP_ASSUM(fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_INVERSE th]));;
let lemma_inverse_evaluation = 
prove(`!L:(A)loop x:A. back L (next L x) = x /\ next L (back L x) = x`,
REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2(SPEC `L:(A)loop` lemma_inverse_on_loop)] THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop))]);;
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)`,
REPEAT GEN_TAC THEN (MP_TAC(CONJUNCT1(SPEC `L:(A)loop`lemma_permute_loop))) THEN DISCH_THEN (MP_TAC o SPEC `m:num` o MATCH_MP lemma_power_inverse) THEN REWRITE_TAC[GSYM lemma_inverse_on_loop] THEN MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN LABEL_TAC "F1" (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop)) THEN REWRITE_TAC[CONJUNCT2(SPECL[`L:(A)loop`; `m:num`] lemma_second_inverse_on_loop)] THEN POP_ASSUM (MP_TAC o SPEC `m:num` o MATCH_MP power_permutation) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o REWRITE_RULE[belong])) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN REWRITE_TAC[GSYM LT_SUC_LE] THEN STRIP_ASSUME_TAC(CONJUNCT2(SPEC `L:(A)loop` lemma_size)) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN ASSUME_TAC (SPEC `L:(A)loop` lemma_order_next) THEN POP_ASSUM (fun th-> MP_TAC (REWRITE_RULE[I_THM](AP_THM th `x:A`))) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_NZ]) THEN DISCH_THEN(fun th-> DISCH_THEN(fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1)])) THEN REWRITE_TAC[IN_ELIM_THM]);;
let lemma_loop_index = new_specification["index"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_next_power_representation);;
let lemma_power_next_in_loop = 
prove(`!L:(A)loop x:A k:num. x belong L ==> ((next L POWER k) x) belong L`,
REPEAT GEN_TAC THEN REWRITE_TAC[belong] THEN STRIP_TAC THEN MP_TAC(SPECL[`k:num`; `x:A`] (MATCH_MP iterate_orbit (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop)))) THEN ASM_REWRITE_TAC[]);;
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)`,
let lemma_next_in_loop = 
prove(`!L:(A)loop x:A. x belong L ==> next L x belong L`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1](SPEC `1` (MATCH_MP lemma_power_next_in_loop th))]));;
let lemma_power_back_in_loop = 
prove(`!L:(A)loop x:A k:num. x belong L ==> ((back L POWER k) x) belong L`,
REPEAT GEN_TAC THEN REWRITE_TAC[belong] THEN STRIP_TAC THEN MP_TAC(SPECL[`k:num`; `x:A`] (MATCH_MP iterate_orbit (CONJUNCT2(SPEC `L:(A)loop` lemma_permute_loop)))) THEN ASM_REWRITE_TAC[]);;
let lemma_back_in_loop = 
prove(`!L:(A)loop x:A. x belong L ==> back L x belong L`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1](SPEC `1` (MATCH_MP lemma_power_back_in_loop th))]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F1" (MP_TAC o SPEC `k:num` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F3" (SUBST1_TAC o SYM) THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")) THEN ABBREV_TAC `n = index (L:(A)loop) (x:A) (y:A)` THEN MP_TAC (CONJUNCT1 (REWRITE_RULE[CONJ_ASSOC] (SPEC `L:(A)loop` loop_lemma))) THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `top (L:(A)loop)`] o MATCH_MP lemma_segment_orbit) THEN USE_THEN "F1"(fun th->REWRITE_TAC[SYM(MATCH_MP lemma_transitive_permutation th)]) THEN REWRITE_TAC[GSYM size; lemma_size; LT_PLUS] THEN DISCH_THEN (MP_TAC o SPECL[`n:num`; `k:num`] o REWRITE_RULE[lemma_inj_orbit_via_list; lemma_inj_list2; power_list]) 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])))));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN SUBGOAL_THEN `!j:num. ((next (L:(A)loop)) POWER j) (x:A) IN dart (H:(A)hypermap)` ASSUME_TAC THENL[INDUCT_TAC THENL[ASM_REWRITE_TAC[POWER_0; I_THM] THEN REWRITE_TAC[COM_POWER; o_THM]; ALL_TAC] THEN REWRITE_TAC[COM_POWER; o_THM] THEN REMOVE_THEN "F3" (fun th -> ASSUME_TAC(SPEC `j:num` (MATCH_MP lemma_power_next_in_loop th))) THEN ABBREV_TAC `y = (next (L:(A)loop) POWER (j:num)) (x:A)` THEN REMOVE_THEN "F1" (MP_TAC o SPEC `y:A` o REWRITE_RULE[is_loop]) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN UNDISCH_THEN `y:A IN dart (H:(A)hypermap)` (fun th -> REWRITE_TAC[MATCH_MP lemma_dart_invariant th]); ALL_TAC] THEN POP_ASSUM SUBST1_TAC 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] THEN REWRITE_TAC[orbit_map; SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (SUBST1_TAC o CONJUNCT2)) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[lemma_def_contour] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[loop_path] THEN REWRITE_TAC[COM_POWER; o_THM] THEN USE_THEN "F2" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop) 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])) THEN SIMP_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") 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] THEN GEN_TAC THEN EQ_TAC THENL[MP_TAC(CONJUNCT1(REWRITE_RULE[CONJ_ASSOC] (SPEC `L:(A)loop` loop_lemma))) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_segment_orbit th]); ALL_TAC] THEN ASM_CASES_TAC `n:num < CARD (dart_of (L:(A)loop))` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (MP_TAC o SPECL[] o SPECL[`0`; `CARD (dart_of (L:(A)loop))`] o REWRITE_RULE[lemma_inj_orbit]) THEN POP_ASSUM (fun th-> REWRITE_TAC[LE_0; REWRITE_RULE[NOT_LT] th; POWER_0; I_THM]) THEN MP_TAC(CONJUNCT1(REWRITE_RULE[CONJ_ASSOC] (SPEC `L:(A)loop` loop_lemma))) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_cycle_orbit th]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_transitive_permutation th); GSYM size]) THEN MP_TAC (CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` lemma_size))) THEN DISCH_THEN (fun th-> REWRITE_TAC[GSYM (REWRITE_RULE[LT_NZ] th)]));;
let let_order_for_loop = 
prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). is_loop H L /\ x belong L ==> 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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN STRIP_TAC THENL[REWRITE_TAC[lemma_inj_contour_via_list] THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_loop_contour (CONJ th th1)])) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_inj_loop_path th); LE_REFL]); ALL_TAC] THEN REWRITE_TAC[loop_path; POWER_0; I_THM] THEN USE_THEN "F1"(MP_TAC o SPEC `(next (L:(A)loop) POWER top L) x` o REWRITE_RULE[is_loop]) THEN REWRITE_TAC[iterate_map_valuation; GSYM lemma_size; lemma_order_next; I_THM] THEN USE_THEN "F2" (MP_TAC o SPEC `top (L:(A)loop)` o MATCH_MP lemma_power_next_in_loop) THEN SIMP_TAC[]);;
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)))`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(in_list (p:num->A) (n:num) (x:A))` THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_list]) THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `j:num` THEN EXISTS_TAC `(p:num->A) (SUC j MOD SUC n)` THEN ASM_REWRITE_TAC[]);;
let lemma_samsara = new_specification["samsara"] (REWRITE_RULE[SKOLEM_THM] lemma_list_next);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F2") THEN USE_THEN "F2" (MP_TAC o SPEC `p:num->A` o MATCH_MP lemma_element_in_list) THEN DISCH_THEN (fun th-> MP_TAC(MATCH_MP (CONJUNCT2 (SPECL[`p:num->A`; `n:num`; `(p:num->A) j`] lemma_samsara)) th)) THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F3") SUBST1_TAC))) THEN AP_TERM_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPECL[`i:num`; `j:num`] o REWRITE_RULE[lemma_inj_list2]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
let evaluation_samsara = 
prove(`!p:num->A n:num. is_inj_list p n ==> samsara p n (p n) = p 0 /\ !j:num. j < n ==> samsara p n (p j) = p (SUC j)`,
REPEAT GEN_TAC THEN DISCH_THEN (ASSUME_TAC o MATCH_MP samsara_formula) THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`) THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN MP_TAC (SPEC `1` (MATCH_MP MOD_MULT (SPEC `n:num` NON_ZERO))) THEN REWRITE_TAC [ARITH_RULE `(SUC n) * 1 = SUC n`]; ALL_TAC] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `j:num` o check (is_forall o concl)) THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th] THEN ASSUME_TAC th) THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (ONCE_REWRITE_RULE[GSYM LT_SUC] th)]));;
let lemma_permutes_via_surjetive = 
prove(`!s:A->bool p:A->A. 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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "G4")))) THEN SUBGOAL_THEN `!y:A. y IN s:A->bool ==> (?x:A. x IN s /\ p x = y)` (LABEL_TAC "F4") THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "G1") THEN REMOVE_THEN "G4" (fun th-> (USE_THEN "G1" (MP_TAC o MATCH_MP th))) THEN DISCH_THEN (X_CHOOSE_THEN `t:A` (SUBST_ALL_TAC o SYM)) THEN EXISTS_TAC `t:A` THEN SIMP_TAC[] THEN ASM_CASES_TAC `~(t:A IN s:A->bool)` THENL[USE_THEN "F2" (fun th-> (POP_ASSUM (SUBST_ALL_TAC o MATCH_MP th))) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[] th]); ALL_TAC] THEN REWRITE_TAC[permutes] THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN ASM_CASES_TAC `~(y:A IN s:A->bool)` THENL[STRIP_TAC THENL[EXISTS_TAC `y:A` THEN POP_ASSUM MP_TAC THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F5") THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")) THEN ASM_CASES_TAC `x:A IN s:A->bool` THENL[USE_THEN "F3"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th))) THEN REMOVE_THEN "F6" (SUBST1_TAC) THEN REMOVE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F2"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th))) THEN REMOVE_THEN "F6" SUBST1_TAC THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ASM_CASES_TAC `x':A IN s:A->bool` THENL[USE_THEN "F3"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th))) THEN REMOVE_THEN "F7" (SUBST1_TAC) THEN REMOVE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F2"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th))) THEN REMOVE_THEN "F7" SUBST1_TAC THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F8" o REWRITE_RULE[]) THEN STRIP_TAC THENL[USE_THEN "F4"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th))) THEN STRIP_TAC THEN EXISTS_TAC `x:A` THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) THEN ASM_CASES_TAC `~(x:A IN s:A->bool)` THENL[POP_ASSUM (LABEL_TAC "F11") THEN USE_THEN "F2"(fun th-> (USE_THEN "F11" (MP_TAC o MATCH_MP th))) THEN REMOVE_THEN "F9" SUBST1_TAC THEN DISCH_THEN (fun th-> (POP_ASSUM (MP_TAC o REWRITE_RULE[SYM th]))) THEN REMOVE_THEN "F8" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F12" o REWRITE_RULE[]) THEN ASM_CASES_TAC `~(x':A IN s:A->bool)` THENL[POP_ASSUM (LABEL_TAC "F14") THEN USE_THEN "F2"(fun th-> (USE_THEN "F14" (MP_TAC o MATCH_MP th))) THEN REMOVE_THEN "F10" SUBST1_TAC THEN DISCH_THEN (fun th-> (POP_ASSUM (MP_TAC o REWRITE_RULE[SYM th]))) THEN REMOVE_THEN "F8" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F9" MP_TAC THEN REMOVE_THEN "F10" (SUBST1_TAC o SYM) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[]) THEN POP_ASSUM (MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN SUBGOAL_THEN `IMAGE (p:A->A) (s:A->bool) SUBSET s` MP_TAC THENL[REWRITE_TAC[IMAGE; SUBSET] THEN GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (X_CHOOSE_THEN `t:A` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN USE_THEN "F3"(fun th-> (POP_ASSUM (MP_TAC o MATCH_MP th))) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F1" (fun th-> (DISCH_THEN (fun th1-> (MP_TAC (MATCH_MP SURJECTIVE_IFF_INJECTIVE (CONJ th th1)))))) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (MP_TAC o SPECL[`x:A`; `x':A`]) THEN SIMP_TAC[]);;
let lemma_back_index = 
prove(`!n:num i:num. 0 < i /\ i <= n ==> (i + n) MOD (SUC n) = PRE i`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP LT_SUC_PRE th]) THEN REWRITE_TAC[ADD] THEN REWRITE_TAC[GSYM ADD_SUC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC n`; `PRE i`] MOD_MULT_ADD)] THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (MATCH_MP (ARITH_RULE `i:num <= n:num ==> PRE i < SUC n`) th)]));;
let lemma_suc_mod = 
prove(`!m:num n:num. ~(n = 0) ==> SUC (m MOD n) MOD n = SUC m MOD n`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (MP_TAC o SPEC `m:num` o MATCH_MP DIVMOD_EXIST) THEN DISCH_THEN (X_CHOOSE_THEN `q:num` (X_CHOOSE_THEN `r:num` (CONJUNCTS_THEN2 (LABEL_TAC "F2") ASSUME_TAC))) THEN USE_THEN "F2" (fun th-> (POP_ASSUM(fun th1-> SUBST_ALL_TAC (CONJUNCT2 (MATCH_MP DIVMOD_UNIQ (CONJ th th1)))))) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM ADD_SUC; MOD_MULT_ADD]);;
let lemma_from_index = 
prove(`!n:num j:num. j <= n ==> SUC ((j + n) MOD SUC n) MOD SUC n = j`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[MATCH_MP lemma_suc_mod (SPEC `k:num` NON_ZERO); GSYM ADD_SUC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC k`; `i:num`] MOD_MULT_ADD)] THEN POP_ASSUM(fun th-> REWRITE_TAC[MATCH_MP MOD_LT (REWRITE_RULE[GSYM LT_SUC_LE] th)]));;
let lemma_from_index2 = 
prove(`!n:num i:num. i <= n ==> (((SUC i MOD SUC n) + n) MOD SUC n) = i`,
REPEAT STRIP_TAC 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))] THEN REWRITE_TAC[MATCH_MP MOD_ADD_MOD (SPEC `k:num` NON_ZERO)] THEN REWRITE_TAC[ADD] THEN REWRITE_TAC[GSYM ADD_SUC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[(REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC k`; `i:num`] MOD_MULT_ADD))] THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (REWRITE_RULE[GSYM LT_SUC_LE] th)]));;
let lemma_samsara_permute = 
prove(`!p:num->A n:num. is_inj_list p n ==> samsara p n permutes support_list p n`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN MATCH_MP_TAC lemma_permutes_via_surjetive THEN REWRITE_TAC[lemma_finite_list; GSYM in_list; lemma_samsara] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[lemma_in_list] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (SUBST1_TAC))) THEN EXISTS_TAC `SUC j MOD SUC n` THEN REWRITE_TAC[LE_MOD_SUC] THEN USE_THEN "F1" (MP_TAC o SPEC `j:num` o MATCH_MP samsara_formula) THEN POP_ASSUM(fun th->REWRITE_TAC[th]); ALL_TAC] THEN GEN_TAC THEN REWRITE_TAC[lemma_in_list] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (SUBST1_TAC))) THEN EXISTS_TAC `(p:num->A) (((j:num) + (n:num)) MOD SUC n)` THEN USE_THEN "F1" (MP_TAC o SPEC `((j:num) + (n:num)) MOD SUC n` o MATCH_MP samsara_formula) THEN REWRITE_TAC[LE_MOD_SUC] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN POP_ASSUM(fun th-> REWRITE_TAC[MATCH_MP lemma_from_index th]));;
let lemma_samsara_power = 
prove(`!p:num->A n:num. is_inj_list p n ==> ((samsara p n) POWER (SUC n)) (p 0) = p 0 /\ (!j:num. j <= n ==> ((samsara p n) POWER j) (p 0) = p j)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN SUBGOAL_THEN `!j:num. j <= n ==> ((samsara (p:num->A) n) POWER j) (p 0) = p j` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F2") THEN DISCH_THEN (LABEL_TAC "F3") THEN USE_THEN "F3" (fun th -> (ASSUME_TAC (MATCH_MP LT_IMP_LE (REWRITE_RULE[LE_SUC_LT] th)))) THEN REWRITE_TAC[COM_POWER; o_THM] THEN POP_ASSUM (fun th-> REMOVE_THEN "F2" (fun th1 -> REWRITE_TAC[REWRITE_RULE[th] th1])) THEN USE_THEN "F1" (MP_TAC o SPEC `j:num` o CONJUNCT2 o MATCH_MP evaluation_samsara) THEN POP_ASSUM (fun th -> REWRITE_TAC[REWRITE_RULE[LE_SUC_LT] th]); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COM_POWER; o_THM] THEN POP_ASSUM (fun th -> REWRITE_TAC[REWRITE_RULE[LE_REFL] (SPEC `n:num` th)]) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP evaluation_samsara th]));;
let lemma_generate_loop = 
prove(`!p:num->A n:num. is_inj_list p n ==> 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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN MATCH_MP_TAC lemma_loop_representation THEN EXISTS_TAC `(p:num->A) 0` THEN REWRITE_TAC[lemma_finite_list] THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_samsara_permute th]) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_samsara_power) THEN MP_TAC (SPEC `n:num` NON_ZERO) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP orbit_cyclic th]) THEN REWRITE_TAC[LT_SUC_LE; support_list] THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_samsara_power) THEN SET_TAC[lemma_two_series_eq]);;
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) ==> is_loop H (loop(support_list p n, samsara p n))`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_inj_contour_via_list] THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) (LABEL_TAC "F3")) THEN REWRITE_TAC[is_loop] THEN GEN_TAC THEN REWRITE_TAC[belong] THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_generate_loop th]) THEN REWRITE_TAC[GSYM in_list; lemma_in_list] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN ASM_CASES_TAC `j:num = n` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F2"(fun th-> REWRITE_TAC[MATCH_MP evaluation_samsara th]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM(fun th-> (POP_ASSUM(fun th1->(LABEL_TAC "F4" (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th)))))) THEN USE_THEN "F4"(fun th1->(USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP (CONJUNCT2(MATCH_MP evaluation_samsara th)) th1]))) THEN REMOVE_THEN "F1" (MP_TAC o SPEC `j:num` o REWRITE_RULE[lemma_def_contour]) THEN ASM_REWRITE_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_inj_contour; support_list] THEN CONV_TAC ((LAND_CONV o ONCE_DEPTH_CONV) SYM_CONV) THEN REWRITE_TAC[GSYM LT_SUC_LE] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP CARD_FINITE_SERIES_EQ (CONJUNCT2 th)]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP lemma_first_dart_on_inj_contour th) THEN ASSUME_TAC (CONJUNCT2 th))) THEN POP_ASSUM (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour]) THEN REWRITE_TAC[IMP_IMP; CONJ_SYM] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_darts_in_contour th; support_list]));;
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)`,
REPEAT STRIP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN MP_TAC (AP_THM (SPEC `L:(A)loop` lemma_order_next) `x:A`) THEN REWRITE_TAC[I_THM] THEN MP_TAC(CONJUNCT1(CONJUNCT2(SPEC `L:(A)loop` lemma_size))) THEN REWRITE_TAC[LT_NZ; IMP_IMP; support_list; loop_path] THEN DISCH_THEN (MP_TAC o MATCH_MP orbit_cyclic) THEN REWRITE_TAC[lemma_size; GSYM LT_SUC_LE]);;
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)`,
REPEAT STRIP_TAC THEN REWRITE_TAC[belong] THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_dart_loop_via_path th]) THEN REWRITE_TAC[in_list]);;
(*******************************************************************************************************************************)
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))) ==> (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))))`,
REPEAT GEN_TAC 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"))))))) THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "FC") (LABEL_TAC "F8")) THEN USE_THEN "F8" (MP_TAC o SPECL[`k:num`; `0`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= k:num ==> 0 < k`) th; LE_REFL]) THEN DISCH_THEN (LABEL_TAC "F9") THEN SUBGOAL_THEN `1 <= top (L:(A)loop)` (LABEL_TAC "F10") THENL[ ONCE_REWRITE_TAC[GSYM LE_SUC] THEN REWRITE_TAC[GSYM TWO] THEN REWRITE_TAC[GSYM lemma_size; size] THEN MATCH_MP_TAC CARD_ATLEAST_2 THEN EXISTS_TAC `(p:num->A) 0` THEN EXISTS_TAC `(p:num->A) (k:num)` THEN REWRITE_TAC[GSYM belong] THEN ASM_REWRITE_TAC[loop_lemma]; ALL_TAC] THEN USE_THEN "F3" (MP_TAC o MATCH_MP (ARITH_RULE `2 <= k:num ==> 0 < PRE k /\ 0 < k /\ PRE k < k`)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "K1") (CONJUNCTS_THEN2 (LABEL_TAC "K2") (LABEL_TAC "K3"))) THEN STRIP_TAC THENL[REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "G10") THEN DISCH_THEN (LABEL_TAC "G12") THEN REMOVE_THEN "F7" MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THEN REMOVE_THEN "F4" MP_TAC THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong th]) THEN DISCH_THEN (LABEL_TAC "G4") THEN REMOVE_THEN "F6" MP_TAC THEN USE_THEN "F5" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong th]) THEN DISCH_THEN (LABEL_TAC "G6") THEN MP_TAC (SPECL[`L:(A)loop`; `(p:num->A) (k:num)`; `0`] loop_path) THEN REWRITE_TAC[POWER_0; I_THM] THEN DISCH_THEN (LABEL_TAC "G15") THEN USE_THEN "F1" (fun th-> (REMOVE_THEN "F5" (fun th1-> (MP_TAC (MATCH_MP let_order_for_loop (CONJ th th1)))))) THEN ABBREV_TAC `ploop = loop_path (L:(A)loop) ((p:num->A) (k:num))` THEN ABBREV_TAC `n = top (L:(A)loop)` THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G16") (MP_TAC)) THEN REWRITE_TAC[one_step_contour] THEN USE_THEN "G15" SUBST1_TAC THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN USE_THEN "G12" SUBST1_TAC THEN REWRITE_TAC[face_map_injective] THEN DISCH_THEN (fun th-> (ASSUME_TAC (MATCH_MP lemma_in_list2 (CONJ (SPEC `n:num` LE_REFL) th)))) THEN USE_THEN "G6" (MP_TAC o SPEC `PRE k`) THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "K3" (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "G17") THEN USE_THEN "K2" MP_TAC THEN REWRITE_TAC[LT0_LE1] THEN USE_THEN "F2" (fun th1 -> (DISCH_THEN (fun th2 -> (MP_TAC (MATCH_MP lemma_shift_inj_contour (CONJ th1 th2)))))) THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < k:num ==> k-1 = PRE k`) th]) THEN DISCH_THEN (LABEL_TAC "G18") THEN USE_THEN "K2" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < k:num ==> k - 1 = PRE k`) th]) THEN MP_TAC(SPECL[`p:num->A`; `1`; `PRE k`] lemma_shift_path_evaluation) THEN ONCE_REWRITE_TAC[GSYM ADD_SYM] THEN USE_THEN "K2" (fun th -> REWRITE_TAC[SYM(MATCH_MP LT_PRE th)]) THEN DISCH_THEN (fun th -> LABEL_TAC "G19" th THEN MP_TAC th) THEN USE_THEN "G15" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "G20") 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 THENL[REWRITE_TAC[shift_path] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN GEN_TAC THEN REPLICATE_TAC 2 STRIP_TAC THEN ASM_CASES_TAC `i:num = PRE k` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "K2" (fun th -> REWRITE_TAC[SYM(MATCH_MP LT_PRE th); LE_REFL]) THEN USE_THEN "G15" (SUBST1_TAC o SYM) THEN USE_THEN "G16" MP_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN DISCH_THEN (MP_TAC o SPECL[`j:num`; `0`] o CONJUNCT2) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN MESON_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[GSYM LT_LE] THEN REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[GSYM LT_SUC] THEN USE_THEN "K2" (fun th -> REWRITE_TAC[SYM(MATCH_MP LT_SUC_PRE th)]) THEN DISCH_TAC THEN DISCH_THEN (ASSUME_TAC o SYM) THEN MP_TAC (SPECL[`ploop:num->A`; `n:num`; `(p:num->A) (SUC i)`; `j:num`] lemma_in_list2) THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [th]) THEN USE_THEN "G6" (MP_TAC o SPEC `SUC i`) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN REWRITE_TAC[LT_0]; ALL_TAC] 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)))))))))))) 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")))))) THEN USE_THEN "G24" (MP_TAC o SPEC `PRE k`) THEN REWRITE_TAC[LE_REFL; shift_path] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN USE_THEN "K2" (fun th -> (REWRITE_TAC[SYM(MATCH_MP LT_PRE th)])) THEN DISCH_THEN (LABEL_TAC "G26") THEN REMOVE_THEN "G4" MP_TAC THEN REWRITE_TAC[lemma_in_list] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "G27") (LABEL_TAC "G28"))) THEN SUBGOAL_THEN `j:num < n:num` (LABEL_TAC "G30") THENL[REWRITE_TAC[LT_LE] THEN USE_THEN "G27" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F9" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN USE_THEN "G28" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "G17" SUBST1_TAC THEN USE_THEN "G10" SUBST1_TAC THEN REWRITE_TAC[node_map_injective] THEN USE_THEN "F8" (MP_TAC o SPECL[`k:num`; `1`]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <=k ==> 1 < k`) th; LE_REFL]) THEN MESON_TAC[]; ALL_TAC] THEN REMOVE_THEN "G21" MP_TAC THEN REWRITE_TAC[shift_path] THEN REWRITE_TAC[ADD_0] THEN DISCH_THEN (LABEL_TAC "G31") THEN REMOVE_THEN "G25" (MP_TAC o SPEC `j:num`) THEN USE_THEN "G30" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN REMOVE_THEN "G28" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "G31") THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `PRE k + (n:num)` THEN REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "G23" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `PRE k` THEN EXISTS_TAC `PRE k + (j:num)` THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[LT_ADD_LCANCEL] THEN USE_THEN "G30" (fun th -> REWRITE_TAC[th]) THEN REPLICATE_TAC 2 (POP_ASSUM SUBST1_TAC) THEN USE_THEN "G10" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G26" SUBST1_TAC THEN USE_THEN "G22" SUBST1_TAC THEN USE_THEN "G17" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F4" (LABEL_TAC "TP" o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop) THEN REMOVE_THEN "F1" (fun th->(USE_THEN "TP"(fun th1-> (LABEL_TAC "F1" (MATCH_MP let_order_for_loop (CONJ th th1)))))) THEN MP_TAC (SPECL[`L:(A)loop`; `next (L:(A)loop) ((p:num->A) 0)`; `top (L:(A)loop)`] loop_path) THEN REWRITE_TAC[iterate_map_valuation2; GSYM lemma_size; lemma_order_next; I_THM] THEN DISCH_THEN (LABEL_TAC "F4" o SYM) THEN REMOVE_THEN "F5" MP_TAC THEN USE_THEN "TP" (fun th -> REWRITE_TAC[MATCH_MP lemma_belong th]) THEN DISCH_THEN (LABEL_TAC "F5") THEN REMOVE_THEN "F6" MP_TAC THEN REMOVE_THEN "TP" (fun th -> REWRITE_TAC[MATCH_MP lemma_belong th]) THEN DISCH_THEN (LABEL_TAC "F6") THEN ABBREV_TAC `ploop = loop_path (L:(A)loop) (next L ((p:num->A) 0))` THEN ABBREV_TAC `n = top (L:(A)loop)` THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "G10") THEN DISCH_THEN (LABEL_TAC "G12") THEN REMOVE_THEN "F7" MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THEN USE_THEN "F1" (CONJUNCTS_THEN2 (LABEL_TAC "G16") (MP_TAC)) THEN REWRITE_TAC[one_step_contour] THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN USE_THEN "G10" (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th-> (ASSUME_TAC (MATCH_MP lemma_in_list2 (CONJ (SPEC `n:num` LE_0) (SYM th))))) THEN USE_THEN "F6" (MP_TAC o SPEC `1`) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `2 <= k:num ==> 1 < k`) th]) THEN REWRITE_TAC[ARITH_RULE `0 < 1`] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN DISCH_THEN (LABEL_TAC "G17") THEN REMOVE_THEN "F2" (MP_TAC o SPEC `PRE k` o MATCH_MP lemma_sub_inj_contour) THEN USE_THEN "K3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN DISCH_THEN (LABEL_TAC "G18") 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 THENL[REPEAT STRIP_TAC THEN MP_TAC (SPECL[`ploop:num->A`; `n:num`; `(p:num->A) (j:num)`; `i:num`] lemma_in_list2) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [th])) THEN REWRITE_TAC[] THEN USE_THEN "F6" (MP_TAC o SPEC `j:num`) 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)]))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] 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)))))))))))) 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")))))) THEN USE_THEN "G24" (MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[LE_REFL] THEN DISCH_THEN (LABEL_TAC "G26") THEN REMOVE_THEN "F5" MP_TAC THEN REWRITE_TAC[lemma_in_list] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "G27") (LABEL_TAC "G28"))) THEN SUBGOAL_THEN `~(j:num = 0)` MP_TAC THENL[USE_THEN "F9" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN USE_THEN "G28" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM (SPEC `H:(A)hypermap` node_map_injective)] THEN USE_THEN "G12" (SUBST1_TAC o SYM) THEN USE_THEN "G17" (SUBST1_TAC o SYM) THEN USE_THEN "F8" (MP_TAC o SPECL[`PRE k`; `0`]) THEN USE_THEN "K3" (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th]) THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[GSYM LT_NZ] THEN DISCH_THEN (LABEL_TAC "G29") THEN EXISTS_TAC `g:num->A` THEN EXISTS_TAC `(n:num) + PRE k` THEN REWRITE_TAC[is_Moebius_contour] THEN USE_THEN "G23" (fun th -> REWRITE_TAC[th]) THEN EXISTS_TAC `j:num` THEN EXISTS_TAC `n:num` THEN USE_THEN "G29" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G27" (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[LT_ADD] THEN USE_THEN "K1" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G26" SUBST1_TAC THEN USE_THEN "G21" SUBST1_TAC THEN USE_THEN "G22" SUBST1_TAC THEN USE_THEN "G24" (MP_TAC o SPEC `j:num`) THEN USE_THEN "G27" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G28" (SUBST1_TAC o SYM) THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN USE_THEN "G12" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G17" (fun th -> REWRITE_TAC[th]));;
(* Some facts about face_loop, node_loop and their injective contours *)
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN REWRITE_TAC[lemma_face_contour; face_contour] THEN REWRITE_TAC[lemma_def_inj_orbit] THEN MESON_TAC[]);;
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`,
REWRITE_TAC[face] THEN REPEAT STRIP_TAC THEN MP_TAC(SPECL[`x:A`; `k:num`](MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` face_map_and_darts))) THEN ASM_REWRITE_TAC[inj_orbit_imp_inj_face_contour]);;
let lemma_face_cycle = 
prove(`!(H:(A)hypermap) (x:A). ((face_map H) POWER (CARD (face H x))) x = x`,
REWRITE_TAC[face] THEN MESON_TAC[face_map_and_darts; lemma_cycle_orbit]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[orbit_map;GE; LE_0; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL[STRIP_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPEC `n:num` o MATCH_MP power_inverse_element_lemma) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_permutation_via_its_inverse) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` MP_TAC) THEN DISCH_THEN (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[GSYM multiplication_exponents] THEN MESON_TAC[]);;
let inj_orbit_imp_inj_node_contour = 
prove( `!(H:(A)hypermap) (x:A) (k:num). inj_orbit (inverse (node_map H)) x k ==> is_inj_contour H (node_contour H x) k`,
REPEAT GEN_TAC THEN REWRITE_TAC[lemma_def_inj_contour] THEN REWRITE_TAC[lemma_node_contour; node_contour] THEN REWRITE_TAC[lemma_def_inj_orbit] THEN MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[node] THEN MP_TAC (SPEC `H:(A)hypermap` node_map_and_darts) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F2" (LABEL_TAC "F3" o MATCH_MP PERMUTES_INVERSE) 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))))))) 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))))])))) THEN MESON_TAC[inj_orbit_imp_inj_node_contour]);;
let lemma_node_cycle = 
prove(`!(H:(A)hypermap) (x:A). ((node_map H) POWER (CARD (node H x))) x = x`,
REWRITE_TAC[node] THEN MESON_TAC[hypermap_lemma; lemma_cycle_orbit]);;
let lemma_node_inverse_cycle = 
prove(`!(H:(A)hypermap) (x:A). ((inverse (node_map H)) POWER (CARD (node H x))) x = x`,
REPEAT GEN_TAC THEN ASSUME_TAC (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)) THEN CONV_TAC SYM_CONV THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM(MATCH_MP inverse_power_function th)]) THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[lemma_node_cycle]);;
let lemma_node_contour_connection = 
prove(`!(H:(A)hypermap) (x:A) (y:A). y IN node H x ==> (?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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] lemma_node_inverse_cycle) THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] NODE_NOT_EMPTY) THEN REWRITE_TAC[LT1_NZ; LT_NZ; IMP_IMP] THEN MP_TAC (SPEC`x:A` (MATCH_MP lemma_orbit_inverse_map_eq (SPEC `H:(A)hypermap` node_map_and_darts))) THEN REWRITE_TAC[GSYM node] THEN DISCH_THEN (fun th -> (ASSUME_TAC th THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[SYM th])) THEN DISCH_THEN (MP_TAC o MATCH_MP orbit_cyclic) THEN POP_ASSUM SUBST1_TAC THEN DISCH_TAC THEN REMOVE_THEN "F1" MP_TAC THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[GSYM node_contour] THEN STRIP_TAC THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_inj_node_contour th]) THEN REWRITE_TAC[node_contour; POWER_0; I_THM]);;
let lemma_via_inverse_node_map = 
prove(`!H:(A)hypermap x:A y:A. y IN node H x ==> ?j:num. j < CARD (node H x) /\ y = (inverse (node_map H) POWER j) x`,
REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o REWRITE_RULE[node_contour] o MATCH_MP lemma_node_contour_connection) THEN MESON_TAC[]);;
let lemmaICJHAOQ = 
prove(`!(H:(A)hypermap) L:(A)loop. is_loop H L /\ (!g:num->A m:num. ~(is_Moebius_contour H g m)) ==> ~(?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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") MP_TAC) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_FORALL_THM] 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"))))))))) THEN SUBGOAL_THEN `?s:num. s <= k /\(p:num->A) s IN node (H:(A)hypermap) (p (k:num))` MP_TAC THENL[EXISTS_TAC `k:num` THEN REWRITE_TAC[node; orbit_reflect; LE_REFL]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP] THEN DISCH_THEN (X_CHOOSE_THEN `s:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) (LABEL_TAC "F11"))) THEN REMOVE_THEN "F10" (SUBST_ALL_TAC o MATCH_MP lemma_node_identity) THEN SUBGOAL_THEN `~((p:num->A) 0 = p (s:num))` (LABEL_TAC "F12") THENL[USE_THEN "F7" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MESON_TAC[lemma_node_identity]; ALL_TAC] THEN SUBGOAL_THEN `0 < s:num` (LABEL_TAC "F14") THENL[ASM_CASES_TAC `s:num = 0` THENL[USE_THEN "F12" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[LT_NZ] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F3" (MP_TAC o SPEC `s:num` o MATCH_MP lemma_subcontour) THEN USE_THEN "F9" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F16") THEN USE_THEN "F5" (MP_TAC o SPEC `s:num`) THEN USE_THEN "F14" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F9" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F17") 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 THENL[USE_THEN "F8" (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (MP_TAC o MATCH_MP lemma_node_contour_connection) ASSUME_TAC)) THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (CONJUNCTS_THEN2 (ASSUME_TAC) (ASSUME_TAC o CONJUNCT1 o CONJUNCT2))) THEN EXISTS_TAC `u:num` THEN POP_ASSUM SUBST1_TAC THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> (REWRITE_TAC[th]))); ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP] THEN DISCH_THEN (X_CHOOSE_THEN `t:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19")) (LABEL_TAC "F20"))) THEN SUBGOAL_THEN `0 < t:num` (LABEL_TAC "F21") THENL[ASM_CASES_TAC `t:num = 0` THENL[USE_THEN "F19" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[node_contour; POWER_0; I_THM] THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REWRITE_TAC[LT_NZ] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F16" (MP_TAC o MATCH_MP lemmaQZTPGJV) 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"))))))) THEN SUBGOAL_THEN `0 < d:num` (LABEL_TAC "F26") THENL[ASM_CASES_TAC `d:num = 0` THENL[USE_THEN "F23" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F22" SUBST1_TAC THEN USE_THEN "F12" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REWRITE_TAC[LT_NZ] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F22" (SUBST_ALL_TAC o SYM) THEN REMOVE_THEN "F23" (SUBST_ALL_TAC o SYM) THEN SUBGOAL_THEN `!i:num. 0 < i /\ i <= d:num ==> ~(((w:num->A) i) belong (L:(A)loop) )` (LABEL_TAC "F27") THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G4") MP_TAC) THEN REWRITE_TAC[LE_LT] THEN STRIP_TAC THENL[POP_ASSUM (LABEL_TAC "G5") THEN USE_THEN "F25" (MP_TAC o SPEC `i:num`) THEN USE_THEN "G5" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "G6") (CONJUNCTS_THEN2 (LABEL_TAC "G7") (SUBST1_TAC o CONJUNCT1)))) THEN USE_THEN "G4" (fun th1 -> (USE_THEN "G6" (fun th2 -> (ASSUME_TAC (MATCH_MP LTE_TRANS (CONJ th1 th2)))))) THEN USE_THEN "G7" (fun th1 -> (USE_THEN "F9" (fun th2 -> (ASSUME_TAC (MATCH_MP LTE_TRANS (CONJ th1 th2)))))) THEN USE_THEN "F5" (MP_TAC o SPEC `j:num`) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F17" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `(w:num->A) 1 = face_map (H:(A)hypermap) (w 0)` (LABEL_TAC "F28") THENL[USE_THEN "F4" (LABEL_TAC "G7" o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F1"(MP_TAC o SPEC `(w:num->A) 0` o REWRITE_RULE[is_loop]) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[one_step_contour] THEN STRIP_TAC THENL[REMOVE_THEN "G7" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F6" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN USE_THEN "F5" (MP_TAC o SPEC `1`) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th; ARITH_RULE `0 < 1`]) THEN MESON_TAC[]; ALL_TAC] THEN USE_THEN "F24" (MP_TAC o SPEC `0` o REWRITE_RULE[lemma_def_contour] o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour]) THEN USE_THEN "F26" (fun th-> REWRITE_TAC[th; one_step_contour; GSYM ONE]) THEN STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_TAC THEN REMOVE_THEN "G7" MP_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (MP_TAC o SPEC `1`) THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT1_NZ]) THEN POP_ASSUM (fun th-> REWRITE_TAC[ th; ARITH_RULE `0 < 1`]) THEN MESON_TAC[]; ALL_TAC] THEN USE_THEN "F18" (LABEL_TAC "F29" o MATCH_MP lemma_inj_node_contour) THEN MP_TAC(SPECL[`H:(A)hypermap`; `(w:num->A) (d:num)`; `0`] node_contour) THEN REWRITE_TAC[POWER_0; I_THM] THEN DISCH_THEN (LABEL_TAC "F30") 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 THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G20") (LABEL_TAC "G21")) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "G22") THEN ASM_CASES_TAC `i:num = d:num` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F30" (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN (USE_THEN "F29" (MP_TAC o SPECL[`j:num`; `0`] o CONJUNCT2 o REWRITE_RULE[lemma_def_inj_contour; lemma_def_contour])) THEN USE_THEN "G20" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G21" (fun th -> REWRITE_TAC[th]) THEN MESON_TAC[]; ALL_TAC] THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE] THEN DISCH_THEN (LABEL_TAC "G25") THEN REWRITE_TAC[node_contour] THEN MP_TAC (SPEC `j:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `v:num` SUBST1_TAC) THEN REWRITE_TAC[GSYM node] THEN DISCH_THEN (fun th -> (MP_TAC (MATCH_MP in_orbit_lemma (SYM th)))) THEN USE_THEN "G25" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F25" (MP_TAC o SPEC `i:num`) THEN USE_THEN "G25" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (fun th -> (LABEL_TAC "G26" (CONJUNCT1(CONJUNCT2 th)) THEN LABEL_TAC "G27" (CONJUNCT1(CONJUNCT2(CONJUNCT2 th)))))) THEN USE_THEN "F11" (MP_TAC o SPEC `u:num`) THEN USE_THEN "G26" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "F9" (fun th -> (USE_THEN "G26" (fun th1 -> MP_TAC(MATCH_MP LTE_TRANS (CONJ th1 th))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) THEN REWRITE_TAC[GSYM node] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] 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))))))))))) 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")))))) THEN SUBGOAL_THEN `!i:num. 0 < i /\ i < (d:num) + (t:num) ==> ~((g:num->A) i belong (L:(A)loop))` (LABEL_TAC "M6") THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G30") (LABEL_TAC "G31")) THEN ASM_CASES_TAC `i:num <= d:num` THENL[POP_ASSUM (LABEL_TAC "G32") THEN USE_THEN "M4" (MP_TAC o SPEC `i:num`) THEN USE_THEN "G32" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F27" (MP_TAC o SPEC `i:num`) THEN USE_THEN "G30" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "G32" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE]) THEN REWRITE_TAC[LT_EXISTS] THEN DISCH_THEN (X_CHOOSE_THEN `l:num` ASSUME_TAC) THEN USE_THEN "G31" MP_TAC THEN POP_ASSUM (SUBST1_TAC) THEN REWRITE_TAC[LT_ADD_LCANCEL] THEN DISCH_THEN (LABEL_TAC "G34") THEN USE_THEN "M5" (MP_TAC o SPEC `SUC l`) THEN USE_THEN "G34" (fun th-> (REWRITE_TAC[MATCH_MP LT_IMP_LE th])) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F20" (MP_TAC o SPEC `SUC l`) THEN USE_THEN "G34" (fun th -> REWRITE_TAC[th; CONTRAPOS_THM]) THEN DISCH_THEN(fun th -> SIMP_TAC[th]) THEN USE_THEN "G34" (fun th1 -> (USE_THEN "F18" (fun th -> REWRITE_TAC[MATCH_MP LT_TRANS (CONJ th1 th)]))); ALL_TAC] THEN REMOVE_THEN "F19" (MP_TAC) THEN USE_THEN "M2" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F19") THEN REMOVE_THEN "M1" (SUBST_ALL_TAC o SYM) THEN REMOVE_THEN "F28" MP_TAC THEN USE_THEN "M4" (MP_TAC o SPEC `1`) THEN USE_THEN "F26" (MP_TAC o REWRITE_RULE[GSYM LT1_NZ]) THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F28") THEN USE_THEN "M5" (MP_TAC o SPEC `PRE t`) THEN REWRITE_TAC[ARITH_RULE `PRE (t:num) <= t`] THEN REWRITE_TAC[node_contour] THEN DISCH_TAC THEN REMOVE_THEN "M2" MP_TAC THEN REWRITE_TAC[node_contour] THEN USE_THEN "F21" (fun th -> (GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP LT_SUC_PRE th])) THEN REWRITE_TAC[COM_POWER; o_THM] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM node_contour] THEN USE_THEN "F21" (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `0 < t:num ==> (d:num) + (PRE t) = PRE(d + t)`) th]) THEN DISCH_THEN (LABEL_TAC "M2") 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)))))) THEN ABBREV_TAC `m = (d:num) + (t:num)` THEN ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`] THEN DISCH_THEN ASSUME_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `g:num->A`;`m:num`] lemmaILTXRQD) THEN ASM_REWRITE_TAC[] THEN USE_THEN "M2" (fun th -> REWRITE_TAC[SYM th]) THEN USE_THEN "F19" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM NOT_EXISTS_THM] THEN POP_ASSUM(fun th -> MESON_TAC[th]));;
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`,
REPEAT GEN_TAC 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"))))))) THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[lemma_in_list]) THEN STRIP_TAC THEN REWRITE_TAC[THREE; lemma_size; LE_SUC] THEN USE_THEN "F1" (fun th-> (USE_THEN "F4" (fun th1 -> MP_TAC (MATCH_MP let_order_for_loop (CONJ th th1))))) THEN REWRITE_TAC[POWER_0; I_THM] THEN MP_TAC (SPECL[`L:(A)loop`; `x:A`; `0`] loop_path) THEN REWRITE_TAC[POWER_0; I_THM] THEN DISCH_THEN (fun th -> (LABEL_TAC "F6" th THEN SUBST1_TAC th)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) THEN REMOVE_THEN "F5" MP_TAC THEN USE_THEN "F4"(fun th -> REWRITE_TAC[MATCH_MP lemma_belong th]) THEN DISCH_THEN (LABEL_TAC "F5") THEN USE_THEN "F4" MP_TAC THEN REMOVE_THEN "F4"(fun th -> REWRITE_TAC[MATCH_MP lemma_belong th]) THEN DISCH_THEN (LABEL_TAC "F4") THEN ABBREV_TAC `ploop = loop_path (L:(A)loop) (x:A)` THEN ABBREV_TAC `n = top (L:(A)loop)` THEN SUBGOAL_THEN `~(x:A = y:A)` (LABEL_TAC "F7") THENL[FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN MESON_TAC[]; ALL_TAC] THEN MP_TAC(SPECL[`support_list (ploop:num->A) (n:num)`; `x:A`; `y:A`] CARD_ATLEAST_2) THEN REWRITE_TAC[GSYM in_list] THEN ASM_REWRITE_TAC[lemma_finite_list] THEN USE_THEN "H1" (fun th -> (MP_TAC (MATCH_MP lemma_number_darts_of_inj_contour th) THEN ASSUME_TAC th)) THEN DISCH_THEN SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [TWO; LE_SUC; LE_LT] THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (SUBST_ALL_TAC o SYM) THEN USE_THEN "F5" (MP_TAC o REWRITE_RULE[lemma_in_list]) THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN REWRITE_TAC[SPEC `m:num` SEGMENT_TO_ONE] THEN STRIP_TAC THENL[POP_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM SUBST_ALL_TAC THEN POP_ASSUM SUBST_ALL_TAC THEN REMOVE_THEN "F6" (SUBST_ALL_TAC o SYM) THEN USE_THEN "H2" (MP_TAC o REWRITE_RULE[one_step_contour]) THEN ONCE_REWRITE_TAC[DISJ_SYM] THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[GSYM node_map_inverse_representation]) THEN DISCH_TAC THEN MP_TAC (SPECL[`node_map (H:(A)hypermap)`; `(ploop:num->A) 0`] in_orbit_map1) THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM node; SYM th]) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F8") THEN USE_THEN "H1" (MP_TAC o SPEC `0` o CONJUNCT1 o REWRITE_RULE[lemma_def_inj_contour; lemma_def_contour]) THEN REWRITE_TAC[ZR_LT_1; GSYM ONE; one_step_contour] THEN ONCE_REWRITE_TAC[DISJ_SYM] THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[GSYM node_map_inverse_representation]) THEN DISCH_TAC THEN MP_TAC (SPECL[`node_map (H:(A)hypermap)`; `(ploop:num->A) 1`] in_orbit_map1) THEN POP_ASSUM (fun th -> REWRITE_TAC[GSYM node; SYM th]) THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP lemma_node_identity) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F8" (MP_TAC o SYM) THEN POP_ASSUM SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [GSYM o_THM] THEN REWRITE_TAC[GSYM POWER_2] THEN MP_TAC (ARITH_RULE `~(2 = 0)`) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[GSYM face] o MATCH_MP card_orbit_le) THEN UNDISCH_TAC `is_inj_contour (H:(A)hypermap) (ploop:num->A) 1` THEN DISCH_THEN ( fun th -> (ASSUME_TAC (MATCH_MP lemma_first_dart_on_inj_contour (CONJ ZR_LT_1 th)))) THEN USE_THEN "F2" (MP_TAC o SPEC `(ploop:num->A) 0`) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN POP_ASSUM MP_TAC THEN ARITH_TAC);;
(************ GENERATION PART *****************)
let is_node_going = new_definition `!(H:(A)hypermap) (L:(A)loop) x:A y:A. is_node_going H L x y 
    <=> ?k:num. y = ((next L) POWER k) x /\ (!i:num. i <= k ==> ((next L) POWER i) x = ((inverse (node_map H)) POWER i) x)`;;
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}`;;
(* Intuitively, a loop is partitioned by atoms *)
let atom_reflect = 
prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). x IN atom H L x`,
REPEAT GEN_TAC THEN REWRITE_TAC[atom; IN_ELIM_THM; is_node_going] THEN EXISTS_TAC `0` THEN REWRITE_TAC[LE_0; LE; POWER_0; I_THM] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM]);;
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`,
REWRITE_TAC[atom; IN_ELIM_THM] THEN MESON_TAC[]);;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[is_node_going] 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")))) THEN EXISTS_TAC `(k:num) + (m:num)` THEN REWRITE_TAC[addition_exponents; o_THM] THEN USE_THEN "F1" (SUBST1_TAC o SYM) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN ASM_CASES_TAC `i:num <= m:num` THENL[POP_ASSUM (fun th -> (USE_THEN "F2" (fun thm-> REWRITE_TAC[MATCH_MP (SPEC `i:num` thm) th]))); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` MP_TAC) THEN ABBREV_TAC `j = SUC d` THEN DISCH_THEN SUBST_ALL_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[addition_exponents; o_THM] THEN REMOVE_THEN "F2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `m:num`) THEN REMOVE_THEN "F1" (SUBST1_TAC o SYM) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REMOVE_THEN "F5" MP_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN DISCH_THEN (fun th -> (REMOVE_THEN "F4" (fun thm -> REWRITE_TAC[MATCH_MP (SPEC `j:num` thm) th]))));;
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 `,
REPEAT GEN_TAC THEN REWRITE_TAC[is_node_going] 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")))) THEN ASM_CASES_TAC `m:num <= k:num` THENL[DISJ1_TAC THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN EXISTS_TAC `d:num` THEN USE_THEN "F3" (MP_TAC o ONCE_REWRITE_RULE[ADD_SYM]) THEN REWRITE_TAC[addition_exponents; o_THM] THEN USE_THEN "F1" (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN USE_THEN "F4" (MP_TAC o SPEC `(m:num) + (i:num)`) THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[addition_exponents; o_THM] THEN USE_THEN "F2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `m:num`) THEN REMOVE_THEN "F1" (SUBST1_TAC o SYM) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN SIMP_TAC[]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d1:num` SUBST_ALL_TAC) THEN ABBREV_TAC `d = SUC d1` THEN EXISTS_TAC `d:num` THEN USE_THEN "F1" (MP_TAC o ONCE_REWRITE_RULE[ADD_SYM]) THEN REWRITE_TAC[addition_exponents; o_THM] THEN USE_THEN "F3" (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN USE_THEN "F2" (MP_TAC o SPEC `(k:num) + (i:num)`) THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[addition_exponents; o_THM] THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`) THEN REMOVE_THEN "F3" (SUBST1_TAC o SYM) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN SIMP_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o REWRITE_RULE[is_node_going]) 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")))) THEN ASM_CASES_TAC `m:num <= k:num` THENL[DISJ2_TAC THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[is_node_going] THEN EXISTS_TAC `d:num` THEN USE_THEN "F3" (MP_TAC o SYM) THEN USE_THEN "F5" (SUBST1_TAC) THEN REWRITE_TAC[addition_exponents; o_THM] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[o_THM; I_THM] o AP_TERM `(back (L:(A)loop)) POWER (m:num)`) THEN REWRITE_TAC[lemma_second_inverse_evaluation] THEN DISCH_THEN (fun th -> REWRITE_TAC[th]) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F6" (MP_TAC o SPEC `i:num`) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= d:num ==> i <= (m:num) + d`) th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d1:num` (SUBST_ALL_TAC)) THEN ABBREV_TAC `d = SUC d1` THEN DISJ1_TAC THEN REWRITE_TAC[is_node_going] THEN EXISTS_TAC `d:num` THEN USE_THEN "F3" (MP_TAC o SYM) THEN USE_THEN "F5" (SUBST1_TAC) THEN REWRITE_TAC[addition_exponents; o_THM] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[o_THM; I_THM] o AP_TERM `(back (L:(A)loop)) POWER (k:num)`) THEN REWRITE_TAC[lemma_second_inverse_evaluation] THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM th]) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F4" (MP_TAC o SPEC `i:num`) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP (ARITH_RULE `i:num <= d:num ==> i <= (k:num) + d`) th]));;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[atom; IN_ELIM_THM] THEN STRIP_TAC THENL[POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_transitive_going (CONJ th1 th2)]))); POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_on_way_going (CONJ th1 th2)]))); POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_second_on_way_going (CONJ th1 th2)]))); POP_ASSUM (fun th1 -> (POP_ASSUM (fun th2 -> REWRITE_TAC[MATCH_MP lemma_transitive_going (CONJ th2 th1)])))]);;
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`,
REPEAT STRIP_TAC THEN REWRITE_TAC[atom; SUBSET; IN_ELIM_THM; GSYM belong] THEN REPEAT STRIP_TAC THENL[POP_ASSUM ((X_CHOOSE_THEN `k:num` (SUBST1_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going]) THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC] THEN POP_ASSUM ((X_CHOOSE_THEN `k:num` (MP_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going]) THEN ASM_CASES_TAC `~((x':A) belong (L:(A)loop))` THENL[POP_ASSUM(fun th -> (REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th])) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th -> MESON_TAC[th]));;
let lemma_atom_out_side_loop = 
prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). ~(x belong L) ==> atom H L x = {x}`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN STRIP_TAC THENL[REWRITE_TAC[atom; SUBSET; IN_ELIM_THM; IN_SING] THEN GEN_TAC THEN STRIP_TAC THENL[POP_ASSUM ((X_CHOOSE_THEN `k:num` (SUBST1_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th]); ALL_TAC] THEN POP_ASSUM ((X_CHOOSE_THEN `k:num` (MP_TAC o CONJUNCT1)) o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[o_THM] o AP_TERM `(back (L:(A)loop)) POWER (k:num)`) THEN REWRITE_TAC[lemma_second_inverse_evaluation] THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th]) THEN REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_SING] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[atom_reflect]);;
let lemma_atom_sub_node = 
prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). (atom H L x) SUBSET (node H x)`,
REPEAT GEN_TAC THEN REWRITE_TAC[atom; SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 SUBST1_TAC (LABEL_TAC "F1"))) THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`) THEN MP_TAC (SPEC `k:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[node; lemma_in_orbit]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (ASSUME_TAC) (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)))] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[node; lemma_in_orbit]);;
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`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `node (H:(A)hypermap) (x:A)` THEN REWRITE_TAC[lemma_atom_sub_node; node] THEN MP_TAC (SPEC `x:A` (MATCH_MP orbit_subset (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))) THEN ASM_REWRITE_TAC[]);;
let lemma_atom_finite = 
prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). FINITE (atom H L x) /\ 1 <= CARD (atom H L x)`,
REPEAT GEN_TAC THEN SUBGOAL_THEN `FINITE (atom (H:(A)hypermap) (L:(A)loop) (x:A))` ASSUME_TAC THENL[MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `node (H:(A)hypermap) (x:A)` THEN REWRITE_TAC[NODE_FINITE; lemma_atom_sub_node]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_ATLEAST_1 THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[atom_reflect]);;
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`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN STRIP_TAC THENL[REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN POP_ASSUM (MP_TAC o MATCH_MP atom_sym) THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP atom_trans th]); ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_THEN (fun th2 -> REWRITE_TAC[MATCH_MP atom_trans th2]));;
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 ==> (next L y) IN (atom H L x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_identity_atom th]) THEN REWRITE_TAC[atom; IN_ELIM_THM] THEN DISJ1_TAC THEN REWRITE_TAC[is_node_going] THEN EXISTS_TAC `1` THEN REWRITE_TAC[POWER_1] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `i:num = 1` THENL[POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[POWER_1]; ALL_TAC] THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE] THEN REWRITE_TAC[ARITH_RULE `!i:num. i < 1 <=> i = 0`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POWER_0]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_identity_atom th]) THEN REWRITE_TAC[atom; IN_ELIM_THM] THEN DISJ2_TAC THEN REWRITE_TAC[is_node_going] THEN EXISTS_TAC `1` THEN REWRITE_TAC[POWER_1] THEN REWRITE_TAC[lemma_inverse_evaluation] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC `i:num = 1` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_1] THEN REWRITE_TAC[lemma_inverse_evaluation] THEN ASM_MESON_TAC[]; ALL_TAC] THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM LT_LE] THEN REWRITE_TAC[ARITH_RULE `!i:num. i < 1 <=> i = 0`] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POWER_0] );;
let next_and_loop_darts = 
prove(`!L:(A)loop. FINITE(dart_of L) /\ (next L permutes dart_of L)`,
MESON_TAC[loop_lemma]);;
let back_and_loop_darts = 
prove(`!L:(A)loop. FINITE(dart_of L) /\ (back L permutes dart_of L)`,
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)))))`,
REPEAT GEN_TAC THEN REWRITE_TAC [GSYM SKOLEM_THM] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] 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")))))) 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") THENL[ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NOT_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [DE_MORGAN_THM; TAUT `~ ~A = A`; TAUT `(~A \/ B) <=> (A==>B)`] THEN DISCH_THEN (LABEL_TAC "G1") THEN REMOVE_THEN "F5" MP_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `dart_of (L:(A)loop) = atom (H:(A)hypermap) L (x:A)` (LABEL_TAC "G2") THENL[SUBGOAL_THEN `!k:num. ((next (L:(A)loop)) POWER k) (x:A) IN (atom (H:(A)hypermap) L x)` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM; node; atom_reflect]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G2") THEN REWRITE_TAC[COM_POWER; o_THM] THEN USE_THEN "G2" (fun th1 -> (USE_THEN "G1" (fun th2 -> (MP_TAC(MATCH_MP th2 th1))))) THEN (USE_THEN "G2" (fun th2-> (DISCH_THEN (fun th3 -> (REWRITE_TAC[MATCH_MP lemma_atom_absorb_quark (CONJ th2 th3)]))))); ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th2]) THEN REWRITE_TAC[SUBSET; GSYM belong] THEN GEN_TAC THEN USE_THEN "F2" (fun th2-> (DISCH_THEN (fun th3-> (MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th2 th3)))))) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (SUBST1_TAC o CONJUNCT2)) THEN POP_ASSUM (fun th -> REWRITE_TAC[SPEC `k:num` th]); ALL_TAC] THEN REMOVE_THEN "F3" (LABEL_TAC "F3" o REWRITE_RULE[belong]) THEN REMOVE_THEN "F4" (LABEL_TAC "F4" o REWRITE_RULE[belong]) THEN REMOVE_THEN "G2" SUBST_ALL_TAC THEN LABEL_TAC "G3" (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node) THEN USE_THEN "F3" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1)))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]) THEN USE_THEN "F4" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1)))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]); ALL_TAC] THEN POP_ASSUM (X_CHOOSE_THEN `h:A` ASSUME_TAC) THEN EXISTS_TAC `h:A` THEN POP_ASSUM (fun th -> SIMP_TAC[th]) THEN ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NOT_EXISTS_THM] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [DE_MORGAN_THM; TAUT `~ ~A = A`; TAUT `(~A \/ B) <=> (A==>B)`] THEN DISCH_THEN (LABEL_TAC "G1") THEN REMOVE_THEN "F5" MP_TAC THEN REWRITE_TAC[] THEN SUBGOAL_THEN `dart_of (L:(A)loop) = atom (H:(A)hypermap) L (x:A)` (LABEL_TAC "G2") THENL[SUBGOAL_THEN `!k:num. ((back (L:(A)loop)) POWER k) (x:A) IN (atom (H:(A)hypermap) L x)` ASSUME_TAC THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM; node; atom_reflect]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G2") THEN REWRITE_TAC[COM_POWER; o_THM] THEN USE_THEN "G2" (fun th1 -> (USE_THEN "G1" (fun th2 -> (MP_TAC(MATCH_MP th2 th1))))) THEN (USE_THEN "G2" (fun th2-> (DISCH_THEN (fun th3 -> (REWRITE_TAC[MATCH_MP lemma_second_absorb_quark (CONJ th2 th3)]))))); ALL_TAC] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th2]) THEN REWRITE_TAC[SUBSET; GSYM belong] THEN GEN_TAC THEN USE_THEN "F2" (fun th2-> (DISCH_THEN (fun th3-> (MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th2 th3) ))))) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (MP_TAC o CONJUNCT2)) THEN ONCE_REWRITE_TAC[lemma_inverse_on_loop] THEN MP_TAC (SPEC `k:num` (MATCH_MP power_inverse_element_lemma (SPEC `L:(A)loop` back_and_loop_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[SPEC `j:num` th]); ALL_TAC] THEN REMOVE_THEN "F3" (LABEL_TAC "F3" o REWRITE_RULE[belong]) THEN REMOVE_THEN "F4" (LABEL_TAC "F4" o REWRITE_RULE[belong]) THEN REMOVE_THEN "G2" SUBST_ALL_TAC THEN LABEL_TAC "G3" (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node) THEN USE_THEN "F3" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1)))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]) THEN USE_THEN "F4" (fun th1 -> (USE_THEN "G3" (fun th2 -> (MP_TAC(MATCH_MP lemma_in_subset (CONJ th2 th1)))))) THEN DISCH_THEN (fun th -> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]));;
(* The definition of quotient hypermaps *)
let is_normal = new_definition `!(H:(A)hypermap) (NF:(A)loop -> bool). is_normal H NF 
<=> (!(L:(A)loop). L IN NF ==> ((is_loop H L) /\ (?x:A. x IN dart H /\ x belong L))) /\
    (!(L:(A)loop). L IN NF ==> (?y:A z:A. y belong L /\ z belong L /\ ~(node H y = node H z ))) /\
    (!(L:(A)loop) (L':(A)loop) (x:A). L IN NF /\ L' IN NF /\ x belong L /\ x belong L' ==> L = L') /\
    (!(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') `;;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]) ASSUME_TAC) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `x:A` MP_TAC)) THEN POP_ASSUM (fun th1 -> (DISCH_THEN (fun th2-> REWRITE_TAC[MATCH_MP support_loop_sub_dart (CONJ th1 th2)]))));;
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}`;;
let support_darts = new_definition `!(NF:(A)loop->bool). support_darts NF  = UNIONS {dart_of (L:(A)loop) | L IN NF}`;;
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`,
REPEAT STRIP_TAC THEN REWRITE_TAC[belong] THEN MATCH_MP_TAC lemma_in_subset THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN MATCH_MP_TAC lemma_atom_sub_loop THEN ASM_REWRITE_TAC[]);;
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`,
REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma_in_subset THEN EXISTS_TAC `dart_of (L:(A)loop)` THEN POP_ASSUM (fun th-> REWRITE_TAC[GSYM belong; th]) THEN POP_ASSUM(fun th1->(POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemm_nornal_loop_sub_dart (CONJ th th1)]))));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[support_darts; quotient_darts] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN STRIP_TAC THENL[REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `dart_of (L:(A)loop)` THEN STRIP_TAC THENL[EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN UNDISCH_THEN `t:A->bool = atom (H:(A)hypermap) (L:(A)loop) (x':A)` SUBST_ALL_TAC THEN MATCH_MP_TAC lemma_in_subset THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x':A)` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (fun th -> (REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th])); ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN STRIP_TAC THENL[EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `x:A` THEN POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[GSYM belong]; ALL_TAC] THEN REWRITE_TAC[atom_reflect]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN SUBGOAL_THEN `support_darts (NF:(A)loop->bool) SUBSET dart H` ASSUME_TAC THENL[REWRITE_TAC[support_darts; SUBSET; IN_UNIONS; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th2 -> (POP_ASSUM (fun th1 -> MP_TAC (MATCH_MP lemm_nornal_loop_sub_dart (CONJ th1 th2))))) THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[lemma_in_subset]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[hypermap_lemma]);;
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`,
REWRITE_TAC[belong; support_darts] THEN SET_TAC[]);;
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`,
REPEAT GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[support_darts; IN_UNIONS; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `L:(A)loop` THEN POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM belong] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MESON_TAC[lemma_in_support2]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") MP_TAC) THEN SPEC_TAC (`n:num`, `n:num`) THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM] THEN SIMP_TAC[]; ALL_TAC] THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F2") THEN REWRITE_TAC[COM_POWER; o_THM] THEN ABBREV_TAC `y = ((node_map (H:(A)hypermap)) POWER (n:num)) (x:A)` THEN REMOVE_THEN "F2" (MP_TAC o REWRITE_RULE[lemma_in_support]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN MP_TAC (SPECL[`node_map (H:(A)hypermap)`; `1`; `y:A`] lemma_in_orbit) THEN REWRITE_TAC[POWER_1; GSYM node] THEN DISCH_TAC 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]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (MP_TAC o ONCE_REWRITE_RULE[CONJ_SYM])) THEN REWRITE_TAC[lemma_in_support2]);;
let lemma_loop_outside_node = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A). is_normal H NF /\ L IN NF ==> ~(dart_of L SUBSET node H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_normal]) (ASSUME_TAC)) THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TAUT `(A ==> ~B) <=> (B ==> ~A)`] THEN REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(A /\ B /\ ~C) <=> (A /\ B ==> C)`] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[belong] 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))))))) THEN REPLICATE_TAC 2 (POP_ASSUM (SUBST1_TAC o SYM o MATCH_MP lemma_node_identity)) THEN SIMP_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) 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]))) THEN DISCH_THEN (LABEL_TAC "F3" o CONJUNCT1) THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_normal]) THEN ASM_REWRITE_TAC[belong] THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC)) THEN SUBGOAL_THEN `~(x:A = y:A)` ASSUME_TAC THENL[POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[size] THEN MATCH_MP_TAC CARD_ATLEAST_2 THEN EXISTS_TAC `x:A` THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[loop_lemma]);;
let disjoint_loops = 
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 /\ x belong L' ==> L = L'`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) MP_TAC) THEN POP_ASSUM (fun th-> MESON_TAC[CONJUNCT1(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_normal] th)))]));;
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)))`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_support_and_atoms th]) THEN ASM_CASES_TAC `~(x:A IN UNIONS (quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)))` THENL[EXISTS_TAC `{x:A}` THEN POP_ASSUM(fun th -> SIMP_TAC[th]); ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_UNIONS; IN_ELIM_THM]) THEN DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F2" ))) 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")))) THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `t:A->bool` THEN POP_ASSUM SUBST_ALL_TAC THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" (fun th -> (MP_TAC (SPEC `L:(A)loop`(CONJUNCT1 (REWRITE_RULE[is_normal] th))))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F5" o CONJUNCT1) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP lemma_identity_atom th]) THEN MATCH_MP_TAC lemma_in_loop THEN ASM_MESON_TAC[]);;
let lemma_choice = new_specification ["choice"] (REWRITE_RULE[SKOLEM_THM] lemma_choice_function);;
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}) /\ (!L:(A)loop x:A. L IN NF /\ x belong L ==> choice H NF x = atom H L x)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN STRIP_TAC THENL[POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_choice th]); ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) THEN USE_THEN "F2"(fun th ->(USE_THEN "F3" (fun th1-> (ASSUME_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th)))))) THEN USE_THEN "F1" (fun th-> MP_TAC(CONJUNCT2(SPEC `x:A` (MATCH_MP lemma_choice th)))) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (ASSUME_TAC) (CONJUNCTS_THEN2 (LABEL_TAC "F4") SUBST1_TAC))) THEN SUBGOAL_THEN `L' = L:(A)loop` SUBST_ALL_TAC THENL[MATCH_MP_TAC disjoint_loops THEN ASM_MESON_TAC[]; ALL_TAC] THEN SIMP_TAC[]);;
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`,
REPEAT STRIP_TAC 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) THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT STRIP_TAC THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM] THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);;
let lemma_finite_quotient_darts = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> FINITE (quotient_darts H NF)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN SUBGOAL_THEN `IMAGE (choice (H:(A)hypermap) (NF:(A)loop->bool)) (support_darts NF) = quotient_darts H NF` ASSUME_TAC THENL[REWRITE_TAC[IMAGE; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN REWRITE_TAC[GSYM EXTENSION] THEN EQ_TAC THENL[DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[lemma_in_support]) (SUBST1_TAC))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (LABEL_TAC "F2")) THEN USE_THEN "F1" (ASSUME_TAC o CONJUNCT2 o MATCH_MP first_unique_choice) THEN POP_ASSUM (fun th-> (USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP th th1]))) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_quotient th]); ALL_TAC] THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM] 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)))) THEN USE_THEN "G1" (fun th-> (USE_THEN "G2" (fun th1-> (MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th)))))) THEN DISCH_TAC THEN EXISTS_TAC `y:A` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F1" (MP_TAC o SPECL[`L:(A)loop`; `y:A`] o CONJUNCT2 o MATCH_MP first_unique_choice) THEN ASM_REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN MATCH_MP_TAC FINITE_IMAGE THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_finite_support th]));;
let lemma_finite_normal_loops = 
prove(`!H:(A)hypermap NF:(A)loop->bool. is_normal H NF ==> FINITE NF /\ CARD NF <= CARD (dart H)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") 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 THENL[REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM] THEN REWRITE_TAC[lemma_in_support] THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))) THEN REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `f:A->(A)loop` (LABEL_TAC "F2")) THEN SUBGOAL_THEN `IMAGE (f:A->(A)loop) (support_darts (NF:(A)loop->bool)) = NF` (SUBST1_TAC o SYM) THENL[REWRITE_TAC[IMAGE; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL[ DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN DISCH_THEN (fun th-> (USE_THEN "F2" (fun thm -> MP_TAC(MATCH_MP thm th)))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o CONJUNCT2))) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "F3") 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])) THEN DISCH_THEN (MP_TAC o CONJUNCT2) THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN EXISTS_TAC `y:A` THEN USE_THEN "F3" (fun th-> (USE_THEN "F5" (fun th1-> (ASSUME_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th)))))) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (fun th-> (USE_THEN "F2" (fun thm -> MP_TAC(MATCH_MP thm th)))) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F1" (fun th -> ((CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) (MATCH_MP lemma_finite_support th))) THEN STRIP_TAC THENL[MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD (support_darts (NF:(A)loop->bool))` THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP CARD_IMAGE_LE th]) THEN MATCH_MP_TAC CARD_SUBSET THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; hypermap_lemma]));;
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))))))`,
REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPLICATE_TAC 2 (ONCE_REWRITE_TAC[RIGHT_EXISTS_IMP_THM]) THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x:A IN support_darts (NF:(A)loop->bool))` THENL[EXISTS_TAC `x:A` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN POP_ASSUM (fun th -> (REWRITE_TAC[th] THEN MP_TAC (REWRITE_RULE[lemma_in_support] th))) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`] lemma_border_of_atom) THEN DISCH_THEN (X_CHOOSE_THEN `h1:A->A` (X_CHOOSE_THEN `t1:A->A` (MP_TAC o SPEC `x:A`))) THEN ASM_REWRITE_TAC[] THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_normal]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> SIMP_TAC[th]) THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th -> SIMP_TAC[th]) THEN REPEAT STRIP_TAC THEN EXISTS_TAC `(h1:A->A) (x:A)` THEN EXISTS_TAC `(t1:A->A) (x:A)` THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[]);;
let lemma_head_tail = new_specification ["head";
"tail"] (REWRITE_RULE[SKOLEM_THM] lemma_border_of_atom2);;
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`,
REPEAT GEN_TAC 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"))))) THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F6" o CONJUNCT1) THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `x:A` o MATCH_MP lemma_head_tail) THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th2)]))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F7") (CONJUNCTS_THEN2 (LABEL_TAC "F8") (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10" o CONJUNCT1))))) 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]) THEN REMOVE_THEN "F8" (fun th -> REWRITE_TAC[th]) THEN REMOVE_THEN "F7" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST_ALL_TAC THEN ABBREV_TAC `z = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN REMOVE_THEN "F4" (fun th2 -> (MP_TAC (MATCH_MP lemma_identity_atom th2))) THEN DISCH_THEN SUBST_ALL_TAC THEN REMOVE_THEN "F9" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM; is_node_going]) THEN STRIP_TAC THENL[ASM_CASES_TAC `k:num = 0` THENL[UNDISCH_TAC `z:A = ((next (L:(A)loop)) POWER (k:num)) (y:A)` THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN FIRST_X_ASSUM (MP_TAC o SPEC `1` o check (is_forall o concl)) THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th; POWER_1]) THEN USE_THEN "F5" (fun th -> SIMP_TAC[th]); ALL_TAC] THEN ASM_CASES_TAC `k:num = 0` THENL[UNDISCH_TAC `y:A = ((next (L:(A)loop)) POWER (k:num)) (z:A)` THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM; EQ_SYM]; ALL_TAC] THEN FIRST_X_ASSUM (MP_TAC o SPEC `1` o check (is_forall o concl)) THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th; POWER_1]) THEN USE_THEN "F10" (fun th -> SIMP_TAC[th]));;
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`,
REPEAT GEN_TAC 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"))))) THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F6" o CONJUNCT1) THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `x:A` o MATCH_MP lemma_head_tail) THEN USE_THEN "F3" (fun th1 -> (USE_THEN "F2" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th2)]))) 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)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) 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]) THEN REMOVE_THEN "F8" (fun th -> REWRITE_TAC[th]) THEN REMOVE_THEN "F7" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST_ALL_TAC THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN REMOVE_THEN "F4" (fun th2 -> (MP_TAC (MATCH_MP lemma_identity_atom th2))) THEN DISCH_THEN SUBST_ALL_TAC THEN REMOVE_THEN "F9" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM; is_node_going]) THEN STRIP_TAC THENL[ASM_CASES_TAC `k:num = 0` THENL[UNDISCH_TAC `z:A = ((next (L:(A)loop)) POWER (k:num)) (y:A)` THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN FIND_ASSUM (MP_TAC o AP_TERM `back (L:(A)loop)`) `z:A = ((next (L:(A)loop)) POWER (k:num)) (y:A)` THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ]) THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP LT_SUC_PRE th] THEN ASSUME_TAC th) THEN REWRITE_TAC[COM_POWER; o_THM] THEN REWRITE_TAC[lemma_inverse_evaluation] THEN FIRST_ASSUM (MP_TAC o REWRITE_RULE[ARITH_RULE `PRE k <= k`] o SPEC `PRE k` o check (is_forall o concl)) THEN DISCH_THEN (SUBST1_TAC) THEN DISCH_THEN (MP_TAC o AP_TERM `inverse (node_map (H:(A)hypermap))`) THEN REWRITE_TAC[iterate_map_valuation] THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[SYM(MATCH_MP LT_SUC_PRE th)]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F10" (fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN ASM_CASES_TAC `k:num = 0` THENL[UNDISCH_TAC `y:A = ((next (L:(A)loop)) POWER (k:num)) (z:A)` THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM; EQ_SYM]; ALL_TAC] THEN FIND_ASSUM (MP_TAC o AP_TERM `back (L:(A)loop)`) `y:A = ((next (L:(A)loop)) POWER (k:num)) (z:A)` THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM LT_NZ]) THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[MATCH_MP LT_SUC_PRE th] THEN ASSUME_TAC th) THEN REWRITE_TAC[COM_POWER; o_THM] THEN REWRITE_TAC[lemma_inverse_evaluation] THEN FIRST_ASSUM (MP_TAC o REWRITE_RULE[ARITH_RULE `PRE k <= k`] o SPEC `PRE k` o check (is_forall o concl)) THEN DISCH_THEN (SUBST1_TAC) THEN DISCH_THEN (MP_TAC o AP_TERM `inverse (node_map (H:(A)hypermap))`) THEN REWRITE_TAC[iterate_map_valuation] THEN POP_ASSUM (fun th -> ONCE_REWRITE_TAC[SYM(MATCH_MP LT_SUC_PRE th)]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F5" (fun th -> REWRITE_TAC[GSYM th]));;
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 ==> head H NF x IN atom H L x /\ ~(next L (head H NF x) = inverse (node_map H) (head H NF x))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F2"(fun th -> (USE_THEN "F3"(fun th1-> ASSUME_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th))))) THEN USE_THEN "F1"(fun th-> MP_TAC (CONJUNCT2(SPEC `x:A`(MATCH_MP lemma_head_tail th)))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) 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))))) THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` (SUBST_ALL_TAC) THENL[MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]);;
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 ==> tail H NF x IN atom H L x /\ ~(tail H NF x = inverse (node_map H) (back L (tail H NF x)))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F2"(fun th -> (USE_THEN "F3"(fun th1-> ASSUME_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th))))) THEN USE_THEN "F1"(fun th-> MP_TAC (CONJUNCT2(SPEC `x:A`(MATCH_MP lemma_head_tail th)))) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) 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)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")) THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` (SUBST_ALL_TAC) THENL[MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]);;
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 ==> atom H L x = atom H L (tail H NF x) /\ atom H L x = atom H L (head H NF x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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))))))))) THEN DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_identity_atom th1)) 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))))))))) THEN DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_identity_atom th1)) THEN MESON_TAC[]);;
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 ==> head H NF y = head H NF x /\ tail H NF y = tail H NF x`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2")(CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN USE_THEN "F3"(fun th2->(USE_THEN "F4"(fun th3->LABEL_TAC "F6"(MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN USE_THEN "F4"(fun th1->(LABEL_TAC "F7"(MATCH_MP lemma_identity_atom th1))) THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_unique_head THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) 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] THEN MATCH_MP_TAC lemma_unique_tail THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST1_TAC o SYM) 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))]))))));;
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 ==> head H NF x belong L /\ tail H NF x belong L`,
REPEAT GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_in_loop THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A` THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP head_on_loop th; CONJUNCT2(CONJUNCT2 th)]); ALL_TAC] THEN MATCH_MP_TAC lemma_in_loop THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A` THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP tail_on_loop th; CONJUNCT2(CONJUNCT2 th)]));;
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 ==> next L x = inverse (node_map H) x`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "FC")))) 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]))) THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1) THEN USE_THEN "FC" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM]) THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) THEN ASM_CASES_TAC `k:num = 0` THENL[POP_ASSUM SUBST_ALL_TAC THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[POWER_0; I_THM]) THEN DISCH_THEN (ASSUME_TAC o ONCE_REWRITE_RULE[SPEC `next (L:(A)loop)` orbit_one_point]) THEN USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2)) THEN POP_ASSUM SUBST1_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[SUBSET; IN_SING; node] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))); ALL_TAC] THEN REMOVE_THEN "F6" (MP_TAC o REWRITE_RULE[POWER_1; LT1_NZ; LT_NZ ] o SPEC `1`) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node) THEN USE_THEN "FC"(fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_subset (CONJ th1 th))))) THEN DISCH_THEN(fun th->REWRITE_TAC[MATCH_MP lemma_node_identity th]) THEN USE_THEN "F3" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1)))) THEN REWRITE_TAC[POWER_1] THEN DISCH_THEN(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2)) THEN DISCH_THEN SUBST1_TAC THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[iterate_map_valuation] o SYM o AP_TERM `next (L:(A)loop)`) THEN DISCH_THEN (fun th-> MP_TAC (REWRITE_RULE[LT_SUC_LE] (MATCH_MP orbit_cyclic (CONJ (SPEC `k:num` NON_ZERO) th)))) THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_two_series_eq) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC o CONJUNCT2)) THEN MP_TAC (SPEC `i:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC)) THEN REWRITE_TAC[node; lemma_in_orbit]; ALL_TAC] THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))));;
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 ==> ~((next L (head H NF x)) IN (atom H L x))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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]))) THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1) THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (MP_TAC)) o MATCH_MP head_on_loop) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma_map_next THEN EXISTS_TAC `NF:(A)loop->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_in_loop THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F5" (fun th2 -> (ONCE_REWRITE_TAC[GSYM (MATCH_MP lemma_identity_atom th2)])) THEN POP_ASSUM (fun th2 -> (ONCE_REWRITE_TAC[MATCH_MP lemma_identity_atom th2])) THEN REWRITE_TAC[atom_reflect]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN REMOVE_THEN "FC"(fun th-> (MP_TAC (MATCH_MP head_on_loop th ))) THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN REMOVE_THEN "F3"(fun th->(DISCH_THEN(fun th1->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th th1))))) 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]))) THEN DISCH_THEN (MP_TAC o SPEC `head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` o REWRITE_RULE[is_loop] o CONJUNCT1) THEN REWRITE_TAC[one_step_contour] THEN ASM_REWRITE_TAC[]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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]))) THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1) THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (MP_TAC)) o MATCH_MP tail_on_loop) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN ABBREV_TAC `y = back (L:(A)loop) (tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A))` THEN POP_ASSUM (MP_TAC o AP_TERM `next (L:(A)loop)`) THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation] THEN DISCH_THEN SUBST_ALL_TAC THEN MATCH_MP_TAC lemma_map_next THEN EXISTS_TAC `NF:(A)loop->bool` THEN POP_ASSUM (LABEL_TAC "F6") THEN USE_THEN "F6" (fun th2 -> (SUBST_ALL_TAC (SYM(MATCH_MP lemma_identity_atom th2)))) THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma_in_loop THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);;
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 ==> 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)) /\ inverse (face_map H) (tail H NF x) = head H NF (inverse (face_map H) (tail H NF x))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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]))) THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1) THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) o MATCH_MP head_on_loop) THEN ABBREV_TAC `y = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F5"(fun th3->LABEL_TAC "F8" (MATCH_MP lemma_in_loop (CONJ th2 th3))))) 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]))) THEN USE_THEN "F6" (fun th -> SIMP_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F8" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1)))) THEN REWRITE_TAC[POWER_1] THEN DISCH_THEN (fun th -> (REWRITE_TAC[th] THEN LABEL_TAC "F9" th)) THEN SUBGOAL_THEN `next (L:(A)loop) (y:A) = tail (H:(A)hypermap) (NF:(A)loop->bool) (next L y)` (LABEL_TAC "F10") THENL[CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_unique_tail THEN EXISTS_TAC `L:(A)loop` THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation] THEN ASM_REWRITE_TAC[atom_reflect]; ALL_TAC] THEN REMOVE_THEN "F10" (SUBST1_TAC o SYM) THEN SIMP_TAC[] THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12")) o MATCH_MP tail_on_loop) THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F11"(fun th3->LABEL_TAC "F14" (MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN USE_THEN "F14" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_back_in_loop th1)))) THEN REWRITE_TAC[POWER_1] THEN DISCH_THEN (LABEL_TAC "F15") 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]))) THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation] THEN REWRITE_TAC[one_step_contour] THEN USE_THEN "F12" (fun th -> SIMP_TAC[th]) THEN REWRITE_TAC[face_map_inverse_representation] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F15" (fun th->REWRITE_TAC[th]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_unique_head THEN EXISTS_TAC `L:(A)loop` THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation] THEN ASM_REWRITE_TAC[atom_reflect]);;
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))) /\ (?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)))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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]))) THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1) THEN STRIP_TAC THENL[USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) o MATCH_MP tail_on_loop) THEN ABBREV_TAC `y = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F5"(fun th3->LABEL_TAC "F8" (MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN USE_THEN "F8"(fun th1->(USE_THEN "F2"(fun th2->(MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th2)))))) THEN USE_THEN "F1"(fun th1->(DISCH_THEN(fun th2->(MP_TAC (SPEC `1` (MATCH_MP lemma_node_in_support2 (CONJ th1 th2))))))) THEN REWRITE_TAC[POWER_1; lemma_in_support] THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10"))) THEN EXISTS_TAC `L':(A)loop` THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_unique_head THEN EXISTS_TAC `L':(A)loop` THEN ASM_REWRITE_TAC[atom_reflect] THEN REMOVE_THEN "F6" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))] THEN DISCH_TAC THEN USE_THEN "F10" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1)))) THEN REWRITE_TAC[POWER_1] THEN POP_ASSUM (fun th -> SUBST1_TAC th THEN LABEL_TAC "F11" th) THEN DISCH_TAC THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC THENL[MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REMOVE_THEN "F11" (MP_TAC o AP_TERM `back (L:(A)loop)`) THEN ONCE_REWRITE_TAC[lemma_inverse_evaluation] THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN MESON_TAC[EQ_SYM]; ALL_TAC] THEN USE_THEN "FC" ((CONJUNCTS_THEN2 (LABEL_TAC "F15") (LABEL_TAC "F16")) o MATCH_MP head_on_loop) THEN ABBREV_TAC `y = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN USE_THEN "F3"(fun th2->(REMOVE_THEN "F15"(fun th3->LABEL_TAC "F17" (MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN USE_THEN "F17"(fun th1->(USE_THEN "F2"(fun th2->(MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th2)))))) THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` ASSUME_TAC) THEN USE_THEN "F1"(fun th1->(DISCH_THEN(fun th2->(MP_TAC (SPEC `j:num` (MATCH_MP lemma_node_in_support2 (CONJ th1 th2))))))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[lemma_in_support] THEN DISCH_THEN (X_CHOOSE_THEN `P:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19"))) THEN EXISTS_TAC `P:(A)loop` THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_unique_tail THEN EXISTS_TAC `P:(A)loop` THEN ASM_REWRITE_TAC[atom_reflect] THEN REMOVE_THEN "F16" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`) THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))] THEN DISCH_THEN (MP_TAC o AP_TERM `next (P:(A)loop)`) THEN REWRITE_TAC[lemma_inverse_evaluation] THEN DISCH_THEN (SUBST_ALL_TAC o SYM) THEN REMOVE_THEN "F19" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_back_in_loop th1)))) THEN REWRITE_TAC[POWER_1] THEN REWRITE_TAC[lemma_inverse_evaluation] THEN DISCH_TAC THEN SUBGOAL_THEN `L:(A)loop = P:(A)loop` SUBST1_TAC THENL[MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SIMP_TAC[]);;
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))`,
MESON_TAC[node_map_on_margin]);;
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 ==> (!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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> (LABEL_TAC "F5" (MATCH_MP lemma_in_loop (CONJ th th1))))) 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)))))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")) 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]))) THEN DISCH_THEN (LABEL_TAC "F8" o CONJUNCT1) THEN USE_THEN "F3" (fun th-> USE_THEN "F6" (fun th1-> (LABEL_TAC "F9" (MATCH_MP lemma_in_loop (CONJ th th1))))) THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN REMOVE_THEN "F6" (SUBST_ALL_TAC o MATCH_MP lemma_identity_atom) THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM]) THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))) THEN USE_THEN "F9" (fun th-> USE_THEN "F5" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4")) THEN ASM_CASES_TAC `k:num <= top (L:(A)loop)` 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)))))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM(fun th-> MP_TAC (MATCH_MP LT_IMP_LE (REWRITE_RULE[NOT_LE] th))) THEN USE_THEN "H3" (fun th -> DISCH_THEN (fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1)))) THEN USE_THEN "H2"(fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP lemma_sub_part (CONJ th th1)])); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))) THEN ASM_CASES_TAC `k:num = 0` THENL[POP_ASSUM SUBST_ALL_TAC THEN USE_THEN "G1" (MP_TAC o REWRITE_RULE[POWER_0; I_THM]) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (REWRITE_RULE[I_THM] (SYM(AP_THM (SPEC `next (L:(A)loop)` POWER_0) `y:A`))) THEN MP_TAC (SPEC `top (L:(A)loop)` LE_0) THEN USE_THEN "F5" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP determine_loop_index th]) THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "G2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `k:num`) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; NOT_LE; LT_EXISTS; CONJUNCT1 ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN USE_THEN "G2" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `SUC d`) THEN USE_THEN "G1" (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM (COM_POWER_FUNCTION)] THEN USE_THEN "G2" (SUBST1_TAC o SYM o REWRITE_RULE[LE_PLUS] o SPEC `d:num`) 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)`) THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th]));;
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 ==> (!i:num. i <= index L y (head H NF x) ==> (next L POWER i) y = (inverse (node_map H) POWER i) y)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> (LABEL_TAC "F5" (MATCH_MP lemma_in_loop (CONJ th th1))))) 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)))))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")) 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]))) THEN DISCH_THEN (LABEL_TAC "F8" o CONJUNCT1) THEN USE_THEN "F3" (fun th-> USE_THEN "F6" (fun th1-> (LABEL_TAC "F9" (MATCH_MP lemma_in_loop (CONJ th th1))))) THEN ABBREV_TAC `z = head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` THEN REMOVE_THEN "F6" (SUBST_ALL_TAC o MATCH_MP lemma_identity_atom) THEN USE_THEN "F4" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM]) THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))) THEN ASM_CASES_TAC `k:num = 0` THENL[POP_ASSUM SUBST_ALL_TAC THEN USE_THEN "G1" (MP_TAC o REWRITE_RULE[POWER_0; I_THM]) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (REWRITE_RULE[I_THM] (SYM(AP_THM (SPEC `next (L:(A)loop)` POWER_0) `z:A`))) THEN MP_TAC (SPEC `top (L:(A)loop)` LE_0) THEN USE_THEN "F9" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP determine_loop_index th]) THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "G2" (MP_TAC o SPEC `1`) THEN POP_ASSUM(fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ] th; POWER_1]) THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))) THEN USE_THEN "F5" (fun th-> USE_THEN "F9" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4")) THEN ASM_CASES_TAC `k:num <= top (L:(A)loop)` 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)))))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM(fun th-> MP_TAC (MATCH_MP LT_IMP_LE (REWRITE_RULE[NOT_LE] th))) THEN USE_THEN "H3" (fun th -> DISCH_THEN (fun th1-> ASSUME_TAC (MATCH_MP LE_TRANS (CONJ th th1)))) THEN REPEAT STRIP_TAC THEN USE_THEN "H2" (MP_TAC o SPEC `i:num`) THEN POP_ASSUM (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)])));;
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 ==> (index L x y) + (index L y z) = index L x z`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN USE_THEN "F1"(fun th-> USE_THEN "F2"(fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) THEN USE_THEN "F1"(fun th-> USE_THEN "F3"(fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")) THEN USE_THEN "F2"(fun th-> USE_THEN "F3"(fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) THEN ABBREV_TAC `nz = index (L:(A)loop) y z` THEN ABBREV_TAC `n = index (L:(A)loop) x y` THEN ABBREV_TAC `m = index (L:(A)loop) x z` THEN USE_THEN "F10" MP_TAC THEN USE_THEN "F6" SUBST1_TAC THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN USE_THEN "F8" SUBST1_TAC THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN ((X_CHOOSE_THEN `q:num` MP_TAC) o MATCH_MP lemma_congruence_on_loop) THEN ASM_CASES_TAC `q:num = 0` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[CONJUNCT1 MULT; CONJUNCT1 ADD; lemma_size] THEN DISCH_THEN (fun th-> REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F11") THEN DISCH_TAC 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)))) THEN REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC THEN MP_TAC(SPECL[`size (L:(A)loop)`; `(q:num) * (size (L:(A)loop))`; `m:num`] LE_ADD_RCANCEL) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F9"(fun th-> USE_THEN "F4" (fun th1-> MP_TAC (MATCH_MP LE_ADD2 (CONJ th th1)))) THEN DISCH_THEN (fun th-> DISCH_THEN (fun th1-> (MP_TAC (MATCH_MP LE_TRANS (CONJ th1 th))))) THEN REWRITE_TAC[lemma_size; CONJUNCT2 ADD] THEN ARITH_TAC);;
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 ==> (index L (tail H NF x) y) + (index L y (head H NF x)) = index L (tail H NF x) (head H NF x)`,
REPEAT GEN_TAC THEN DISCH_THEN (fun th-> LABEL_TAC "FC"(MATCH_MP from_tail th) THEN MP_TAC th) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")) THEN MATCH_MP_TAC add_steps THEN ASM_REWRITE_TAC[] THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_loop (CONJ th th1)])) 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")) THEN USE_THEN "F6" (fun th-> USE_THEN "F5"(fun th1-> LABEL_TAC "F9" (CONJUNCT2(MATCH_MP lemma_loop_index (CONJ th th1))))) THEN ABBREV_TAC `u = tail (H:(A)hypermap) NF x` THEN ABBREV_TAC `v = head (H:(A)hypermap) NF x` THEN ASM_CASES_TAC `index (L:(A)loop) u y <= index L u v` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F10" o REWRITE_RULE[NOT_LE; GSYM LE_SUC_LT]) THEN USE_THEN "FC" (MP_TAC o SPEC `SUC(index (L:(A)loop) u v)`) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th; GSYM COM_POWER_FUNCTION]) THEN USE_THEN "FC" (MP_TAC o SPEC `index (L:(A)loop) u v`) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `index (L:(A)loop) u v` LE_PLUS) th)]) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F9" (SUBST1_TAC o SYM) THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F3")) THEN ASM_CASES_TAC `~(x:A belong L:(A)loop)` THENL[POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_power_back_and_next_outside_loop th]) THEN REWRITE_TAC[atom_reflect]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F2" o REWRITE_RULE[]) THEN ABBREV_TAC `y = ((next (L:(A)loop)) POWER (m:num)) (x:A)` THEN REWRITE_TAC[atom; IN_ELIM_THM] THEN DISJ1_TAC THEN REWRITE_TAC[is_node_going] THEN EXISTS_TAC `m:num` THEN ASM_SIMP_TAC[]);;
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 ==> (!i:num. i <= index L x (head H NF x) ==> (next L POWER i) x IN atom H L x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") 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]))) THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect) 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] THEN DISCH_THEN (MP_TAC o MATCH_MP to_head) THEN DISCH_THEN (fun th-> USE_THEN "F4" (fun th1-> (MP_TAC (MATCH_MP lemma_sub_part (CONJ th th1))))) THEN USE_THEN "F5"(fun th-> DISCH_THEN (fun th1-> (REWRITE_TAC [MATCH_MP lemma_in_atom (CONJ th th1)]))));;
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 ==> 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)} /\ (!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)) /\ 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)}`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")) THEN USE_THEN "F5" (fun th-> USE_THEN "F4"(fun th1-> (MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")) THEN ABBREV_TAC `u = tail (H:(A)hypermap) NF x` THEN POP_ASSUM (LABEL_TAC "UL") THEN ABBREV_TAC `v = head (H:(A)hypermap) NF x` THEN POP_ASSUM (LABEL_TAC "VL") 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 THENL[ONCE_REWRITE_TAC[TAUT `A <=> ~ ~A`] THEN GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [NOT_EXISTS_THM; DE_MORGAN_THM; NOT_FORALL_THM] THEN DISCH_THEN (LABEL_TAC "H1" o REWRITE_RULE[]) THEN SUBGOAL_THEN `!n:num. (next (L:(A)loop) POWER n) u = (inverse (node_map (H:(A)hypermap)) POWER n) u` (LABEL_TAC "H2") THENL[MATCH_MP_TAC num_WF THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "G1") THEN USE_THEN "H1" (MP_TAC o SPEC `n:num`) THEN STRIP_TAC 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] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM COM_POWER_FUNCTION] THEN USE_THEN "G1" (SUBST1_TAC o SYM o REWRITE_RULE[LT_PLUS] o SPEC `n:num`) THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM th; COM_POWER_FUNCTION]); ALL_TAC] THEN USE_THEN "F5" (MP_TAC o MATCH_MP lemma_transitive_permutation) THEN USE_THEN "H2" (SUBST1_TAC o MATCH_MP lemma_orbit_eq) THEN REWRITE_TAC[MATCH_MP lemma_orbit_inverse_map_eq (SPEC `H:(A)hypermap` node_map_and_darts); GSYM node] 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))))) THEN REWRITE_TAC[CONTRAPOS_THM] THEN SET_TAC[]; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [num_WOP] THEN DISCH_THEN (X_CHOOSE_THEN `n:num` ((CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9")) o CONJUNCT1)) THEN SUBGOAL_THEN `n:num <= index (L:(A)loop) u v` (LABEL_TAC "F10") THENL[USE_THEN "F9" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE] THEN DISCH_THEN (LABEL_TAC "H1") 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)`)) THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] 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`)) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F7" (SUBST1_TAC o SYM) THEN EXPAND_TAC "v" 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] THEN ABBREV_TAC `w = (next (L:(A)loop) POWER n) u` THEN POP_ASSUM (LABEL_TAC "WL") THEN USE_THEN "WL" (MP_TAC o SYM) THEN USE_THEN "F10"(fun th-> USE_THEN "F6"(fun th1-> MP_TAC(MATCH_MP LE_TRANS (CONJ th th1)))) THEN USE_THEN "F5" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP determine_loop_index) THEN USE_THEN "F8" MP_TAC 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])) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN USE_THEN "WL" (fun th -> DISCH_THEN (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_in_atom)) THEN USE_THEN "UL" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) 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)))]))) THEN DISCH_TAC THEN USE_THEN "F9" MP_TAC THEN POP_ASSUM 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] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_unique_head) THEN USE_THEN "VL" SUBST1_TAC THEN DISCH_THEN (SUBST_ALL_TAC o SYM) THEN POP_ASSUM (SUBST_ALL_TAC o SYM) THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `atom (H:(A)hypermap) L x = {(next L POWER i) u | i:num | i <= index L u v}` (LABEL_TAC "F11") THENL[REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:A` THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "H1") THEN USE_THEN "H1" (fun th-> USE_THEN "F3" (fun th1-> MP_TAC (MATCH_MP lemma_in_loop (CONJ th1 th)))) THEN USE_THEN "F5" (fun th-> DISCH_THEN (ASSUME_TAC o CONJUNCT2 o MATCH_MP lemma_loop_index o CONJ th)) THEN EXISTS_TAC `index (L:(A)loop) u y` THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM th]) THEN USE_THEN "H1" 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] 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))) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th; LE_ADD]); ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))) THEN USE_THEN "F8"(fun th-> USE_THEN "H1" (fun th1-> MP_TAC (MATCH_MP lemma_sub_part (CONJ th th1)))) 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])) THEN REWRITE_TAC[IMP_IMP] THEN USE_THEN "H2" (fun th-> DISCH_THEN (fun th1-> MP_TAC(REWRITE_RULE[SYM th] (MATCH_MP lemma_in_atom th1)))) THEN EXPAND_TAC "u" 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] THEN USE_THEN "F11"(fun th-> REWRITE_TAC[th]) THEN USE_THEN "F8"(fun th-> REWRITE_TAC[MATCH_MP lemma_two_series_eq th]));;
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 ==> atom H L x = {x}`,
REPEAT GEN_TAC THEN DISCH_THEN((CONJUNCTS_THEN2 (LABEL_TAC "F1" o REWRITE_RULE[GSYM CONJ_ASSOC]) (LABEL_TAC "F2")) o REWRITE_RULE[CONJ_ASSOC]) THEN USE_THEN "F2" (MP_TAC o AP_TERM `next (L:(A)loop) POWER 0`) THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o DEPTH_CONV) [POWER_0; I_THM] THEN MP_TAC (SPEC `top (L:(A)loop)` LE_0) THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP margin_in_loop) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (LABEL_TAC "F3" o MATCH_MP determine_loop_index) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP atomic_particles) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th; CONJUNCT1 LE]) THEN REWRITE_TAC[SET_RULE `!p:num->A. {p i | i = 0} = {p 0}`; POWER_0; I_THM] THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect) THEN POP_ASSUM (SUBST1_TAC) THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]));;
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 ==> next L x = inverse (node_map H) x`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "FC")))) 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]))) THEN DISCH_THEN (LABEL_TAC "F4" o CONJUNCT1) THEN USE_THEN "FC" (MP_TAC o REWRITE_RULE[atom; IN_ELIM_THM]) THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) THEN ASM_CASES_TAC `k:num = 0` THENL[POP_ASSUM SUBST_ALL_TAC THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[POWER_0; I_THM]) THEN DISCH_THEN (ASSUME_TAC o ONCE_REWRITE_RULE[SPEC `next (L:(A)loop)` orbit_one_point]) THEN USE_THEN "F3"(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2)) THEN POP_ASSUM SUBST1_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[SUBSET; IN_SING; node] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[orbit_reflect]; ALL_TAC] THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))); ALL_TAC] THEN REMOVE_THEN "F6" (MP_TAC o REWRITE_RULE[POWER_1; LT1_NZ; LT_NZ ] o SPEC `1`) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[is_node_going]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node) THEN USE_THEN "FC"(fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_subset (CONJ th1 th))))) THEN DISCH_THEN(fun th->REWRITE_TAC[MATCH_MP lemma_node_identity th]) THEN USE_THEN "F3" (fun th1-> (MP_TAC (SPEC `1` (MATCH_MP lemma_power_next_in_loop th1)))) THEN REWRITE_TAC[POWER_1] THEN DISCH_THEN(fun th2->MP_TAC(MATCH_MP lemma_transitive_permutation th2)) THEN DISCH_THEN SUBST1_TAC THEN REMOVE_THEN "F5" (MP_TAC o REWRITE_RULE[iterate_map_valuation] o SYM o AP_TERM `next (L:(A)loop)`) THEN DISCH_THEN (fun th-> MP_TAC (REWRITE_RULE[LT_SUC_LE] (MATCH_MP orbit_cyclic (CONJ (SPEC `k:num` NON_ZERO) th)))) THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_two_series_eq) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC o CONJUNCT2)) THEN MP_TAC (SPEC `i:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC)) THEN REWRITE_TAC[node; lemma_in_orbit]; ALL_TAC] THEN USE_THEN "F1"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))));;
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`,
REPEAT GEN_TAC THEN DISCH_THEN ((CONJUNCTS_THEN2 (LABEL_TAC "F1" o REWRITE_RULE[GSYM CONJ_ASSOC]) (LABEL_TAC "F2")) o REWRITE_RULE[CONJ_ASSOC]) THEN USE_THEN "F1" (MP_TAC o MATCH_MP margin_in_loop) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP node_map_free_loop) 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)))])) THEN DISCH_THEN (LABEL_TAC "F5") THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP tail_on_loop) THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] lemma_atom_sub_node) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_subset) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th]) THEN USE_THEN "F1"(MP_TAC o CONJUNCT2 o MATCH_MP atomic_particles) THEN USE_THEN "F1"(fun th->REWRITE_TAC[CONJUNCT1(MATCH_MP change_to_margin th)]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7")) THEN USE_THEN "F3"(fun th-> USE_THEN "F4"(fun th1->MP_TAC(CONJUNCT2(MATCH_MP lemma_loop_index (CONJ th1 th))))) THEN ABBREV_TAC `u = tail (H:(A)hypermap) NF x` THEN ABBREV_TAC `v = head (H:(A)hypermap) NF x` THEN ABBREV_TAC `n = index (L:(A)loop) u v` THEN USE_THEN "F6" (SUBST1_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`) THEN USE_THEN "F5" (SUBST1_TAC o SYM) THEN DISCH_THEN (MP_TAC o SYM) THEN REWRITE_TAC[node_map_inverse_representation; COM_POWER_FUNCTION] THEN DISCH_THEN (fun th->(MP_TAC(MATCH_MP orbit_cyclic (CONJ (SPEC `n:num` NON_ZERO) (SYM th))))) THEN REWRITE_TAC[MATCH_MP lemma_orbit_inverse_map_eq (SPEC `H:(A)hypermap` node_map_and_darts); LT_SUC_LE; GSYM node] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F7"(fun th-> REWRITE_TAC[th]));;
let lemma_fmap = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). ?f:(A->bool)->(A->bool). (!s:A->bool. is_normal H NF ==> (~(s IN quotient_darts H NF) ==> f s = s) /\ (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)))))`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN ASM_CASES_TAC `~((s:A->bool) IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))` THENL[EXISTS_TAC `s:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` MP_TAC)) THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) (LABEL_TAC "F4")) THEN ASM_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `x:A` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (face_map H (head H NF (x:A)))` THEN ASM_REWRITE_TAC[]);;
let lemma_nmap = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). ?f:(A->bool)->(A->bool). (!s:A->bool. is_normal H NF ==> (~(s IN quotient_darts H NF) ==> f s = s) /\ (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 /\ f s = atom H L' ((node_map H) (tail H NF x)))))`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN DISCH_THEN (LABEL_TAC "F1") THEN ASM_CASES_TAC `~((s:A->bool) IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))` THENL[EXISTS_TAC `s:A->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (X_CHOOSE_THEN `x:A` MP_TAC)) THEN DISCH_THEN (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) (LABEL_TAC "F4")) 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)))))))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3" o CONJUNCT1))) THEN ASM_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `x:A` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `L:(A)loop` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `L':(A)loop` THEN EXISTS_TAC `atom (H:(A)hypermap) (L':(A)loop) (node_map H (tail H NF (x:A)))` THEN ASM_REWRITE_TAC[]);;
let lemma_face_map = new_specification ["fmap"] (REWRITE_RULE[SKOLEM_THM] lemma_fmap);;
let lemma_node_map = new_specification ["nmap"] (REWRITE_RULE[SKOLEM_THM] lemma_nmap);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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) THEN USE_THEN "F2" (fun th-> (USE_THEN "F3" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)]))) THEN STRIP_TAC THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L':(A)loop`; `x':A`] atom_reflect) 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) THEN USE_THEN "F3"(fun th2->(DISCH_THEN(fun th3->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x':A`] atom_reflect) THEN POP_ASSUM (SUBST1_TAC o SYM) 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))))))))))) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1) THEN SIMP_TAC[]);;
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))`,
REPEAT GEN_TAC 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"))))) 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) THEN USE_THEN "F2" (fun th-> (USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)]))) THEN STRIP_TAC THEN SUBGOAL_THEN `L'':(A)loop = L:(A)loop` SUBST_ALL_TAC THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L'':(A)loop`; `x':A`] atom_reflect) 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) THEN USE_THEN "F4"(fun th2->(DISCH_THEN(fun th3->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x':A`] atom_reflect) 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) 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))))))))))) THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2) THEN SUBGOAL_THEN `L''':(A)loop = L':(A)loop` SUBST_ALL_TAC THENL[MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `node_map (H:(A)hypermap) (tail H (NF:(A)loop->bool) (x':A))` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
let fmap_permute = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (fmap H NF) permutes (quotient_darts H NF)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[permutes] THEN STRIP_TAC THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_face_map th]); ALL_TAC] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN GEN_TAC THEN ASM_CASES_TAC `~(y:A->bool IN (quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)))` THENL[EXISTS_TAC `y:A->bool` THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y:A->bool` o MATCH_MP lemma_face_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th-> REWRITE_TAC[th] THEN (LABEL_TAC "G1" th)) THEN GEN_TAC THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))` THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_face_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) 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))) 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))))))))) THEN DISCH_THEN (SUBST1_TAC) THEN DISCH_TAC THEN SUBGOAL_THEN `y:A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)` MP_TAC THENL[ POP_ASSUM (SUBST1_TAC o SYM) THEN MATCH_MP_TAC lemma_in_quotient 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))]))))) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F2" o REWRITE_RULE[]) THEN USE_THEN "F2" (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) 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))) 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]))) THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) ((inverse (face_map (H:(A)hypermap))) (tail H (NF:(A)loop->bool) (x:A)))` THEN STRIP_TAC 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)))))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8")))) 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))))))))) THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_identity_atom 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)))])))))) THEN USE_THEN "FC" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN GEN_TAC THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))` THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_face_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F3" (fun th-> (USE_THEN "F4" (fun th1 -> (REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)])))); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) 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))) 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))))))))) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F7") 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))))))))) THEN DISCH_THEN (LABEL_TAC "F8") THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect) THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM) THEN USE_THEN "F8"(fun th2->(DISCH_THEN(fun th3->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect) THEN USE_THEN "F7" (SUBST1_TAC o SYM) 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))))))))))) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) 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)))))))) THEN DISCH_THEN (SUBST1_TAC o SYM o CONJUNCT1 o CONJUNCT2 o CONJUNCT2) THEN REWRITE_TAC [MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))] 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))]))))));;
let nmap_permute = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (nmap H NF) permutes (quotient_darts H NF)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[permutes] THEN STRIP_TAC THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_node_map th]); ALL_TAC] THEN REWRITE_TAC[EXISTS_UNIQUE] THEN GEN_TAC THEN ASM_CASES_TAC `~(y:A->bool IN (quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)))` THENL[EXISTS_TAC `y:A->bool` THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y:A->bool` o MATCH_MP lemma_node_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (fun th-> REWRITE_TAC[th] THEN (LABEL_TAC "G1" th)) THEN GEN_TAC THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))` THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_node_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) 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))) 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]))) 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))))))))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 (LABEL_TAC "G5") (LABEL_TAC "G6")))) THEN DISCH_THEN (LABEL_TAC "G7") 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 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP unique_nmap) THEN POP_ASSUM SUBST1_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN POP_ASSUM (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN USE_THEN "G4" (fun th1 -> (USE_THEN "G5" (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th1 th2)]))); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) 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))) 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]))) 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))))))))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 (LABEL_TAC "G5") (LABEL_TAC "G6")))) THEN EXISTS_TAC `atom (H:(A)hypermap) (L':(A)loop) ((inverse (node_map (H:(A)hypermap))) (head H (NF:(A)loop->bool) (x:A)))` THEN ABBREV_TAC `y = inverse (node_map H) (head H NF (x:A))` THEN POP_ASSUM (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))] THEN DISCH_THEN (LABEL_TAC "G7" o SYM) 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))))))))) THEN USE_THEN "G7" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F8") THEN USE_THEN "F4"(fun th2->(USE_THEN "F8"(fun th3-> MP_TAC (MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN USE_THEN "G6" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN USE_THEN "G4" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP unique_nmap) THEN USE_THEN "G6" (SUBST1_TAC o SYM) THEN USE_THEN "G7" (SUBST1_TAC ) THEN DISCH_THEN SUBST1_TAC 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))]))))) THEN GEN_TAC THEN ASM_CASES_TAC `~(y':A->bool IN quotient_darts (H:(A)hypermap) (NF:(A)loop->bool))` THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_node_map th]) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `y':A->bool` o MATCH_MP lemma_node_map) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN POP_ASSUM SUBST1_TAC 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))))))))) THEN USE_THEN "F4"(fun th2->(DISCH_THEN(fun th3-> MP_TAC (MATCH_MP lemma_in_loop (CONJ th2 th3))))) THEN USE_THEN "F3" (fun th1 -> (DISCH_THEN (fun th2 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th1 th2)]))); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[quotient_darts; IN_ELIM_THM]) 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))) 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)))))) 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) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) 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)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (CONJUNCTS_THEN2 (LABEL_TAC "F15") MP_TAC))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F17") SUBST1_TAC) 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)))]))))) THEN DISCH_THEN (LABEL_TAC "F18") THEN SUBGOAL_THEN `Q:(A)loop = P:(A)loop` SUBST_ALL_TAC THENL[MP_TAC(SPECL[`H:(A)hypermap`; `P:(A)loop`; `z:A`] atom_reflect) THEN USE_THEN "F17" SUBST1_TAC THEN USE_THEN "F14" MP_TAC 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]))) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop o CONJUNCT2) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `z:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `Q':(A)loop = L:(A)loop` SUBST_ALL_TAC THENL[MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `x:A`] atom_reflect) THEN USE_THEN "F18" (SUBST1_TAC o SYM) THEN USE_THEN "F15" MP_TAC 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]))) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop o (CONJUNCT2)) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REMOVE_THEN "F17" (SUBST1_TAC) 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))))))))) 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) THEN USE_THEN "F18" SUBST1_TAC 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)))))))))))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G7" (SUBST1_TAC o SYM) THEN REWRITE_TAC[node_map_injective] THEN DISCH_THEN (LABEL_TAC "F19") 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))))))))) THEN SUBGOAL_THEN `P:(A)loop = L':(A)loop` SUBST_ALL_TAC THENL[ MP_TAC(SPECL[`H:(A)hypermap`; `P:(A)loop`; `(tail H (NF:(A)loop->bool) (t:A))`] atom_reflect) THEN USE_THEN "F20" (SUBST1_TAC o SYM) THEN USE_THEN "F19" SUBST1_TAC THEN USE_THEN "F14" MP_TAC 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]))) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop o CONJUNCT2) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REPLICATE_TAC 2 (POP_ASSUM SUBST1_TAC) THEN POP_ASSUM SUBST1_TAC THEN SIMP_TAC[]);;
(* THE DEFINITION OF THE QUOTION HYPERMAP *)
let emap = new_definition `!(H:(A)hypermap) (NF:(A)loop->bool). emap H NF = inverse (fmap H NF) o inverse (nmap H NF)`;;
let emap_permute = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF ==> (emap H NF) permutes (quotient_darts H NF)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[emap] THEN MATCH_MP_TAC PERMUTES_COMPOSE THEN USE_THEN "F1" (MP_TAC o MATCH_MP nmap_permute) THEN DISCH_THEN (fun th->REWRITE_TAC[MATCH_MP PERMUTES_INVERSE th]) THEN USE_THEN "F1" (MP_TAC o MATCH_MP fmap_permute) THEN DISCH_THEN (fun th->REWRITE_TAC[MATCH_MP PERMUTES_INVERSE th]));;
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)`;;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (ASSUME_TAC o MATCH_MP lemma_finite_quotient_darts) THEN USE_THEN "F1" (LABEL_TAC "F2" o MATCH_MP nmap_permute) THEN USE_THEN "F1" (LABEL_TAC "F3" o MATCH_MP fmap_permute) THEN USE_THEN "F1" (LABEL_TAC "F4" o MATCH_MP emap_permute) THEN REWRITE_TAC[quotient] THEN ABBREV_TAC `D = quotient_darts (H:(A)hypermap) (NF:(A)loop->bool)` THEN ABBREV_TAC `e = emap (H:(A)hypermap) (NF:(A)loop->bool)` THEN ABBREV_TAC `n = nmap (H:(A)hypermap) (NF:(A)loop->bool)` THEN ABBREV_TAC `f = fmap (H:(A)hypermap) (NF:(A)loop->bool)` THEN SUBGOAL_THEN `(e:(A->bool)->(A->bool)) o (n:(A->bool)->(A->bool)) o (f:(A->bool)->(A->bool)) = I` ASSUME_TAC THENL[EXPAND_TAC "e" THEN EXPAND_TAC "n" THEN EXPAND_TAC "f" THEN REWRITE_TAC[emap] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[lemma_4functions] THEN USE_THEN "F2" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o th; I_O_ID]); ALL_TAC] THEN MATCH_MP_TAC lemma_hypermap_rep THEN ASM_REWRITE_TAC[]);;
let choice_reflect = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF ==> x IN choice H NF x`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN ASM_CASES_TAC `~(x:A IN support_darts NF)` THENL[USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o MATCH_MP first_unique_choice) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_SING]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_darts; lemma_in_support]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` MP_TAC) THEN POP_ASSUM (fun th -> (DISCH_THEN (fun th1-> MP_TAC (MATCH_MP unique_choice (CONJ th th1))))) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[atom_reflect]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN GEN_TAC THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM] THEN EQ_TAC 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)))) THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `x:A`] choice_reflect) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_loop (CONJ th th1))))) THEN POP_ASSUM (fun th->(DISCH_THEN(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th))))) THEN SIMP_TAC[]; ALL_TAC] THEN REWRITE_TAC[lemma_in_support] THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))) THEN EXISTS_TAC `L':(A)loop` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC unique_choice THEN ASM_REWRITE_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[quotient_darts; IN_ELIM_THM] 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)))) THEN EXISTS_TAC `x:A` THEN USE_THEN "F3"(fun th->(USE_THEN "F2"(fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)]))) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC unique_choice THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[lemma_choice_in_quotient]);;
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`,
REPEAT GEN_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN ASM_CASES_TAC `~(x:A IN support_darts (NF:(A)loop->bool))` THENL[USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o MATCH_MP first_unique_choice) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F3") THEN REMOVE_THEN "F2" MP_TAC THEN USE_THEN "F3" (fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_support]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))) 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)))))))) THEN DISCH_THEN SUBST_ALL_TAC THEN USE_THEN "F2" (fun th->REWRITE_TAC[MATCH_MP lemma_identity_atom th]) THEN MATCH_MP_TAC unique_choice THEN ASM_REWRITE_TAC[] THEN USE_THEN "F4"(fun th->(USE_THEN "F2"(fun th1->REWRITE_TAC[MATCH_MP lemma_in_loop (CONJ th th1)]))));;
let choice_at_margin = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF ==> choice H NF x = choice H NF (tail H NF x) /\ choice H NF x = choice H NF (head H NF x)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN ASM_CASES_TAC `~(x:A IN support_darts (NF:(A)loop->bool))` THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `x:A` o MATCH_MP lemma_head_tail) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_support]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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))))))))) 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))))))))) 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)))))))) THEN DISCH_THEN (SUBST_ALL_TAC o SYM) THEN USE_THEN "F1" (fun th-> (USE_THEN "F4"(fun th1->REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)]))) THEN USE_THEN "F1" (fun th-> (USE_THEN "F5"(fun th1->REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)]))));;
let choice_and_head_tail = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF ==> tail H NF x IN choice H NF x /\ head H NF x IN choice H NF x`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN STRIP_TAC THENL[USE_THEN "F1" (MP_TAC o CONJUNCT1 o SPEC `x:A` o MATCH_MP choice_at_margin) THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC] THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o SPEC `x:A` o MATCH_MP choice_at_margin) THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP choice_reflect th]));;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support])) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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)))))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (SUBST1_TAC o SYM o CONJUNCT1 o CONJUNCT2)) THEN REWRITE_TAC[] THEN USE_THEN "F4"(fun th->(USE_THEN "F2"(fun th1->(REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])))) 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)))))))) 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)))))))) THEN DISCH_THEN SUBST1_TAC 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)))))))) THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support])) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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))))))))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (SUBST1_TAC o SYM)))) THEN REWRITE_TAC[] THEN USE_THEN "F5"(fun th->(USE_THEN "F4"(fun th1->(REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])))) 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))]))))) 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))]))))) 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 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (SUBST1_TAC o MATCH_MP unique_nmap) THEN SIMP_TAC[]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support])) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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)))))))))) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop`(CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))) 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)))))))))) THEN USE_THEN "F6" (fun th->REWRITE_TAC[SYM th]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8" o CONJUNCT2)) THEN REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse2_hypermap_maps); o_THM] THEN USE_THEN "F8" (SUBST1_TAC o SYM) THEN REWRITE_TAC[emap; o_THM] THEN USE_THEN "F7" (fun th-> (USE_THEN "F4" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)]))) THEN USE_THEN "F1" (fun th-> MP_TAC (MATCH_MP fmap_permute th)) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th]) THEN CONV_TAC SYM_CONV THEN USE_THEN "F1" (fun th-> MP_TAC (MATCH_MP nmap_permute th)) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSE_EQ th]) THEN USE_THEN "F4"(fun th->(USE_THEN "F7"(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th))))) THEN USE_THEN "F1"(fun th->(DISCH_THEN (fun th1->REWRITE_TAC[MATCH_MP fmap_via_choice (CONJ th th1)]))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))] THEN USE_THEN "F4"(fun th->(USE_THEN "F5"(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th1 th))))) THEN USE_THEN "F1"(fun th->(DISCH_THEN (fun th1->REWRITE_TAC[MATCH_MP nmap_via_choice (CONJ th th1)]))) THEN REMOVE_THEN "F6" (SUBST1_TAC o SYM) THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts))] THEN USE_THEN "F1"(fun th->REWRITE_TAC[SYM(CONJUNCT2(SPEC `x:A`(MATCH_MP choice_at_margin th)))]));;
let lemmaJMKRXLA = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF /\ plain_hypermap H ==> plain_hypermap (quotient H NF)`,
REPEAT GEN_TAC THEN REWRITE_TAC[plain_hypermap] THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") ASSUME_TAC) THEN REWRITE_TAC[MATCH_MP convolution_belong (CONJUNCT2 (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` edge_map_and_darts))] THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN GEN_TAC THEN USE_THEN "F1"(fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th]) THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN USE_THEN "F1"(fun th -> (POP_ASSUM (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC))) THEN USE_THEN "F1"(fun th -> (REMOVE_THEN "F3" (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1))))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2 o CONJUNCT2) THEN POP_ASSUM(fun th->(MP_TAC (AP_THM th `head (H:(A)hypermap) (NF:(A)loop->bool) (x:A)`))) THEN REWRITE_TAC[o_THM; I_THM] THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (fun th-> MESON_TAC[MATCH_MP choice_at_margin th]));;
(* The definition of isomorphic hypermaps *)
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN SUBGOAL_THEN `!x:A. x IN s ==> (f:A->B) x IN t /\ ((g:B->C) (f x)) IN w` (LABEL_TAC "F3") THENL[GEN_TAC THEN DISCH_TAC THEN POP_ASSUM(fun th-> USE_THEN "F1" (ASSUME_TAC o REWRITE_RULE[th] o SPEC `x:A` o CONJUNCT1 o REWRITE_RULE[INJ])) THEN ASM_REWRITE_TAC[] 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])) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[INJ; o_THM] THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN(fun th->(POP_ASSUM (MP_TAC o CONJUNCT2 o REWRITE_RULE[th] o SPEC `x:A`))) THEN SIMP_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN USE_THEN "F3" (MP_TAC o SPEC `x:A`) THEN REMOVE_THEN "F3" (MP_TAC o SPEC `y:A`) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F2" (MP_TAC o SPECL[`(f:A->B) (x:A)`; `(f:A->B) (y:A)`] o CONJUNCT2 o REWRITE_RULE[INJ]) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPECL[`x:A`; `y:A`] o CONJUNCT2 o REWRITE_RULE[INJ] ) THEN ASM_REWRITE_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[SURJ; o_THM] THEN STRIP_TAC THENL[REPEAT STRIP_TAC THEN POP_ASSUM(fun th-> USE_THEN "F1" (ASSUME_TAC o REWRITE_RULE[th] o SPEC `x:A` o CONJUNCT1 o REWRITE_RULE[SURJ])) 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])) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN POP_ASSUM(fun th->(REMOVE_THEN "F2" (MP_TAC o REWRITE_RULE[th] o SPEC `x:C` o CONJUNCT2 o REWRITE_RULE[SURJ]))) THEN DISCH_THEN (X_CHOOSE_THEN `y:B` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN POP_ASSUM(fun th->(REMOVE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o SPEC `y:B` o CONJUNCT2 o REWRITE_RULE[SURJ]))) THEN DISCH_THEN (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN EXISTS_TAC `z:A` THEN ASM_REWRITE_TAC[]);;
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`,
MESON_TAC[BIJ; COMPOSE_INJ; COMPOSE_SURJ]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1" o REWRITE_RULE[BIJ]) THEN USE_THEN "F1" (MP_TAC o REWRITE_RULE[INJ] o CONJUNCT1) THEN REWRITE_TAC[ISPECL[`f:A->B`; `s:A->bool`] INJECTIVE_ON_LEFT_INVERSE] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2") (X_CHOOSE_THEN `g:B->A` (LABEL_TAC "F3"))) THEN EXISTS_TAC `g:B->A` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `SURJ (g:B->A) t s` (LABEL_TAC "F4") THENL[REWRITE_TAC[SURJ] THEN STRIP_TAC THENL[REPEAT STRIP_TAC THEN USE_THEN "F1" (MP_TAC o SPEC `x:B` o CONJUNCT2 o REWRITE_RULE[SURJ] o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN REMOVE_THEN "F3" (MP_TAC o SPEC `y:A`) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (fun th -> MESON_TAC[th]); ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN USE_THEN "F4" (fun th -> (USE_THEN "F2" (ASSUME_TAC o REWRITE_RULE[th] o SPEC `x:A`))) THEN EXISTS_TAC `(f:A->B) x` THEN USE_THEN "F4" (fun th -> (USE_THEN "F3" (MP_TAC o REWRITE_RULE[th] o SPEC `x:A`))) THEN POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `BIJ (g:B->A) t s` (LABEL_TAC "F5") THENL[REWRITE_TAC[BIJ] THEN ASM_REWRITE_TAC[INJ] THEN STRIP_TAC THENL[POP_ASSUM (fun th-> MESON_TAC[REWRITE_RULE[SURJ] th]); ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))) 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))) THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST_ALL_TAC o SYM))) 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))) THEN DISCH_THEN (X_CHOOSE_THEN `b:A` (CONJUNCTS_THEN2 ASSUME_TAC (SUBST_ALL_TAC o SYM))) THEN AP_TERM_TAC THEN POP_ASSUM(fun th->(USE_THEN "F3"(MP_TAC o REWRITE_RULE[th] o SPEC `b:A`))) THEN REMOVE_THEN "F7" (SUBST1_TAC o SYM) THEN POP_ASSUM(fun th->(REMOVE_THEN "F3"(MP_TAC o REWRITE_RULE[th] o SPEC `a:A`))) THEN MESON_TAC[]; ALL_TAC] THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC THEN (DISCH_THEN (LABEL_TAC "G1")) 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]))) THEN USE_THEN "G2" (fun th-> (USE_THEN "F3" (fun thm -> (ASSUME_TAC (MATCH_MP thm th))))) THEN USE_THEN "G2" (fun th-> (USE_THEN "F2" (fun thm -> (ASSUME_TAC (MATCH_MP thm th))))) THEN USE_THEN "F5" (MP_TAC o CONJUNCT1 o REWRITE_RULE[BIJ]) 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]))) THEN ASM_REWRITE_TAC[]);;
let I_BIJ = 
prove(`!s:A->bool. BIJ I s s`,
REWRITE_TAC[BIJ; INJ; SURJ] THEN REWRITE_TAC[I_THM] THEN MESON_TAC[]);;
let iso = new_definition `!(H:(A)hypermap) (H':(B)hypermap) . H iso H'  <=> (?f:A->B. BIJ f (dart H) (dart H')  /\
!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))`;;
let iso_reflect = 
prove(`!(H:(A)hypermap). H iso H`,
GEN_TAC THEN REWRITE_TAC[iso] THEN EXISTS_TAC `I:A->A` THEN REWRITE_TAC[I_THM; I_BIJ]);;
let iso_sym = 
prove(`!(H:(A)hypermap) (G:(B)hypermap). H iso G ==> G iso H`,
REPEAT GEN_TAC THEN REWRITE_TAC[iso] THEN DISCH_THEN (X_CHOOSE_THEN `f:A->B` (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))) THEN USE_THEN "F1" (MP_TAC o MATCH_MP BIJ_INVERSE) THEN DISCH_THEN(X_CHOOSE_THEN `g:B->A` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2(LABEL_TAC "FC") (LABEL_TAC "F4")))) THEN EXISTS_TAC `g:B->A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN STRIP_TAC THENL[USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT1 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F4" (MP_TAC o SPEC `x:B` o CONJUNCT1 o REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ]) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT1 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F7" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `(g:B->A) x`))) THEN USE_THEN "F5" (fun th-> USE_THEN "FC" (MP_TAC o REWRITE_RULE[th] o SPEC `x:B`)) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `g:B->A`) THEN USE_THEN "F3" (fun thm-> (USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP thm th]))); ALL_TAC] THEN STRIP_TAC THENL[USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F4" (MP_TAC o SPEC `x:B` o CONJUNCT1 o REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ]) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT1 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) 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`))) THEN USE_THEN "F5" (fun th-> USE_THEN "FC" (MP_TAC o REWRITE_RULE[th] o SPEC `x:B`)) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `g:B->A`) THEN USE_THEN "F3" (fun thm-> (USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP thm th]))); ALL_TAC] THEN USE_THEN "F5" (LABEL_TAC "F6" o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F4" (MP_TAC o SPEC `x:B` o CONJUNCT1 o REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ]) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) 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`))) THEN USE_THEN "F5" (fun th-> USE_THEN "FC" (MP_TAC o REWRITE_RULE[th] o SPEC `x:B`)) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (MP_TAC o SYM o AP_TERM `g:B->A`) THEN USE_THEN "F3" (fun thm-> (USE_THEN "F8" (fun th -> REWRITE_TAC[MATCH_MP thm th]))));;
let iso_trans = 
prove(`!(H:(A)hypermap) (G:(B)hypermap) (W:(C)hypermap). H iso G /\ G iso W ==> H iso W`,
REPEAT GEN_TAC THEN REWRITE_TAC[iso] 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")))) THEN EXISTS_TAC `(g:B->C) o (f:A->B)` THEN USE_THEN "F1" (fun th-> (USE_THEN "F3" (fun th1-> REWRITE_TAC[MATCH_MP COMPOSE_BIJ (CONJ th th1)]))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o REWRITE_RULE[INJ] o CONJUNCT1 o REWRITE_RULE[BIJ]) THEN USE_THEN "F5" (fun th-> (DISCH_THEN(fun thm-> (LABEL_TAC "F6" (MATCH_MP thm th))))) THEN REWRITE_TAC[o_THM] THEN STRIP_TAC THENL[USE_THEN "F5" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `x:A`))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F6" (fun th-> (USE_THEN "F4" (MP_TAC o CONJUNCT1 o REWRITE_RULE[th] o SPEC `(f:A->B) x`))) THEN SIMP_TAC[]; ALL_TAC] THEN STRIP_TAC THENL[USE_THEN "F5" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[th] o SPEC `x:A`))) THEN DISCH_THEN (SUBST1_TAC o SYM) 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`))) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F5" (fun th-> (USE_THEN "F2" (MP_TAC o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[th] o SPEC `x:A`))) THEN DISCH_THEN (SUBST1_TAC o SYM) 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`))) THEN SIMP_TAC[]);;
(* DESCRIBE FACES OF QUOTIENT HYPERMAPS - This is definition of F(L) in the blueprint *)
let cycle = new_definition `!(H:(A)hypermap) (L:(A)loop). cycle H L = {atom H L x |x:A | x belong L}`;;
let lemma_in_cycle2 = 
prove(`!(H:(A)hypermap) (L:(A)loop) (x:A). x belong L ==> atom H L x IN cycle H L`,
REWRITE_TAC[cycle; IN_ELIM_THM] THEN MESON_TAC[]);;
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' ==> L = L'`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (MP_TAC o CONJUNCT2) THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (LABEL_TAC "F3" o CONJUNCT2)) THEN SUBGOAL_THEN `atom (H:(A)hypermap) (L:(A)loop) (x:A) IN cycle H L` MP_TAC THENL[REWRITE_TAC[cycle; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F2" (SUBST1_TAC o CONJUNCT2 o CONJUNCT2) THEN REWRITE_TAC[cycle; IN_ELIM_THM] THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN MP_TAC(SPECL[`H:(A)hypermap`; `L':(A)loop`; `y:A`] atom_reflect) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F3"(fun th->(DISCH_THEN(fun th1->ASSUME_TAC(MATCH_MP lemma_in_loop (CONJ th th1))))) THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]);;
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 ==> cycle H L = orbit_map (fmap H NF) (atom H L x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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") THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `0` THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G1") THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4"))) THEN ASM_CASES_TAC `next (L:(A)loop) (u:A) = inverse (node_map (H:(A)hypermap)) u` THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `u:A`] atom_reflect) THEN DISCH_THEN(fun th->POP_ASSUM(fun th1->MP_TAC(MATCH_MP lemma_atom_absorb_quark (CONJ th th1)))) THEN DISCH_THEN (SUBST1_TAC o MATCH_MP lemma_identity_atom) THEN USE_THEN "G2" (ASSUME_TAC o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop) THEN REMOVE_THEN "G4" (ASSUME_TAC o REWRITE_RULE[POWER; o_THM]) THEN ABBREV_TAC `z = (next (L:(A)loop) (u:A))` THEN REMOVE_THEN "G1" (MP_TAC o SPECL[`z:A`; `v:A`]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `u:A`] atom_reflect) THEN USE_THEN "G2" MP_TAC THEN USE_THEN "F2" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_unique_head) 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))))))) 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))))))) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "G2" (ASSUME_TAC o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop) THEN DISCH_THEN (LABEL_TAC "G5") THEN REMOVE_THEN "G4" (ASSUME_TAC o REWRITE_RULE[POWER; o_THM]) THEN ABBREV_TAC `z = (next (L:(A)loop) (u:A))` THEN REMOVE_THEN "G1" (MP_TAC o SPECL[`z:A`; `v:A`]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (X_CHOOSE_THEN `k:num` MP_TAC) THEN REMOVE_THEN "G5" (SUBST1_TAC o SYM) THEN REWRITE_TAC[iterate_map_valuation2] THEN MESON_TAC[]; ALL_TAC] 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") THENL[INDUCT_TAC THENL[REPEAT STRIP_TAC THEN EXISTS_TAC `x':A` THEN ASM_REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN GEN_TAC THEN POP_ASSUM (LABEL_TAC "G4") THEN DISCH_THEN (LABEL_TAC "G5") THEN REWRITE_TAC[COM_POWER; o_THM] THEN REMOVE_THEN "G5" (fun th-> (REMOVE_THEN "G4" (MP_TAC o REWRITE_RULE[th] o SPEC `x':A`))) THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 (LABEL_TAC "G6") (SUBST1_TAC))) THEN EXISTS_TAC `(face_map (H:(A)hypermap)) (head H (NF:(A)loop->bool) (a:A))` 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))]))))) THEN MATCH_MP_TAC unique_fmap THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN REWRITE_TAC[cycle; orbit_map; IN_ELIM_THM; GE; LE_0] THEN EQ_TAC THENL[DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (SUBST1_TAC))) THEN USE_THEN "F3"(fun th->(USE_THEN "F6"(fun th1->(MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1)))))) THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (ASSUME_TAC o CONJUNCT2)) THEN REMOVE_THEN "F4" (MP_TAC o SPECL[`n:num`; `x:A`; `y:A`]) THEN ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (MP_TAC o SPECL[`n:num`; `x:A`]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (fun th-> LABEL_TAC "F1" th THEN MP_TAC (SPEC `L:(A)loop` (CONJUNCT1(REWRITE_RULE[is_normal] (CONJUNCT1 th))))) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ((X_CHOOSE_THEN `x:A` (MP_TAC o CONJUNCT2)) o CONJUNCT2) 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))]))) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient (CONJUNCT1 th)); GSYM face; FACE_FINITE]));;
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}`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[EXTENSION; face_set; set_of_orbits; IN_ELIM_THM] THEN GEN_TAC THEN REWRITE_TAC[GSYM EXTENSION] THEN USE_THEN "F1"(fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN EQ_TAC THENL[REWRITE_TAC[quotient_darts; IN_ELIM_THM] THEN DISCH_THEN (X_CHOOSE_THEN `atm:A->bool` (CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC))) 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))) THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_cycle_is_face THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `L:(A)loop`(CONJUNCTS_THEN2 (LABEL_TAC "F2") SUBST1_TAC)) 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]))) THEN DISCH_THEN ((X_CHOOSE_THEN `x:A` (LABEL_TAC "F3" o CONJUNCT2)) o CONJUNCT2) THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_in_quotient THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC lemma_cycle_is_face THEN ASM_REWRITE_TAC[]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[EXTENSION; IN_UNIONS; GSYM belong] THEN GEN_TAC THEN EQ_TAC THENL[DISCH_TAC THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th; atom_reflect]); ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[cycle; IN_ELIM_THM]) (LABEL_TAC "F3"))) THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") SUBST_ALL_TAC)) THEN POP_ASSUM (fun th-> (POP_ASSUM (fun th1 -> (REWRITE_TAC[MATCH_MP lemma_in_loop (CONJ th th1)])))));;
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 ==> face (quotient H NF) (atom H L x) = cycle H L`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") ASSUME_TAC) THEN REWRITE_TAC[face] THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN CONV_TAC SYM_CONV THEN POP_ASSUM (fun th1 -> (POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_cycle_is_face (CONJ th th1)]))));;
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 ==> UNIONS(face (quotient H NF) (atom H L x)) = dart_of L`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemmaQF th]) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC lemma_support_cycle THEN EXISTS_TAC `NF:(A)loop->bool` THEN ASM_REWRITE_TAC[]);;
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]);;
let lemma_sub_support = 
prove(`!s:(A->bool)->bool t:A->bool. t IN s ==> t SUBSET (UNIONS s)`,
SET_TAC[]);;
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 ==> (!y:A. y belong L <=> choice H NF y IN face (quotient H NF) (atom H L x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN GEN_TAC THEN EQ_TAC THENL[DISCH_THEN (fun th -> ASSUME_TAC th THEN MP_TAC th) THEN USE_THEN "F2" (MP_TAC o CONJUNCT1) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP unique_choice th]) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemmaQF (CONJ th th1)])) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th]); ALL_TAC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_sub_support) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_support_QF (CONJ th th1)])) THEN USE_THEN "F1" (ASSUME_TAC o SPEC `y:A` o MATCH_MP choice_reflect) THEN DISCH_THEN (fun th-> POP_ASSUM(fun th1 -> REWRITE_TAC[belong; MATCH_MP lemma_in_subset (CONJ th th1)])));;
let lemma_in_QuotientFace = 
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 ==> atom H L y IN face (quotient H NF) (atom H L x)`,
REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `atom (H:(A)hypermap) (L:(A)loop) (y:A) = choice H (NF:(A)loop->bool) y` SUBST1_TAC THENL[CONV_TAC SYM_CONV THEN MATCH_MP_TAC unique_choice THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_MESON_TAC[lemma_in_QF]);;
(* DESCRIBE NODES OF QUOTIENT HYPERMAPS *)
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)`;;
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 ==> node H x SUBSET support_darts NF`,
REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SUBSET; node; orbit_map; IN_ELIM_THM; GE; LE_0] THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_node_in_support2 th]));;
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`,
REWRITE_TAC[node; orbit_map; GE; LE_0; IN_ELIM_THM]);;
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]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN ASM_CASES_TAC `~((x:A) IN support_darts (NF:(A)loop->bool))` THENL[USE_THEN "F1" (MP_TAC o SPEC `x:A` o CONJUNCT1 o MATCH_MP first_unique_choice) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUBSET; IN_SING] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[node_refl]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_support]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` MP_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP unique_choice th]) THEN REWRITE_TAC[lemma_atom_sub_node]);;
let lemma_support_QN = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A. is_normal H NF /\ x IN support_darts NF ==> support_node H NF (choice H NF x) = node H x`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[EXTENSION; support_node; IN_UNIONS; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL[DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[lemma_in_node]) ASSUME_TAC)) THEN DISCH_THEN (X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN POP_ASSUM MP_TAC 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 THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM] THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP lemma_choice_sub_node) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G1") THEN REWRITE_TAC[COM_POWER; o_THM] 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)) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1 (MATCH_MP lemma_quotient th))]) THEN DISCH_THEN (MP_TAC o SPEC `i:num` o MATCH_MP lemma_dart_invariant_power_node) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1 (MATCH_MP lemma_quotient th)]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th]) THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2(LABEL_TAC "G2") SUBST_ALL_TAC)) THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP choice_reflect) THEN REMOVE_THEN "G1" (fun th-> (DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1))))) THEN DISCH_THEN (SUBST1_TAC o MATCH_MP lemma_node_identity) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_quotient th)))]) THEN USE_THEN "F1" (LABEL_TAC "G3" o CONJUNCT1 o SPEC `y:A` o MATCH_MP choice_and_head_tail) THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP lemma_choice_sub_node) THEN DISCH_THEN (fun th -> USE_THEN "G3" (fun th1 -> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1)))) THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_node_identity th]) THEN USE_THEN "F1"(fun th-> USE_THEN "G2" (fun th1-> REWRITE_TAC[CONJUNCT2(CONJUNCT2(MATCH_MP nmap_via_choice (CONJ th th1)))])) THEN ABBREV_TAC `z = tail (H:(A)hypermap) (NF:(A)loop->bool) (y:A)` THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `z:A`; `1`] lemma_in_node2)) THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_node_identity th]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_choice_sub_node th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[IMP_IMP; lemma_in_subset]; ALL_TAC] 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 THENL[INDUCT_TAC THENL[EXISTS_TAC `0` THEN REWRITE_TAC[POWER_0; I_THM] THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC] THEN POP_ASSUM (X_CHOOSE_THEN `k:num` (LABEL_TAC "F3")) THEN REWRITE_TAC[COM_POWER; o_THM] THEN ABBREV_TAC `y = (node_map (H:(A)hypermap) POWER (i:num)) (x:A)` 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)) THEN USE_THEN "F1" (MP_TAC o MATCH_MP nmap_permute) THEN DISCH_THEN (MP_TAC o SPEC `k:num` o MATCH_MP iterate_orbit) THEN DISCH_THEN (fun thm-> (USE_THEN "F4" (fun th -> (MP_TAC (MATCH_MP thm th))))) THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM] 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")))) THEN REMOVE_THEN "F3" MP_TAC THEN USE_THEN "F7" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN ASM_CASES_TAC `~(y:A = inverse (node_map (H:(A)hypermap)) (back (L:(A)loop) (y:A)))` THENL[EXISTS_TAC `SUC k` THEN REWRITE_TAC[COM_POWER; o_THM] THEN USE_THEN "F7" (SUBST1_TAC) 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)))))))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F6"(fun th->(USE_THEN "F5"(fun th1->MP_TAC(MATCH_MP lemma_in_support2 (CONJ th th1))))) THEN USE_THEN "F1"(fun th->(DISCH_THEN (fun th1->REWRITE_TAC[MATCH_MP nmap_via_choice (CONJ th th1)]))) THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_unique_tail th]) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC] THEN EXISTS_TAC `k:num` THEN USE_THEN "F7" SUBST1_TAC THEN POP_ASSUM (LABEL_TAC "F8" o REWRITE_RULE[]) THEN USE_THEN "F3" (fun th-> (USE_THEN "F8" (fun th1 -> MP_TAC (MATCH_MP lemma_second_absorb_quark (CONJ th th1))))) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM node_map_inverse_representation]) THEN DISCH_THEN (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[lemma_in_node]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN POP_ASSUM (MP_TAC o SPEC `k:num`) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F3")) THEN EXISTS_TAC `(nmap (H:(A)hypermap) (NF:(A)loop->bool) POWER (j:num)) (choice (H:(A)hypermap) (NF:(A)loop->bool) (x:A))` THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_quotient th))))]) THEN MESON_TAC[lemma_in_node]);;
let lemma_QuotientNode = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A. is_normal H NF /\ x IN support_darts NF ==> node (quotient H NF) (choice H NF x) = {choice H NF y |y:A | y IN node H x}`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) 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)) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1(MATCH_MP lemma_quotient th))]) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_subset) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_quotient th)]) THEN DISCH_THEN (LABEL_TAC "F3") THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN REWRITE_TAC[GSYM EXTENSION] THEN EQ_TAC THENL[DISCH_THEN (fun th-> ASSUME_TAC th THEN MP_TAC th) THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o (MATCH_MP lemma_in_subset)) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP atom_via_choice th]) THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (SUBST_ALL_TAC o CONJUNCT2)) THEN EXISTS_TAC `y:A` THEN SIMP_TAC[] THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_sub_support) THEN REWRITE_TAC[GSYM support_node] THEN USE_THEN "F1" (fun th-> (USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP lemma_support_QN (CONJ th th1)]))) THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP choice_reflect) THEN REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[lemma_in_subset]; ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN USE_THEN "F1" (fun th-> (USE_THEN "F2" (fun th1-> REWRITE_TAC[GSYM(MATCH_MP lemma_support_QN (CONJ th th1))]))) THEN REWRITE_TAC[support_node; IN_UNIONS] THEN DISCH_THEN (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 (fun th -> MP_TAC th THEN (LABEL_TAC "GG" th)) (LABEL_TAC "F4"))) THEN USE_THEN "F3" (MP_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_subset) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP atom_via_choice th]) THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (SUBST_ALL_TAC o CONJUNCT2)) THEN USE_THEN "F1" (fun th-> (USE_THEN "F4" (fun th1 -> (REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)])))) THEN USE_THEN "GG" (fun th-> REWRITE_TAC[th]));;
let lemma_in_QN = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A). is_normal H NF /\ x IN support_darts NF ==> (!y:A. choice H NF y IN node (quotient H NF) (choice H NF x) <=> y IN node H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN GEN_TAC THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_QuotientNode (CONJ th th1)])) THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL[DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th]) (LABEL_TAC "F3"))) THEN MATCH_MP_TAC lemma_in_subset THEN EXISTS_TAC `choice (H:(A)hypermap) (NF:(A)loop->bool) (a:A)` THEN USE_THEN "F1" (MP_TAC o SPEC `y:A` o MATCH_MP lemma_choice_sub_node) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_choice_sub_node th]) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP choice_reflect th]); ALL_TAC] THEN MESON_TAC[]);;
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 ==> choice H NF y IN node (quotient H NF) (choice H NF x)`,
MESON_TAC[lemma_in_QN]);;
let lemma_in_node3 = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) (x:A) (y:A). 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`,
MESON_TAC[lemma_in_QN]);;
(* The definition of face collections *)
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`;;
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]);;
let face_map_restrict = 
prove(`!(H:(A)hypermap) x:A. res (face_map H) (face H x) permutes face H x`,
REPEAT GEN_TAC THEN REWRITE_TAC[permutes] THEN SIMP_TAC[res] THEN GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN ASM_CASES_TAC `~((y:A) IN face (H:(A)hypermap) x)` THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN ASM_CASES_TAC `~(y':A IN face (H:(A)hypermap) x)` THENL[ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (SUBST_ALL_TAC o MATCH_MP lemma_face_identity) THEN DISCH_TAC THEN MP_TAC(REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `y':A`; `1`] lemma_in_face)) THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[]) THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (fun th -> (ASSUME_TAC (AP_THM th `y:A`)))) THEN MP_TAC (SPECL[`H:(A)hypermap`; `y:A`; `j:num`] lemma_in_face) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_TAC THEN EXISTS_TAC `inverse (face_map (H:(A)hypermap)) y` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))] THEN GEN_TAC THEN ASM_CASES_TAC `~(y':A IN face (H:(A)hypermap) y)` THENL[ASM_REWRITE_TAC[] THEN DISCH_THEN (SUBST_ALL_TAC) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[face; orbit_reflect]) THEN MESON_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[face_map_inverse_representation]);;
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`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; orbit_reflect]; ALL_TAC] THEN MP_TAC(SPECL[`H:(A)hypermap`; `x:A`; `n:num`] lemma_in_face) THEN ABBREV_TAC `y = (face_map (H:(A)hypermap) POWER n) x` THEN DISCH_TAC THEN REWRITE_TAC[COM_POWER; o_THM] THEN ASM_REWRITE_TAC[res]);;
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))`;;
let face_collection = new_definition `!H:(A)hypermap. face_collection H = {face_loop H x |x:A| x IN dart H}`;;
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)`,
REPEAT GEN_TAC THEN REWRITE_TAC[face_loop] THEN MATCH_MP_TAC lemma_loop_representation THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[FACE_FINITE; face_map_restrict] THEN REWRITE_TAC[orbit_map; power_res_face_map; face]);;
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`,
REPEAT STRIP_TAC THEN REWRITE_TAC[face_loop] THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN REWRITE_TAC[GSYM face_loop] THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (LABEL_TAC "F0")) THEN USE_THEN "F0" (MP_TAC o SPEC `face_map (H:(A)hypermap)` o MATCH_MP RIGHT_MULT_MAP) THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))] THEN REWRITE_TAC[GSYM (CONJUNCT2 POWER)] THEN DISCH_THEN (LABEL_TAC "F1" o SYM) THEN SUBGOAL_THEN `(res (face_map (H:(A)hypermap)) (face H y)) POWER (SUC j) = I` ASSUME_TAC THENL[REWRITE_TAC[FUN_EQ_THM;I_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x:A IN face (H:(A)hypermap) (y:A))` THENL[MATCH_MP_TAC power_permutation_outside_domain THEN EXISTS_TAC `face (H:(A)hypermap) y` THEN ASM_REWRITE_TAC[face_map_restrict; FACE_FINITE]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[]) THEN DISCH_THEN (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN REWRITE_TAC[power_res_face_map] THEN POP_ASSUM (fun th-> MP_TAC (AP_THM th `x:A`)) THEN REWRITE_TAC[I_THM]; ALL_TAC] THEN POP_ASSUM (MP_TAC o SPEC `inverse(res (face_map (H:(A)hypermap)) (face H y))` o MATCH_MP RIGHT_MULT_MAP) THEN REWRITE_TAC[POWER; I_O_ID; GSYM o_ASSOC] THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES_o (SPECL[`H:(A)hypermap`; `y:A`] face_map_restrict); I_O_ID] THEN DISCH_THEN (LABEL_TAC "F3") THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REMOVE_THEN "F0" (SUBST1_TAC) THEN REWRITE_TAC[power_res_face_map]);;
let face_loop_lemma = 
prove(`!(H:(A)hypermap) x:A. is_loop H (face_loop H x)`,
REPEAT STRIP_TAC THEN REWRITE_TAC[is_loop; belong; face_loop_rep] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[res] THEN REWRITE_TAC[one_step_contour]);;
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))`,
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))) ==> is_normal H (face_collection H)`,
REPEAT GEN_TAC THEN REWRITE_TAC[is_normal] THEN DISCH_THEN (LABEL_TAC "F2") THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[face_loop_lemma] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[face; orbit_reflect; face_loop_rep]; ALL_TAC] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[face_loop_rep] THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[face; orbit_reflect] THEN REWRITE_TAC[GSYM face] THEN USE_THEN "F2" (fun thm->(POP_ASSUM (fun th-> MESON_TAC[MATCH_MP thm th]))); ALL_TAC] THEN STRIP_TAC THENL[REPEAT GEN_TAC THEN REWRITE_TAC [face_collection; IN_ELIM_THM; belong] 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)) THEN REMOVE_THEN "G1" SUBST_ALL_TAC THEN REMOVE_THEN "G2" SUBST_ALL_TAC THEN REWRITE_TAC[face_loop_rep] THEN STRIP_TAC THEN REWRITE_TAC[face_loop] THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN SIMP_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC [face_collection;IN_ELIM_THM; belong] THEN DISCH_THEN (CONJUNCTS_THEN2 (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) MP_TAC) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[face_loop_rep] THEN POP_ASSUM (LABEL_TAC "H1") THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3")) THEN EXISTS_TAC `face_loop (H:(A)hypermap) y` THEN REWRITE_TAC[face_loop_rep; face; orbit_reflect] THEN EXISTS_TAC `y:A` THEN SIMP_TAC[] THEN USE_THEN "H1" (MP_TAC o MATCH_MP lemma_face_subset) THEN USE_THEN "H2" (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN REWRITE_TAC[face] THEN DISCH_THEN (fun th-> MP_TAC (MATCH_MP lemma_in_subset (CONJ th (SPECL[`face_map (H:(A)hypermap)`; `x:A`] orbit_reflect)))) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_subset) THEN USE_THEN "H3" (SUBST_ALL_TAC o MATCH_MP lemma_node_identity) THEN DISCH_THEN (fun th-> (POP_ASSUM(fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)]))));;
let lemma_support_face_collection = 
prove(`!(H:(A)hypermap). support_darts (face_collection H) = dart H`,
GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN REWRITE_TAC[lemma_in_support] THEN REWRITE_TAC[face_collection; IN_ELIM_THM] THEN EQ_TAC THENL[STRIP_TAC THEN POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[belong; face_loop_rep] THEN POP_ASSUM (MP_TAC o MATCH_MP lemma_face_subset) THEN REWRITE_TAC[IMP_IMP; lemma_in_subset]; ALL_TAC] THEN STRIP_TAC THEN EXISTS_TAC `face_loop (H:(A)hypermap) x` THEN REWRITE_TAC[belong; face; face_loop_rep; orbit_reflect] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);;
let lemma_card_face_collection = 
prove(`!(H:(A)hypermap). FINITE (face_collection H) /\ CARD (face_collection H) = number_of_faces H`,
GEN_TAC 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 THENL[REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_face_representation) THEN STRIP_TAC THEN REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `x:A` THEN EXISTS_TAC `face_loop (H:(A)hypermap) (x:A)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `t:(A->bool)->(A)loop` (LABEL_TAC "F1")) THEN SUBGOAL_THEN `IMAGE (t:(A->bool)->(A)loop) (face_set (H:(A)hypermap)) = (face_collection H)` (LABEL_TAC "F2") THENL[REWRITE_TAC[IMAGE; face_collection; face_set; EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[set_of_orbits; IN_ELIM_THM] THEN REWRITE_TAC[GSYM face] THEN STRIP_TAC THEN EXISTS_TAC `x'':A` THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN USE_THEN "F1" (MP_TAC o SPEC `face (H:(A)hypermap) x''`) THEN POP_ASSUM (fun th -> ASSUME_TAC th THEN REWRITE_TAC[REWRITE_RULE[lemma_in_face_set] th]) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[face_loop] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G1") SUBST1_TAC)) THEN REWRITE_TAC[set_of_orbits; IN_ELIM_THM; GSYM face] THEN EXISTS_TAC `face (H:(A)hypermap) (y:A)` THEN STRIP_TAC THENL[EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F1" (MP_TAC o SPEC `face (H:(A)hypermap) (y:A)`) THEN USE_THEN "G1" (fun th -> REWRITE_TAC[REWRITE_RULE[lemma_in_face_set] th]) THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[face_loop] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `FINITE (face_collection (H:(A)hypermap))` (LABEL_TAC "F3") THENL[ POP_ASSUM (SUBST1_TAC o SYM) THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[number_of_faces] THEN REMOVE_THEN "F2" (SUBST1_TAC o SYM) THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN REWRITE_TAC[FINITE_HYPERMAP_ORBITS] THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) THEN REMOVE_THEN "F4" (fun th -> USE_THEN "F1" (fun thm -> MP_TAC (MATCH_MP thm th))) THEN STRIP_TAC THEN REMOVE_THEN "F5" (fun th -> USE_THEN "F1" (fun thm -> MP_TAC (MATCH_MP thm th))) THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "F6" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN UNDISCH_THEN `(t:(A->bool)->(A)loop) x = face_loop (H:(A)hypermap) (x')` SUBST1_TAC THEN DISCH_THEN (MP_TAC o AP_TERM `dart_of:(A)loop->(A->bool)`) THEN REWRITE_TAC[face_loop_rep]);;
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`,
REPEAT STRIP_TAC THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN REPEAT GEN_TAC THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts)) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[lemma_in_face]);;
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`,
REPEAT STRIP_TAC THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_face_identity) THEN REPEAT GEN_TAC 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))) THEN REWRITE_TAC[lemma_in_face]);;
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`,
REPEAT GEN_TAC THEN REPEAT GEN_TAC 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))) THEN REWRITE_TAC[lemma_in_face]);;
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`,
REPEAT STRIP_TAC THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_node_identity) THEN REPEAT GEN_TAC THEN MP_TAC (MATCH_MP inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts)) THEN DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REWRITE_TAC[lemma_in_node2]);;
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`,
REPEAT STRIP_TAC THEN POP_ASSUM (SUBST1_TAC o MATCH_MP lemma_node_identity) THEN REPEAT GEN_TAC 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))) THEN REWRITE_TAC[lemma_in_node2]);;
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`,
REPEAT GEN_TAC THEN REPEAT GEN_TAC 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))) THEN REWRITE_TAC[lemma_in_node2]);;
let SING_EQ = 
prove(`!x:A y:A. {x} = {y} <=> x = y`,
SET_TAC[]);;
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))`,
GEN_TAC THEN REWRITE_TAC[lemma_edge_nondegenerate] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F2"(LABEL_TAC "F3" o MATCH_MP normal_face_collection) THEN SUBGOAL_THEN `!x:A. choice (H:(A)hypermap) (face_collection H) x = {x}` (LABEL_TAC "F4") THENL[GEN_TAC THEN ASM_CASES_TAC `~(x:A IN dart (H:(A)hypermap))` THENL[POP_ASSUM (ASSUME_TAC o REWRITE_RULE[GSYM lemma_support_face_collection]) THEN USE_THEN "F3" (MP_TAC o SPEC `x:A` o CONJUNCT1 o MATCH_MP first_unique_choice) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G4" o REWRITE_RULE[]) THEN USE_THEN "G4" (MP_TAC o REWRITE_RULE[GSYM lemma_support_face_collection]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[GSYM(MATCH_MP lemma_choice_in_quotient th)]) THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM] 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")))) THEN USE_THEN "G5" (MP_TAC o REWRITE_RULE[face_collection; IN_ELIM_THM]) THEN DISCH_THEN (X_CHOOSE_THEN `z:A` (CONJUNCTS_THEN2 (LABEL_TAC "G8") (LABEL_TAC "G9"))) THEN USE_THEN "F3" (MP_TAC o SPEC `x:A` o MATCH_MP choice_reflect) THEN REMOVE_THEN "G7" SUBST1_TAC THEN USE_THEN "G6" (MP_TAC o REWRITE_RULE[belong]) THEN USE_THEN "G9" SUBST1_TAC THEN REWRITE_TAC[face_loop_rep] THEN DISCH_THEN (LABEL_TAC "G10") THEN DISCH_THEN (LABEL_TAC "G11") THEN SUBGOAL_THEN `~(next (L:(A)loop) y = inverse (node_map (H:(A)hypermap)) y)` MP_TAC THENL[USE_THEN "G9" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[face_loop_rep] THEN USE_THEN "G10" (fun th-> REWRITE_TAC[res; th]) THEN USE_THEN "F1" (MP_TAC o SPEC `y:A`) THEN USE_THEN "G8" (MP_TAC o MATCH_MP lemma_face_subset) THEN DISCH_THEN (fun th -> (USE_THEN "G10" (fun th1-> (LABEL_TAC "G12" (MATCH_MP lemma_in_subset (CONJ th th1)))))) THEN USE_THEN "G12" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `y:A`] atom_reflect) THEN USE_THEN "G6" MP_TAC THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (LABEL_TAC "G14" o MATCH_MP lemma_unique_head) THEN SUBGOAL_THEN `~(y = inverse (node_map (H:(A)hypermap)) (back (L:(A)loop) y))` MP_TAC THENL[ONCE_REWRITE_TAC[lemma_inverse_on_loop] THEN REWRITE_TAC[face_loop_rep] THEN USE_THEN "G9" SUBST1_TAC THEN REWRITE_TAC[face_loop_rep] THEN USE_THEN "G10" (fun th-> REWRITE_TAC[MATCH_MP lemma_inverse_res th]) THEN USE_THEN "G10" (ASSUME_TAC o MATCH_MP lemma_inverse_in_face) THEN ABBREV_TAC `t = inverse (face_map (H:(A)hypermap)) y` THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[GSYM face_map_inverse_representation] o SYM) THEN USE_THEN "F1" (MP_TAC o SPEC `t:A`) THEN USE_THEN "G8" (MP_TAC o MATCH_MP lemma_face_subset) THEN DISCH_THEN (fun th -> (POP_ASSUM (fun th1-> (ASSUME_TAC (MATCH_MP lemma_in_subset (CONJ th th1)))))) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `y:A`] atom_reflect) THEN USE_THEN "G6" MP_TAC THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP lemma_unique_tail) THEN POP_ASSUM(fun th-> (DISCH_THEN (fun th1 -> (ASSUME_TAC (MATCH_MP EQ_TRANS (CONJ th th1)))))) THEN POP_ASSUM MP_TAC THEN USE_THEN "G6" MP_TAC THEN USE_THEN "G5" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP atom_one_point) THEN DISCH_TAC THEN REMOVE_THEN "G11" MP_TAC THEN USE_THEN "G9" (SUBST1_TAC o SYM) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[iso] THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN EXISTS_TAC `(\x:A. {x})` THEN STRIP_TAC THENL[REWRITE_TAC[BIJ] THEN STRIP_TAC THENL[REWRITE_TAC[INJ] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[GSYM lemma_support_face_collection] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_choice_in_quotient th)]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN MESON_TAC[SING_EQ]; ALL_TAC] THEN REWRITE_TAC[SURJ] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[GSYM lemma_support_face_collection] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_choice_in_quotient th)]) THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN GEN_TAC THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th]) THEN REWRITE_TAC[lemma_support_face_collection] THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]) THEN MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[] THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==> nmap H (face_collection H) {x} = {node_map H x}` (LABEL_TAC "F5") THENL[REWRITE_TAC[GSYM lemma_support_face_collection] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "G1") THEN USE_THEN "F4" (fun th -> REWRITE_TAC[GSYM th]) THEN USE_THEN "F3"(fun th-> (USE_THEN "G1" (fun th1-> REWRITE_TAC[MATCH_MP nmap_via_choice (CONJ th th1)]))) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th-> MP_TAC(CONJUNCT1(SPEC `x:A` (GSYM(MATCH_MP choice_at_margin th))))) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th; SING_EQ]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `!x:A. x IN dart (H:(A)hypermap) ==> fmap H (face_collection H) {x} = {face_map H x}` (LABEL_TAC "F6") THENL[REWRITE_TAC[GSYM lemma_support_face_collection] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "G1") THEN USE_THEN "F4" (fun th -> REWRITE_TAC[GSYM th]) THEN USE_THEN "F3"(fun th-> (USE_THEN "G1" (fun th1-> REWRITE_TAC[MATCH_MP fmap_via_choice (CONJ th th1)]))) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th-> MP_TAC(CONJUNCT2(SPEC `x:A` (GSYM(MATCH_MP choice_at_margin th))))) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th; SING_EQ]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN ASM_REWRITE_TAC[emap] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F7"(fun th-> (USE_THEN "F5"(fun thm -> REWRITE_TAC[MATCH_MP thm th]))) THEN USE_THEN "F7"(fun th-> (USE_THEN "F6"(fun thm -> REWRITE_TAC[MATCH_MP thm th]))) THEN REWRITE_TAC [o_THM] THEN USE_THEN "F3" (fun th -> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)]) THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM face_map_inverse_representation] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F3" (fun th -> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN USE_THEN "F7" (LABEL_TAC "F8" o CONJUNCT1 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F8" (fun th-> (USE_THEN "F6" (fun thm -> REWRITE_TAC[MATCH_MP thm th]))) THEN USE_THEN "F8" (LABEL_TAC "F9" o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_invariant) THEN USE_THEN "F9" (fun th-> (USE_THEN "F5" (fun thm -> REWRITE_TAC[MATCH_MP thm th]))) THEN MP_TAC (AP_THM (CONJUNCT1 (SPEC `H:(A)hypermap` hypermap_cyclic)) `x:A`) THEN DISCH_THEN (MP_TAC o SYM o REWRITE_RULE[o_THM; I_THM]) THEN REWRITE_TAC[SING_EQ]);;
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)}`;;
let set_one_point = 
prove(`!s:A->bool x:A. FINITE s /\ CARD s = 1 /\ x IN s ==> s = {x}`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP CARD_DELETE) THEN ASM_REWRITE_TAC[SUB_REFL] THEN USE_THEN "F1" (MP_TAC o SPEC `x:A` o MATCH_MP FINITE_DELETE_IMP) THEN REWRITE_TAC[IMP_IMP; GSYM HAS_SIZE; HAS_SIZE_0] THEN DISCH_TAC THEN USE_THEN "F3" (fun th-> MP_TAC th THEN MP_TAC (MATCH_MP INSERT_DELETE th)) THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC[EQ_SYM]);;
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})))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[canon_loop; IN_ELIM_THM; IN_ELIM_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F2")) THEN USE_THEN "F1"(fun th -> REWRITE_TAC[MATCH_MP lemmaQuotientFace th; IN_ELIM_THM]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F3") SUBST_ALL_TAC)) THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `!y:A. atom (H:(A)hypermap) (L:(A)loop) (y:A) = {y}` (LABEL_TAC "F4") THENL[GEN_TAC THEN ASM_CASES_TAC `y:A belong L` THENL[MATCH_MP_TAC set_one_point THEN USE_THEN "F2" (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (y:A)`) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[lemma_atom_finite; atom_reflect]; ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_atom_out_side_loop th]); ALL_TAC] 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") THENL[REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN GEN_TAC THEN POP_ASSUM (LABEL_TAC "F5") THEN DISCH_THEN (LABEL_TAC "F6") THEN REWRITE_TAC[COM_POWER; o_THM] THEN USE_THEN "F6"(fun th-> (USE_THEN "F5"(fun thm->REWRITE_TAC[SYM(MATCH_MP thm th)]))) THEN USE_THEN "F6" (LABEL_TAC "F7" o SPEC `n:num` o MATCH_MP lemma_power_next_in_loop) THEN ABBREV_TAC `a = (next (L:(A)loop) POWER n) z` 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)))))))) 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))))))))) THEN USE_THEN "F4" (fun th -> REWRITE_TAC[th; IN_SING]) THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!z:A. z belong L ==>dart_of L = face H z` (LABEL_TAC "F6") THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F7" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN USE_THEN "F7" (fun th-> USE_THEN "F5"(fun thm-> (MP_TAC ( MATCH_MP thm th)))) THEN REWRITE_TAC[face; orbit_map; GE; LE_0] THEN ASM_ASM_SET_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[lemma_loop_identity; face_loop_rep] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F7" (fun th-> (USE_THEN "F6"(fun thm-> (LABEL_TAC "F8" (MATCH_MP thm th))))) THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x':A belong L)` THENL[POP_ASSUM (LABEL_TAC "F9") THEN USE_THEN "F9" (fun th-> REWRITE_TAC[MATCH_MP lemma_back_and_next_outside_loop th]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[belong]) THEN POP_ASSUM SUBST1_TAC THEN MESON_TAC[res]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F9" o REWRITE_RULE[]) THEN USE_THEN "F5"(fun thm -> USE_THEN "F9" (fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP thm th))])) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[belong]) THEN POP_ASSUM SUBST1_TAC THEN MESON_TAC[res]; ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 SUBST1_TAC (LABEL_TAC "F3")))) THEN REWRITE_TAC[canon_loop; IN_ELIM_THM] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemmaQuotientFace th]) THEN STRIP_TAC THENL[ASM_ASM_SET_TAC; ALL_TAC] THEN GEN_TAC THEN REWRITE_TAC[cycle; IN_ELIM_THM] THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F3" (MP_TAC o SPEC `x:A`) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[CARD_SINGLETON]);;
let lemmaSTKBEPH = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF /\ number_of_faces H <= CARD (canon_loop H NF) ==> NF = face_collection H /\ H iso quotient H NF`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) 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 THENL[REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM] THEN STRIP_TAC THEN EXISTS_TAC `cycle (H:(A)hypermap) (L:(A)loop)` THEN SIMP_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `t:(A)loop->((A->bool)->bool)` (LABEL_TAC "F3")) THEN ABBREV_TAC `S = {L:(A)loop | L IN (NF:(A)loop->bool) /\ cycle (H:(A)hypermap) L IN canon_loop H NF}` 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") THENL[REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN EQ_TAC THENL[DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN EXPAND_TAC "S" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (fun th-> (USE_THEN "F3"(fun thm-> REWRITE_TAC[MATCH_MP thm th])) THEN REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (fun th -> (LABEL_TAC "F4" th THEN MP_TAC th)) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_canonical_function th]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (ASSUME_TAC) (SUBST_ALL_TAC o CONJUNCT1))) THEN EXISTS_TAC `L:(A)loop` THEN EXPAND_TAC "S" THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN REMOVE_THEN "F3" (MP_TAC o SPEC `L:(A)loop`) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(S:(A)loop->bool) = face_collection (H:(A)hypermap)` (LABEL_TAC "F5") THENL[SUBGOAL_THEN `(S:(A)loop->bool) SUBSET face_collection (H:(A)hypermap)` (LABEL_TAC "GG") THENL[EXPAND_TAC "S" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (MP_TAC)) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_canonical_function th]) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "G3")))) THEN USE_THEN "G2" MP_TAC THEN USE_THEN "G1" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP lemma_cycle_eq) 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]))) THEN DISCH_THEN (MP_TAC o CONJUNCT2) THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (LABEL_TAC "G5"))) THEN REWRITE_TAC[face_collection; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN USE_THEN "G3" (MP_TAC o SPEC `x:A`) THEN ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC (SPEC `H:(A)hypermap` lemma_card_face_collection) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")) THEN USE_THEN "G1"(fun th->(USE_THEN "GG"(fun th1->(MP_TAC(MATCH_MP FINITE_SUBSET (CONJ th th1)))))) THEN DISCH_THEN (MP_TAC o ISPEC `t:(A)loop->((A->bool)->bool)` o MATCH_MP CARD_IMAGE_LE) THEN REMOVE_THEN "F4" SUBST1_TAC THEN REMOVE_THEN "F2" (fun th-> (DISCH_THEN (fun th1 -> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1))))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "GG"(fun th->(USE_THEN "G1"(fun th1->(MP_TAC(MATCH_MP CARD_SUBSET (CONJ th th1)))))) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (LABEL_TAC "G3" o REWRITE_RULE[LE_ANTISYM]) THEN MATCH_MP_TAC CARD_SUBSET_EQ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `S:(A)loop->bool SUBSET NF:(A)loop->bool` (LABEL_TAC "F6") THENL[EXPAND_TAC "S" THEN SET_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `S:(A)loop->bool = NF:(A)loop->bool` (LABEL_TAC "F7") THENL[MATCH_MP_TAC SUBSET_ANTISYM THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[SUBSET] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "G7") 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]))) THEN DISCH_THEN (MP_TAC o CONJUNCT2) THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G9") (LABEL_TAC "G10"))) THEN SUBGOAL_THEN `face_loop (H:(A)hypermap) (y:A) IN face_collection H` MP_TAC THENL[REWRITE_TAC[face_collection;IN_ELIM_THM] THEN EXISTS_TAC `y:A` THEN USE_THEN "G9" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F5" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "G11") THEN SUBGOAL_THEN `y:A belong face_loop (H:(A)hypermap) y` (LABEL_TAC "G12") THENL[REWRITE_TAC[belong; face_loop_rep; face; orbit_reflect]; ALL_TAC] THEN ABBREV_TAC `L' = face_loop (H:(A)hypermap) y` THEN SUBGOAL_THEN `x:(A)loop = L'` SUBST1_TAC THENL[MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN USE_THEN "F6"(fun th-> (USE_THEN "G11" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)]))); ALL_TAC] THEN USE_THEN "G11" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN STRIP_TAC THENL[USE_THEN "F7" (SUBST1_TAC o SYM) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `is_edge_nondegenerate (H:(A)hypermap)` (LABEL_TAC "F8") THENL[REWRITE_TAC[lemma_edge_nondegenerate] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "G1") THEN SUBGOAL_THEN `x:A belong face_loop (H:(A)hypermap) x` (LABEL_TAC "G2") THENL[REWRITE_TAC[belong; face_loop_rep; face; orbit_reflect]; ALL_TAC] THEN SUBGOAL_THEN `face_loop (H:(A)hypermap) x IN face_collection H` MP_TAC THENL[REWRITE_TAC[face_collection; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ABBREV_TAC `L = face_loop (H:(A)hypermap) x` THEN USE_THEN "F5" (SUBST1_TAC o SYM) THEN EXPAND_TAC "S" THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G3") MP_TAC) THEN USE_THEN "F1"(fun th ->REWRITE_TAC[MATCH_MP lemma_canonical_function th]) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "G4") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "G5")))) THEN REMOVE_THEN "G4" MP_TAC THEN USE_THEN "G3" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (SUBST_ALL_TAC o SYM o MATCH_MP lemma_cycle_eq) THEN POP_ASSUM (MP_TAC o SPEC `x:A`) THEN USE_THEN "G2" (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (ASSUME_TAC o CONJUNCT2) 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))))))) 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))))))) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN (CONJUNCTS_THEN2 (ASSUME_TAC) (MP_TAC)) THEN POP_ASSUM SUBST1_TAC THEN DISCH_TAC THEN DISCH_THEN (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] 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 THENL[ GEN_TAC THEN DISCH_THEN (LABEL_TAC "G1") THEN SUBGOAL_THEN `x:A belong face_loop (H:(A)hypermap) x` (LABEL_TAC "G2") THENL[REWRITE_TAC[belong; face_loop_rep; face; orbit_reflect]; ALL_TAC] THEN SUBGOAL_THEN `face_loop (H:(A)hypermap) x IN face_collection (H:(A)hypermap)` MP_TAC THENL[REWRITE_TAC[face_collection; IN_ELIM_THM] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN USE_THEN "F5" (SUBST1_TAC o SYM) THEN USE_THEN "F7" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "G3") THEN REWRITE_TAC[GSYM face_loop_rep; GSYM belong] THEN ABBREV_TAC `L = face_loop (H:(A)hypermap) x` THEN ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`] THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [NOT_EXISTS_THM; DE_MORGAN_THM; TAUT `~ ~A <=> A`] THEN STRIP_TAC THEN SUBGOAL_THEN `dart_of (L:(A)loop) SUBSET node (H:(A)hypermap) (x:A)` MP_TAC THENL[REWRITE_TAC[SUBSET; GSYM belong] THEN GEN_TAC THEN POP_ASSUM (LABEL_TAC "G20") THEN DISCH_THEN (LABEL_TAC "G21") THEN REMOVE_THEN "G20" (MP_TAC o SPEC `x':A`) 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)))))))) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th -> REWRITE_TAC[th])) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[node; orbit_reflect]; ALL_TAC] THEN USE_THEN "F1" (fun th -> (USE_THEN "G3" (fun th1-> REWRITE_TAC[MATCH_MP lemma_loop_outside_node (CONJ th th1)]))); ALL_TAC] THEN USE_THEN "F7" (SUBST1_TAC o SYM) THEN USE_THEN "F5" SUBST1_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP face_quotient_lemma th]));;
(* Cyclic hypermaps *)
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) /\ (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)))))`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))` THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[IN_UNION]) THEN ASM_CASES_TAC `x:A IN support_list (p:num->A) (k:num)` THENL[ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM]) THEN STRIP_TAC THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `(q:num->A) (SUC i MOD SUC k)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "F1" MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM]) THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `(p:num->A) (((i:num) + (k:num)) MOD (SUC k))` THEN ASM_REWRITE_TAC[]);;
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) /\ ((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))))`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))` THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[IN_UNION]) THEN ASM_CASES_TAC `x:A IN support_list (p:num->A) (k:num)` THENL[ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM]) THEN STRIP_TAC THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `(q:num->A) i` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "F1" MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM]) THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `(p:num->A) i` THEN ASM_REWRITE_TAC[]);;
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) /\ (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)))))`,
REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))` THENL[EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM (ASSUME_TAC o REWRITE_RULE[]) THEN ASM_REWRITE_TAC[] THEN POP_ASSUM (LABEL_TAC "F1" o REWRITE_RULE[IN_UNION]) THEN ASM_CASES_TAC `x:A IN support_list (p:num->A) (k:num)` THENL[ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM]) THEN STRIP_TAC THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `(p:num->A) ((SUC i) MOD (SUC k))` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "F1" MP_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[support_list; IN_ELIM_THM]) THEN STRIP_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `(q:num->A) ((i + k) MOD (SUC k))` THEN ASM_REWRITE_TAC[]);;
let lemma_cyclic_edge_map = new_specification ["cyc_emap"] (REWRITE_RULE[SKOLEM_THM] edge_cyclic_map_lemma);;
let lemma_cyclic_node_map = new_specification ["cyc_nmap"] (REWRITE_RULE[SKOLEM_THM] node_cyclic_map_lemma);;
let lemma_cyclic_face_map = new_specification ["cyc_fmap"] (REWRITE_RULE[SKOLEM_THM] face_cyclic_map_lemma);;
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 ==> (!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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN STRIP_TAC THENL[MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(p:num->A) i`] lemma_cyclic_edge_map)) THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `p:num->A` lemma_element_in_list) th)) 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]) THENL[REWRITE_TAC[IN_UNION; GSYM in_list] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F5" (fun th -> REWRITE_TAC[REWRITE_RULE[in_list] th]) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC))) THEN USE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`] o REWRITE_RULE[lemma_inj_list2]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(q:num->A) i`] lemma_cyclic_edge_map)) THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `q:num->A` lemma_element_in_list) th)) 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]) THENL[REWRITE_TAC[IN_UNION; GSYM in_list] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~((q:num->A) i IN (support_list p (k:num)))`(fun th -> REWRITE_TAC[th]) THENL[REWRITE_TAC[GSYM in_list] THEN USE_THEN "F3" (MP_TAC o SPEC `i:num` o REWRITE_RULE[lemma_list_disjoint2]) THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC))) THEN USE_THEN "F2" (MP_TAC o SPECL[`j:num`; `i:num`] o REWRITE_RULE[lemma_inj_list2]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
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 ==> (!i:num. i <= k ==> cyc_nmap p q k (p i) = q i /\ cyc_nmap p q k (q i) = p i)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN STRIP_TAC THENL[MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(p:num->A) i`] lemma_cyclic_node_map)) THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `p:num->A` lemma_element_in_list) th)) 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]) THENL[REWRITE_TAC[IN_UNION; GSYM in_list] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F5" (fun th -> REWRITE_TAC[REWRITE_RULE[in_list] th]) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC))) THEN USE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`] o REWRITE_RULE[lemma_inj_list2]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(q:num->A) i`] lemma_cyclic_node_map)) THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `q:num->A` lemma_element_in_list) th)) 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]) THENL[REWRITE_TAC[IN_UNION; GSYM in_list] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~((q:num->A) i IN (support_list p (k:num)))`(fun th -> REWRITE_TAC[th]) THENL[REWRITE_TAC[GSYM in_list] THEN USE_THEN "F3" (MP_TAC o SPEC `i:num` o REWRITE_RULE[lemma_list_disjoint2]) THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC))) THEN USE_THEN "F2" (MP_TAC o SPECL[`j:num`; `i:num`] o REWRITE_RULE[lemma_inj_list2]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
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 ==> (!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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F4") THEN STRIP_TAC THENL[MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(p:num->A) i`] lemma_cyclic_face_map)) THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `p:num->A` lemma_element_in_list) th)) 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]) THENL[REWRITE_TAC[IN_UNION; GSYM in_list] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F5" (fun th -> REWRITE_TAC[REWRITE_RULE[in_list] th]) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC))) THEN USE_THEN "F1" (MP_TAC o SPECL[`j:num`; `i:num`] o REWRITE_RULE[lemma_inj_list2]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN MP_TAC (CONJUNCT2(SPECL[`p:num->A`; `q:num->A`; `k:num`; `(q:num->A) i`] lemma_cyclic_face_map)) THEN USE_THEN "F4" (fun th -> LABEL_TAC "F5" (MATCH_MP (SPEC `q:num->A` lemma_element_in_list) th)) 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]) THENL[REWRITE_TAC[IN_UNION; GSYM in_list] THEN POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `~((q:num->A) i IN (support_list p (k:num)))`(fun th -> REWRITE_TAC[th]) THENL[REWRITE_TAC[GSYM in_list] THEN USE_THEN "F3" (MP_TAC o SPEC `i:num` o REWRITE_RULE[lemma_list_disjoint2]) THEN USE_THEN "F4"(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (CONJUNCTS_THEN2 (LABEL_TAC "F7") SUBST1_TAC))) THEN USE_THEN "F2" (MP_TAC o SPECL[`j:num`; `i:num`] o REWRITE_RULE[lemma_inj_list2]) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
let cyclic_hypermap = new_definition `!p:num->A q:num->A k:num. cyclic_hypermap p q k 
    = 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)`;;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FF") THEN REWRITE_TAC[cyclic_hypermap] THEN MATCH_MP_TAC lemma_hypermap_rep THEN SUBGOAL_THEN `FINITE (support_list (p:num->A) (k:num) UNION support_list (q:num->A) k)` (LABEL_TAC "F1") THENL[REWRITE_TAC[FINITE_UNION; lemma_finite_list]; ALL_TAC] THEN USE_THEN "F1" (fun th->REWRITE_TAC[th]) THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_permutes_via_surjetive THEN USE_THEN "F1" (fun th->REWRITE_TAC[th]) THEN REWRITE_TAC[lemma_cyclic_edge_map] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM] THEN STRIP_TAC THENL[DISJ2_TAC THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `SUC i MOD SUC k` THEN REWRITE_TAC[LE_MOD_SUC] THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_emap) THEN POP_ASSUM (fun th->REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1) THEN SIMP_TAC[]; ALL_TAC] THEN DISJ1_TAC THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `((i:num) + (k:num)) MOD SUC k` THEN REWRITE_TAC[LE_MOD_SUC] THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_emap) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) THEN SIMP_TAC[]; ALL_TAC] THEN GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM] THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `(q:num->A) (SUC i MOD SUC k)` 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) THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC 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))] THEN REWRITE_TAC[MATCH_MP MOD_ADD_MOD (SPEC `k:num` NON_ZERO)] THEN REWRITE_TAC[ADD] THEN REWRITE_TAC[GSYM ADD_SUC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[(REWRITE_RULE[MULT_CLAUSES] (SPECL[`1`; `SUC k`; `i:num`] MOD_MULT_ADD))] THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP MOD_LT (REWRITE_RULE[GSYM LT_SUC_LE] th)]); ALL_TAC] THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `(p:num->A) (((i:num) + k) MOD SUC k)` 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) THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (fun th->REWRITE_TAC[MATCH_MP lemma_from_index th]); ALL_TAC] THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_permutes_via_surjetive THEN USE_THEN "F1" (fun th->REWRITE_TAC[th]) THEN REWRITE_TAC[lemma_cyclic_node_map] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM] THEN STRIP_TAC THENL[DISJ2_TAC THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `i:num` THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_nmap) THEN POP_ASSUM (fun th->REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1) THEN SIMP_TAC[]; ALL_TAC] THEN DISJ1_TAC THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `i:num` THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_nmap) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) THEN SIMP_TAC[]; ALL_TAC] THEN GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM] THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `(q:num->A) i` 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)) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `(p:num->A) i` 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))) THEN SIMP_TAC[]; ALL_TAC] THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_permutes_via_surjetive THEN USE_THEN "F1" (fun th->REWRITE_TAC[th]) THEN REWRITE_TAC[lemma_cyclic_face_map] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM] THEN STRIP_TAC THENL[DISJ1_TAC THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `SUC i MOD SUC k` THEN REWRITE_TAC[LE_MOD_SUC] THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_fmap) THEN POP_ASSUM (fun th->REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT1) THEN SIMP_TAC[]; ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `((i:num) + (k:num)) MOD SUC k` THEN REWRITE_TAC[LE_MOD_SUC] THEN USE_THEN "FF" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_cyclic_fmap) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]) THEN DISCH_THEN (SUBST1_TAC o CONJUNCT2) THEN SIMP_TAC[]; ALL_TAC] THEN GEN_TAC THEN REWRITE_TAC[IN_UNION; support_list; IN_ELIM_THM] THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `(p:num->A) (((i:num) + (k:num)) MOD SUC k)` 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) THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN POP_ASSUM (fun th->REWRITE_TAC[MATCH_MP lemma_from_index th]); ALL_TAC] THEN POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `(q:num->A) (SUC i MOD SUC k)` 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) THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma_from_index2 th]); ALL_TAC] THEN REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~(x:A IN (support_list (p:num->A) (k:num)) UNION (support_list (q:num->A) k))` THENL[POP_ASSUM (LABEL_TAC "G10") THEN MP_TAC (CONJUNCT1(SPECL[`p:num->A`; `q:num->A`; `k:num`; `x:A`] lemma_cyclic_face_map)) THEN USE_THEN "G10" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT1(SPECL[`p:num->A`; `q:num->A`; `k:num`; `x:A`] lemma_cyclic_node_map)) THEN USE_THEN "G10" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (CONJUNCT1(SPECL[`p:num->A`; `q:num->A`; `k:num`; `x:A`] lemma_cyclic_edge_map)) THEN USE_THEN "G10" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[IN_UNION; support_list; IN_ELIM_THM]) THEN STRIP_TAC THENL[POP_ASSUM SUBST1_TAC THEN POP_ASSUM (LABEL_TAC "H1") 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)) 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) 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) THEN AP_TERM_TAC THEN POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma_from_index2 th]); ALL_TAC] THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (LABEL_TAC "H1") 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)) 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) 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) THEN AP_TERM_TAC THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP lemma_from_index th]));;
(* no double joints *)
let is_no_double_joins = new_definition `is_no_double_joins (H:(A)hypermap) 
   <=> (!x y. x IN dart H /\ y IN node H x /\ edge_map H y IN node H (edge_map H x) ==> x = y)`;;
let margin_in_support_darts = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool) x:A. is_normal H NF /\ x IN support_darts NF ==> head H NF x IN support_darts NF /\ tail H NF x IN support_darts NF`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[lemma_in_support])) THEN DISCH_THEN (X_CHOOSE_THEN `L:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4"))) THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_in_support2 THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[belong] THEN MATCH_MP_TAC lemma_in_subset THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN USE_THEN "F4"(fun th -> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th]) 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)))]))) THEN REWRITE_TAC[atom_reflect]; ALL_TAC] THEN MATCH_MP_TAC lemma_in_support2 THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[belong] THEN MATCH_MP_TAC lemma_in_subset THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN USE_THEN "F4" (fun th->REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th]) 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)))]))) THEN REWRITE_TAC[atom_reflect]);;
let lemmaQuotientNoDoubleJoins = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). is_normal H NF /\ is_no_double_joins H /\ plain_hypermap H ==> is_no_double_joins (quotient H NF)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN REWRITE_TAC[is_no_double_joins] THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))) THEN USE_THEN "F5" (MP_TAC o MATCH_MP lemma_node_subset) THEN DISCH_THEN (fun th-> (USE_THEN "F6" (fun th1 -> LABEL_TAC "F8" (MATCH_MP lemma_in_subset (CONJ th th1))))) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_quotient) THEN DISCH_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC (SUBST_ALL_TAC o CONJUNCT1)) THEN REMOVE_THEN "F5" MP_TAC THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP atom_via_choice th]) THEN DISCH_THEN (X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 (LABEL_TAC "F5") MP_TAC)) THEN USE_THEN "F1" (fun th -> ONCE_REWRITE_TAC[CONJUNCT2 (SPEC `a:A`(MATCH_MP choice_at_margin th))]) THEN DISCH_THEN SUBST_ALL_TAC THEN REMOVE_THEN "F8" MP_TAC THEN USE_THEN "F1" (fun th-> ONCE_REWRITE_TAC[MATCH_MP atom_via_choice th]) THEN DISCH_THEN (X_CHOOSE_THEN `b:A` (CONJUNCTS_THEN2 (LABEL_TAC "F8") MP_TAC)) 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))]) THEN DISCH_THEN SUBST_ALL_TAC THEN REMOVE_THEN "F7" MP_TAC THEN USE_THEN "F1" (fun th-> (USE_THEN "F5" (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1))))) 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))]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F1" (fun th-> (USE_THEN "F8" (fun th1 -> MP_TAC (MATCH_MP emap_via_choice (CONJ th th1))))) 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))]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F10") (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F1" (fun th-> (REMOVE_THEN "F5" (fun th1-> (LABEL_TAC "F5" (CONJUNCT1 (MATCH_MP margin_in_support_darts (CONJ th th1))))))) THEN USE_THEN "F1" (fun th-> (REMOVE_THEN "F8" (fun th1-> (LABEL_TAC "F8" (CONJUNCT1 (MATCH_MP margin_in_support_darts (CONJ th th1))))))) THEN ABBREV_TAC `u = head (H:(A)hypermap) (NF:(A)loop->bool) (a:A)` THEN ABBREV_TAC `v = head (H:(A)hypermap) (NF:(A)loop->bool) (b:A)` THEN USE_THEN "F6" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_node3) THEN USE_THEN "F7" MP_TAC THEN USE_THEN "F9" MP_TAC THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_node3) THEN REMOVE_THEN "F2" (MP_TAC o SPECL[`u:A`; `v:A`] o REWRITE_RULE[is_no_double_joins]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_finite_support) THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)])) THEN DISCH_THEN SUBST1_TAC THEN SIMP_TAC[]);;
let lemmaSimpleQuotient = 
prove(`!H:(A)hypermap NF:(A)loop->bool. is_normal H NF ==> (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))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F2" o REWRITE_RULE[simple_hypermap]) THEN REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6")))) THEN REMOVE_THEN "F2" (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN USE_THEN "F3" (fun th-> (USE_THEN "F4" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)]))) THEN DISCH_THEN (LABEL_TAC "F2") THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1 -> MP_TAC (MATCH_MP lemma_in_support2 (CONJ th1 th)))) 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)))))) 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))]))) 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))]))) THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F5" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP] 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)))))) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_SING; EQ_SYM]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "F2") THEN REWRITE_TAC[simple_hypermap] THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM] 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))) THEN REWRITE_TAC[SUBSET; IN_SING] THEN GEN_TAC THEN REWRITE_TAC[IN_INTER] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") MP_TAC) 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))]))) THEN REWRITE_TAC[cycle; IN_ELIM_THM] THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "F6") SUBST_ALL_TAC)) THEN SUBGOAL_THEN `(y:A) IN node (H:(A)hypermap) (x:A)` (LABEL_TAC "F7") THENL[MATCH_MP_TAC lemma_in_node3 THEN EXISTS_TAC `NF:(A)loop->bool` THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F3" (fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th)])) 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))]))) 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))]))) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F2" (MP_TAC o SPECL[`L:(A)loop`; `x:A`; `y:A`]) THEN ASM_REWRITE_TAC[EQ_SYM]; ALL_TAC] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_SING] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_INTER; node_refl; face_refl] );;
let lemmaNodalFixedPoint = 
prove(`!(H:(A)hypermap) (NF:(A)loop->bool). (is_normal H NF /\ simple_hypermap (quotient H NF) ==> (~(is_node_nondegenerate (quotient H NF)) <=> (?(L:(A)loop) x:A. L IN NF /\ x belong L /\ node H x SUBSET (dart_of L))))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REWRITE_TAC[is_node_nondegenerate; NOT_FORALL_THM; NOT_IMP] THEN EQ_TAC THENL[USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN DISCH_THEN (X_CHOOSE_THEN `atm:A->bool` (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "F3"))) THEN REWRITE_TAC[quotient_darts; IN_ELIM_THM] 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))) THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] THEN REMOVE_THEN "F3" MP_TAC THEN REWRITE_TAC[ISPEC `nmap (H:(A)hypermap) (NF:(A)loop->bool)` orbit_one_point] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)]) THEN REWRITE_TAC[GSYM node] THEN DISCH_THEN (LABEL_TAC "F6") THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (fun th1 -> (MP_TAC (MATCH_MP lemma_in_support2 (CONJ th th1))))) THEN USE_THEN "F1" (fun th->DISCH_THEN(fun th1-> (MP_TAC(MATCH_MP lemma_support_QN (CONJ th th1))))) THEN REWRITE_TAC[support_node] 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))]))) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[UNIONS_1] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_atom_sub_loop th]); ALL_TAC] 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"))))) THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (fun th1 -> (LABEL_TAC "F7" (MATCH_MP lemma_in_support2 (CONJ th th1))))) THEN SUBGOAL_THEN `atom (H:(A)hypermap) (L:(A)loop) (x:A) = node H x` (LABEL_TAC "F8") THENL[MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[lemma_atom_sub_node] THEN REWRITE_TAC[SUBSET] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "G1") THEN USE_THEN "F6" (fun th-> USE_THEN "G1" (fun th1-> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1)))) THEN REWRITE_TAC[GSYM belong] THEN DISCH_THEN (LABEL_TAC "G2") THEN USE_THEN "G2" (fun th-> USE_THEN "F4" (fun th1 -> (LABEL_TAC "G3" (MATCH_MP lemma_in_support2 (CONJ th th1))))) 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)))))) 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))]))) 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))]))) THEN DISCH_THEN (LABEL_TAC "G4") THEN USE_THEN "G2" MP_TAC THEN USE_THEN "F5" MP_TAC THEN REWRITE_TAC[IMP_IMP] 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)))))) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] THEN USE_THEN "F2" (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` o REWRITE_RULE[simple_hypermap]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN USE_THEN "F4"(fun th->USE_THEN "F5"(fun th1->REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)])) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[atom_reflect]; ALL_TAC] THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN USE_THEN "F4" (fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_quotient (CONJ th th1)])) THEN POP_ASSUM MP_TAC 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)))]))) THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F1" (fun th-> USE_THEN "F7" (fun th1 -> REWRITE_TAC[CONJUNCT2(CONJUNCT2(MATCH_MP nmap_via_choice (CONJ th th1)))])) THEN USE_THEN "F1" (MP_TAC o SPEC `tail (H:(A)hypermap) (NF:(A)loop->bool) (x:A)` o MATCH_MP choice_reflect) THEN USE_THEN "F1" (fun th -> REWRITE_TAC[SYM(CONJUNCT1(SPEC `x:A` (MATCH_MP choice_at_margin th)))]) THEN USE_THEN "F9" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[node; orbit_map; GE; LE_0; IN_ELIM_THM] THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (MP_TAC o REWRITE_RULE[GSYM COM_POWER] o AP_TERM `node_map (H:(A)hypermap)`)) THEN MP_TAC (AP_THM (SPECL[`n:num`; `node_map (H:(A)hypermap)`] COM_POWER) `x:A`) THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `SUC n`]lemma_in_node2) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F1" (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP choice_identity (CONJ th th1)])));;
(* Complementary contours and complementary contour loops - name: complement. Only for face contours *)
let ind = new_recursive_definition num_RECURSION 
   `(!H:(A)hypermap x:A. ind H x 0 = 0) 
    /\ (!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))))`;;
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))`;;
let complement = new_definition `!H:(A)hypermap x:A n:num. complement H x n = mirror H x n n`;;
let lemma_node_nondegenerate = 
prove(`!H:(A)hypermap. is_node_nondegenerate H <=> (!x:A. x IN dart H ==> 2 <= CARD (node H x))`,
GEN_TAC THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F1") THEN GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARD_ATLEAST_2 THEN EXISTS_TAC `node_map (H:(A)hypermap) (x:A)` THEN EXISTS_TAC `x:A` THEN REWRITE_TAC[NODE_FINITE; node_refl] THEN REWRITE_TAC[REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `x:A`; `1`] lemma_in_node2)] THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A` o REWRITE_RULE[is_node_nondegenerate]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[is_node_nondegenerate] THEN REPEAT STRIP_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A`) THEN POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[SPEC `node_map (H:(A)hypermap)` orbit_one_point]) THEN REWRITE_TAC[GSYM node] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[CARD_SINGLETON] THEN ARITH_TAC);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th]) THEN MESON_TAC[lemma_in_node2; POWER_1]);;
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)`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[ind; ONE; POWER; o_THM; I_THM; ADD ] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_dart_inveriant_under_inverse_maps)) THEN DISCH_THEN (fun th-> POP_ASSUM (fun th1 -> MP_TAC (MATCH_MP (REWRITE_RULE[lemma_node_nondegenerate] th1) th))) THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN (LABEL_TAC "F3") THEN REWRITE_TAC[ind; LT_ADD] THEN MP_TAC (SPEC `SUC(SUC n)` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN REMOVE_THEN "F2" (MP_TAC o SPEC `j:num` o MATCH_MP lemma_dart_invariant_power_face) THEN ABBREV_TAC `y:A = (face_map (H:(A)hypermap) POWER j) x` THEN DISCH_TAC THEN REMOVE_THEN "F1" (MP_TAC o SPEC `y:A` o REWRITE_RULE[lemma_node_nondegenerate]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN ARITH_TAC);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC)) THEN SPEC_TAC (`m:num`, `m:num`) THEN INDUCT_TAC THENL[REWRITE_TAC[LT]; ALL_TAC] THEN ASM_CASES_TAC `n:num = m:num` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[MATCH_MP lemma_increasing_index_one (CONJ th th1)])); ALL_TAC] THEN DISCH_THEN(fun th-> POP_ASSUM(fun th1-> ASSUME_TAC(REWRITE_RULE[GSYM LT_LE] (CONJ (REWRITE_RULE[LT_SUC_LE] th) th1)))) 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))))) THEN POP_ASSUM (fun th-> POP_ASSUM (fun thm -> MP_TAC (MATCH_MP thm th))) THEN REWRITE_TAC[IMP_IMP; LT_TRANS]);;
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`,
REPLICATE_TAC 2 GEN_TAC THEN INDUCT_TAC THENL[REWRITE_TAC[LE_0]; ALL_TAC] THEN POP_ASSUM (fun thm-> (DISCH_THEN (fun th-> MP_TAC (MATCH_MP thm th) THEN ASSUME_TAC th))) THEN POP_ASSUM (MP_TAC o SPEC `n:num` o MATCH_MP lemma_increasing_index_one) THEN ARITH_TAC);;
let lemma_segment_complement = 
prove(`!H:(A)hypermap x:A n:num i:num. is_node_nondegenerate H /\ x IN dart H /\ i <= n ==> (!j:num. j <= ind H x i ==> mirror H x i j = mirror H x n j)`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC)) THEN SPEC_TAC (`i:num`, `i:num`) THEN SPEC_TAC (`n:num`, `n:num`) THEN MATCH_MP_TAC num_WF THEN INDUCT_TAC THENL[REWRITE_TAC[LT] 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] THEN POP_ASSUM (LABEL_TAC "F3") THEN DISCH_THEN (LABEL_TAC "F4") THEN GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `i:num = SUC n` THENL[POP_ASSUM SUBST1_TAC THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (fun th -> (POP_ASSUM (fun th1 -> LABEL_TAC "F5" (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th))))) THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F6") THEN REWRITE_TAC[mirror; join] THEN USE_THEN "F5" (LABEL_TAC "F7" o REWRITE_RULE[LT_SUC_LE]) THEN SUBGOAL_THEN `j:num <= ind (H:(A)hypermap) (x:A) (n:num)` (LABEL_TAC "F8") THENL[ASM_CASES_TAC `i:num = n` THENL[POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> (POP_ASSUM(fun th1-> (MP_TAC (REWRITE_RULE[GSYM LT_LE] (CONJ th1 th)))))) 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))))))) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN ARITH_TAC; ALL_TAC] THEN USE_THEN "F8" (fun th -> REWRITE_TAC[th]) 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`)) THEN DISCH_THEN(fun thm-> USE_THEN "F6"(MP_TAC o MATCH_MP thm)) THEN SIMP_TAC[]);;
let lemma_indepentdent_complement = 
prove(`!H:(A)hypermap x:A n:num m:num. is_node_nondegenerate H /\ x IN dart H /\ n <= m ==> complement H x n = mirror H x m n`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (MP_TAC o REWRITE_RULE[LE_EXISTS]))) THEN DISCH_THEN (X_CHOOSE_THEN `i:num` SUBST1_TAC) THEN SPEC_TAC (`i:num`, `i:num`) THEN INDUCT_TAC THENL[REWRITE_TAC[ADD_0; complement]; ALL_TAC] THEN REWRITE_TAC[ADD_SUC] THEN REWRITE_TAC[mirror; join] 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))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[COND_ELIM_THM; MATCH_MP (ARITH_RULE `!n:num i m. n + i <= m ==> n <= m`) th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
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 ==> complement H x n = mirror H x i n`,
REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC)) THEN DISCH_THEN (LABEL_TAC "F3") THEN ASM_CASES_TAC `n:num <= i:num` 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))]))) ;ALL_TAC] THEN REWRITE_TAC[complement] THEN CONV_TAC SYM_CONV THEN POP_ASSUM (ASSUME_TAC o MATCH_MP LT_IMP_LE o REWRITE_RULE[NOT_LE]) THEN REMOVE_THEN "F3" MP_TAC 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))]))));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN SUBGOAL_THEN `!i:num j:num. i < j ==> (id:num->num) i < id j` (LABEL_TAC "F2") THENL[REPEAT GEN_TAC THEN DISCH_THEN ((X_CHOOSE_THEN `k:num` SUBST1_TAC) o REWRITE_RULE[LT_EXISTS]) THEN SPEC_TAC(`k:num`, `k:num`) THEN INDUCT_TAC THENL[USE_THEN "F1" (fun th -> REWRITE_TAC[GSYM ONE; GSYM ADD1; th]); ALL_TAC] THEN REMOVE_THEN "F1" (MP_TAC o SPEC `((i:num) + (SUC k))`) THEN REWRITE_TAC[GSYM ADD_SUC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[LT_TRANS]; ALL_TAC] THEN REPEAT GEN_TAC THEN EQ_TAC THENL[POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN ASM_CASES_TAC `i:num = j:num` THENL[POP_ASSUM SUBST1_TAC THEN ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `j:num < i:num` THENL[REMOVE_THEN "F2" (fun thm -> POP_ASSUM (MP_TAC o MATCH_MP thm)) THEN REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[ARITH_RULE `!a:num b. a < b /\ b < a <=> F`]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LT]) THEN DISCH_THEN (fun th-> POP_ASSUM (fun th1 -> REWRITE_TAC[REWRITE_RULE[GSYM LT_LE] (CONJ th th1)])));;
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)`,
REPEAT GEN_TAC THEN (DISCH_THEN (LABEL_TAC "F1")) THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[EQ_REFL] THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[REWRITE_RULE[LT_LE] th] THEN ASSUME_TAC th) THEN REMOVE_THEN "F1" (fun th-> (MP_TAC (SPECL[`i:num`; `n:num`] (MATCH_MP lemma_inc_monotone th)))) THEN POP_ASSUM (fun th-> REWRITE_TAC[th; LT_LE]) THEN SIMP_TAC[]);;
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)`,
let lemma_num_partition = 
prove(`!id:num->num. id 0 = 0 /\ (!i:num. id i < id (SUC i)) ==> (!n:num. (?i:num. n = id i) \/ (?j:num. id j < n /\ n < id (SUC j)))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN GEN_TAC THEN SUBGOAL_THEN `!i:num. i <= (id:num->num) i` (LABEL_TAC "F3") THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0]; ALL_TAC] THEN USE_THEN "F2" (MP_TAC o SPEC `i:num`) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LET_TRANS) THEN ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `!i:num j:num. i < j ==> (id:num->num) i < id j` (LABEL_TAC "GG") THENL[REPEAT GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV) [LT_EXISTS] THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN SPEC_TAC (`d:num`, `d:num`) THEN INDUCT_TAC THENL[USE_THEN "F2" (fun th-> REWRITE_TAC[GSYM ONE; GSYM ADD1; th]); ALL_TAC] THEN USE_THEN "F2" (MP_TAC o SPEC `(i:num) + (SUC d)`) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[ADD_SUC; IMP_IMP] THEN ARITH_TAC; ALL_TAC] THEN ASM_CASES_TAC `n:num = 0` THENL[DISJ1_TAC THEN EXISTS_TAC `0` THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F4" o REWRITE_RULE[GSYM LT_NZ]) THEN SUBGOAL_THEN `(?x:num. (id:num->num) x < n) /\ (?M:num. !x:num. id x < n ==> x <= M)` MP_TAC THENL[STRIP_TAC THENL[EXISTS_TAC `0` THEN USE_THEN "F1" SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN EXISTS_TAC `n:num` THEN GEN_TAC THEN USE_THEN "F3" (MP_TAC o SPEC `x:num`) THEN REWRITE_TAC[IMP_IMP] THEN ARITH_TAC; ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV) [num_MAX] THEN DISCH_THEN (X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 (LABEL_TAC "F5") (LABEL_TAC "F6"))) THEN SUBGOAL_THEN `(?x:num. n <= (id:num->num) x)` MP_TAC THENL[EXISTS_TAC `n:num` THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV) [num_WOP] THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F7") (LABEL_TAC "F8"))) THEN SUBGOAL_THEN `m:num < k:num` (LABEL_TAC "F9") THENL[USE_THEN "F7" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT; NOT_LE] THEN GEN_REWRITE_TAC (LAND_CONV)[LE_LT] THEN STRIP_TAC THENL[USE_THEN "GG" (fun thm -> POP_ASSUM (MP_TAC o MATCH_MP thm)) THEN USE_THEN "F7" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LET_TRANS) THEN USE_THEN "F5" MP_TAC THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM SUBST_ALL_TAC THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN ASM_CASES_TAC `n:num = (id:num->num) k` THENL[DISJ1_TAC THEN EXISTS_TAC `k:num` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F7" (fun th-> (POP_ASSUM (fun th1 -> (LABEL_TAC "F7" (REWRITE_RULE[GSYM LT_LE] (CONJ th th1)))))) THEN DISJ2_TAC THEN EXISTS_TAC `m:num` THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN REMOVE_THEN "F9" (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC)) THEN ASM_CASES_TAC `1 <= d:num` THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[LE_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (SUBST_ALL_TAC)) THEN REMOVE_THEN "F8" (MP_TAC o SPEC `(m:num) + 1` o ONCE_REWRITE_RULE[GSYM ADD_SUC]) THEN REWRITE_TAC[ARITH_RULE `!a:num b:num. a + 1 < a + 1 + (SUC b)`] THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[NOT_LE; GSYM ADD1]) THEN REMOVE_THEN "F6" (MP_TAC o SPEC `SUC m`) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; ARITH_RULE `d:num < 1 <=> d = 0`]) THEN DISCH_THEN (fun th-> POP_ASSUM (MP_TAC o REWRITE_RULE[th; GSYM ONE; GSYM ADD1])) THEN SIMP_TAC[]);;
let index_representation = 
prove(`!m:num u:num n:num. m < n /\ n < u ==> ?j:num. 1 <= j /\ j < u - m /\ n = m + j`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN REMOVE_THEN "F1" (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN EXISTS_TAC `SUC d` THEN REWRITE_TAC[EQ_REFL; GE_1] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC)) THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [GSYM ADD_ASSOC] THEN REWRITE_TAC[ADD_SUB2] THEN ARITH_TAC);;
let lemma_num_partition2 = 
prove(`!id:num->num. id 0 = 0 /\ (!i:num. id i < id (SUC i)) ==> (!n:num. n = 0 \/ (?i:num j:num. 1 <= j /\ j <= (id (SUC i)) - (id i) /\ n = (id i) + j))`,
GEN_TAC THEN (DISCH_THEN (LABEL_TAC "F1")) THEN GEN_TAC THEN ASM_CASES_TAC `n:num = 0` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th] THEN ASSUME_TAC th) THEN USE_THEN "F1" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_num_partition) THEN STRIP_TAC THENL[POP_ASSUM MP_TAC THEN ASM_CASES_TAC `i:num = 0` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (fun th -> REWRITE_TAC[CONJUNCT1 th]) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; TAUT `~A /\ A <=> F`]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `d:num` THEN EXISTS_TAC `((id:num->num) (SUC d)) - (id d)` THEN REWRITE_TAC[LE_REFL] THEN USE_THEN "F1" (MP_TAC o REWRITE_RULE[LT_EXISTS] o SPEC `d:num` o CONJUNCT2) THEN DISCH_THEN (X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN REWRITE_TAC[ADD_SUB2; GE_1]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN (POP_ASSUM (MP_TAC o REWRITE_RULE[LT_EXISTS])) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST1_TAC)) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN DISCH_THEN(X_CHOOSE_THEN `m:num` (ASSUME_TAC o REWRITE_RULE[GSYM ADD_ASSOC])) THEN EXISTS_TAC `j:num` THEN EXISTS_TAC `SUC d` THEN REWRITE_TAC[EQ_REFL; GE_1] THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM ADD_ASSOC; ADD_SUB2] THEN ARITH_TAC);;
let lemma_complement_path = 
prove(`!(H:(A)hypermap) (x:A). plain_hypermap H /\ is_node_nondegenerate H /\ x IN dart H ==> (!i:num. complement H x (ind H x i) = node_map H ((inverse (face_map H) POWER i) x)) /\ (!i:num. complement H x (SUC (ind H x i)) = inverse (node_map H) ((inverse (face_map H) POWER (SUC i)) x)) /\ (!i:num. face_map H (complement H x (ind H x i)) = complement H x (SUC (ind H x i))) /\ (!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)) /\ (!n:num. is_contour H (complement H x) n)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) 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") THENL[INDUCT_TAC THENL[REWRITE_TAC[POWER; ind; I_THM; complement; mirror; node_contour]; ALL_TAC] 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)))])) THEN REWRITE_TAC[mirror; join] 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)))))) THEN USE_THEN "G1" (fun th -> REWRITE_TAC[REWRITE_RULE[GSYM NOT_LE] th]) THEN REWRITE_TAC[node_contour; ind; ADD_SUB2] THEN REWRITE_TAC[COM_POWER; o_THM] THEN ONCE_REWRITE_TAC[COM_POWER_FUNCTION] THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC i)) x` THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))] THEN REWRITE_TAC[POWER_FUNCTION] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM node_map_inverse_representation; COM_POWER_FUNCTION] THEN POP_ASSUM (LABEL_TAC "G2") THEN MP_TAC (SPEC `SUC i` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (fun th -> (ASSUME_TAC (AP_THM th `x:A`)))) THEN USE_THEN "F3" (MP_TAC o SPEC `j:num` o MATCH_MP lemma_dart_invariant_power_face) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F2" (fun th-> (DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[lemma_node_nondegenerate] th)))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP SUC_PRE_2 th]) THEN REWRITE_TAC[lemma_node_cycle]; ALL_TAC] THEN STRIP_TAC THENL[POP_ASSUM (fun th -> REWRITE_TAC[th]); ALL_TAC] 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") THENL[GEN_TAC 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))))) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LE_SUC_LT] 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))]))) THEN REWRITE_TAC[mirror; join; REWRITE_RULE[GSYM NOT_LE] (SPEC `i:num` LT_PLUS)] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [ADD1; ADD_SUB2] THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [ONE; PRE] THEN REWRITE_TAC[node_contour; POWER_0; I_THM]; ALL_TAC] THEN STRIP_TAC THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] 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") THENL[REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])) THEN GEN_TAC THEN REWRITE_TAC[COM_POWER; o_THM] THEN ABBREV_TAC `y = (node_map (H:(A)hypermap)) ((inverse (face_map H) POWER (i:num)) (x:A))` THEN POP_ASSUM (fun th-> REWRITE_TAC[REWRITE_RULE[node_map_inverse_representation] (SYM th)]) THEN REWRITE_TAC[GSYM (ISPECL[`inverse (face_map (H:(A)hypermap))`; `inverse(node_map (H:(A)hypermap))`; `y:A`] o_THM)] THEN REWRITE_TAC[GSYM inverse2_hypermap_maps] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[face_map_inverse_representation] THEN REWRITE_TAC[GSYM (ISPECL[`inverse (face_map (H:(A)hypermap))`; `inverse(node_map (H:(A)hypermap))`] o_THM)] THEN REWRITE_TAC[GSYM inverse2_hypermap_maps] THEN REWRITE_TAC[GSYM (ISPECL[`edge_map (H:(A)hypermap)`; `edge_map (H:(A)hypermap)`] o_THM)] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[REWRITE_RULE[plain_hypermap] th; I_THM]); ALL_TAC] THEN STRIP_TAC THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] 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") THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4")) THEN SUBGOAL_THEN `(ind (H:(A)hypermap) (x:A) (i:num)) + (j:num) <= ind H x (SUC i)` MP_TAC THENL[REWRITE_TAC[ind; LE_ADD_LCANCEL] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] 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))]))) THEN REWRITE_TAC[mirror; join] THEN USE_THEN "G3" (fun th-> (REWRITE_TAC[MATCH_MP (ARITH_RULE `!n:num j:num. 1 <= j ==> ~(n +j <= n)`) th])) THEN REWRITE_TAC[ADD_SUB2] THEN REWRITE_TAC[node_contour; POWER_FUNCTION] THEN USE_THEN "G3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP LT_SUC_PRE (REWRITE_RULE[LT1_NZ] th))]); ALL_TAC] THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC THEN REWRITE_TAC[lemma_def_contour] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[one_step_contour] THEN SUBGOAL_THEN `ind (H:(A)hypermap) (x:A) 0 = 0 /\ (!i:num. ind H x i < ind H x (SUC i))` MP_TAC 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] THEN DISCH_THEN (MP_TAC o SPEC `i:num` o MATCH_MP lemma_num_partition) THEN STRIP_TAC THENL[DISJ1_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM (fun th1 -> POP_ASSUM (fun th-> MP_TAC (MATCH_MP index_representation (CONJ th th1)))) THEN REWRITE_TAC[ind; ADD_SUB2] THEN DISCH_THEN (X_CHOOSE_THEN `t:num` (CONJUNCTS_THEN2 (LABEL_TAC "F10") (CONJUNCTS_THEN2 (LABEL_TAC "F11") SUBST1_TAC))) THEN USE_THEN "F11" (MP_TAC o MATCH_MP (ARITH_RULE `a:num < PRE b ==> a < b`)) THEN USE_THEN "F10" (fun th -> DISCH_THEN (fun th1 -> USE_THEN "F7"(fun thm -> REWRITE_TAC[MATCH_MP thm (CONJ th th1)]))) THEN REWRITE_TAC[GSYM ADD_SUC] THEN POP_ASSUM (MP_TAC o MATCH_MP (ARITH_RULE `a:num < PRE b ==> SUC a < b`)) THEN POP_ASSUM (MP_TAC o MATCH_MP (ARITH_RULE `1 <= t:num ==> 1 <= SUC t `)) THEN REWRITE_TAC[IMP_IMP] THEN USE_THEN "F7" (fun thm -> DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP thm th])) THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC j)) (x:A)` THEN REWRITE_TAC[COM_POWER; o_THM]);;
let lemma_inj_complement = 
prove(`!H:(A)hypermap x:A. plain_hypermap H /\ simple_hypermap H /\ is_node_nondegenerate H /\ x IN dart H ==> is_inj_contour H (complement H x) (PRE (ind H x (CARD (face H x))))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN REWRITE_TAC[lemma_inj_contour_via_list] THEN USE_THEN "F1"(fun th-> USE_THEN "F3"(fun th1-> USE_THEN "F4"(fun th2-> (LABEL_TAC "GG" (CONJ th (CONJ th1 th2)))))) THEN USE_THEN "GG" (LABEL_TAC "GH" o MATCH_MP lemma_increasing_index_one o CONJUNCT2) 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") 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] THEN USE_THEN "GG" (fun th -> REWRITE_TAC[MATCH_MP lemma_complement_path th]) THEN REWRITE_TAC[lemma_inj_list2] THEN MATCH_MP_TAC WLOG_LT THEN SIMP_TAC[] THEN STRIP_TAC THENL[MESON_TAC[]; ALL_TAC] THEN REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7") THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F8") (CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10"))) THEN ASM_CASES_TAC `i:num = 0` THENL[POP_ASSUM SUBST_ALL_TAC THEN SUBGOAL_THEN `!a:num b:num. 2 <= b ==> PRE (a + (PRE b)) = a + (PRE (PRE b))` (LABEL_TAC "N1") THENL[REPEAT GEN_TAC THEN DISCH_THEN ((X_CHOOSE_THEN `d:num` SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM]) o REWRITE_RULE[LE_EXISTS]) THEN REWRITE_TAC[TWO; ADD_SUC; GSYM ADD1; PRE]; ALL_TAC] THEN USE_THEN "F6" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_num_partition2) THEN USE_THEN "F7" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REWRITE_RULE[LT_NZ] th]) THEN SIMP_TAC[] 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)))) THEN REWRITE_TAC[ind; ADD_SUB2] THEN DISCH_THEN (LABEL_TAC "G3") THEN REMOVE_THEN "F10" (MP_TAC o ONCE_REWRITE_RULE[SYM(SPECL[`H:(A)hypermap`; `x:A`] (CONJUNCT1 ind))]) THEN USE_THEN "GG" (fun th -> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_complement_path th); POWER_0; I_THM]) THEN USE_THEN "GG" (fun th -> MP_TAC(SPECL[`m:num`; `j:num`] (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_complement_path th))))))) THEN USE_THEN "G1" (fun th-> REWRITE_TAC[th]) THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC m)) (x:A)` THEN POP_ASSUM (LABEL_TAC "G4") 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) 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]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ (SPEC `j:num` LT_PLUS) th)]) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))] THEN REWRITE_TAC[POWER_FUNCTION] THEN DISCH_THEN (LABEL_TAC "G6" o SYM) THEN USE_THEN "G6" (fun th-> (ASSUME_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `x:A`; `SUC j`] lemma_in_node2)))) THEN USE_THEN "G4" (fun th-> (MP_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `x:A`; `SUC m`] lemma_power_inverse_in_face2)))) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] THEN USE_THEN "F4" (fun th -> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th])) THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN SUBST_ALL_TAC 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))))) THEN USE_THEN "GH" (fun th -> REWRITE_TAC[GSYM(MATCH_MP lemma_inc_monotone th)]) THEN REWRITE_TAC[GSYM LE_SUC_LT] THEN ONCE_REWRITE_TAC[LE_LT] THEN STRIP_TAC THENL[MP_TAC (SPECL[`x:A`;`SUC m`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` face_map_and_darts))) THEN REWRITE_TAC[GSYM face] THEN POP_ASSUM (fun th -> (LABEL_TAC "G7" th THEN REWRITE_TAC[th; lemma_def_inj_orbit])) THEN DISCH_THEN (MP_TAC o SPECL[`SUC m`; `0`]) THEN REWRITE_TAC[LE_REFL; LT_NZ; NON_ZERO; POWER_0; I_THM] THEN USE_THEN "G5" (fun th-> (REWRITE_TAC[th])); ALL_TAC] THEN POP_ASSUM (SUBST_ALL_TAC o SYM) THEN USE_THEN "F9" (MP_TAC o REWRITE_RULE[ind]) THEN USE_THEN "G4" SUBST1_TAC THEN USE_THEN "F4" (fun th1-> USE_THEN "F3" (fun th-> (LABEL_TAC "G8" (MATCH_MP (REWRITE_RULE[lemma_node_nondegenerate] th) th1)))) THEN USE_THEN "G8" (fun th -> USE_THEN "N1"(fun thm -> REWRITE_TAC[MATCH_MP thm th])) THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (ASSUME_TAC o MATCH_MP (ARITH_RULE `!a:num b. 2 <= b /\ a <= PRE (PRE b) ==> SUC a < b`)) THEN MP_TAC (SPECL[`x:A`;`SUC j`] (MATCH_MP lemma_segment_orbit (SPEC `H:(A)hypermap` node_map_and_darts))) THEN REWRITE_TAC[GSYM node] THEN POP_ASSUM (fun th -> REWRITE_TAC[th;lemma_def_inj_orbit]) THEN DISCH_THEN (MP_TAC o SPECL[`SUC j`; `0`]) THEN REWRITE_TAC[LE_REFL; LT_NZ; NON_ZERO; POWER_0; I_THM] THEN USE_THEN "G6" (fun th-> (REWRITE_TAC[th])); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "H1" o REWRITE_RULE[GSYM LT_NZ]) THEN USE_THEN "H1" (fun th-> USE_THEN "F7" (fun th1-> (LABEL_TAC "H2" (MATCH_MP LT_TRANS (CONJ th th1))))) THEN USE_THEN "F6" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_num_partition2) THEN USE_THEN "H2" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REWRITE_RULE[LT_NZ] th]) THEN SIMP_TAC[] 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)))) THEN REWRITE_TAC[ind; ADD_SUB2] THEN DISCH_THEN (LABEL_TAC "H4") THEN USE_THEN "F6" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_num_partition2) THEN USE_THEN "H1" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REWRITE_RULE[LT_NZ] th]) THEN SIMP_TAC[] 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)))) THEN REWRITE_TAC[ind; ADD_SUB2] THEN DISCH_THEN (LABEL_TAC "H6") THEN REMOVE_THEN "F10" (MP_TAC o ONCE_REWRITE_RULE[SYM(SPECL[`H:(A)hypermap`; `x:A`] (CONJUNCT1 ind))]) THEN USE_THEN "GG" (fun th -> MP_TAC(SPECL[`m:num`; `k:num`] (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_complement_path th))))))) THEN USE_THEN "H3" (fun th-> REWRITE_TAC[th]) THEN ABBREV_TAC `y = (inverse (face_map (H:(A)hypermap)) POWER (SUC m)) (x:A)` THEN POP_ASSUM (LABEL_TAC "H7") 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) 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]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ (SPEC `k:num` LT_PLUS) th)]) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "GG" (fun th -> MP_TAC(SPECL[`u:num`; `v:num`] (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(MATCH_MP lemma_complement_path th))))))) THEN USE_THEN "H5" (fun th-> REWRITE_TAC[th]) THEN ABBREV_TAC `z = (inverse (face_map (H:(A)hypermap)) POWER (SUC u)) (x:A)` THEN POP_ASSUM (LABEL_TAC "H9") 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) 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]) THEN POP_ASSUM (fun th -> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ (SPEC `v:num` LT_PLUS) th)]) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "K2") THEN SUBGOAL_THEN `(z:A) IN face H (y:A)` MP_TAC THENL[USE_THEN "H8" (MP_TAC) THEN USE_THEN "K1" (SUBST1_TAC o SYM) THEN GEN_REWRITE_TAC (LAND_CONV) [MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))] THEN MP_TAC(SPEC `SUC u` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC)) THEN REWRITE_TAC[GSYM lemma_add_exponent_function; ADD_SUC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[lemma_in_face]; ALL_TAC] THEN SUBGOAL_THEN `(z:A) IN node H (y:A)` MP_TAC THENL[USE_THEN "K2" (MP_TAC o SYM) THEN GEN_REWRITE_TAC (LAND_CONV) [GSYM(MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` node_map_and_darts)))] THEN MP_TAC(SPEC `k:num` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` node_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC)) THEN REWRITE_TAC[GSYM lemma_add_exponent_function; ADD_SUC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[lemma_in_node2]; ALL_TAC] THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] THEN SUBGOAL_THEN `y:A IN dart (H:(A)hypermap)` (LABEL_TAC "K3") THENL[USE_THEN "H7" (MP_TAC o SYM) THEN MP_TAC(SPEC `SUC m` (MATCH_MP power_inverse_element_lemma (SPEC `H:(A)hypermap` face_map_and_darts))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (SUBST1_TAC)) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_dart_invariant_power_face th]); ALL_TAC] THEN USE_THEN "K3" (fun th -> USE_THEN "F2" (fun th1 -> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th])) THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN SUBST_ALL_TAC THEN SUBGOAL_THEN `v:num = k:num` (SUBST_ALL_TAC) THENL[MP_TAC (MATCH_MP (ARITH_RULE `!i:num. 1 <= i ==> PRE i < i`) (SPECL[`H:(A)hypermap`; `y:A`] NODE_NOT_EMPTY)) THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list] o MATCH_MP lemma_inj_node_contour) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[node_contour] o SPECL[`v:num`; `k:num`] o REWRITE_RULE[lemma_inj_list2]) THEN USE_THEN "K2" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "H4" (fun th -> REWRITE_TAC[th]) THEN USE_THEN "H6" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN REWRITE_TAC[EQ_ADD_RCANCEL] THEN REMOVE_THEN "F7" (MP_TAC o REWRITE_RULE[LT_ADD_RCANCEL]) THEN USE_THEN "GH" (fun th -> (DISCH_THEN (MP_TAC o REWRITE_RULE[GSYM(MATCH_MP lemma_inc_monotone th)]))) 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))))) THEN USE_THEN "GH" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM(MATCH_MP lemma_inc_monotone th)]) THEN USE_THEN "K1" (fun th-> (MP_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `y:A`; `SUC u`] lemma_in_face)))) THEN DISCH_THEN (SUBST1_TAC o SYM o MATCH_MP lemma_face_identity) THEN DISCH_THEN (LABEL_TAC "K4") THEN DISCH_THEN ((X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) o REWRITE_RULE[LT_EXISTS]) THEN USE_THEN "K1" MP_TAC THEN USE_THEN "H8" (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM (CONJUNCT2 ADD); addition_exponents; o_THM] THEN MP_TAC (SPEC `SUC u` (MATCH_MP power_permutation (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INJECTIVE th]) THEN DISCH_TAC THEN USE_THEN "K4" (MP_TAC o MATCH_MP (ARITH_RULE `!a:num b c. a + b < c ==> b < c`)) THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list] o MATCH_MP lemma_inj_face_contour) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[face_contour] o SPECL[`0`; `SUC d`] o REWRITE_RULE[lemma_inj_list2]) THEN REWRITE_TAC[LE_0; LE_REFL; POWER_0; I_THM] THEN POP_ASSUM (fun th-> MESON_TAC[th; GSYM NON_ZERO]));;
(* Restricted hypermap *)
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)))`;;
let canon = new_definition `!H:(A)hypermap NF:(A)loop->bool. 
    canon H NF = {L |L:(A)loop| L IN NF /\ ?x:A. x belong L /\ L = face_loop H x}`;;
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}`;;
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`,
REWRITE_TAC[belong; canon_darts] THEN SET_TAC[]);;
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`,
REPEAT GEN_TAC THEN EQ_TAC THENL[REWRITE_TAC[canon_darts; IN_UNIONS; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `L:(A)loop` THEN POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM belong] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN MESON_TAC[is_in_canon_darts]);;
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 ==> ~(x IN canon_darts H NF)`,
REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM (MP_TAC o check (is_neg o concl)) THEN ONCE_REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[lemma_in_canon_darts] THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `L':(A)loop = L:(A)loop` SUBST_ALL_TAC THENL[MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] THEN UNDISCH_TAC `L':(A)loop IN canon (H:(A)hypermap) (NF:(A)loop->bool)` THEN SIMP_TAC[canon; IN_ELIM_THM]; ALL_TAC] THEN ASM_REWRITE_TAC[]);;
let GET_EDGE_NONDEGENERATE hpmap = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap))))))));;
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 ==> (!n:num.((face_map H) POWER n) x = (next L POWER n) x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[canon; IN_ELIM_THM]) (LABEL_TAC "F1")) THEN DISCH_THEN ((X_CHOOSE_THEN `y:A` (SUBST_ALL_TAC o CONJUNCT2)) o CONJUNCT2) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[belong; face_loop_rep] THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP lemma_face_identity th]) THEN REWRITE_TAC[power_res_face_map]);;
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 ==> (L IN canon H NF <=> ?x:A. x belong L /\ (!n. ((face_map H) POWER n) x = (next L POWER n) x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F2" o GET_EDGE_NONDEGENERATE) (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F3"))) THEN EQ_TAC THENL[REWRITE_TAC[canon; IN_ELIM_THM] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN EXISTS_TAC `x:A` THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM SUBST1_TAC THEN GEN_TAC THEN REWRITE_TAC[face_loop_rep; GSYM power_res_face_map]; ALL_TAC] THEN DISCH_THEN (X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN REWRITE_TAC[canon; IN_ELIM_THM] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN EXISTS_TAC `x:A` THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[lemma_loop_identity; face_loop_rep] THEN SUBGOAL_THEN `dart_of (L:(A)loop) = face (H:(A)hypermap) (x:A)` (LABEL_TAC "F6") THENL[USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN REWRITE_TAC[face; orbit_map] THEN CONV_TAC SYM_CONV THEN POP_ASSUM MP_TAC THEN SET_TAC[]; ALL_TAC] THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN ASM_CASES_TAC `~((x':A) IN (dart_of (L:(A)loop)))` THENL[POP_ASSUM (LABEL_TAC "F7") THEN USE_THEN "F7" (fun th-> REWRITE_TAC[MATCH_MP lemma_permutes_exception (CONJ (CONJUNCT1 (SPEC `L:(A)loop` lemma_permute_loop)) th)]) THEN REMOVE_THEN "F6" (fun th-> REMOVE_THEN "F7" (LABEL_TAC "F8" o REWRITE_RULE[th])) 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] THEN USE_THEN "F6" (fun th-> POP_ASSUM (LABEL_TAC "F9" o REWRITE_RULE[th])) THEN USE_THEN "F9" (fun th-> REWRITE_TAC[MATCH_MP lemma_face_identity th]) THEN REWRITE_TAC[res; face_refl] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[face; orbit_map; IN_ELIM_THM; GE; LE_0]) THEN DISCH_THEN (X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN REWRITE_TAC[COM_POWER_FUNCTION] THEN USE_THEN "F5" (fun th-> REWRITE_TAC[SPEC `n:num` th]) THEN REWRITE_TAC[COM_POWER_FUNCTION]);;
let GET_SIMPLE_PROPERTY hpmap = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap))))));; let GET_NODE_NONDEGENERATE hpmap = (CONJUNCT1(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] hpmap)))))))));;
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 ==> (L IN canon H NF <=> ?x:A. dart_of L = face H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) 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))) THEN EQ_TAC 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))]))) THEN DISCH_THEN (X_CHOOSE_THEN `y:A` (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2"))) THEN EXISTS_TAC `y:A` THEN USE_THEN "G1" (fun th-> REWRITE_TAC[MATCH_MP lemma_transitive_permutation th]) THEN REWRITE_TAC[face; orbit_map] THEN POP_ASSUM MP_TAC THEN SET_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `x:A` (LABEL_TAC "H1")) 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))]))) 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)))) THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th]) THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[COM_POWER; o_THM] THEN USE_THEN "H2" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_power_next_in_loop) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "H3") THEN LABEL_TAC "H4" (SPECL[`H:(A)hypermap`; `x:A`; `n:num`] lemma_in_face) THEN ABBREV_TAC `y:A = (face_map (H:(A)hypermap) POWER (n:num)) (x:A)` THEN REMOVE_THEN "H4" (fun th-> SUBST_ALL_TAC (MATCH_MP lemma_face_identity th)) THEN USE_THEN "F4" (MP_TAC o SPEC `L:(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]) 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)) THEN USE_THEN "H3" (fun th-> REWRITE_TAC[th; one_step_contour]) THEN STRIP_TAC THEN USE_THEN "H3" (MP_TAC o REWRITE_RULE[belong; POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "H1" (SUBST1_TAC) THEN POP_ASSUM (LABEL_TAC "H4") 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))))) THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_simple_hypermap th; IN_SING]) THEN POP_ASSUM (fun th-> (GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th])) THEN CONV_TAC (LAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[GSYM node_map_inverse_representation] THEN USE_THEN "F2" (MP_TAC o GSYM o SPEC `y:A` o REWRITE_RULE[is_node_nondegenerate]) 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))]))) THEN REWRITE_TAC[IMP_IMP] THEN MESON_TAC[]);;
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 ==> (L IN canon H NF <=> (!x:A. x belong L ==> next L x = face_map H x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN EQ_TAC THENL[DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th -> REWRITE_TAC[REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP lemma_power_canon_next th))]); ALL_TAC] THEN DISCH_THEN (LABEL_TAC "F4") 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]))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F5") (X_CHOOSE_THEN `y:A` (LABEL_TAC "F6" o CONJUNCT2))) 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))]))) THEN EXISTS_TAC `y:A` THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]) THEN INDUCT_TAC THENL[REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN REWRITE_TAC[COM_POWER; o_THM] THEN POP_ASSUM (fun th-> SUBST1_TAC th THEN ASSUME_TAC th) THEN CONV_TAC SYM_CONV THEN USE_THEN "F6" (MP_TAC o SPEC `n:num` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F4" (fun thm -> DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP thm th])));;
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 ==> (~(L IN canon H NF) <=> (?x:A. x belong L /\ next L x = inverse (node_map H) x))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN ONCE_REWRITE_TAC[TAUT `(~A <=> B) <=> (A <=> ~B)`] THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; TAUT `(~A \/ B) <=> (A ==> B)`] THEN USE_THEN "F1" (fun th -> REWRITE_TAC[MATCH_MP lemma_true_loop_via_map th]) THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F2") THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F3") THEN POP_ASSUM (fun th-> REWRITE_TAC[th] THEN (LABEL_TAC "F3" th)) THEN USE_THEN "F2" (fun th-> USE_THEN "F3" (SUBST1_TAC o MATCH_MP th)) THEN REMOVE_THEN "F1" (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5")) 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))))) THEN USE_THEN "F4" (MP_TAC o SPEC `x:A` o REWRITE_RULE[lemma_edge_nondegenerate] o GET_EDGE_NONDEGENERATE) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (LABEL_TAC "F6") THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "F7") THEN USE_THEN "F6" (fun th-> (USE_THEN "F7" (LABEL_TAC "F8" o MATCH_MP th))) THEN USE_THEN "F1" (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "G2") (LABEL_TAC "G3"))) 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]))) THEN DISCH_THEN (MP_TAC o SPEC `x:A` o REWRITE_RULE[is_loop] o CONJUNCT1) THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th; one_step_contour]) THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]));;
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 ==> next L x = face_map H x \/ next L x = inverse(node_map H) x`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") ASSUME_TAC)) 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]))) THEN DISCH_THEN (MP_TAC o SPEC `x:A` o REWRITE_RULE[is_loop] o CONJUNCT1) THEN POP_ASSUM (fun th-> REWRITE_TAC[th; one_step_contour]));;
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 ==> (next L x = face_map H x <=> ~(next L x = inverse(node_map H) x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1" o GET_EDGE_NONDEGENERATE) (LABEL_TAC "F2")) THEN USE_THEN "F2" (STRIP_ASSUME_TAC o MATCH_MP lemma_next_on_normal_loop) THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A` o REWRITE_RULE[lemma_edge_nondegenerate]) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_dart th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN CONV_TAC (RAND_CONV SYM_CONV) THEN REMOVE_THEN "F1" (MP_TAC o SPEC `x:A` o REWRITE_RULE[lemma_edge_nondegenerate]) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_in_dart th]));;
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 ==> (next L x = inverse(node_map H) x <=> ~(next L x = face_map H x))`,
ONCE_REWRITE_TAC[TAUT `(A <=> ~B) <=> (B <=> ~A)`] THEN REWRITE_TAC[lemma_next_exclusive]);;
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 ==> (head H NF x = x <=> next L x = face_map H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN EQ_TAC THENL[DISCH_TAC THEN USE_THEN "F2" (MP_TAC o CONJUNCT2 o MATCH_MP head_on_loop) THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> MP_TAC (MATCH_MP lemma_next_exclusive (CONJ th th1)))) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1 -> REWRITE_TAC [MATCH_MP lemma_next_exclusive (CONJ th th1)])) THEN DISCH_TAC THEN MATCH_MP_TAC lemma_unique_head THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[atom_reflect]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC)) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(CONJUNCT1(MATCH_MP change_parameters th))] THEN MP_TAC th) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC)) THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop) THEN MATCH_MP_TAC lemma_head_via_restricted THEN ASM_REWRITE_TAC[]);;
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 ==> (tail H NF x = x <=> x = face_map H (back L x))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN EQ_TAC THENL[DISCH_TAC THEN USE_THEN "F2" (MP_TAC o CONJUNCT2 o MATCH_MP tail_on_loop) THEN POP_ASSUM SUBST1_TAC THEN REMOVE_THEN "F2" (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN USE_THEN "F5" (LABEL_TAC "F6" o REWRITE_RULE[POWER_1] o SPEC `1` o (MATCH_MP lemma_power_back_in_loop)) 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)`) THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC 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] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_next_exclusive) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN REMOVE_THEN "F2" (CONJUNCTS_THEN2 (LABEL_TAC "F3") (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN USE_THEN "F5" (LABEL_TAC "F6" o REWRITE_RULE[POWER_1] o SPEC `1` o (MATCH_MP lemma_power_back_in_loop)) 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)`) THEN DISCH_THEN SUBST1_TAC THEN DISCH_TAC 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] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_next_exclusive) THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN SIMP_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC lemma_unique_tail THEN EXISTS_TAC `L:(A)loop` THEN ASM_REWRITE_TAC[atom_reflect] THEN USE_THEN "F6" (fun th-> REWRITE_TAC[REWRITE_RULE[POWER_1] (SPEC `1` (MATCH_MP lemma_power_next_in_loop th))]) THEN POP_ASSUM (fun th -> REWRITE_TAC[lemma_inverse_evaluation; th]));;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC)) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(CONJUNCT2(MATCH_MP change_parameters th))] THEN MP_TAC th) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") MP_TAC)) THEN DISCH_THEN (ASSUME_TAC o MATCH_MP lemma_in_loop) THEN MATCH_MP_TAC lemma_tail_via_restricted THEN ASM_REWRITE_TAC[]);;
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 ==> (atom H L x = {x} <=> next L x = face_map H x /\ face_map H (back L x) = x)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (LABEL_TAC "F2" o CONJUNCT2) THEN EQ_TAC THENL[DISCH_THEN (LABEL_TAC "F3") THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o MATCH_MP head_on_loop) THEN USE_THEN "F3" SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_head_via_restricted th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F2" (MP_TAC o CONJUNCT1 o MATCH_MP tail_on_loop) THEN USE_THEN "F3" SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_tail_via_restricted th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th]); ALL_TAC] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")) THEN MATCH_MP_TAC atom_one_point THEN EXISTS_TAC `NF:(A)loop->bool` THEN USE_THEN "F2" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_head_via_restricted) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_tail_via_restricted) THEN USE_THEN "F4" (fun th-> MESON_TAC[SYM th; EQ_SYM]));;
(* the condition which neeeds to split a loop into two other special loops *)
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 
    <=> is_restricted H  /\ is_normal H NF /\ L IN NF /\ ~(L IN canon H NF) /\ x belong L /\ head H NF x = x`;;
let lemma_mInside_Exists = 
prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x ==> ?m:num. ((!i:num. i <= SUC m ==> ((next L POWER i) x = (face_map H POWER i) x)) /\ ~((next L POWER (SUC (SUC m))) x = (face_map H POWER (SUC (SUC m))) x))`,
REPEAT GEN_TAC 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")))))) THEN REMOVE_THEN "F4" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM; NOT_FORALL_THM;NOT_IMP ] THEN DISCH_THEN (LABEL_TAC "F7") 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))]))) THEN EXISTS_TAC `x:A` THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN MATCH_MP_TAC num_WF THEN INDUCT_TAC THENL[REWRITE_TAC[ARITH_RULE `m:num < 0 <=> F`; POWER_0; I_THM]; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F8") THEN DISCH_THEN (LABEL_TAC "F9") THEN ASM_CASES_TAC `n:num = 0` THENL[POP_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[GSYM ONE; POWER_1] THEN CONV_TAC SYM_CONV 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)))))))) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REMOVE_THEN "F7" (MP_TAC o SPEC `d:num`) THEN STRIP_TAC THENL[USE_THEN "F9" (MP_TAC o REWRITE_RULE[LT_SUC_LE] o SPEC `i:num`) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM SUBST1_TAC THEN SIMP_TAC[]);;
(* The notion of flag is actually defined on quotient hypermaps. I only use this notion for those with restricted cover hypermap, so I define that in term of cover hypermaps. *)
let lemma_mInside = new_specification["mInside"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_mInside_Exists);;
let lemma_bound_mInside = 
prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x ==> SUC (mInside H NF L x) < CARD (face H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") 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]) THEN USE_THEN "F1" (LABEL_TAC "F8" o CONJUNCT1 o MATCH_MP lemma_mInside) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT] THEN DISCH_THEN (LABEL_TAC "F9") 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))]))) THEN EXISTS_TAC `x:A` THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]) THEN GEN_TAC THEN MP_TAC (REWRITE_RULE[LT1_NZ; LT_NZ] (SPECL[`H:(A)hypermap`; `x:A`] FACE_NOT_EMPTY)) THEN DISCH_THEN (MP_TAC o SPEC `n:num` o MATCH_MP DIVMOD_EXIST) 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")))) THEN REWRITE_TAC[lemma_add_exponent_function] THEN LABEL_TAC "G2" (SPECL[`H:(A)hypermap`; `x:A`] lemma_face_cycle) THEN USE_THEN "G2" (fun th-> REWRITE_TAC[MATCH_MP power_map_fix_point th]) THEN USE_THEN "F8" (MP_TAC o SPEC `CARD (face (H:(A)hypermap) (x:A))`) THEN USE_THEN "F9" (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP power_map_fix_point th]) THEN REMOVE_THEN "F8" (MP_TAC o SPEC `r:num`) 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])));;
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 ==> ?q:num. m = q * CARD (face H x) + n`,
REWRITE_TAC[face] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma_congruence_on_orbit THEN EXISTS_TAC `dart (H:(A)hypermap)` THEN ASM_REWRITE_TAC[SPEC`H:(A)hypermap` face_map_and_darts]);;
let dart_inside = new_definition `!H:(A)hypermap (NF:(A)loop->bool) (L:(A)loop) (x:A). 
    dart_inside H NF L x = {((face_map H) POWER i) x | i:num | 1 <= i /\ i <= mInside  H NF L x}`;;
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 ==> dart_inside H NF L x SUBSET dart_of L`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN REWRITE_TAC[SUBSET; dart_inside; IN_ELIM_THM; GSYM belong] THEN GEN_TAC THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3")) SUBST1_TAC)) THEN USE_THEN "F1" (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_mInside) 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)))]) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN MATCH_MP_TAC lemma_power_next_in_loop THEN USE_THEN "F1" (fun th-> REWRITE_TAC[REWRITE_RULE[is_split_condition] th]));;
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)`;;
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)) 
    /\ (!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)))`;;
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`;;
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`,
REPEAT GEN_TAC 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")))) THEN USE_THEN "F4" (fun th-> USE_THEN "F3" (ASSUME_TAC o SYM o REWRITE_RULE[LE_REFL; th] o SPEC `n:num`)) THEN USE_THEN "F2" (fun th -> REWRITE_TAC[size; MATCH_MP lemma_transitive_permutation th; face]) THEN STRIP_TAC THENL[USE_THEN "F1"(fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1)])) THEN USE_THEN "F1"(fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1)])) THEN REMOVE_THEN "F1" (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN REWRITE_TAC[LT_SUC_LE] THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o REWRITE_RULE[lemma_add_one_assumption]) THEN REWRITE_TAC[lemma_two_series_eq]; ALL_TAC] THEN USE_THEN "F1"(fun th-> USE_THEN "F4" (fun th1-> REWRITE_TAC[MATCH_MP orbit_cyclic (CONJ th th1); CARD_FINITE_SERIES_LE])));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_mInside) 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) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COM_POWER] THEN REWRITE_TAC[o_THM; LE_REFL; GSYM heading] THEN (DISCH_THEN (LABEL_TAC "F2")) THEN DISCH_THEN (SUBST_ALL_TAC o SYM) THEN ABBREV_TAC `m = SUC (mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A))` THEN POP_ASSUM (LABEL_TAC "FC") THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_split_condition]) THEN DISCH_THEN (LABEL_TAC "F3" o SPEC `m:num` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN ABBREV_TAC `y = (next (L:(A)loop) POWER (m:num)) (x:A)` THEN USE_THEN "F3" MP_TAC THEN USE_THEN "F1" ((CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1))) o REWRITE_RULE[is_split_condition]) THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN USE_THEN "F2" (fun th-> DISCH_THEN (fun th1 -> REWRITE_TAC[REWRITE_RULE[th] (MATCH_MP lemma_next_exclusive th1)])) THEN POP_ASSUM (LABEL_TAC "F4") THEN USE_THEN "F2" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`; `m:num`] lemma_in_face) 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)) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F4" SUBST1_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `y:A`] node_refl) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] 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]) THEN SUBGOAL_THEN `x:A IN dart (H:(A)hypermap)` MP_TAC THENL[MATCH_MP_TAC lemma_in_dart 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]) ; ALL_TAC] THEN DISCH_THEN (fun th-> (POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th; IN_SING]))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F1" (MP_TAC o REWRITE_RULE[POWER_1; GE_1] o SPEC `1` o CONJUNCT1 o MATCH_MP lemma_mInside) THEN SIMP_TAC[]);;
let CONJ3 th1 th2 th3 = (CONJ th1 (CONJ th2 th3));; let CONJ4 th1 th2 th3 th4 = (CONJ th1 (CONJ th2 (CONJ th3 th4)));;
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}) /\ ((face_map (quotient H NF) POWER (SUC m)) (atom H L x) = atom H L ((face_map H POWER (SUC m)) x)))`,
REPEAT GEN_TAC 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")))))) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) 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") THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS)))) THEN USE_THEN "F6" (fun th-> DISCH_THEN (SUBST1_TAC o SYM o MATCH_MP th)) THEN USE_THEN "F4" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop) 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] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_singleton_atom th]) THEN STRIP_TAC THENL[REWRITE_TAC[COM_POWER_FUNCTION] THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS)))) THEN USE_THEN "F6" (fun th-> DISCH_THEN (SUBST1_TAC o MATCH_MP th)) THEN REWRITE_TAC[COM_POWER_FUNCTION] 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] 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])) THEN DISCH_THEN (fun th-> LABEL_TAC "H3" th THEN SUBST1_TAC th) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [GSYM COM_POWER_FUNCTION; lemma_inverse_evaluation] THEN USE_THEN "H3" (fun th-> USE_THEN "H2" (MP_TAC o REWRITE_RULE[th])) THEN DISCH_THEN (MP_TAC o MATCH_MP LE_TRANS o CONJ (SPEC `d:num` LE_PLUS)) THEN DISCH_THEN (fun th-> MP_TAC(MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS)))) THEN DISCH_THEN (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP th1 th; COM_POWER_FUNCTION])) THEN USE_THEN "H3" (fun th-> USE_THEN "H2" (MP_TAC o REWRITE_RULE[th])) THEN DISCH_THEN (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS)))) THEN USE_THEN "F6"(fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC] THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th]) 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") THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM] THEN ARITH_TAC; ALL_TAC] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) THEN ASM_CASES_TAC `i:num = 0` THENL[POP_ASSUM (LABEL_TAC "H3") THEN USE_THEN "H3" (fun th-> REWRITE_TAC[th; GSYM ONE; POWER_1; I_THM]) 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)]))) THEN USE_THEN "F5" SUBST1_TAC THEN USE_THEN "F7" (MP_TAC o SPEC `SUC 0`) THEN USE_THEN "H2" MP_TAC THEN USE_THEN "H3" SUBST1_TAC THEN REWRITE_TAC[GSYM ONE] THEN DISCH_THEN (fun th-> REWRITE_TAC[th; LE_REFL; POWER_1]) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[REWRITE_RULE[GE_1; POWER_1] (SPEC `1` th)]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "H3" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM COM_POWER_FUNCTION] THEN FIRST_ASSUM (MP_TAC o check (is_imp o concl)) 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)])) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F4" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F7" (MP_TAC o SPEC `i:num`) 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)]))) THEN USE_THEN "F6" (MP_TAC o SPEC `i:num`) THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th))) THEN DISCH_THEN (fun th -> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS))]) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "H4") THEN USE_THEN "H4" (fun th-> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN ABBREV_TAC `u = (face_map (H:(A)hypermap) POWER i) x` THEN DISCH_THEN (LABEL_TAC "H5") 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)]))) 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)))))) THEN USE_THEN "H4" SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "u" THEN REWRITE_TAC[COM_POWER_FUNCTION] THEN USE_THEN "H2" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th (SPEC `m:num` LE_PLUS)))) THEN DISCH_THEN(fun th->USE_THEN "F6"(fun th1->GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [SYM(MATCH_MP th1 th)])) 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] THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]) THEN ASM_CASES_TAC `m = 0` THENL[POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM ONE; POWER_1] 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)]))) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "H1" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)[GSYM COM_POWER_FUNCTION] THEN USE_THEN "H1" (fun th-> USE_THEN "F8" (SUBST1_TAC o REWRITE_RULE[th; LE_REFL] o SPEC `m:num`)) THEN USE_THEN "F4" (MP_TAC o SPEC `m:num` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F7" (MP_TAC o SPEC `m:num`) THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th; LE_REFL]) THEN USE_THEN "F6" (MP_TAC o REWRITE_RULE[LE_PLUS] o SPEC `m:num`) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "H2") THEN USE_THEN "H2" (fun th-> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN ABBREV_TAC `u = (face_map (H:(A)hypermap) POWER m) x` THEN DISCH_THEN (LABEL_TAC "H3") 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)]))) 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)))))) THEN USE_THEN "H2" SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN (fun th-> REWRITE_TAC[th]));;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "FC") THEN USE_THEN "FC" (MP_TAC o REWRITE_RULE[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")))))) THEN REWRITE_TAC[heading] THEN USE_THEN "FC" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_mInside) 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 THEN ABBREV_TAC `m = mInside (H:(A)hypermap) NF L x` THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_face_contour_on_loop th]));;
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 ==> SUC (mInside H NF L x) < CARD (cycle H L)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") 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]) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT; CONJUNCT2 LE] THEN STRIP_TAC 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))) 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))))))))) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)]) THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_atom_on_inside_dart th]) THEN DISCH_TAC 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) THEN POP_ASSUM SUBST1_TAC 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)))) THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP lemma_node_identity) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_heading th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F10") 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) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `1 <= CARD (cycle (H:(A)hypermap) (L:(A)loop))` (LABEL_TAC "F11") THENL[MATCH_MP_TAC CARD_ATLEAST_1 THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (x:A)` THEN USE_THEN "F3" (fun th-> (USE_THEN "F4"(fun th1-> REWRITE_TAC[MATCH_MP lemma_cycle_finite (CONJ th th1)]))) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th]); ALL_TAC] THEN USE_THEN "F11" (fun th-> REWRITE_TAC[th]) 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))) 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))))))))) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_quotient th)]) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN ABBREV_TAC `n = CARD (cycle (H:(A)hypermap) (L:(A)loop))` THEN DISCH_TAC THEN MP_TAC (SPECL[`(H:(A)hypermap)`;`(L:(A)loop)`; `(x:A)`] atom_reflect) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN DISCH_THEN (LABEL_TAC "F12" o SYM) 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") THENL[REPEAT STRIP_TAC THEN USE_THEN "F1" (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_mInside) THEN POP_ASSUM(fun th-> USE_THEN "F10" (fun th1 -> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1)))) 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))]) ; ALL_TAC] THEN USE_THEN "F14" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `n:num`) THEN USE_THEN "F12" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F15") 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))]))) THEN EXISTS_TAC `x:A` 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] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_loop_eq_face th]));;
let lemma_mAdd_Exists = 
prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x ==> ?p:num. (!i:num. 1 <= i /\ i <= p ==> ~((face_map H POWER i) (heading H NF L x) IN support_darts NF)) /\ ((face_map H POWER (SUC p)) (heading H NF L x) IN support_darts NF)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F2") 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 THENL[POP_ASSUM (MP_TAC o SYM o REWRITE_RULE[heading]) THEN REWRITE_TAC[MATCH_MP inverse_power_function (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))] 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))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN DISCH_THEN (MP_TAC o AP_TERM `face_map (H:(A)hypermap) POWER (CARD (face H (x:A)))`) THEN REWRITE_TAC[lemma_face_cycle; GSYM lemma_add_exponent_function] THEN ABBREV_TAC `k = CARD (face (H:(A)hypermap) (x:A)) + (j:num)` 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)))) THEN DISCH_THEN (ASSUME_TAC o SYM) THEN EXISTS_TAC `k:num` THEN POP_ASSUM (SUBST1_TAC) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[lemma_in_support] THEN EXISTS_TAC `L:(A)loop` THEN POP_ASSUM (fun th-> (REWRITE_TAC[REWRITE_RULE[is_split_condition] th])); ALL_TAC] THEN POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE[num_WOP]) 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"))) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (SUBST_ALL_TAC o REWRITE_RULE[GSYM ADD1])) THEN EXISTS_TAC `d:num` THEN REMOVE_THEN "F3" (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[LT_SUC_LE; DE_MORGAN_THM]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `(A ==> ~B \/ C) <=> (A /\ B ==> C)`] THEN SIMP_TAC[]);;
let lemma_mAdd = new_specification["mAdd"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_mAdd_Exists);;
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) /\
(L IN canon H NF ==> canon_flag H NF) /\ (~(L IN canon H NF) ==> flag H NF L x)`;;
let lemma_marked_dart = 
prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_marked H NF L x ==> head H NF x = x /\ inverse (node_map H) x IN canon_darts H NF`,
REPEAT GEN_TAC THEN REWRITE_TAC[is_marked] 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)))))) 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)))))))) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_canon_darts]) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F6") (LABEL_TAC "F7"))) THEN USE_THEN "F7" (MP_TAC o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop) 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)))))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[CONJUNCT1 (SPEC `H:(A)hypermap` inverse2_hypermap_maps)] THEN REWRITE_TAC[o_THM; MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))] THEN USE_THEN "F6"(fun th-> DISCH_THEN(fun th1-> REWRITE_TAC[MATCH_MP is_in_canon_darts (CONJ th1 th)])));;
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) ==> is_split_condition H NF L x`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") ASSUME_TAC) THEN REWRITE_TAC[is_split_condition] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_marked_dart th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[REWRITE_RULE[is_marked] th]));;
let attach = new_definition `!H:(A)hypermap (NF:(A)loop->bool) (L:(A)loop) (x:A). 
    attach H NF L x = ((face_map H) POWER (SUC (mAdd H NF L x))) (heading H NF L x)`;;
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`,
REWRITE_TAC[attach; heading; GSYM lemma_add_exponent_function; lemma_in_face]);;
let lemma_on_attach = 
prove(`!H:(A)hypermap NF:(A)loop->bool L:(A)loop x:A. is_split_condition H NF L x ==> ~(node H (heading H NF L x) = node H (attach H NF L x)) /\ SUC (mAdd H NF L x) < CARD (face H x)`,
REPEAT GEN_TAC THEN DISCH_THEN (LABEL_TAC "F1") THEN USE_THEN "F1" (LABEL_TAC "F2" o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_split_condition]) 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]) 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)))))) THEN STRIP_TAC THENL[ USE_THEN "F1" (LABEL_TAC "F3" o CONJUNCT1 o MATCH_MP lemma_mInside) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_mAdd) THEN GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [TAUT `(A ==> ~B) <=> ~(A /\B)`; GSYM NOT_EXISTS_THM] THEN REWRITE_TAC[CONTRAPOS_THM] THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F4") THEN REWRITE_TAC[attach] THEN ABBREV_TAC `p = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `y:A`; `SUC p`] lemma_in_face) THEN MP_TAC(SPECL[`H:(A)hypermap`; `(face_map (H:(A)hypermap) POWER (SUC p)) (y:A)`] node_refl) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] THEN POP_ASSUM (LABEL_TAC "F5") THEN USE_THEN "FA" (MP_TAC o SPEC `SUC m` o MATCH_MP lemma_dart_invariant_power_face) THEN EXPAND_TAC "m" THEN USE_THEN "F5" (fun th-> REWRITE_TAC[GSYM heading; th]) THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F6" (ASSUME_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN USE_THEN "F9" (fun th-> (POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th; IN_SING]))) THEN ASM_CASES_TAC `p:num = 0` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th; GSYM ONE; POWER_1]) THEN ONCE_REWRITE_TAC[SPEC `face_map (H:(A)hypermap)` orbit_one_point] THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[GSYM face]) 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]) THEN DISCH_THEN (MP_TAC o SPEC `y:A`) THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th; CARD_SINGLETON]) THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F10" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN USE_THEN "F5" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV)[SYM th]) THEN REWRITE_TAC[heading; COM_POWER; o_THM;face_map_injective] THEN USE_THEN "F4" SUBST1_TAC THEN USE_THEN "F3" (fun th-> MP_TAC(MATCH_MP th (MATCH_MP LT_IMP_LE (SPEC `m:num` LT_PLUS)))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN DISCH_TAC THEN EXISTS_TAC `p:num` THEN POP_ASSUM SUBST1_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th; LE_REFL]) THEN MATCH_MP_TAC lemma_in_support2 THEN EXISTS_TAC `L:(A)loop` THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC] THEN SUBGOAL_THEN `1 < CARD (face (H:(A)hypermap) (x:A))` MP_TAC THENL[ 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]) THEN DISCH_THEN (fun th-> USE_THEN "FA" (MP_TAC o MATCH_MP th)) THEN REWRITE_TAC[THREE] THEN ARITH_TAC; ALL_TAC] 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]) THEN DISCH_THEN (LABEL_TAC "F9") THEN USE_THEN "F9" SUBST1_TAC THEN REWRITE_TAC[LT_SUC] THEN USE_THEN "F1" (MP_TAC o SPEC `PRE (CARD (face (H:(A)hypermap) (x:A)))` o CONJUNCT1 o MATCH_MP lemma_mAdd) THEN USE_THEN "F9" SUBST1_TAC THEN REWRITE_TAC[PRE; GE_1] THEN REWRITE_TAC[GSYM NOT_LT] THEN REWRITE_TAC[CONTRAPOS_THM] THEN SIMP_TAC[] THEN DISCH_THEN (fun th-> (MATCH_MP_TAC th)) THEN REWRITE_TAC[heading] THEN REWRITE_TAC[GSYM (SPEC `face_map (H:(A)hypermap)` lemma_add_exponent_function)] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ARITH_RULE `!m:num n:num. (SUC m) + (SUC n) = m + SUC (SUC n)`] THEN USE_THEN "F9" (SUBST1_TAC o SYM) THEN REWRITE_TAC[SPEC `face_map (H:(A)hypermap)` lemma_add_exponent_function] THEN REWRITE_TAC[lemma_face_cycle] 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) THEN REWRITE_TAC[LE_PLUS] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN MATCH_MP_TAC lemma_in_support2 THEN EXISTS_TAC `L:(A)loop` THEN USE_THEN "F2" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]) THEN USE_THEN "F8" (fun th-> REWRITE_TAC[th]));;
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)`,
REPEAT GEN_TAC THEN (DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2"))) THEN SUBGOAL_THEN `?g:num->A m:num. is_Moebius_contour (H:(A)hypermap) (g:num->A) (m:num)` MP_TAC THENL[POP_ASSUM MP_TAC 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`] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemmaICJHAOQ) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN EXISTS_TAC `p:num->A` THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[lemmaLIPYTUI]);;
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) ==> 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))`,
REPEAT GEN_TAC THEN DISCH_THEN (fun th -> LABEL_TAC "FC" (CONJUNCT1 th) THEN LABEL_TAC "F1" (MATCH_MP lemma_split_marked_loop th)) 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]) THEN SUBGOAL_THEN `flag (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` (LABEL_TAC "F2") THENL[USE_THEN "F6" MP_TAC THEN USE_THEN "FC" (fun th-> REWRITE_TAC[REWRITE_RULE[is_marked] th]); ALL_TAC] THEN USE_THEN "F1" ((CONJUNCTS_THEN2 (LABEL_TAC "F9") (LABEL_TAC "F10")) o MATCH_MP lemma_mInside) 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) THEN USE_THEN "F1" (LABEL_TAC "HD" o REWRITE_RULE[heading] o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN REWRITE_TAC[attach; heading] THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN ABBREV_TAC `p = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "PN") THEN ABBREV_TAC `y = (face_map (H:(A)hypermap) POWER (SUC m)) (x:A)` THEN POP_ASSUM (LABEL_TAC "F14") THEN ABBREV_TAC `z = (face_map (H:(A)hypermap) POWER (SUC p)) (y:A)` THEN POP_ASSUM (LABEL_TAC "F15") THEN SUBGOAL_THEN `!k:num. 1 <= k /\ k <= SUC m ==> ~((z:A) = (face_map H POWER k) (x:A))` (LABEL_TAC "F16") THENL[GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM; NOT_LE] THEN USE_THEN "F15" (SUBST1_TAC o SYM) THEN ASM_CASES_TAC `k:num < 1` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM ADD1] o ONCE_REWRITE_RULE[GSYM ADD_SYM] o REWRITE_RULE[NOT_LT; LE_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[COM_POWER; o_THM; face_map_injective] THEN DISCH_THEN (LABEL_TAC "G1") THEN ASM_CASES_TAC `p:num = 0` THENL[POP_ASSUM (fun th-> POP_ASSUM (MP_TAC o REWRITE_RULE[th; POWER_0; I_THM])) THEN USE_THEN "F14" (SUBST1_TAC o SYM) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_bound_mInside) THEN USE_THEN "MN" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_congruence_on_face) THEN DISCH_THEN (X_CHOOSE_THEN `q:num` MP_TAC) THEN ARITH_TAC ; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G2" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN ASM_CASES_TAC `SUC m < SUC d` THENL[POP_ASSUM (fun th-> SIMP_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "G3" o REWRITE_RULE[NOT_LT]) THEN USE_THEN "F11" (MP_TAC o SPEC `p:num`) THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th; LE_REFL]) THEN DISCH_TAC THEN USE_THEN "F7" (MP_TAC o SPEC `d:num` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F9" (MP_TAC o SPEC `d:num`) THEN USE_THEN "G3" (fun th-> (REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (MATCH_MP LT_IMP_LE (SPEC `d:num` LT_PLUS)) th)])) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G1" (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> MP_TAC(MATCH_MP lemma_in_support2 (CONJ th th1)))) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F16" (fun th-> REWRITE_TAC[th]) THEN REMOVE_THEN "F12" (MP_TAC o REWRITE_RULE[lemma_in_support]) THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F17") (LABEL_TAC "F18"))) THEN ASM_CASES_TAC `L':(A)loop = L:(A)loop` THENL[POP_ASSUM (SUBST1_TAC o SYM) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F19") THEN ASM_CASES_TAC `L':(A)loop IN canon (H:(A)hypermap) (NF:(A)loop->bool)` THENL[POP_ASSUM (LABEL_TAC "G4") THEN USE_THEN "F15" MP_TAC THEN USE_THEN "F14" (SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] 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)))) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` MP_TAC) THEN USE_THEN "G4" (fun th-> USE_THEN "F18" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_power_canon_next (CONJ th th1)])) THEN DISCH_TAC THEN USE_THEN "F18" (MP_TAC o SPEC `j:num` o MATCH_MP lemma_power_next_in_loop) THEN POP_ASSUM (SUBST1_TAC o SYM) 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] THEN DISCH_THEN (MP_TAC o MATCH_MP disjoint_loops) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F18" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F20") 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))))))) THEN USE_THEN "F21"(fun th->USE_THEN "F18"(fun th1-> LABEL_TAC "F22"(MATCH_MP lemma_in_loop (CONJ th1 th)))) 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") THENL[USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_dart_inside_sub_loop) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[GSYM belong] o MATCH_MP lemma_in_subset) 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] THEN MESON_TAC[disjoint_loops]; ALL_TAC] 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] THEN USE_THEN "F2"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP (CONJUNCT2 (REWRITE_RULE[flag] th)))) THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[lemma_in_canon_darts]) THEN ABBREV_TAC `u = head (H:(A)hypermap) (NF:(A)loop->bool) (z:A)` THEN POP_ASSUM (LABEL_TAC "H1") THEN DISCH_THEN (X_CHOOSE_THEN `K:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3"))) THEN USE_THEN "H3" (MP_TAC o REWRITE_RULE[POWER_1] o SPEC `1` o MATCH_MP lemma_power_next_in_loop) 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)))))) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[CONJUNCT1 (SPEC `H:(A)hypermap` inverse2_hypermap_maps); o_THM] THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))] THEN DISCH_THEN (LABEL_TAC "H4") THEN USE_THEN "FC" (LABEL_TAC "H5" o CONJUNCT2 o MATCH_MP lemma_marked_dart) THEN USE_THEN "F18"(fun th-> USE_THEN "F22"(fun th1-> MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1)))) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H6") (LABEL_TAC "H7"))) THEN SUBGOAL_THEN `face_contour (H:(A)hypermap) (y:A) (SUC p) = loop_path (L':(A)loop) (z:A) 0` (LABEL_TAC "HG") THENL[USE_THEN "F15" (fun th-> REWRITE_TAC[face_contour; loop_path; POWER_0; I_THM; th]); ALL_TAC] 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") THENL[MATCH_MP_TAC lemma_glue_contours THEN REWRITE_TAC[lemma_face_contour] 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]))) THEN DISCH_THEN (fun th-> USE_THEN "F18" (fun th1 -> MP_TAC (CONJUNCT1(MATCH_MP let_order_for_loop (CONJ th th1))))) 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)) THEN DISCH_THEN (fun th-> REWRITE_TAC[REWRITE_RULE[lemma_def_inj_contour] th]) THEN USE_THEN "HG" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN ABBREV_TAC `fway = glue (face_contour H (y:A)) (loop_path (L':(A)loop) (z:A)) (SUC p)` THEN POP_ASSUM (LABEL_TAC "H9") THEN USE_THEN "H5" MP_TAC THEN USE_THEN "H4" (fun th-> USE_THEN "H2" (fun th1-> MP_TAC (MATCH_MP is_in_canon_darts (CONJ th th1)))) THEN REWRITE_TAC[IMP_IMP] THEN USE_THEN "F2" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP (CONJUNCT1(REWRITE_RULE[flag] th)))) 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")))))) 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") THENL[MATCH_MP_TAC lemma_join_contours THEN USE_THEN "H8" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "H12" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "H10" (fun th-> REWRITE_TAC[th]) THEN EXPAND_TAC "fway" THEN USE_THEN "HG" (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN USE_THEN "H7" (fun th-> REWRITE_TAC[loop_path; SYM th; one_step_contour]); ALL_TAC] THEN ABBREV_TAC `way = join (fway:num->A) (sway:num->A) ((SUC p) + (k:num))` THEN SUBGOAL_THEN `~(planar_hypermap (H:(A)hypermap))` MP_TAC THENL[MATCH_MP_TAC lemmaLoopSeparation THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `way:num->A` THEN EXISTS_TAC `((SUC p)+(k:num)) + (s:num) +1` THEN USE_THEN "H15" (fun th-> REWRITE_TAC[th]) 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]))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THENL[REWRITE_TAC [ADD_ASSOC; GSYM ADD1; GE_1]; ALL_TAC] THEN SUBGOAL_THEN `(way:num->A) 0 = (y:A)` SUBST1_TAC THENL[EXPAND_TAC "way" THEN REWRITE_TAC[join; LE_0] THEN EXPAND_TAC "fway" THEN REWRITE_TAC[glue; LE_0] THEN REWRITE_TAC[face_contour; POWER_0;I_THM]; ALL_TAC] THEN USE_THEN "HD" (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THENL[EXPAND_TAC "way" THEN REWRITE_TAC[join] THEN REWRITE_TAC[CONJUNCT2 ADD; GE_1] THEN EXPAND_TAC "fway" THEN REWRITE_TAC[glue; GE_1; face_contour; POWER_1]; ALL_TAC] THEN SUBGOAL_THEN `(way:num->A) (((SUC p) +(k:num)) +(s:num) + 1) = inverse (node_map (H:(A)hypermap)) (x:A)` SUBST1_TAC THENL[EXPAND_TAC "way" THEN GEN_REWRITE_TAC (DEPTH_CONV) [GSYM ADD1] THEN REWRITE_TAC[second_join_evaluation] THEN USE_THEN "H11" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H16") (LABEL_TAC "H17")) THEN ASM_CASES_TAC `i:num <= (SUC p) + (k:num)` THENL[POP_ASSUM (LABEL_TAC "H18") THEN EXPAND_TAC "way" THEN USE_THEN "H18" (fun th -> REWRITE_TAC[join; th]) THEN ASM_CASES_TAC `i <= SUC p` THENL[POP_ASSUM (LABEL_TAC "H19") THEN EXPAND_TAC "fway" THEN USE_THEN "H19" (fun th -> REWRITE_TAC[glue; th; face_contour]) THEN ASM_CASES_TAC `i:num = SUC p` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "H19" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F15" SUBST1_TAC THEN USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC disjoint_loops THEN EXISTS_TAC `H:(A)hypermap` THEN EXISTS_TAC `NF:(A)loop->bool` THEN EXISTS_TAC `z:A` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F18" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC] 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))))) THEN USE_THEN "F11" (MP_TAC o SPEC `i:num`) THEN USE_THEN "H20" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "H16" (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (fun th1-> USE_THEN "F5"(fun th-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th1 th)])); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "H21") THEN EXPAND_TAC "fway" THEN USE_THEN "H21" (fun th-> REWRITE_TAC[glue; th]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN REWRITE_TAC[ADD_SUB2; loop_path] THEN USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC disjoint_loops 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)` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F18" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "H21") THEN EXPAND_TAC "way" THEN USE_THEN "H21" (fun th-> REWRITE_TAC[join; th]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "H22")) THEN USE_THEN "H22" (SUBST1_TAC) THEN REWRITE_TAC[ADD_SUB2; PRE] THEN POP_ASSUM (fun th-> USE_THEN "H17" (LABEL_TAC "H24" o REWRITE_RULE[th; LE_ADD_LCANCEL; GSYM ADD1; LE_SUC])) THEN USE_THEN "H24" (MP_TAC o REWRITE_RULE[in_list] o SPEC `sway:num->A` o MATCH_MP lemma_element_in_list) THEN DISCH_THEN (fun th1-> USE_THEN "H14" (fun th-> MP_TAC (MATCH_MP lemma_in_subset (CONJ th th1)))) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN (ASSUME_TAC o REWRITE_RULE[]) THEN MATCH_MP_TAC lemma_not_in_canon_darts THEN EXISTS_TAC `L:(A)loop` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F6" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `x:A`; `1`] lemma_power_inverse_in_node2)) THEN DISCH_THEN (SUBST1_TAC o SYM o MATCH_MP lemma_node_identity) THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_on_heading) THEN REWRITE_TAC[heading] THEN USE_THEN "MN" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F14" SUBST1_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN EXISTS_TAC `x:A` THEN USE_THEN "F7" (fun th-> REWRITE_TAC[th; node_refl]); ALL_TAC] THEN USE_THEN "F3"(fun th-> REWRITE_TAC[REWRITE_RULE[is_restricted] th]); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[dart_inside; IN_ELIM_THM]) THEN USE_THEN "MN" SUBST1_TAC THEN ABBREV_TAC `u = head (H:(A)hypermap) (NF:(A)loop->bool) (z:A)` THEN POP_ASSUM (LABEL_TAC "G1") 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)`))) THEN REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse2_hypermap_maps); o_THM; COM_POWER_FUNCTION] THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts))] THEN DISCH_THEN (LABEL_TAC "G4") THEN USE_THEN "F9" (MP_TAC o SPEC `SUC i`) THEN USE_THEN "G3" (fun th-> REWRITE_TAC[ONCE_REWRITE_RULE[GSYM LE_SUC] th]) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "G5" o SYM) THEN USE_THEN "F7" (LABEL_TAC "G6" o SPEC `SUC i` o MATCH_MP lemma_power_next_in_loop) THEN ABBREV_TAC `v = (next (L:(A)loop) POWER (SUC i)) (x:A)` THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `u:A`; `1`] lemma_power_inverse_in_node2)) THEN USE_THEN "G5" SUBST1_TAC THEN DISCH_TAC 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))))))))) THEN MP_TAC (SPECL[`H:(A)hypermap`; `L':(A)loop`; `z:A`] lemma_atom_sub_node) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_subset) THEN USE_THEN "G1" SUBST1_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity) THEN DISCH_THEN (fun th-> POP_ASSUM (LABEL_TAC "G7" o REWRITE_RULE[SYM th])) THEN SUBGOAL_THEN `~(planar_hypermap (H:(A)hypermap))` MP_TAC THENL[MATCH_MP_TAC lemmaLoopSeparation THEN EXISTS_TAC `L:(A)loop` THEN EXISTS_TAC `face_contour (H:(A)hypermap) (y:A)` THEN EXISTS_TAC `SUC p` THEN REWRITE_TAC[GE_1; lemma_face_contour; face_contour; POWER_0; I_THM; POWER_1] 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]))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN USE_THEN "HD" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F1" (MP_TAC o MATCH_MP lemma_on_attach) THEN REWRITE_TAC[attach; heading] THEN USE_THEN "MN" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "PN" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F14" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F15" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 (fun th-> REWRITE_TAC[th]) (LABEL_TAC "G8")) THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G9") (LABEL_TAC "G10")) THEN ASM_CASES_TAC `i':num = SUC p` THENL[POP_ASSUM SUBST1_TAC THEN USE_THEN "F15" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F19" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] 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] THEN REWRITE_TAC[disjoint_loops]; ALL_TAC] THEN POP_ASSUM (fun th-> POP_ASSUM(fun th1-> (LABEL_TAC "G11" (REWRITE_RULE[GSYM LT_LE; LT_SUC_LE] (CONJ th1 th))))) THEN USE_THEN "F11" (MP_TAC o SPEC `i':num`) THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC] THEN EXISTS_TAC `v:A` THEN USE_THEN "G6" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "G7" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F3"(fun th-> REWRITE_TAC[REWRITE_RULE[is_restricted] th]));;
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) ==> ?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 THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F10") 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)))))) THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F15") THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN SUBGOAL_THEN `2 <= CARD (cycle (H:(A)hypermap) (L:(A)loop))` (LABEL_TAC "F16") THENL[MATCH_MP_TAC CARD_ATLEAST_2 THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (y:A)` THEN EXISTS_TAC `atom (H:(A)hypermap) (L:(A)loop) (z:A)` THEN USE_THEN "F4"(fun th-> USE_THEN "F5" (fun th1 -> REWRITE_TAC[MATCH_MP lemma_cycle_finite (CONJ th th1)])) THEN USE_THEN "F9" (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th]) THEN USE_THEN "F12" (fun th-> REWRITE_TAC[MATCH_MP lemma_in_cycle2 th]) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_on_attach) THEN USE_THEN "F15" (fun th -> USE_THEN "F10" (fun th1-> REWRITE_TAC[th; th1; CONTRAPOS_THM])) THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect) THEN POP_ASSUM (SUBST1_TAC o SYM) 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))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th]); ALL_TAC] THEN USE_THEN "F12" (MP_TAC o SPEC `H:(A)hypermap` o MATCH_MP lemma_in_cycle2) 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)))))))) THEN USE_THEN "CF" SUBST1_TAC THEN MP_TAC (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` face_map_and_darts) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_index_on_orbit) THEN USE_THEN "CF" (SUBST1_TAC o SYM) THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19"))) THEN USE_THEN "F4"(LABEL_TAC "QF" o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o MATCH_MP lemma_quotient) THEN ASM_CASES_TAC `n = 0` THENL[REMOVE_THEN "F19" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM] THEN DISCH_THEN (LABEL_TAC "F19") THEN EXISTS_TAC `PRE (CARD (cycle (H:(A)hypermap) (L:(A)loop)))` THEN ONCE_REWRITE_TAC[GSYM LT_SUC] THEN USE_THEN "F16" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ (SPEC `1` LE_PLUS) (REWRITE_RULE[TWO] th)))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th; LT_PLUS]) THEN EXPAND_TAC "m" THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_mInside_and_length_cycle th]) THEN POP_ASSUM SUBST1_TAC THEN MP_TAC (MATCH_MP lemma_cycle_orbit (ISPEC `quotient (H:(A)hypermap) (NF:(A)loop->bool)` face_map_and_darts)) THEN DISCH_THEN (MP_TAC o SPEC `atom (H:(A)hypermap) (L:(A)loop) (x:A)`) THEN USE_THEN "QF" SUBST1_TAC THEN USE_THEN "CF" (SUBST1_TAC o SYM) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; LT_EXISTS; CONJUNCT1 ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN EXISTS_TAC `d:num` THEN USE_THEN "F19" (fun th-> REWRITE_TAC[SYM th]) THEN USE_THEN "F18" (fun th->REWRITE_TAC[MATCH_MP LT_TRANS (CONJ (SPEC `d:num` LT_PLUS) th)]) THEN USE_THEN "F6" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT; LE_LT] THEN STRIP_TAC THENL[POP_ASSUM (LABEL_TAC "F24") THEN USE_THEN "F1" (MP_TAC o SPEC `SUC d` o CONJUNCT1 o MATCH_MP lemma_atom_on_inside_dart) THEN USE_THEN "MN" SUBST1_TAC THEN USE_THEN "F24" (fun th-> REWRITE_TAC[GE_1; REWRITE_RULE[GSYM LE_SUC_LT] th]) THEN USE_THEN "QF" SUBST1_TAC THEN USE_THEN "F19" (SUBST1_TAC o SYM) THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[IN_SING] THEN USE_THEN "F14" (MP_TAC o SPEC `SUC d`) THEN USE_THEN "F24" (fun th-> REWRITE_TAC[GE_1; MATCH_MP LT_IMP_LE (ONCE_REWRITE_RULE[GSYM LT_SUC] th)]) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "F19" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_atom_on_inside_dart) THEN USE_THEN "MN" SUBST1_TAC THEN USE_THEN "QF" SUBST1_TAC THEN DISCH_THEN (SUBST1_TAC) THEN USE_THEN "F10" SUBST1_TAC THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect) THEN POP_ASSUM SUBST1_TAC 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))) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity) THEN EXPAND_TAC "y" THEN EXPAND_TAC "z" THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_attach th]));;
let lemma_route = new_specification["mRoute"] (REWRITE_RULE[GSYM RIGHT_EXISTS_IMP_THM; SKOLEM_THM] lemma_route_exists);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (MATCH_MP lemma_route (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F9") (CONJUNCTS_THEN2 (LABEL_TAC "F10") (LABEL_TAC "F11"))) THEN USE_THEN "F9" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_heading th]) THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_on_attach th]) THEN ABBREV_TAC `m = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F12") THEN ABBREV_TAC `p = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F14") THEN ABBREV_TAC `q = mRoute (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F15") THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN USE_THEN "F9" (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (MP_TAC o REWRITE_RULE[ADD_SYM; ADD_SUC])) THEN REWRITE_TAC[GSYM ADD_SUC] THEN DISCH_THEN (SUBST_ALL_TAC o ONCE_REWRITE_RULE[ADD_SYM]) THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[LT_ADD] THEN ASM_CASES_TAC `~((d:num) + (p:num) = 0)` THENL[POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ]) THEN SIMP_TAC[]; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[]) THEN DISCH_THEN (MP_TAC o MATCH_MP (ARITH_RULE `!a:num b:num. a + b = 0 ==> a = 0 /\ b = 0`)) THEN DISCH_THEN (CONJUNCTS_THEN2 SUBST_ALL_TAC SUBST_ALL_TAC) THEN USE_THEN "F11" MP_TAC THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN REWRITE_TAC[ADD_0] THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_atom_on_inside_dart) THEN USE_THEN "F12" SUBST1_TAC THEN DISCH_THEN (SUBST1_TAC) THEN USE_THEN "F4" (fun th-> REWRITE_TAC[MATCH_MP lemma_quotient th]) THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F16") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "F17") THEN USE_THEN "F16" (MP_TAC o REWRITE_RULE[heading]) THEN USE_THEN "F7" (MP_TAC o SPEC `SUC m` o MATCH_MP lemma_power_next_in_loop) THEN USE_THEN "F1" (MP_TAC o SPEC `SUC m` o CONJUNCT1 o MATCH_MP lemma_mInside) THEN EXPAND_TAC "m" THEN REWRITE_TAC[LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM heading] THEN USE_THEN "F16" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F18") 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))]))) THEN DISCH_TAC 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) THEN POP_ASSUM SUBST1_TAC 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))) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_node1) THEN USE_THEN "F3" (fun th-> LABEL_TAC "CV"(REWRITE_RULE[edge_map_convolution] (CONJUNCT1(CONJUNCT2(CONJUNCT2(REWRITE_RULE[is_restricted] th)))))) THEN USE_THEN "CV" (fun th-> MP_TAC (AP_THM th `head (H:(A)hypermap) (NF:(A)loop->bool) (y:A)`)) THEN DISCH_THEN (SUBST1_TAC o SYM o REWRITE_RULE[o_THM]) THEN DISCH_THEN (LABEL_TAC "F19") THEN USE_THEN "F17" (MP_TAC o REWRITE_RULE[attach]) THEN USE_THEN "F14" SUBST1_TAC THEN REWRITE_TAC[GSYM ONE; POWER_1] THEN USE_THEN "F16" SUBST1_TAC THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `z:A`] node_refl) THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_node1) THEN USE_THEN "CV" (fun th -> MP_TAC (AP_THM th `y:A`)) THEN REWRITE_TAC[o_THM] THEN DISCH_THEN (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F20" o MATCH_MP lemma_node_identity) THEN REMOVE_THEN "F19" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F21") 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F22") (LABEL_TAC "F24")) 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)))) 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)))))) THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) 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]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F25" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F21" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (fun th-> USE_THEN "F24" (LABEL_TAC "F26" o REWRITE_RULE[SYM th])) THEN USE_THEN "F1" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_mInside) THEN ONCE_REWRITE_TAC[COM_POWER] THEN REWRITE_TAC[o_THM] THEN USE_THEN "F1" (MP_TAC o SPEC `SUC m` o CONJUNCT1 o MATCH_MP lemma_mInside) THEN EXPAND_TAC "m" THEN REWRITE_TAC[LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM heading] THEN USE_THEN "F16" SUBST1_TAC 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))))))))) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (fun th -> REWRITE_TAC[th]));;
let genex = new_definition `!H:(A)hypermap  (NF:(A)loop->bool) (L:(A)loop) x:A. genex H NF L x 
= 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))`;;
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)`;;
let geney = new_definition `!H:(A)hypermap  (NF:(A)loop->bool) (L:(A)loop) x:A. geney H NF L x 
= 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)))`;;
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))`;;
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))`;;
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))`;;
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) ==> (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)`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[genex; tpx; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN USE_THEN "F10" (fun th-> USE_THEN "F9" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12")) THEN ABBREV_TAC `id = index (L:(A)loop) (z:A) (y:A)` THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_glue_inj_contours THEN USE_THEN "F8" (fun th-> USE_THEN "F10" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP let_order_for_loop (CONJ th th1))))) 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))])) THEN USE_THEN "MN" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o CONJUNCT2 o MATCH_MP lemma_on_attach)) THEN DISCH_THEN (fun th-> MP_TAC(MATCH_MP LT_TRANS (CONJ (SPEC `m:num` LT_PLUS) th))) THEN MP_TAC (CONJUNCT1(SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] lemma_new_darts_in_face)) THEN USE_THEN "YEL" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_face_identity th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_inj_face_contour th]) THEN REWRITE_TAC[is_glueing] 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]) THEN SIMP_TAC[] THEN GEN_TAC THEN REWRITE_TAC[face_contour] THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (LABEL_TAC "G2")) 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)) THEN USE_THEN "G1" (fun th-> USE_THEN "G2" (fun th1-> USE_THEN "YEL" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN REWRITE_TAC[CONTRAPOS_THM; loop_path; lemma_in_list] THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (SUBST1_TAC o CONJUNCT2)) THEN MATCH_MP_TAC lemma_in_support2 THEN EXISTS_TAC `L:(A)loop` THEN USE_THEN "F5" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC] THEN SUBGOAL_THEN `loop_path (L:(A)loop) (z:A) (id:num) = face_contour (H:(A)hypermap) (y:A) 0` MP_TAC THENL[USE_THEN "F12" (fun th-> REWRITE_TAC[loop_path; face_contour; POWER_0;I_THM; th]); ALL_TAC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) THEN REWRITE_TAC[face_contour; COM_POWER_FUNCTION] THEN EXPAND_TAC "z" THEN USE_THEN "YEL" (fun th-> USE_THEN "MN" (fun th1-> REWRITE_TAC[attach; th; th1])));;
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 ==> ?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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (CONJUNCTS_THEN2 (LABEL_TAC "F3") (LABEL_TAC "F4")))) THEN USE_THEN "F1"(fun th->USE_THEN "F2"(fun th1-> MP_TAC(MATCH_MP lemma_increasing_index_one (CONJ th th1)))) THEN MP_TAC (SPECL[`H:(A)hypermap`; `x:A`] (CONJUNCT1 ind)) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (LABEL_TAC "INC") THEN USE_THEN "INC" (MP_TAC o SPEC `k:num` o MATCH_MP lemma_num_partition2) THEN USE_THEN "F3" (fun th->REWRITE_TAC[REWRITE_RULE[LT1_NZ; LT_NZ] th]) 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"))))) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [ind; ADD_SUB2; GSYM LT_SUC_LE] 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)] THEN DISCH_THEN ASSUME_TAC THEN EXISTS_TAC `i:num` THEN EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[] THEN USE_THEN "INC" (fun th-> ONCE_REWRITE_TAC[MATCH_MP lemma_inc_monotone (CONJUNCT2 th)]) THEN USE_THEN "F4" MP_TAC THEN USE_THEN "F6" SUBST1_TAC 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]) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LTE_TRANS) THEN SIMP_TAC[]);;
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`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (MP_TAC o REWRITE_RULE[LE_EXISTS])) THEN DISCH_THEN (X_CHOOSE_THEN `i:num` SUBST1_TAC) THEN REWRITE_TAC[ADD_SUB2; lemma_add_exponent_function ] THEN USE_THEN "F1" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_inverse th]) THEN USE_THEN "F1" (MP_TAC o SPEC `m:num` o MATCH_MP power_permutation) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") 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)) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN ABBREV_TAC `u = back (L:(A)loop) (z:A)` THEN POP_ASSUM (LABEL_TAC "G1") THEN USE_THEN "G1" (MP_TAC o AP_TERM `next (L:(A)loop)`) THEN REWRITE_TAC[lemma_inverse_evaluation] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G1" (fun th-> USE_THEN "F10" (LABEL_TAC "G2" o REWRITE_RULE[th] o MATCH_MP lemma_back_in_loop)) THEN REWRITE_TAC[node_map_inverse_representation] THEN ONCE_REWRITE_TAC[TAUT `A <=> (~A ==> F)`] 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))))])))) THEN USE_THEN "G1" (SUBST1_TAC o SYM) THEN REWRITE_TAC[lemma_inverse_evaluation] THEN ASM_CASES_TAC `m:num = 0` THENL[EXPAND_TAC "z" THEN USE_THEN "YEL" (fun th1-> USE_THEN "MN"(fun th-> REWRITE_TAC[attach; GSYM COM_POWER_FUNCTION; th; th1])) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM; face_map_injective] THEN DISCH_THEN (MP_TAC o AP_TERM `next (L:(A)loop)`) THEN REWRITE_TAC[lemma_inverse_evaluation] 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)) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [TAUT `A <=> ~(~A)`] THEN REWRITE_TAC[CONTRAPOS_THM] 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)))])))) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "ZEL" (fun th-> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "YEL" (fun th1-> USE_THEN "MN"(fun th-> REWRITE_TAC[attach; GSYM COM_POWER_FUNCTION; th; th1])) THEN REWRITE_TAC[POWER_0; I_THM; face_map_injective] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) 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))) THEN USE_THEN "YEL" (fun th-> REWRITE_TAC[CONTRAPOS_THM; th]) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "G1" SUBST1_TAC THEN USE_THEN "G2" (fun th -> USE_THEN "F5"(fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])));;
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) ==> (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)`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC(MATCH_MP lemma_on_adding_darts (CONJ th th1)))) THEN USE_THEN "YEL" (fun th-> USE_THEN "ZEL" (fun th1-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th; th1])) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12")) THEN USE_THEN "F11" (fun th-> USE_THEN "F9" (LABEL_TAC "F14" o REWRITE_RULE[th] o MATCH_MP lemma_next_in_loop)) THEN USE_THEN "F12" (fun th-> USE_THEN "F10" (LABEL_TAC "F15" o REWRITE_RULE[th] o MATCH_MP lemma_back_in_loop)) THEN ABBREV_TAC `v = node_map (H:(A)hypermap) (z:A)` THEN POP_ASSUM (LABEL_TAC "VL") THEN ABBREV_TAC `u = inverse (node_map (H:(A)hypermap)) (y:A)` THEN POP_ASSUM (LABEL_TAC "UL") THEN USE_THEN "F14" (fun th-> USE_THEN "F15" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F16") (LABEL_TAC "F17")) THEN ABBREV_TAC `id = index (L:(A)loop) (u:A) (v:A)` THEN USE_THEN "F3" (MP_TAC o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "R1") ((CONJUNCTS_THEN2 (LABEL_TAC "R2") (MP_TAC o CONJUNCT2)) o CONJUNCT2)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "R3") (LABEL_TAC "R4" o CONJUNCT1)) 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)))))) THEN STRIP_TAC THENL[MATCH_MP_TAC lemma_glue_inj_contours THEN USE_THEN "F8" (fun th-> USE_THEN "F14" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP let_order_for_loop (CONJ th th1))))) 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))])) 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] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_inj_complement) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_sub_inj_contour) THEN USE_THEN "MN" (fun th-> USE_THEN "F1"(LABEL_TAC "F19" o REWRITE_RULE[th] o CONJUNCT2 o MATCH_MP lemma_on_attach)) THEN USE_THEN "F19" (MP_TAC o MATCH_MP LT_TRANS o CONJ (SPEC `m:num` LT_PLUS)) 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)))) THEN DISCH_THEN (LABEL_TAC "F20" o MATCH_MP lemma_face_identity) THEN USE_THEN "F20"(fun th-> REWRITE_TAC[th]) 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))))))) THEN DISCH_THEN (MP_TAC o MATCH_MP LT_PRE_LE) THEN DISCH_THEN (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP th1 th])) THEN REWRITE_TAC[is_glueing] 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]) THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM(SPECL[`H:(A)hypermap`; `z:A`] (CONJUNCT1 ind))] 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)))]))) THEN USE_THEN "VL" (fun th-> REWRITE_TAC[POWER_0; I_THM; th]) THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F21") (LABEL_TAC "F22")) 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)))))))) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `i:num` MP_TAC)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F23") (CONJUNCTS_THEN2 (LABEL_TAC "F24") (CONJUNCTS_THEN2 (LABEL_TAC "F25") SUBST1_TAC))) 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))))))))))) THEN USE_THEN "F24" (fun th-> USE_THEN "F25" (fun th1-> REWRITE_TAC[th; th1])) THEN DISCH_THEN SUBST1_TAC THEN EXPAND_TAC "z" THEN USE_THEN "MN" (fun th-> REWRITE_TAC[attach; th]) THEN USE_THEN "F23" (MP_TAC o MATCH_MP LT_IMP_LE o ONCE_REWRITE_RULE[GSYM LT_SUC]) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) th)]) THEN REWRITE_TAC[SUB_SUC] THEN USE_THEN "F23" (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "F26")) THEN USE_THEN "F26" (SUBST1_TAC) THEN REWRITE_TAC[ADD_SUB2] THEN USE_THEN "F1" (MP_TAC o SPEC `SUC d` o CONJUNCT1 o MATCH_MP lemma_mAdd) THEN USE_THEN "MN" (fun th-> USE_THEN "YEL" (fun th1-> REWRITE_TAC[th; th1; GE_1])) THEN USE_THEN "F26" (fun th-> REWRITE_TAC[th; LE_ADDR; CONTRAPOS_THM; lemma_in_list; loop_path]) THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (MP_TAC o CONJUNCT2)) THEN ABBREV_TAC `g = (face_map (H:(A)hypermap) POWER (SUC d)) (y:A)` 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)) THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1-> MP_TAC (MATCH_MP lemma_in_support2 (CONJ th th1)))) THEN USE_THEN "F4" (fun th-> DISCH_THEN(fun th1-> MP_TAC (MATCH_MP lemma_node_sub_support_darts (CONJ th th1)))) THEN MP_TAC (SPECL[`H:(A)hypermap`; `g:A`; `i:num`] lemma_power_inverse_in_node2) THEN DISCH_THEN (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_node_identity th)]) THEN DISCH_THEN(fun th->REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th (SPECL[`H:(A)hypermap`; `g:A`] node_refl))]); ALL_TAC] THEN SUBGOAL_THEN `loop_path (L:(A)loop) (u:A) (id:num) = complement (H:(A)hypermap) (z:A) 0` MP_TAC THENL[GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM(SPECL[`H:(A)hypermap`; `z:A`] (CONJUNCT1 ind))] 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)))]))) THEN USE_THEN "VL" (fun th-> REWRITE_TAC[POWER_0; I_THM; loop_path; th]) THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]) 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)))])))) THEN EXPAND_TAC "z" THEN USE_THEN "MN" (fun th-> USE_THEN "YEL" (fun th1-> REWRITE_TAC[attach; th; th1])) THEN REWRITE_TAC[MATCH_MP reduce_exponent (CONJ (CONJUNCT2 (SPEC `H:(A)hypermap` face_map_and_darts)) (SPEC `m:num` LE_PLUS))] THEN REWRITE_TAC[ADD1; ADD_SUB2; POWER_1] THEN ONCE_REWRITE_TAC[GSYM(MATCH_MP PERMUTES_INJECTIVE (CONJUNCT2 (SPEC`H:(A)hypermap` node_map_and_darts)))] THEN USE_THEN "R1" (MP_TAC o SPEC `y:A` o REWRITE_RULE[edge_convolution]) 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))]))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "UL" (MP_TAC o AP_TERM `node_map (H:(A)hypermap)`) THEN REWRITE_TAC[MATCH_MP PERMUTES_INVERSES (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts))]);;
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}`;;
let lemma_in_couple = 
prove(`!x:A a:A b:A. x IN {a, b} <=> x = a \/ x = b`,
SET_TAC[]);;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC(CONJUNCT1(MATCH_MP lemma_genex_loop (CONJ th th1))))) THEN DISCH_THEN (LABEL_TAC "F3" o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list]) 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") THENL[REWRITE_TAC[genex; start_glue_evaluation; loop_path; POWER_0; I_THM]; ALL_TAC] THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THENL[REWRITE_TAC[belong] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th; GSYM in_list]) THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN MP_TAC (SPEC `tpx (H:(A)hypermap) NF L x` LE_0) THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC] THEN STRIP_TAC THENL[ONCE_REWRITE_TAC[GSYM EQ_SUC] THEN REWRITE_TAC[GSYM lemma_size; size] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP lemma_size_list th]); ALL_TAC] THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th]) THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `i:num` (CONJUNCT2 (MATCH_MP lemma_samsara_power th)))) THEN SUBGOAL_THEN `i:num <= tpx (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th]) THENL[MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `index (L:(A)loop) (attach (H:(A)hypermap) NF L x) (heading H NF L x)` THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th; tpx; LE_ADD]); ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[genex] THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th; loop_path]); ALL_TAC] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1") THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnax; MATCH_MP lemma_generate_loop th]) THEN ABBREV_TAC `m = index (L:(A)loop) (attach (H:(A)hypermap) NF L x) (heading H NF L x)` THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `(m:num) + (i:num)` (CONJUNCT2 (MATCH_MP lemma_samsara_power th)))) THEN SUBGOAL_THEN `(m:num) + (i:num) <= tpx (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th]) THENL[EXPAND_TAC "m" THEN USE_THEN "H1" (fun th->REWRITE_TAC[tpx; LE_ADD_LCANCEL; th]); ALL_TAC] THEN DISCH_THEN SUBST1_TAC 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 THENL[REWRITE_TAC[loop_path; face_contour; POWER_0; I_THM] THEN EXPAND_TAC "m" THEN POP_ASSUM (LABEL_TAC "H2") THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (MATCH_MP lemma_split_marked_loop (CONJ th th1)))) THEN DISCH_THEN (MP_TAC o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(CONJUNCT2(MATCH_MP lemma_loop_index th))]); ALL_TAC] THEN REWRITE_TAC[genex] THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th; face_contour]));;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (LABEL_TAC "F2")) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC(CONJUNCT1(MATCH_MP lemma_geney_loop (CONJ th th1))))) THEN DISCH_THEN (LABEL_TAC "F3" o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list]) 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") THENL[REWRITE_TAC[geney; start_glue_evaluation; loop_path; POWER_0; I_THM]; ALL_TAC] THEN USE_THEN "F4" (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THENL[REWRITE_TAC[belong] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th; GSYM in_list]) THEN USE_THEN "F4" (SUBST1_TAC o SYM) THEN MP_TAC (SPEC `tpy (H:(A)hypermap) NF L x` LE_0) THEN REWRITE_TAC[lemma_element_in_list]; ALL_TAC] THEN STRIP_TAC THENL[ONCE_REWRITE_TAC[GSYM EQ_SUC] THEN REWRITE_TAC[GSYM lemma_size; size] THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[MATCH_MP lemma_size_list th]); ALL_TAC] THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "F5") THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th]) THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `i:num` (CONJUNCT2 (MATCH_MP lemma_samsara_power th)))) THEN SUBGOAL_THEN `i:num <= tpy (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th]) THENL[MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `index (L:(A)loop) (inverse (node_map H) (heading H NF L x)) (node_map H (attach H NF L x))` THEN USE_THEN "F5" (fun th -> REWRITE_TAC[th; tpy; LE_ADD]); ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[geney] THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP first_glue_evaluation th; loop_path]); ALL_TAC] THEN GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1") THEN USE_THEN "F4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F3" (fun th-> REWRITE_TAC[dnay; MATCH_MP lemma_generate_loop th]) 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))` THEN USE_THEN "F3" (fun th-> MP_TAC(SPEC `(m:num) + (i:num)` (CONJUNCT2 (MATCH_MP lemma_samsara_power th)))) THEN SUBGOAL_THEN `(m:num) + (i:num) <= tpy (H:(A)hypermap) NF L x` (fun th-> REWRITE_TAC[th]) THENL[EXPAND_TAC "m" THEN USE_THEN "H1" (fun th->REWRITE_TAC[tpy; LE_ADD_LCANCEL; th]); ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN POP_ASSUM (LABEL_TAC "H2") 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 THENL[REWRITE_TAC[loop_path; face_contour; POWER_0; I_THM] THEN EXPAND_TAC "m" THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> LABEL_TAC "H3" (MATCH_MP lemma_split_marked_loop (CONJ th th1)))) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_back_in_loop) THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> REWRITE_TAC[CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1))])) THEN USE_THEN "H3" ((CONJUNCTS_THEN2 MP_TAC (ASSUME_TAC o CONJUNCT1)) o MATCH_MP lemma_on_heading) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_next_in_loop) THEN POP_ASSUM (SUBST1_TAC) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (SUBST1_TAC o SYM o CONJUNCT2 o MATCH_MP lemma_loop_index) THEN ONCE_REWRITE_TAC[SYM(SPECL[`H:(A)hypermap`; `attach (H:(A)hypermap) NF L x`] (CONJUNCT1 ind))] THEN USE_THEN "F1" (fun th-> USE_THEN "F2" (fun th1-> MP_TAC (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN USE_THEN "H3" (MP_TAC o CONJUNCT2 o REWRITE_RULE[is_split_condition]) THEN DISCH_THEN (fun th-> (MP_TAC (CONJUNCT1 (CONJUNCT2 th)) THEN MP_TAC (CONJUNCT1 th))) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_dart) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o REWRITE_RULE[is_marked]) THEN DISCH_THEN ((CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN DISCH_THEN (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP;GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[CONJUNCT1(MATCH_MP lemma_complement_path th)]) THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN USE_THEN "H2" (fun th-> REWRITE_TAC[geney; th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP second_glue_evaluation th]));;
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))`,
REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F1") (CONJUNCTS_THEN2 (LABEL_TAC "F2") (LABEL_TAC "F3"))) THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[lemma_in_support] THEN DISCH_THEN (X_CHOOSE_THEN `L':(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "F4") (LABEL_TAC "F5"))) THEN USE_THEN "F1" (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_mAdd) THEN USE_THEN "F2" (fun th-> USE_THEN "F3" (fun th1-> REWRITE_TAC[th; th1])) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity) THEN ABBREV_TAC `z = (face_map (H:(A)hypermap) POWER (i:num)) (heading H NF L x)` THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `z:A`] node_refl) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "F6") THEN USE_THEN "F1" (LABEL_TAC "F7" o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_split_condition]) THEN USE_THEN "F5" (fun th-> USE_THEN "F4" (fun th1-> MP_TAC (MATCH_MP lemma_in_support2 (CONJ th th1)))) THEN USE_THEN "F7" (fun th-> DISCH_THEN (fun th1-> MP_TAC (MATCH_MP lemma_node_sub_support_darts (CONJ th th1)))) THEN DISCH_THEN (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_subset (CONJ th th1)])));;
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 <=> (?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))))`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN GEN_TAC THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_on_dnax o CONJ th)) THEN USE_THEN "YEL" (fun th-> USE_THEN "ZEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[tpx; th; th1; th2]))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (LABEL_TAC "F15")))) THEN USE_THEN "F11" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong_loop th]) THEN USE_THEN "F12" SUBST1_TAC THEN EQ_TAC THENL[DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))) THEN ASM_CASES_TAC `i:num <= index (L:(A)loop) z y` THENL[POP_ASSUM (LABEL_TAC "H3") THEN USE_THEN "F14" (fun th-> USE_THEN "H3" (MP_TAC o MATCH_MP th)) THEN USE_THEN "H2" (fun th-> REWRITE_TAC[SYM th]) THEN DISCH_TAC THEN DISJ1_TAC THEN EXISTS_TAC `i:num` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H4")) o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN USE_THEN "H1" MP_TAC THEN USE_THEN "H4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [th; LE_ADD_LCANCEL]) THEN DISCH_THEN (LABEL_TAC "F5") THEN DISJ2_TAC THEN USE_THEN "F15" (fun th-> USE_THEN "F5" (MP_TAC o MATCH_MP th)) THEN USE_THEN "H4" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[SYM th; SYM th1])) THEN DISCH_TAC THEN EXISTS_TAC `SUC d` THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[GE_1; th]); ALL_TAC] THEN ASM_CASES_TAC `(?i:num. i <= index (L:(A)loop) z y /\ y' = (next L POWER (i:num)) z)` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th] THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H6") SUBST1_TAC) th)) THEN EXISTS_TAC `i:num` 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))]) THEN USE_THEN "H6" (fun th-> USE_THEN "F14" (fun th1-> REWRITE_TAC[SYM (MATCH_MP th1 th)])); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H7") (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))) THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H7")) o REWRITE_RULE[LE_EXISTS]) THEN USE_THEN "H7" (SUBST1_TAC) THEN EXISTS_TAC `(index (L:(A)loop) z y)+ i` THEN REWRITE_TAC[ADD_ASSOC; LE_ADD] THEN USE_THEN "H7" (fun th-> MP_TAC(REWRITE_RULE[SYM th] (SPECL[`i:num`; `d:num`] LE_ADD))) THEN DISCH_THEN (fun th-> USE_THEN "F15" (fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)])));;
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`,
MESON_TAC[lemma_in_dnax]);;
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`,
MESON_TAC[lemma_in_dnax]);;
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 <=> (?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))))`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN USE_THEN "YEL" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_on_heading)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12" o CONJUNCT1)) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1))))) THEN USE_THEN "ZEL" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F15") THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> REWRITE_TAC[GSYM th; GSYM th1])) THEN USE_THEN "F9" (LABEL_TAC "A3" o MATCH_MP lemma_next_in_loop) THEN USE_THEN "F10" (LABEL_TAC "A4" o MATCH_MP lemma_back_in_loop) THEN USE_THEN "A4" (fun th-> USE_THEN "A3" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A5") (LABEL_TAC "A6")) THEN ABBREV_TAC `ny = index (L:(A)loop) (next L y) (back L z)` THEN POP_ASSUM (LABEL_TAC "A8") THEN GEN_TAC THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_on_dnay o CONJ th)) THEN USE_THEN "YEL" (fun th-> USE_THEN "ZEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[tpy; th; th1; th2]))) THEN USE_THEN "A8" (fun th2-> USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1-> REWRITE_TAC[SYM th; SYM th1; th2]))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "B1") (CONJUNCTS_THEN2 (LABEL_TAC "B2") (CONJUNCTS_THEN2 (LABEL_TAC "B3") (LABEL_TAC "B4")))) THEN USE_THEN "B1" (fun th-> REWRITE_TAC[MATCH_MP lemma_belong_loop th]) THEN USE_THEN "B2" SUBST1_TAC THEN EQ_TAC THENL[DISCH_THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2"))) THEN ASM_CASES_TAC `i:num <= ny` THENL[POP_ASSUM (LABEL_TAC "H3") THEN DISJ1_TAC THEN USE_THEN "B3" (fun th-> USE_THEN "H3" (MP_TAC o MATCH_MP th)) THEN USE_THEN "H2" (fun th-> REWRITE_TAC[SYM th]) THEN DISCH_TAC THEN EXISTS_TAC `i:num` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H4")) o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN USE_THEN "H1" MP_TAC THEN USE_THEN "H4" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [th; LE_ADD_LCANCEL]) THEN DISCH_THEN (LABEL_TAC "H5") THEN DISJ2_TAC THEN USE_THEN "H5" MP_TAC THEN MP_TAC (SPEC `d:num` GE_1) 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)))))) 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]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index) 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")))))) THEN USE_THEN "B4" (fun th-> USE_THEN "H5" (MP_TAC o MATCH_MP th)) THEN USE_THEN "H4" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[SYM th; SYM th1])) THEN DISCH_TAC 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)))))) 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]) THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] 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) THEN USE_THEN "H7" (fun th-> USE_THEN "H8" (fun th1-> USE_THEN "H9" (fun th2-> REWRITE_TAC[th; th1; SYM th2]))) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REMOVE_THEN "H8" MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN SUBST1_TAC 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)))))) THEN REWRITE_TAC[SUB_SUC] THEN USE_THEN "H6" ((X_CHOOSE_THEN `s:num` (LABEL_TAC "H10") o REWRITE_RULE[LT_EXISTS])) THEN USE_THEN "H10" (fun th-> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [th; ADD_SUB2]) THEN USE_THEN "H10" (fun th -> GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [SYM th]) THEN DISCH_THEN (SUBST1_TAC) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H11") (LABEL_TAC "H12")) THEN EXISTS_TAC `SUC s` THEN EXISTS_TAC `b:num` THEN USE_THEN "H7" (fun th-> USE_THEN "H11" (fun th1 -> USE_THEN "H12" (fun th2-> REWRITE_TAC[th; th1; th2; GE_1]))) THEN USE_THEN "H10" (fun th-> REWRITE_TAC[th; LE_ADDR]); ALL_TAC] THEN ASM_CASES_TAC `(?i:num. i <= ny:num /\ y' = (next (L:(A)loop) POWER (i:num)) (next L y))` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th] THEN (X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 (LABEL_TAC "T1") SUBST1_TAC) th)) THEN EXISTS_TAC `i:num` 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))]) THEN USE_THEN "T1" (fun th-> USE_THEN "B3" (fun th1-> REWRITE_TAC[SYM (MATCH_MP th1 th)])); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) 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"))))))) THEN USE_THEN "T3" ((X_CHOOSE_THEN `d:num` (LABEL_TAC "T7")) o REWRITE_RULE[LE_EXISTS]) THEN EXISTS_TAC `(ny:num) + ((ind (H:(A)hypermap) z d) + b)` THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN USE_THEN "T5" (MP_TAC) THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN USE_THEN "T7" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ONCE_REWRITE_RULE[ADD_SYM] th]) THEN GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV)[GSYM (CONJUNCT2 ADD); lemma_add_exponent_function] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MATCH_MP inverse_power_function (CONJUNCT2(SPEC `H:(A)hypermap` face_map_and_darts))] THEN DISCH_THEN (SUBST1_TAC) THEN DISCH_THEN (LABEL_TAC "T8") THEN SUBGOAL_THEN `(ind (H:(A)hypermap) z d) + b <= ind H z m` (LABEL_TAC "T9") THENL[MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `ind (H:(A)hypermap) z (SUC d)` THEN USE_THEN "T7" MP_TAC THEN USE_THEN "T2" (fun th-> ONCE_REWRITE_TAC[SYM(MATCH_MP LE_SUC_PRE th)]) THEN REWRITE_TAC[CONJUNCT2 ADD; GSYM ADD_SUC] THEN DISCH_THEN (fun th-> MP_TAC (REWRITE_RULE[SYM th] (SPECL[`PRE a`; `SUC d`] LE_ADDR))) THEN DISCH_TAC 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)))))) 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]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_increasing_index_one) 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))])) THEN REWRITE_TAC[ind] THEN REWRITE_TAC[LE_ADD_LCANCEL; GSYM LT_SUC_LE] THEN MP_TAC (SPECL[`H:(A)hypermap`; `(inverse (face_map (H:(A)hypermap)) POWER (SUC d)) z`] NODE_NOT_EMPTY) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP LE_SUC_PRE th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "T9" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "B4" (fun th-> USE_THEN "T9" (MP_TAC o MATCH_MP th)) THEN DISCH_THEN (SUBST1_TAC) 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)))))) 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]) THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] 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) THEN USE_THEN "T8" (fun th-> USE_THEN "T4" (fun th1-> REWRITE_TAC[th; th1])) THEN DISCH_THEN (SUBST1_TAC) THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "T7" (fun th-> (MP_TAC (REWRITE_RULE[SYM th] (SPECL[`a:num`; `d:num`] LE_ADDR)))) THEN ONCE_REWRITE_TAC[GSYM LE_SUC] 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)))) THEN REWRITE_TAC[SUB_SUC] THEN USE_THEN "T7" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o DEPTH_CONV) [th; ADD_SUB]) THEN DISCH_THEN (SUBST1_TAC) THEN USE_THEN "T6" (fun th-> REWRITE_TAC[th]));;
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`,
MESON_TAC[lemma_in_dnay]);;
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`,
MESON_TAC[lemma_in_dnay]);;
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)`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN USE_THEN "YEL" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_on_heading)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12" o CONJUNCT1)) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1))))) THEN USE_THEN "ZEL" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F15") THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> REWRITE_TAC[GSYM th; GSYM th1])) THEN USE_THEN "F9" (fun th-> USE_THEN "F10" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A1") (LABEL_TAC "A2")) THEN USE_THEN "F9" (fun th-> USE_THEN "F10" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A1") (LABEL_TAC "A2")) THEN USE_THEN "F9" (LABEL_TAC "A3" o MATCH_MP lemma_next_in_loop) THEN USE_THEN "F10" (LABEL_TAC "A4" o MATCH_MP lemma_back_in_loop) THEN USE_THEN "A4" (fun th-> USE_THEN "A3" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A5") (LABEL_TAC "A6")) THEN ABBREV_TAC `nz = index (L:(A)loop) z y` THEN POP_ASSUM (LABEL_TAC "A7") THEN ABBREV_TAC `ny = index (L:(A)loop) (next L y) (back L z)` THEN POP_ASSUM (LABEL_TAC "A8") THEN SUBGOAL_THEN `(ny:num) + (SUC nz) = top (L:(A)loop)` (LABEL_TAC "F16") THENL[ASM_CASES_TAC `nz:num = top (L:(A)loop)` THENL[USE_THEN "A2" (MP_TAC o REWRITE_RULE[COM_POWER_FUNCTION] o AP_TERM `next (L:(A)loop)`) THEN POP_ASSUM (LABEL_TAC "B1") THEN USE_THEN "B1" (fun th-> REWRITE_TAC[th; GSYM lemma_size; lemma_order_next; I_THM]) THEN USE_THEN "F12" (fun th-> DISCH_THEN (ASSUME_TAC o REWRITE_RULE[th])) THEN MP_TAC (REWRITE_RULE[POWER_1] (SPECL[`H:(A)hypermap`; `y:A`; `1`] lemma_power_inverse_in_node2)) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_node_identity) THEN USE_THEN "F1" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_on_attach) THEN USE_THEN "YEL"(fun th-> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[th; th1])) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "A1" (fun th-> POP_ASSUM(fun th1 -> LABEL_TAC "B2" (REWRITE_RULE[GSYM LT_LE] (CONJ th th1)))) THEN USE_THEN "A6" (MP_TAC o AP_TERM `next (L:(A)loop)`) THEN REWRITE_TAC[lemma_inverse_evaluation; POWER_FUNCTION; COM_POWER_FUNCTION] THEN USE_THEN "A2" (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONJUNCT2 ADD] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM ADD_SUC] THEN DISCH_THEN (LABEL_TAC "B3" o SYM) THEN SUBGOAL_THEN `(next L POWER 0) z = (next (L:(A)loop) POWER ((SUC ny) + (SUC nz))) z` MP_TAC THENL[USE_THEN "B3" (fun th-> REWRITE_TAC[POWER_0; I_THM; th]); ALL_TAC] THEN SUBGOAL_THEN `0 < CARD (orbit_map (next (L:(A)loop)) z)` MP_TAC THENL[USE_THEN "F10" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_transitive_permutation th); GSYM size; lemma_size; LT_0]); ALL_TAC] THEN MP_TAC (CONJUNCT1(SPEC `L:(A)loop` lemma_permute_loop)) THEN MP_TAC (CONJUNCT1(SPEC `L:(A)loop` loop_lemma)) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_congruence_on_orbit) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[GSYM(MATCH_MP lemma_transitive_permutation th); GSYM size; ADD_0]) THEN DISCH_THEN (X_CHOOSE_THEN `q:num` (LABEL_TAC "B4")) THEN ASM_CASES_TAC `q:num = 0` THENL[USE_THEN "B4" MP_TAC THEN POP_ASSUM (SUBST1_TAC) THEN REWRITE_TAC[CONJUNCT1 MULT] THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (LABEL_TAC "B5") THEN ASM_CASES_TAC `1 < q:num` THENL[USE_THEN "B2" (MP_TAC o ONCE_REWRITE_RULE[GSYM LT_SUC]) THEN USE_THEN "A5" (MP_TAC o ONCE_REWRITE_RULE[GSYM LE_SUC]) THEN REWRITE_TAC[GSYM lemma_size; IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP LET_ADD2) THEN USE_THEN "B4" SUBST1_TAC 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]) THEN REWRITE_TAC[MULT] THEN REWRITE_TAC[LT_ADD_RCANCEL] THEN ARITH_TAC; ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LT]) THEN POP_ASSUM (MP_TAC o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN REWRITE_TAC[IMP_IMP; LE_ANTISYM] THEN DISCH_TAC THEN USE_THEN "B4" MP_TAC THEN POP_ASSUM (SUBST1_TAC o SYM) THEN REWRITE_TAC[MULT_CLAUSES; lemma_size; CONJUNCT2 ADD; EQ_SUC]; ALL_TAC] THEN USE_THEN "F16" (fun th-> REWRITE_TAC[th]) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnax (CONJ th th1))))) THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[tpx; th; th1])) THEN USE_THEN "MN" (fun th-> USE_THEN "A7" (fun th1-> REWRITE_TAC[th; th1])) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4")))) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnay (CONJ th th1))))) THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[tpy; th; th1])) THEN USE_THEN "F12" (fun th2->USE_THEN "F15" (fun th3-> REWRITE_TAC[GSYM th2; GSYM th3])) THEN USE_THEN "MN" (fun th-> USE_THEN "A8" (fun th1-> REWRITE_TAC[tpy; th; th1])) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G5") (CONJUNCTS_THEN2 (LABEL_TAC "G6") (CONJUNCTS_THEN2 (LABEL_TAC "G7") (LABEL_TAC "G8")))) 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") THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1") THEN USE_THEN "F6" MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN (fun th1-> USE_THEN "G5" (fun th-> MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1)))) THEN USE_THEN "G6" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3"))) THEN REMOVE_THEN "H1" (fun th1-> USE_THEN "G1" (fun th-> MP_TAC (MATCH_MP lemma_next_power_representation (CONJ th th1)))) THEN USE_THEN "G2" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (X_CHOOSE_THEN `t:num` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5"))) THEN ASM_CASES_TAC `t:num <= nz` THENL[POP_ASSUM (LABEL_TAC "H6") THEN REMOVE_THEN "H5" (MP_TAC) THEN USE_THEN "H6" (fun th-> USE_THEN "G3" (fun th1 -> REWRITE_TAC[MATCH_MP th1 th])) THEN DISCH_THEN (LABEL_TAC "H7") THEN ASM_CASES_TAC `k:num <= ny` THENL[POP_ASSUM (LABEL_TAC "H8") THEN REMOVE_THEN "H3" MP_TAC THEN USE_THEN "H8" (fun th-> USE_THEN "G7" (fun th1-> REWRITE_TAC[MATCH_MP th1 th])) THEN USE_THEN "A2" (SUBST1_TAC o AP_TERM `next (L:(A)loop)`) THEN REWRITE_TAC[COM_POWER_FUNCTION; GSYM lemma_add_exponent_function] THEN USE_THEN "H7" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "H9") THEN USE_THEN "F8" (fun th-> USE_THEN "F10" (MP_TAC o CONJUNCT1 o MATCH_MP let_order_for_loop o CONJ th)) THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list]) THEN DISCH_THEN (MP_TAC o SPECL[`(k:num) +(SUC nz)`; `t:num`] o REWRITE_RULE[lemma_inj_list]) THEN USE_THEN "H8" (fun th-> USE_THEN "A5" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)])) 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))]) THEN USE_THEN "F16" (SUBST1_TAC o SYM) THEN USE_THEN "H8" (fun th-> REWRITE_TAC[LE_ADD_RCANCEL; th; loop_path]) THEN USE_THEN "H9" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "H2" MP_TAC THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H10")) o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN USE_THEN "H10" SUBST1_TAC THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN DISCH_THEN (LABEL_TAC "H11") THEN USE_THEN "H3" MP_TAC THEN USE_THEN "H10" SUBST1_TAC THEN USE_THEN "H11" (fun th-> USE_THEN "G8" (fun th1-> REWRITE_TAC[MATCH_MP th1 th])) THEN DISCH_THEN (LABEL_TAC "H12") THEN USE_THEN "H11" MP_TAC THEN MP_TAC (SPEC `d:num` GE_1) 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)))))) 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]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index) 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")))))) 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)))))) 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]) THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] 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) THEN USE_THEN "H15" (fun th-> USE_THEN "H16" (fun th1-> USE_THEN "H17" (fun th2-> REWRITE_TAC[th; th1; SYM th2]))) THEN USE_THEN "H12" (SUBST1_TAC o SYM) THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th]) 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)))))) THEN REWRITE_TAC[SUB_SUC] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H14" ((X_CHOOSE_THEN `s:num` (LABEL_TAC "H18") o REWRITE_RULE[LT_EXISTS])) THEN USE_THEN "H18" (fun th-> REWRITE_TAC[th; ADD_SUB2]) THEN DISCH_THEN (LABEL_TAC "H19") THEN MP_TAC (SPECL[`H:(A)hypermap`; `(face_map (H:(A)hypermap) POWER (SUC s)) (y:A)`; `b:num`] lemma_power_inverse_in_node2) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "H19") THEN MP_TAC(SPECL[`a:num`; `SUC s`] LE_ADDR) THEN USE_THEN "H18" (SUBST1_TAC o SYM) THEN MP_TAC (SPEC `s:num` GE_1) THEN USE_THEN "F1" MP_TAC THEN EXPAND_TAC "m" THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SPEC `u:A` o MATCH_MP lemma_node_outside_support_darts) THEN USE_THEN "YEL" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[th; th1])) 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)) THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC] THEN USE_THEN "H4" MP_TAC THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "K1")) o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN USE_THEN "K1" SUBST1_TAC THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN DISCH_THEN (LABEL_TAC "K2") THEN USE_THEN "K2" (fun th-> USE_THEN "G4" (fun th1-> MP_TAC (MATCH_MP th1 th))) THEN USE_THEN "K1" (SUBST1_TAC o SYM) THEN USE_THEN "H5" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "K3") THEN ASM_CASES_TAC `k:num <= ny` THENL[POP_ASSUM (LABEL_TAC "K4") THEN REMOVE_THEN "H3" MP_TAC THEN USE_THEN "K4" (fun th-> USE_THEN "G7" (fun th1-> REWRITE_TAC[MATCH_MP th1 th])) THEN REWRITE_TAC[POWER_FUNCTION] 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)) THEN DISCH_THEN (fun th-> USE_THEN "F5" (fun th1 -> (ASSUME_TAC (MATCH_MP lemma_in_support2 (CONJ th th1))))) THEN USE_THEN "K2" MP_TAC THEN MP_TAC (SPEC `d:num` GE_1) THEN USE_THEN "F1" MP_TAC THEN EXPAND_TAC "m" THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SPEC `u:A` o MATCH_MP lemma_node_outside_support_darts) THEN USE_THEN "K3"(fun th-> USE_THEN "YEL" (fun th1-> REWRITE_TAC[th1; th; node_refl])) THEN USE_THEN "K3" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[SYM th; th1])); ALL_TAC] THEN POP_ASSUM ((X_CHOOSE_THEN `w:num` (LABEL_TAC "K5")) o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN USE_THEN "H2" MP_TAC THEN USE_THEN "K5" SUBST1_TAC THEN REWRITE_TAC[LE_ADD_LCANCEL] THEN DISCH_THEN (LABEL_TAC "K6") THEN USE_THEN "H3" MP_TAC THEN USE_THEN "K5" SUBST1_TAC THEN USE_THEN "K6" (fun th-> USE_THEN "G8" (fun th1-> REWRITE_TAC[MATCH_MP th1 th])) THEN DISCH_THEN (LABEL_TAC "K7") THEN USE_THEN "K6" MP_TAC THEN MP_TAC (SPEC `w:num` GE_1) 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)))))) 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]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index) 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")))))) 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)))))) 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]) THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] 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) THEN USE_THEN "K9" (fun th-> USE_THEN "K10" (fun th1-> USE_THEN "K11" (fun th2-> REWRITE_TAC[th; th1; SYM th2]))) THEN USE_THEN "K7" (SUBST1_TAC o SYM) THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th]) 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)))))) THEN REWRITE_TAC[SUB_SUC] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "K8" ((X_CHOOSE_THEN `p:num` (LABEL_TAC "K12") o REWRITE_RULE[LT_EXISTS])) THEN USE_THEN "K12" (fun th-> REWRITE_TAC[th; ADD_SUB2]) THEN DISCH_THEN (LABEL_TAC "K14") THEN USE_THEN "K3" (fun th-> MP_TAC (REWRITE_RULE[SYM th] (SPECL[`H:(A)hypermap`; `y:A`; `SUC d`] lemma_in_face))) THEN DISCH_THEN (LABEL_TAC "K15" o MATCH_MP lemma_face_identity) THEN USE_THEN "K14" MP_TAC THEN REWRITE_TAC[GSYM (MATCH_MP inverse_power_function (CONJUNCT2 (SPEC `H:(A)hypermap` node_map_and_darts)))] THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `u:A`; `b:num`] lemma_in_node2) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_TAC THEN USE_THEN "K15" (fun th-> MP_TAC (REWRITE_RULE[th] (SPECL[`H:(A)hypermap`; `y:A`; `SUC p`] lemma_in_face))) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM IN_INTER] 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)))))) 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)) THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN POP_ASSUM (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP (REWRITE_RULE[simple_hypermap] th1) th; IN_SING])) THEN USE_THEN "K14" SUBST1_TAC THEN DISCH_THEN (LABEL_TAC "K16") THEN USE_THEN "K10" MP_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th]) 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)))))) THEN REWRITE_TAC[SUB_SUC] THEN USE_THEN "K12" (fun th-> REWRITE_TAC[th; ADD_SUB2]) THEN DISCH_THEN (SUBST1_TAC) THEN DISCH_THEN (MP_TAC o CONJUNCT2 o REWRITE_RULE[lemma_inj_contour_via_list] o MATCH_MP lemma_inj_node_contour) THEN DISCH_THEN (MP_TAC o SPECL[`b:num`; `0`] o REWRITE_RULE[lemma_inj_list2]) THEN POP_ASSUM (fun th-> REWRITE_TAC[LE_0; LE_REFL; node_contour; POWER_0; I_THM; SYM th]) THEN USE_THEN "K9" (fun th-> REWRITE_TAC[REWRITE_RULE[LT1_NZ; LT_NZ] th]); ALL_TAC] THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th]) THEN ONCE_REWRITE_TAC[TAUT `(A ==> ~B) <=> (B ==> ~A)`] THEN USE_THEN "F17" (fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THENL[USE_THEN "F17" (MP_TAC o SPEC `next (L:(A)loop) (y:A)`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_IMP] THEN DISCH_TAC THEN USE_THEN "G5" (fun th-> REWRITE_TAC[th]) 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 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP disjoint_loops th)]) THEN USE_THEN "A3" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN STRIP_TAC THENL[USE_THEN "F17" (MP_TAC o SPEC `z:A`) THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_IMP] THEN DISCH_TAC THEN USE_THEN "G1" (fun th-> REWRITE_TAC[th]) 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 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP disjoint_loops th)]) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN GEN_TAC THEN USE_THEN "F10" (fun th-> DISCH_THEN (fun th1-> MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "T1") (LABEL_TAC "T2")) THEN ABBREV_TAC `nu = index (L:(A)loop) (z:A) u` THEN ASM_CASES_TAC `nu:num <= nz` THENL[DISJ1_TAC THEN USE_THEN "T2" SUBST1_TAC THEN POP_ASSUM (fun th-> USE_THEN "G3"(fun th1->REWRITE_TAC[SYM (MATCH_MP th1 th)])) THEN USE_THEN "G1" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]); ALL_TAC] THEN DISJ2_TAC THEN POP_ASSUM ((X_CHOOSE_THEN `q:num` (LABEL_TAC "T3")) o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN USE_THEN "T3" (fun th-> USE_THEN "T2" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM] o REWRITE_RULE[th])) THEN USE_THEN "A2" (fun th-> REWRITE_TAC[lemma_add_exponent_function; SYM th]) THEN USE_THEN "T1" MP_TAC THEN USE_THEN "T3" SUBST1_TAC THEN USE_THEN "F16" (SUBST1_TAC o SYM o REWRITE_RULE[CONJUNCT2 ADD; GSYM ADD_SUC] o ONCE_REWRITE_RULE[ADD_SYM]) THEN REWRITE_TAC[LE_ADD_LCANCEL; LE_SUC] THEN DISCH_TAC THEN REWRITE_TAC[GSYM POWER_FUNCTION] THEN POP_ASSUM (fun th-> USE_THEN "G7"(fun th1->REWRITE_TAC[SYM (MATCH_MP th1 th)])) THEN USE_THEN "G5" (fun th-> REWRITE_TAC[MATCH_MP lemma_power_next_in_loop th]));;
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) ==> is_normal H (genesis H NF L x)`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN USE_THEN "YEL" (fun th-> USE_THEN "F1" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_on_heading)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F11") (LABEL_TAC "F12" o CONJUNCT1)) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2(MATCH_MP lemma_on_adding_darts (CONJ th th1))))) THEN USE_THEN "ZEL" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (LABEL_TAC "F15") THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> REWRITE_TAC[GSYM th; GSYM th1])) THEN USE_THEN "F9" (fun th-> USE_THEN "F10" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A1") (LABEL_TAC "A2")) THEN USE_THEN "F9" (LABEL_TAC "A3" o MATCH_MP lemma_next_in_loop) THEN USE_THEN "F10" (LABEL_TAC "A4" o MATCH_MP lemma_back_in_loop) THEN USE_THEN "A4" (fun th-> USE_THEN "A3" (fun th1-> (MP_TAC (MATCH_MP lemma_loop_index (CONJ th1 th))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "A5") (LABEL_TAC "A6")) THEN ABBREV_TAC `nz = index (L:(A)loop) z y` THEN POP_ASSUM (LABEL_TAC "A7") THEN ABBREV_TAC `ny = index (L:(A)loop) (next L y) (back L z)` THEN POP_ASSUM (LABEL_TAC "A8") THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnax (CONJ th th1))))) THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[tpx; th; th1])) THEN USE_THEN "MN" (fun th-> USE_THEN "A7" (fun th1-> REWRITE_TAC[th; th1])) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G1") (CONJUNCTS_THEN2 (LABEL_TAC "G2") (CONJUNCTS_THEN2 (LABEL_TAC "G3") (LABEL_TAC "G4")))) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MP_TAC (CONJUNCT2 (MATCH_MP lemma_on_dnay (CONJ th th1))))) THEN USE_THEN "YEL" (fun th -> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[tpy; th; th1])) THEN USE_THEN "F12" (fun th2->USE_THEN "F15" (fun th3-> REWRITE_TAC[GSYM th2; GSYM th3])) THEN USE_THEN "MN" (fun th-> USE_THEN "A8" (fun th1-> REWRITE_TAC[tpy; th; th1])) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "G5") (CONJUNCTS_THEN2 (LABEL_TAC "G6") (CONJUNCTS_THEN2 (LABEL_TAC "G7") (LABEL_TAC "G8")))) 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)))))) 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)))))) 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)))))) THEN USE_THEN "G7" (fun th-> (MP_TAC(MATCH_MP th (SPEC `ny:num` LE_REFL)))) THEN USE_THEN "A6" (SUBST1_TAC o SYM) THEN DISCH_TAC THEN USE_THEN "G5" (MP_TAC o SPEC `ny:num` o MATCH_MP lemma_power_next_in_loop) THEN POP_ASSUM (SUBST1_TAC) THEN DISCH_THEN (LABEL_TAC "F19") THEN USE_THEN "G3" (fun th-> (MP_TAC(MATCH_MP th (SPEC `nz:num` LE_REFL)))) THEN USE_THEN "A2" (SUBST1_TAC o SYM) THEN DISCH_TAC THEN USE_THEN "G1" (MP_TAC o SPEC `nz:num` o MATCH_MP lemma_power_next_in_loop) THEN POP_ASSUM (SUBST1_TAC) THEN DISCH_THEN (LABEL_TAC "F20") 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)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F21") (LABEL_TAC "F22")) THEN SUBGOAL_THEN `!el:A nm:num. node (H:(A)hypermap) ((inverse (node_map H) POWER nm) el) = node H el` (LABEL_TAC "F22E") THENL[REPEAT GEN_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `el:A`; `nm:num`] lemma_power_inverse_in_node2) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_node_identity th]); ALL_TAC] THEN REWRITE_TAC[is_normal] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple] THEN STRIP_TAC THENL[USE_THEN "F4" (MP_TAC o SPEC `L':(A)loop` o CONJUNCT1 o REWRITE_RULE[is_normal]) THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `L':(A)loop IN NF`; POP_ASSUM SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dnax] 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 THENL[REWRITE_TAC[one_step_contour] THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MESON_TAC[MATCH_MP lemma_genex_loop (CONJ th th1)])); ALL_TAC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_make_contour_loop th]) THEN EXISTS_TAC `z:A` THEN USE_THEN "F17" (fun th-> USE_THEN "G1" (fun th1-> REWRITE_TAC[th; th1])); POP_ASSUM SUBST1_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dnay] 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 THENL[REWRITE_TAC[one_step_contour] THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> MESON_TAC[MATCH_MP lemma_geney_loop (CONJ th th1)])); ALL_TAC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_make_contour_loop th]) THEN EXISTS_TAC `next (L:(A)loop) y` THEN USE_THEN "F18" (fun th-> USE_THEN "G5" (fun th1-> REWRITE_TAC[th; th1]))]; ALL_TAC] THEN STRIP_TAC THENL[GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple] THEN STRIP_TAC THENL[USE_THEN "F4" (MP_TAC o SPEC `L':(A)loop` o CONJUNCT1 o CONJUNCT2 o REWRITE_RULE[is_normal]) THEN FIND_ASSUM (fun th-> REWRITE_TAC[th]) `L':(A)loop IN NF`; POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `y:A` THEN EXISTS_TAC `z:A` THEN USE_THEN "G1" (fun th-> USE_THEN "F20" (fun th1-> USE_THEN "F21" (fun th2-> REWRITE_TAC[th; th1; th2]))); POP_ASSUM SUBST1_TAC THEN EXISTS_TAC `next (L:(A)loop) y` THEN EXISTS_TAC `back (L:(A)loop) z` THEN USE_THEN "F19" (fun th-> USE_THEN "G5" (fun th1-> REWRITE_TAC[th; th1])) 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))) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]) THEN USE_THEN "F15" (fun th-> MP_TAC (REWRITE_RULE[POWER_1; SYM th] (SPECL[`H:(A)hypermap`; `z:A`; `1`] lemma_in_node2))) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM(MATCH_MP lemma_node_identity th)]) THEN USE_THEN "F21" (fun th-> REWRITE_TAC[th])]; ALL_TAC] 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") THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "H2"))) THEN REWRITE_TAC[CONTRAPOS_THM] 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))) 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")) THEN ASM_CASES_TAC `g:num <= nz` THENL[POP_ASSUM (fun th-> USE_THEN "G3" (fun th1 -> MP_TAC (MATCH_MP th1 th))) THEN USE_THEN "H4" (SUBST1_TAC o SYM) 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)) THEN USE_THEN "H2" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "H1" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP disjoint_loops th]); ALL_TAC] THEN USE_THEN "H3" MP_TAC THEN POP_ASSUM ((X_CHOOSE_THEN `a:num` (LABEL_TAC "H5") o REWRITE_RULE[NOT_LE; LT_EXISTS])) THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th; LE_ADD_LCANCEL]) THEN DISCH_THEN (LABEL_TAC "H6") THEN USE_THEN "G4" (fun th -> USE_THEN "H6" (MP_TAC o MATCH_MP th)) THEN USE_THEN "H5" (fun th-> USE_THEN "H4" (fun th1 -> REWRITE_TAC[GSYM th; SYM th1])) THEN DISCH_THEN (LABEL_TAC "H7") 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] THEN EXPAND_TAC "m" THEN DISCH_THEN (MP_TAC o SPEC `t:A` o MATCH_MP lemma_node_outside_support_darts) THEN USE_THEN "YEL" (fun th-> USE_THEN "H7" (fun th1-> REWRITE_TAC[th; th1; node_refl])) THEN USE_THEN "H7" (SUBST1_TAC o SYM) THEN USE_THEN "H2" (fun th-> USE_THEN "H1" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC] 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") THENL[REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (CONJUNCTS_THEN2 MP_TAC (LABEL_TAC "H2"))) THEN REWRITE_TAC[CONTRAPOS_THM] 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))) THEN ABBREV_TAC `g = index (dnay (H:(A)hypermap) NF L x) (next L y) t` THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4")) THEN ASM_CASES_TAC `g:num <= ny` THENL[POP_ASSUM (fun th-> USE_THEN "G7" (fun th1 -> MP_TAC (MATCH_MP th1 th))) THEN USE_THEN "H4" (SUBST1_TAC o SYM) THEN DISCH_TAC 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)) THEN USE_THEN "H2" MP_TAC THEN USE_THEN "F5" MP_TAC THEN USE_THEN "H1" MP_TAC THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP disjoint_loops th]); ALL_TAC] THEN USE_THEN "H3" MP_TAC THEN POP_ASSUM ((X_CHOOSE_THEN `a:num` (LABEL_TAC "H5") o REWRITE_RULE[NOT_LE; LT_EXISTS])) THEN USE_THEN "H5" (fun th -> REWRITE_TAC[th; LE_ADD_LCANCEL]) THEN DISCH_THEN (LABEL_TAC "H6") THEN USE_THEN "G8" (fun th -> USE_THEN "H6" (MP_TAC o MATCH_MP th)) THEN USE_THEN "H5" (fun th-> USE_THEN "H4" (fun th1 -> REWRITE_TAC[GSYM th; SYM th1])) THEN DISCH_THEN (LABEL_TAC "H7") THEN USE_THEN "H6" MP_TAC THEN MP_TAC (SPEC `a:num` GE_1) THEN USE_THEN "F17" MP_TAC 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]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP complement_index) 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")))))) THEN USE_THEN "F17" MP_TAC 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]) THEN USE_THEN "F3" (MP_TAC o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o REWRITE_RULE[is_restricted]) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] 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) THEN USE_THEN "H9" (fun th-> USE_THEN "H10" (fun th1-> USE_THEN "H11" (fun th2-> REWRITE_TAC[th; th1; SYM th2]))) THEN USE_THEN "H7" (SUBST1_TAC o SYM) THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "MN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [th]) 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)))))) THEN REWRITE_TAC[SUB_SUC] THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "H8" ((X_CHOOSE_THEN `p:num` (LABEL_TAC "H12") o REWRITE_RULE[LT_EXISTS])) THEN USE_THEN "H12" (fun th-> REWRITE_TAC[th; ADD_SUB2]) THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `(face_map (H:(A)hypermap) POWER (SUC p)) y`;`v:num`] lemma_power_inverse_in_node2) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN DISCH_TAC THEN MP_TAC (SPECL[`u:num`; `SUC p`] LE_ADDR) THEN USE_THEN "H12" (SUBST1_TAC o SYM) THEN EXPAND_TAC "m" THEN MP_TAC (SPEC `p:num` GE_1) THEN USE_THEN "F1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SPEC `t:A` o MATCH_MP lemma_node_outside_support_darts) THEN USE_THEN "YEL" (fun th-> POP_ASSUM (fun th1-> REWRITE_TAC[th; th1])) THEN USE_THEN "H2" (fun th-> USE_THEN "H1" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_support2 (CONJ th th1)])); ALL_TAC] THEN STRIP_TAC THENL[REPEAT GEN_TAC THEN REWRITE_TAC[genesis; IN_DELETE; IN_UNION; lemma_in_couple] THEN ASM_CASES_TAC `(L':(A)loop IN NF) /\ ~(L' = L)` THENL[POP_ASSUM (LABEL_TAC "H1") THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th]) THEN ASM_CASES_TAC `(L'':(A)loop IN NF) /\ ~(L'' = L)` THENL[POP_ASSUM (LABEL_TAC "H2") THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (MP_TAC o CONJUNCT1) THEN POP_ASSUM (MP_TAC o CONJUNCT1) THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REWRITE_TAC[disjoint_loops]; ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN POP_ASSUM (CONJUNCTS_THEN2 (LABEL_TAC "H3") (LABEL_TAC "H4")) THEN ASM_CASES_TAC `L'':(A)loop = dnax (H:(A)hypermap) NF L x` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN USE_THEN "H4" MP_TAC THEN USE_THEN "H3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN USE_THEN "F24" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th)) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN USE_THEN "H4" MP_TAC THEN USE_THEN "H3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN USE_THEN "F25" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th)) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN ASM_CASES_TAC `(L'':(A)loop IN NF) /\ ~(L'' = L)` THENL[POP_ASSUM (LABEL_TAC "H1") THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th]) THEN ASM_CASES_TAC `L':(A)loop = dnax (H:(A)hypermap) NF L x` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN USE_THEN "H1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN USE_THEN "F24" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th)) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN USE_THEN "H1" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN USE_THEN "F25" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP th)) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN ASM_CASES_TAC `L':(A)loop = dnax (H:(A)hypermap) (NF:(A)loop->bool) L x` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN ASM_CASES_TAC `L'':(A)loop = dnax (H:(A)hypermap) NF L x` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) 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)) THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[th; th1])); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM (SUBST1_TAC) THEN ASM_CASES_TAC `L'':(A)loop = dnay (H:(A)hypermap) (NF:(A)loop->bool) L x` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[] THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) 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)) THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[th; th1])); ALL_TAC] THEN REPEAT GEN_TAC THEN REWRITE_TAC[genesis; IN_ELIM_THM; IN_DELETE; IN_UNION; lemma_in_couple] THEN ASM_CASES_TAC `(L':(A)loop IN (NF:(A)loop->bool)) /\ ~(L' = L)` THENL[POP_ASSUM (fun th -> REWRITE_TAC[th] THEN LABEL_TAC "H1" (CONJUNCT1 th)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H2") (LABEL_TAC "H3")) 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]) THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> USE_THEN "H3" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (X_CHOOSE_THEN `M:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5"))) THEN ASM_CASES_TAC `~(M = L:(A)loop)` THENL[EXISTS_TAC `M:(A)loop` THEN POP_ASSUM (fun th-> POP_ASSUM (fun th2 -> POP_ASSUM (fun th1-> REWRITE_TAC[CONJ th1 th; th2]))); ALL_TAC] THEN USE_THEN "H5" MP_TAC THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[]) 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))) THEN STRIP_TAC THENL[EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN ASM_CASES_TAC `L' = dnax (H:(A)hypermap) NF L x` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) THEN USE_THEN "H1" MP_TAC THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_dnax (CONJ th th1)])) 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])))) THEN STRIP_TAC 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)) THEN DISCH_THEN (LABEL_TAC "H3") 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]) THEN USE_THEN "F5" (fun th-> USE_THEN "H2" (fun th1-> USE_THEN "H3" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (X_CHOOSE_THEN `M:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5"))) THEN ASM_CASES_TAC `~(M = L:(A)loop)` THENL[EXISTS_TAC `M:(A)loop` THEN POP_ASSUM (fun th-> POP_ASSUM (fun th2 -> POP_ASSUM (fun th1-> REWRITE_TAC[CONJ th1 th; th2]))); ALL_TAC] THEN USE_THEN "H5" MP_TAC THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[]) 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))) THEN STRIP_TAC THENL[EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN USE_THEN "H2" MP_TAC THEN POP_ASSUM (fun th -> LABEL_TAC "H3" th THEN SUBST1_TAC th) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_via_inverse_node_map) THEN DISCH_THEN (X_CHOOSE_THEN `j:num` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5"))) THEN ASM_CASES_TAC `j:num = 0` THENL[USE_THEN "H5" MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th; POWER_0; I_THM]) THEN USE_THEN "H3" (SUBST1_TAC o SYM) THEN DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN USE_THEN "H1" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "F5" o REWRITE_RULE[GSYM LT_NZ; GSYM LT1_NZ]) THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x` THEN REWRITE_TAC[] THEN REMOVE_THEN "H5" MP_TAC THEN REMOVE_THEN "H4" MP_TAC THEN POP_ASSUM MP_TAC THEN UNDISCH_TAC `i:num <= m` THEN UNDISCH_TAC `1 <= i:num` 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] THEN REWRITE_TAC[lemma_in_dnay2]; ALL_TAC] THEN POP_ASSUM (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN POP_ASSUM SUBST1_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) THEN USE_THEN "H1" MP_TAC THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> REWRITE_TAC[MATCH_MP lemma_in_dnay (CONJ th th1)])) 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])))) THEN USE_THEN "F12" (fun th-> USE_THEN "F15" (fun th1 -> USE_THEN "A8" (fun th2-> REWRITE_TAC[SYM th; SYM th1; th2]))) THEN STRIP_TAC 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)) THEN DISCH_THEN (LABEL_TAC "H3") 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]) THEN USE_THEN "F5" (fun th-> USE_THEN "H2" (fun th1-> USE_THEN "H3" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (X_CHOOSE_THEN `M:(A)loop` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5"))) THEN ASM_CASES_TAC `~(M = L:(A)loop)` THENL[EXISTS_TAC `M:(A)loop` THEN POP_ASSUM (fun th-> POP_ASSUM (fun th2 -> POP_ASSUM (fun th1-> REWRITE_TAC[CONJ th1 th; th2]))); ALL_TAC] THEN USE_THEN "H5" MP_TAC THEN POP_ASSUM (SUBST1_TAC o REWRITE_RULE[]) 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))) THEN STRIP_TAC THENL[EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x` THEN REPLICATE_TAC 2 (POP_ASSUM (fun th-> REWRITE_TAC[th])); ALL_TAC] THEN USE_THEN "H2" MP_TAC THEN POP_ASSUM (fun th -> LABEL_TAC "H3" th THEN SUBST1_TAC th) THEN USE_THEN "F22E" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_via_inverse_node_map) THEN DISCH_THEN (X_CHOOSE_THEN `u:num` (CONJUNCTS_THEN2 (LABEL_TAC "H4") (LABEL_TAC "H5"))) THEN ASM_CASES_TAC `u:num = 0` THENL[USE_THEN "H5" MP_TAC THEN POP_ASSUM (fun th-> REWRITE_TAC[th; POWER_0; I_THM]) THEN DISCH_TAC THEN EXISTS_TAC `dnax (H:(A)hypermap) NF L x` THEN REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN UNDISCH_TAC `i:num <= m` THEN UNDISCH_TAC `1 <= i:num` 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; lemma_in_dnax2]; ALL_TAC] THEN EXISTS_TAC `dnay (H:(A)hypermap) NF L x` THEN REWRITE_TAC[] 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])) THEN UNDISCH_TAC `i:num <= m` THEN UNDISCH_TAC `1 <= i` 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; lemma_in_dnay2]);;
(* Atoms of dnax *)
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`,
REPEAT GEN_TAC 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"))))))))) 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F10") (LABEL_TAC "F11")) THEN USE_THEN "F4"(fun th->USE_THEN "F10"(fun th1-> LABEL_TAC "F12"(MATCH_MP lemma_in_loop (CONJ th th1)))) THEN USE_THEN "F4"(fun th-> USE_THEN "F5" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "XB") (LABEL_TAC "F14")) THEN USE_THEN "F4"(fun th-> USE_THEN "F6" (fun th1-> MP_TAC (MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "YB") (LABEL_TAC "F15")) THEN USE_THEN "F4"(fun th-> USE_THEN "F12" (fun th1-> LABEL_TAC "F16" (CONJUNCT2(MATCH_MP lemma_loop_index (CONJ th th1))))) 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F17") (LABEL_TAC "F18")) THEN ABBREV_TAC `nz = index (L:(A)loop) z (head (H:(A)hypermap) NF z)` THEN POP_ASSUM (LABEL_TAC "NZ") THEN ABBREV_TAC `n1 = index (L:(A)loop) z (tail (H:(A)hypermap) NF y)` THEN POP_ASSUM (LABEL_TAC "N1") THEN ABBREV_TAC `ny = index (L:(A)loop) z y` THEN POP_ASSUM (LABEL_TAC "NY") THEN ABBREV_TAC `n2 = index (L:(A)loop) z (head (H:(A)hypermap) NF y)` THEN POP_ASSUM (LABEL_TAC "N2") THEN ABBREV_TAC `nx = index (L:(A)loop) z x` THEN POP_ASSUM (LABEL_TAC "NX") 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 THENL[STRIP_TAC THENL[EXISTS_TAC `SUC nz` THEN USE_THEN "F8" (fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LE_SUC_LT] th; LT_PLUS]) THEN USE_THEN "F16" (fun th-> REWRITE_TAC[GSYM COM_POWER_FUNCTION; GSYM th; lemma_inverse_evaluation]) 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] THEN EXISTS_TAC `ny:num` THEN GEN_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[CONJUNCT1 (CONJUNCT2 th)]); ALL_TAC] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [num_MAX] 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"))) THEN SUBGOAL_THEN `m:num = n1:num` (LABEL_TAC "H5") THENL[REMOVE_THEN "H2" ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H2") o REWRITE_RULE[LE_EXISTS])) THEN USE_THEN "F4" (LABEL_TAC "H6" o SPEC `m:num` o MATCH_MP lemma_power_next_in_loop) THEN ABBREV_TAC `u = (next (L:(A)loop) POWER m) z` THEN POP_ASSUM (LABEL_TAC "UL") 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 THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "H7") THEN REWRITE_TAC [GSYM COM_POWER_FUNCTION] THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN USE_THEN "H7"(fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)]) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "H6" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop) 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] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_next_exclusive2 th]) THEN STRIP_TAC THEN USE_THEN "H4" (MP_TAC o SPEC `(SUC i) + (m:num)`) THEN USE_THEN "H1" (fun th-> REWRITE_TAC[MATCH_MP LTE_TRANS (CONJ th (SPECL[`SUC i`; `m:num`] LE_ADDR))]) THEN USE_THEN "H2" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM]) THEN USE_THEN "H7"(fun th-> REWRITE_TAC[LE_ADD_RCANCEL; th]) THEN USE_THEN "UL" (fun th-> REWRITE_TAC[lemma_add_exponent_function; th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[GSYM COM_POWER_FUNCTION; lemma_inverse_evaluation; SYM th]) THEN REWRITE_TAC[NOT_LE; LT_ADDR; GSYM LT1_NZ; GE_1]; ALL_TAC] 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])) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom) THEN USE_THEN "UL" (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN USE_THEN "H2" (fun th-> USE_THEN "F15" (fun th1-> REWRITE_TAC[GSYM (ONCE_REWRITE_RULE[ADD_SYM] th); GSYM th1])) THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `u:A`] atom_reflect) THEN POP_ASSUM (fun th-> REWRITE_TAC[MATCH_MP lemma_identity_atom th]) 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] THEN USE_THEN "H3" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[SYM th] o MATCH_MP lemma_tail)) THEN DISCH_TAC THEN USE_THEN "UL" (MP_TAC o SYM) THEN USE_THEN "H2" (MP_TAC o MATCH_MP compare_left o SYM) THEN DISCH_THEN (fun th-> USE_THEN "YB" (fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1)))) THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP determine_loop_index) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "N1"(fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "H1" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[th; th1])) 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 THENL[EXISTS_TAC `nx:num` THEN USE_THEN "F9"(fun th-> USE_THEN "F14"(fun th1-> REWRITE_TAC[th; GSYM th1; LE_REFL])) THEN USE_THEN "F7" (fun th-> ONCE_REWRITE_TAC[SYM th]) 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] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [num_WOP] 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"))) THEN SUBGOAL_THEN `n:num = n2:num` (LABEL_TAC "FG") THENL[REMOVE_THEN "G1" ((X_CHOOSE_THEN `d:num` (LABEL_TAC "G1") o REWRITE_RULE[LE_EXISTS])) THEN ABBREV_TAC `v = (next (L:(A)loop) POWER n) z` THEN POP_ASSUM (LABEL_TAC "VL") 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 THENL[INDUCT_TAC THENL[REWRITE_TAC[LE_0; POWER_0; I_THM]; ALL_TAC] THEN DISCH_THEN (LABEL_TAC "G6") THEN REWRITE_TAC [GSYM COM_POWER_FUNCTION] THEN FIRST_X_ASSUM (MP_TAC o check (is_imp o concl)) THEN USE_THEN "G6"(fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)]) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F6" (MP_TAC o SPEC `i:num` o MATCH_MP lemma_power_next_in_loop) 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] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_next_exclusive2 th]) THEN STRIP_TAC THEN USE_THEN "G4" (MP_TAC o SPEC `(i:num) + (ny:num)`) THEN USE_THEN "G1" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM]) THEN USE_THEN "G6"(fun th-> REWRITE_TAC[LT_ADD_RCANCEL; REWRITE_RULE[LE_SUC_LT] th; LE_ADDR]) THEN USE_THEN "G6" (MP_TAC o MATCH_MP LE_TRANS o CONJ (SPEC `i:num` LE_PLUS)) THEN DISCH_THEN (fun th-> (MP_TAC (ONCE_REWRITE_RULE[GSYM (SPECL[`i:num`; `d:num`; `ny:num`] LE_ADD_RCANCEL)] th))) THEN USE_THEN "G1" (fun th-> REWRITE_TAC[GSYM (ONCE_REWRITE_RULE[ADD_SYM] th)]) THEN DISCH_THEN (fun th -> USE_THEN "G2" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)])) THEN USE_THEN "F15" (fun th-> REWRITE_TAC[lemma_add_exponent_function; SYM th]) THEN POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] 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])) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom) THEN USE_THEN "F15" (fun th-> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN USE_THEN "G1" (fun th-> USE_THEN "VL" (fun th1-> REWRITE_TAC[GSYM (ONCE_REWRITE_RULE[ADD_SYM] th); th1])) 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] THEN USE_THEN "G3" (fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[SYM th] o MATCH_MP lemma_head)) THEN DISCH_TAC THEN USE_THEN "VL" (MP_TAC o SYM) THEN USE_THEN "G2" (fun th-> USE_THEN "XB" (MP_TAC o MATCH_MP LE_TRANS o CONJ th)) THEN USE_THEN "F4" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP determine_loop_index) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "N2"(fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "G1" (fun th-> USE_THEN "G2" (fun th1-> REWRITE_TAC[th; th1])));;
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`,
REPEAT GEN_TAC 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")))))))))))))) 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F16") (LABEL_TAC "F17")) THEN USE_THEN "F6"(fun th-> USE_THEN "F16" (fun th1->MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F18") (LABEL_TAC "F19")) THEN USE_THEN "F6"(fun th-> USE_THEN "F17" (fun th1->MP_TAC(MATCH_MP lemma_loop_index (CONJ th th1)))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F20") (LABEL_TAC "F21")) 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)))))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F22") (LABEL_TAC "F23" o CONJUNCT1)) 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)))))) 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)))))) 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)))))) 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))])))) THEN DISCH_THEN (LABEL_TAC "F25") 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)))))) THEN LABEL_TAC "F26" (SPECL[`H:(A)hypermap`; `L1:(A)loop`; `y:A`] atom_reflect) THEN DISCH_THEN (SUBST_ALL_TAC o MATCH_MP lemma_identity_atom) THEN ABBREV_TAC `u = tail (H:(A)hypermap) N1 y` THEN ABBREV_TAC `v = head (H:(A)hypermap) N1 y` THEN ABBREV_TAC `a = index (L1:(A)loop) x u` THEN ABBREV_TAC `b = index (L1:(A)loop) x v` THEN USE_THEN "F12" (MP_TAC o REWRITE_RULE[LE_EXISTS]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` (LABEL_TAC "F27")) THEN USE_THEN "F27" (fun th-> USE_THEN "F19" (MP_TAC o REWRITE_RULE[ONCE_REWRITE_RULE[ADD_SYM] th; lemma_add_exponent_function])) THEN USE_THEN "F21" (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th-> LABEL_TAC "F28" th THEN MP_TAC th) 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)))) THEN USE_THEN "F17" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP determine_loop_index) THEN DISCH_THEN SUBST_ALL_TAC THEN USE_THEN "F22" (fun th-> USE_THEN "F26"(MP_TAC o REWRITE_RULE[th; IN_ELIM_THM])) THEN DISCH_THEN (X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 (LABEL_TAC "F29") (LABEL_TAC "F30"))) THEN USE_THEN "F15" (MP_TAC o SPEC `a:num`) THEN USE_THEN "F11" (fun th-> REWRITE_TAC[MATCH_MP LT_IMP_LE th]) 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))])) THEN USE_THEN "F21" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F31") 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)) 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") THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1") THEN USE_THEN "F21" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[lemma_add_exponent_function] THEN USE_THEN "F21" (SUBST1_TAC o SYM) THEN USE_THEN "F31" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN USE_THEN "F15" (MP_TAC o SPEC `(i:num) + (a:num)`) 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))]) 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)])) THEN USE_THEN "F27" (fun th-> DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[ADD_SYM] o REWRITE_RULE[SYM th])) THEN DISCH_THEN (fun th-> USE_THEN "F14" (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th (MATCH_MP LT_IMP_LE th1))])) THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[lemma_add_exponent_function] THEN USE_THEN "F21" (SUBST1_TAC o SYM) THEN POP_ASSUM MP_TAC THEN USE_THEN "F23" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F33"(fun th-> USE_THEN "F29" (fun th1 -> MP_TAC (MATCH_MP lemma_sub_part (CONJ th th1)))) 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])) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom) THEN USE_THEN "F29" (fun th-> USE_THEN "F33"(fun th1-> REWRITE_TAC[MATCH_MP th1 th])) THEN REMOVE_THEN "F29" (fun th-> USE_THEN "F23"(fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)])) THEN REMOVE_THEN "F30" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F30") 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)])))) THEN POP_ASSUM (fun th-> REWRITE_TAC[SYM(MATCH_MP lemma_identity_atom th)]) THEN USE_THEN "F33" MP_TAC 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])) THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_in_atom) THEN USE_THEN "F33"(fun th1-> REWRITE_TAC[MATCH_MP th1 (SPEC `d:num` LE_REFL)]) THEN USE_THEN "F23"(fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 (SPEC `d:num` LE_REFL))]) THEN USE_THEN "F28" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F34") 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] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_tail_via_restricted) THEN SUBGOAL_THEN `back (L2:(A)loop) u = back (L1:(A)loop) u` SUBST1_TAC THENL[USE_THEN "F31" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F21" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN USE_THEN "F11" (fun th -> MP_TAC(MATCH_MP LET_TRANS (CONJ (SPEC `m:num` LE_0) th))) THEN DISCH_THEN ((X_CHOOSE_THEN `t:num` (LABEL_TAC "H1" o REWRITE_RULE[CONJUNCT1 ADD])) o REWRITE_RULE[LT_EXISTS]) THEN USE_THEN "H1" SUBST1_TAC THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION; lemma_inverse_evaluation] THEN USE_THEN "F15" MATCH_MP_TAC THEN ONCE_REWRITE_TAC[GSYM LE_SUC] THEN USE_THEN "H1" (SUBST1_TAC o SYM) THEN USE_THEN "F11" (fun th-> REWRITE_TAC[REWRITE_RULE[GSYM LE_SUC_LT] th]) THEN USE_THEN "F12" (fun th-> USE_THEN "F14" (fun th1-> (MP_TAC(MATCH_MP LET_TRANS (CONJ th th1))))) THEN ARITH_TAC; ALL_TAC] THEN USE_THEN "F25" (fun th-> REWRITE_TAC[SYM th]) THEN DISCH_THEN (fun th-> LABEL_TAC "F35" th THEN REWRITE_TAC[th]) THEN USE_THEN "F33" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `d:num`) THEN USE_THEN "F23" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `d:num`) THEN USE_THEN "F28" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "F36") THEN USE_THEN "F34" MP_TAC 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] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_head) THEN SUBGOAL_THEN `next (L2:(A)loop) v = next (L1:(A)loop) v` SUBST1_TAC THENL[USE_THEN "F36" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F28" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[COM_POWER_FUNCTION] THEN USE_THEN "F31" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN USE_THEN "F21" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN REWRITE_TAC[GSYM lemma_add_exponent_function; CONJUNCT2 ADD] THEN USE_THEN "F15" MATCH_MP_TAC THEN REWRITE_TAC[LE_SUC_LT] THEN USE_THEN "F27" (SUBST1_TAC o SYM o ONCE_REWRITE_RULE[ADD_SYM]) THEN USE_THEN "F14"(fun th-> REWRITE_TAC[th]) THEN USE_THEN "F11" (fun th-> USE_THEN "F12" (fun th1-> MP_TAC(MATCH_MP LTE_TRANS (CONJ th th1)))) 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] THEN USE_THEN "F24" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th] THEN LABEL_TAC "F37" th) THEN USE_THEN "F36" (MP_TAC o SYM) 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))))) THEN DISCH_THEN (fun th->USE_THEN "F10" (MP_TAC o MATCH_MP LE_TRANS o CONJ th)) THEN USE_THEN "F32" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP determine_loop_index) THEN DISCH_THEN (LABEL_TAC "F38") THEN CONV_TAC SYM_CONV 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)))))))) THEN USE_THEN "F37"(fun th-> USE_THEN "F35"(fun th1-> USE_THEN "F38"(fun th2-> REWRITE_TAC[th; th1; th2]))) THEN USE_THEN "F22" SUBST1_TAC THEN USE_THEN "F23"(fun th-> REWRITE_TAC[MATCH_MP lemma_two_series_eq th]));;
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) ==> index L (attach H NF L x) (head H NF (attach H NF L x)) <= index L (attach H NF L x) x /\ 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) /\ dnax H NF L x IN genesis H NF L x /\ head H (genesis H NF L x) (attach H NF L x) = head H NF (attach H NF L x) /\ tail H (genesis H NF L x) (attach H NF L x) = attach H NF L x /\ (!i:num. i <= index L (attach H NF L x) (head H NF (attach H NF L x)) ==> 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)) /\ (!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 ==> 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)) /\ 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)) /\ 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))) /\ (!i:num. index L (attach H NF L x) x < i /\ i <= index L (attach H NF L x) (heading H NF L x) ==> 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)}) /\ (!i:num. 1 <= i /\ i <= mAdd H NF L x ==> 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)}) /\ (!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)`,
REPEAT GEN_TAC THEN DISCH_THEN(fun th ->LABEL_TAC "FC"(CONJUNCT1 th) THEN LABEL_TAC "F1"(MATCH_MP lemma_split_marked_loop th)) 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]) 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]))) THEN USE_THEN "F1" (LABEL_TAC "F9" o CONJUNCT1 o MATCH_MP lemma_on_heading) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (fun th1-> LABEL_TAC "F10" (CONJUNCT1(MATCH_MP lemmaHQYMRTX (CONJ th th1))))) THEN REWRITE_TAC[geney; tpy; start_glue_evaluation; loop_path; POWER_0; I_THM] THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (LABEL_TAC "F11" o MATCH_MP lemma_normal_genesis o CONJ th)) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o CONJUNCT2 o MATCH_MP lemma_on_dnax o CONJ th)) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "F12") (CONJUNCTS_THEN2 (LABEL_TAC "F14") (CONJUNCTS_THEN2 (LABEL_TAC "F15") (LABEL_TAC "F16")))) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (LABEL_TAC "F17" o MATCH_MP lemma_in_dnax o CONJ th)) THEN USE_THEN "F1" (LABEL_TAC "F17i" o CONJUNCT1 o MATCH_MP lemma_mInside) THEN LABEL_TAC "F18" (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] attach) 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)) 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)) 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)))))) THEN USE_THEN "F10" (fun th->DISCH_THEN (fun th1-> LABEL_TAC "F24" (MATCH_MP lemma_in_loop (CONJ th (CONJUNCT1 th1))))) 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)) THEN ABBREV_TAC `G = genesis (H:(A)hypermap) NF L x` THEN POP_ASSUM (LABEL_TAC "GL") THEN ABBREV_TAC `Q = dnax (H:(A)hypermap) NF L x` THEN POP_ASSUM (LABEL_TAC "QL") THEN ABBREV_TAC `y = heading (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "YEL") THEN ABBREV_TAC `z = attach (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "ZEL") THEN ABBREV_TAC `m = mAdd (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "MN") THEN ABBREV_TAC `p = mInside (H:(A)hypermap) (NF:(A)loop->bool) (L:(A)loop) (x:A)` THEN POP_ASSUM (LABEL_TAC "PN") THEN ABBREV_TAC `ny = index (L:(A)loop) z y` THEN POP_ASSUM (LABEL_TAC "YN") THEN ABBREV_TAC `nx = index (L:(A)loop) z x` THEN POP_ASSUM (LABEL_TAC "XN") THEN ABBREV_TAC `nh = index (L:(A)loop) z (head (H:(A)hypermap) NF z)` THEN POP_ASSUM (LABEL_TAC "HN") THEN SUBGOAL_THEN `nh:num <= nx` (LABEL_TAC "F27") THENL[MP_TAC (SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect) 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] THEN USE_THEN "HN" (fun th-> DISCH_THEN (LABEL_TAC "H1" o REWRITE_RULE[th] o MATCH_MP to_head)) THEN ASM_CASES_TAC `nh:num <= nx` THENL[POP_ASSUM (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN POP_ASSUM (LABEL_TAC "H2" o REWRITE_RULE[NOT_LE; GSYM LE_SUC_LT]) THEN USE_THEN "H1" (MP_TAC o SPEC `nx:num`) THEN USE_THEN "H2" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `nx:num` LE_PLUS) th)]) THEN DISCH_TAC THEN USE_THEN "H1" (MP_TAC o SPEC `SUC nx`) THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th; GSYM COM_POWER_FUNCTION]) THEN POP_ASSUM (SUBST1_TAC o SYM) THEN USE_THEN "F20" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "H3") 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] THEN DISCH_THEN (LABEL_TAC "H4") THEN USE_THEN "H3" (fun th-> (USE_THEN "H4" (MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_next_exclusive))) THEN USE_THEN "H3" (SUBST1_TAC o SYM) THEN DISCH_THEN (fun th-> (USE_THEN "H4"(MP_TAC o REWRITE_RULE[th] o MATCH_MP lemma_head_via_restricted))) THEN USE_THEN "F1"(fun th-> REWRITE_TAC[REWRITE_RULE[is_split_condition] th]); ALL_TAC] THEN USE_THEN "F27" (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `!i:num. i <= SUC p ==> is_inj_list (loop_path (L:(A)loop) (z:A)) ((nx:num) + i)` (LABEL_TAC "F28") THENL[REWRITE_TAC[lemma_loop_path_via_list; GSYM lemma_inj_orbit_via_list] THEN INDUCT_TAC THENL[REWRITE_TAC[LE_0; ADD_0; lemma_inj_orbit_via_list; GSYM lemma_loop_path_via_list] 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] THEN POP_ASSUM (LABEL_TAC "H1") THEN DISCH_THEN (LABEL_TAC "H2") THEN REWRITE_TAC[ADD_SUC] THEN MATCH_MP_TAC inj_orbit_step THEN EXISTS_TAC `dart_of (L:(A)loop)` THEN REWRITE_TAC[loop_lemma] THEN USE_THEN "H1" MP_TAC THEN USE_THEN "H2" (fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `i:num` LE_PLUS) th)]) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]) THEN REWRITE_TAC[GSYM ADD_SUC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN USE_THEN "F20" (fun th-> REWRITE_TAC[lemma_add_exponent_function; GSYM th]) THEN USE_THEN "FC" (fun th-> USE_THEN "F6" (MP_TAC o SPEC `SUC i` o CONJUNCT2 o MATCH_MP lemmaHQYMRTX o CONJ th)) THEN USE_THEN "PN" (fun th-> USE_THEN "ZEL" (fun th1-> REWRITE_TAC[th; th1])) THEN USE_THEN "H2" (fun th-> REWRITE_TAC[GE_1; th]) 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)) THEN USE_THEN "H2" (fun th-> REWRITE_TAC[th]) THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (fun th-> REWRITE_TAC[GSYM th]); ALL_TAC] THEN SUBGOAL_THEN `(nx:num) + (SUC p) = ny` (LABEL_TAC "F29") THENL[USE_THEN "F28" (MP_TAC o REWRITE_RULE[LE_REFL] o SPEC `SUC p`) THEN USE_THEN "F10" (fun th-> REWRITE_TAC[GSYM(SPEC `(nx:num) + (SUC p)` (MATCH_MP lemma_inj_loop_path th))]) THEN DISCH_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] heading) THEN USE_THEN "F1" (MP_TAC o SPEC `SUC (mInside (H:(A)hypermap) NF L x)` o CONJUNCT1 o MATCH_MP lemma_mInside) THEN USE_THEN "YEL" (fun th-> USE_THEN "PN" (fun th1-> REWRITE_TAC[th; th1; LE_REFL])) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN USE_THEN "F20" SUBST1_TAC THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN POP_ASSUM MP_TAC THEN USE_THEN "F10" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SYM o MATCH_MP determine_loop_index) THEN USE_THEN "YN" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN USE_THEN "F29" (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `Q IN (G:(A)loop-> bool)` (LABEL_TAC "F30") THENL[EXPAND_TAC "Q" THEN EXPAND_TAC "G" THEN REWRITE_TAC[genesis; IN_ELIM_THM; IN_DELETE; IN_UNION; lemma_in_couple]; ALL_TAC] THEN USE_THEN "F30" (fun th-> REWRITE_TAC[th]) THEN SUBGOAL_THEN `tail (H:(A)hypermap) G z = z` (LABEL_TAC "F31") THENL[USE_THEN "F12" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_tail_via_restricted th]) THEN MP_TAC (AP_THM (SPEC `Q:(A)loop` lemma_order_next) `z:A`) THEN USE_THEN "F14" (fun th-> REWRITE_TAC[I_THM; lemma_size; GSYM COM_POWER_FUNCTION; th]) THEN DISCH_THEN (MP_TAC o REWRITE_RULE[lemma_inverse_evaluation] o SYM o AP_TERM `back (Q:(A)loop)`) 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]))))) THEN USE_THEN "F16" (fun th-> REWRITE_TAC[REWRITE_RULE[LE_REFL] (SPEC `m:num` th)]) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F18" (fun th-> REWRITE_TAC[COM_POWER_FUNCTION; th]); ALL_TAC] THEN USE_THEN "F31" (fun th-> REWRITE_TAC[th]) 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") THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1") THEN USE_THEN "F15" (MP_TAC o SPEC `i:num`) THEN USE_THEN "F29" (fun th-> MP_TAC (REWRITE_RULE[th] (SPECL[`nx:num`; `SUC p`] LE_ADD))) THEN USE_THEN "H1" (fun th-> USE_THEN "F27" (fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1)))) THEN DISCH_THEN (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ th th1)])) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(SPECL[`H:(A)hypermap`; `L:(A)loop`; `z:A`] atom_reflect) 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] THEN DISCH_THEN (MP_TAC o SPEC `i:num` o MATCH_MP to_head) THEN USE_THEN "H1"(fun th1-> USE_THEN "HN" (fun th-> REWRITE_TAC[th; th1])); ALL_TAC] 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]))) THEN SUBGOAL_THEN `head (H:(A)hypermap) (G:(A)loop->bool) z = head (H:(A)hypermap) NF z` (LABEL_TAC "F34") THENL[USE_THEN "F33"(fun th->USE_THEN "F32" (MP_TAC o MATCH_MP lemma_in_atom o CONJ th)) THEN DISCH_TAC THEN USE_THEN "F15" (MP_TAC o SPEC `SUC nh`) 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)))]))) THEN REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN POP_ASSUM MP_TAC THEN USE_THEN "F15" (MP_TAC o SPEC `nh:num`) THEN USE_THEN "F29" (fun th-> MP_TAC (REWRITE_RULE[th] (SPECL[`nx:num`; `SUC p`] LE_ADD))) 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)])) THEN USE_THEN "F26" (fun th-> REWRITE_TAC[SYM th]) THEN DISCH_THEN SUBST1_TAC 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))]))) THEN DISCH_THEN (LABEL_TAC "H1") THEN DISCH_TAC 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 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN POP_ASSUM (fun th-> DISCH_THEN (fun th1-> REWRITE_TAC[REWRITE_RULE[th] (SYM(MATCH_MP lemma_head th1))])); ALL_TAC] THEN USE_THEN "F34"(fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1") THEN USE_THEN "H1"(fun th-> USE_THEN "F32"(fun th1-> MP_TAC(MATCH_MP lemma_sub_part (CONJ th1 th)))) THEN USE_THEN "F33"(fun th-> DISCH_THEN (fun th1-> MP_TAC(MATCH_MP lemma_in_atom (CONJ th th1)))) THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_identity_atom th]) THEN USE_THEN "F15" (MP_TAC o SPEC `i:num`) THEN USE_THEN "F29"(fun th-> MP_TAC(REWRITE_RULE[th] (SPECL[`nx:num`; `SUC p`] LE_ADD))) THEN DISCH_THEN (fun th1-> USE_THEN "F27" (fun th-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1)))) THEN USE_THEN "H1" (fun th-> DISCH_THEN(fun th1-> REWRITE_TAC [MATCH_MP LE_TRANS (CONJ th th1)])) THEN DISCH_THEN (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) THEN ABBREV_TAC `u = (next (L:(A)loop) POWER (i:num)) (z:A)` THEN POP_ASSUM (LABEL_TAC "UL") THEN USE_THEN "UL" (MP_TAC o SYM) THEN USE_THEN "H2"(fun th-> USE_THEN "F19"(fun th1-> MP_TAC (MATCH_MP LE_TRANS (CONJ th th1)))) THEN USE_THEN "F10" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (LABEL_TAC "H3" o MATCH_MP determine_loop_index) THEN USE_THEN "H2" MP_TAC THEN USE_THEN "H1" MP_TAC THEN USE_THEN "H3" (SUBST1_TAC o SYM) THEN EXPAND_TAC "nh" THEN EXPAND_TAC "nx" THEN USE_THEN "FC" (MP_TAC o CONJUNCT1 o MATCH_MP lemma_marked_dart) 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)) 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 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_separation_on_loop) THEN USE_THEN "H3" SUBST1_TAC THEN USE_THEN "H3" (fun th-> USE_THEN "XN"(fun th1-> USE_THEN "HN" (fun th2-> REWRITE_TAC[th; th1; th2]))) THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H4") (CONJUNCTS_THEN2 (LABEL_TAC "H5") (CONJUNCTS_THEN2 (LABEL_TAC "H6") (LABEL_TAC "H7")))) 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 THENL[USE_THEN "F15"(fun th-> REWRITE_TAC[LE_0; th]); ALL_TAC] THEN USE_THEN "F29" ((fun th-> MP_TAC (MATCH_MP compare_left th)) o REWRITE_RULE[ADD_SUC; GSYM(CONJUNCT2 ADD)]) THEN DISCH_THEN (MP_TAC o MATCH_MP LTE_TRANS o CONJ (SPEC `nx:num` LT_PLUS)) THEN USE_THEN "H7" (fun th-> DISCH_THEN (MP_TAC o MATCH_MP LET_TRANS o CONJ th)) THEN USE_THEN "H5"(fun th-> USE_THEN "H6"(MP_TAC o MATCH_MP LE_TRANS o CONJ th)) THEN USE_THEN "H4" (MP_TAC o MATCH_MP LET_TRANS o CONJ (SPEC `nh:num` LE_0)) THEN USE_THEN "F14" (MP_TAC o MATCH_MP compare_left o SYM o REWRITE_RULE[tpx]) THEN USE_THEN "ZEL" (fun th-> USE_THEN "YEL" (fun th1-> USE_THEN "YN"(fun th2-> REWRITE_TAC[th; th1; th2]))) THEN USE_THEN "F21" MP_TAC 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)) THEN USE_THEN "F12" MP_TAC THEN USE_THEN "F10" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F5" MP_TAC 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] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP atom_eq th]); ALL_TAC] 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") THENL[GEN_TAC THEN DISCH_THEN (LABEL_TAC "H1") THEN ASM_CASES_TAC `i:num <= SUC p` THENL[POP_ASSUM (LABEL_TAC "H2") THEN USE_THEN "F20" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN USE_THEN "F15" (fun th-> USE_THEN "F29" (SUBST1_TAC o SYM o MATCH_MP th o (MATCH_MP compare_left))) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN CONV_TAC (ONCE_DEPTH_CONV(LAND_CONV(REWR_CONV ADD_SYM))) 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))) THEN USE_THEN "F15" (fun th-> DISCH_THEN (SUBST1_TAC o MATCH_MP th)) THEN CONV_TAC (ONCE_DEPTH_CONV(LAND_CONV (REWR_CONV ADD_SYM))) THEN USE_THEN "F20"(fun th-> REWRITE_TAC[lemma_add_exponent_function; SYM th]) THEN USE_THEN "F17i" (fun th-> USE_THEN "H2" (fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC] THEN POP_ASSUM ((X_CHOOSE_THEN `d:num` (LABEL_TAC "H2")) o REWRITE_RULE[NOT_LE; LT_EXISTS]) THEN USE_THEN "H2" (fun th-> USE_THEN "H1" (LABEL_TAC "H3" o REWRITE_RULE[th; LE_ADD_LCANCEL])) THEN USE_THEN "H2" SUBST1_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [lemma_add_exponent_function] THEN USE_THEN "F17i" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `SUC p`) THEN SUBGOAL_THEN `(next (L:(A)loop) POWER (SUC p)) x = y` SUBST1_TAC THENL[USE_THEN "F20" SUBST1_TAC THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN USE_THEN "F29" (fun th-> USE_THEN "F22" (fun th1-> REWRITE_TAC[th; th1])); ALL_TAC] THEN USE_THEN "F20" SUBST1_TAC THEN USE_THEN "F15" (fun th-> USE_THEN "F29" (SUBST1_TAC o SYM o MATCH_MP th o (MATCH_MP compare_left))) THEN REWRITE_TAC[GSYM lemma_add_exponent_function; GSYM ADD_ASSOC] THEN USE_THEN "F29" (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_CASES_TAC `SUC d < SUC m` THENL[POP_ASSUM (fun th-> USE_THEN "F16"(fun th1-> REWRITE_TAC[MATCH_MP th1 (REWRITE_RULE[LT_SUC_LE] th)])); ALL_TAC] THEN POP_ASSUM (fun th-> USE_THEN "H3"(fun th1-> REWRITE_TAC [REWRITE_RULE[LE_ANTISYM] (CONJ th1 (REWRITE_RULE[NOT_LT] th))])) THEN REWRITE_TAC[ADD_SUC] THEN USE_THEN "F18" (SUBST1_TAC o SYM) THEN USE_THEN "F14" (MP_TAC o REWRITE_RULE[tpx]) 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])))) THEN DISCH_THEN (fun th-> REWRITE_TAC[SYM th; GSYM lemma_size; lemma_order_next; I_THM]); ALL_TAC] THEN USE_THEN "F35"(fun th-> REWRITE_TAC[th]) THEN STRIP_TAC THENL[GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 ((X_CHOOSE_THEN `d:num` ASSUME_TAC) o REWRITE_RULE[LT_EXISTS]) MP_TAC) THEN DISCH_THEN (fun th-> (USE_THEN "F15"(fun th1-> (SUBST1_TAC (SYM (MATCH_MP th1 th))))) THEN MP_TAC th) THEN POP_ASSUM SUBST1_TAC THEN USE_THEN "F29" (SUBST1_TAC o SYM) THEN DISCH_THEN (LABEL_TAC "H1" o REWRITE_RULE[LE_ADD_LCANCEL]) THEN ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[lemma_add_exponent_function] THEN USE_THEN "F29" (MP_TAC o MATCH_MP compare_left) THEN USE_THEN "F15"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP th)) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F20" (SUBST1_TAC o SYM) 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 THENL[MP_TAC (REWRITE_RULE[GE_1; GSYM ADD1] (SYM(SPECL[`SUC p`; `1`; `SUC m`] LE_ADD_LCANCEL))) THEN USE_THEN "F35"(fun th -> DISCH_THEN (fun th1-> REWRITE_TAC[MATCH_MP lemma_sub_part (CONJ th th1)])); ALL_TAC] THEN SUBGOAL_THEN `x:A belong (Q:(A)loop)` (LABEL_TAC "H2") THENL[USE_THEN "F17" (fun th-> REWRITE_TAC[th]) THEN DISJ1_TAC THEN EXISTS_TAC `nx:num` THEN USE_THEN "F29" (fun th-> REWRITE_TAC[MATCH_MP compare_left th]) THEN USE_THEN "F20" (fun th-> REWRITE_TAC[th]); ALL_TAC] THEN SUBGOAL_THEN `head (H:(A)hypermap) G x = x` MP_TAC THENL[USE_THEN "H2" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_head_via_restricted th]) THEN USE_THEN "F35" (MP_TAC o REWRITE_RULE[POWER_1; ADD_SUC; GE_1] o SPEC `1`) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "H2" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SPEC `SUC d` o CONJUNCT1 o MATCH_MP lemma_face_contour_on_loop) THEN USE_THEN "H1"(fun th-> REWRITE_TAC[th; GE_1]) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC(SPECL[`SUC p`; `SUC m`] LE_ADD) THEN USE_THEN "H1"(fun th-> DISCH_THEN (fun th1-> MP_TAC(MATCH_MP LE_TRANS (CONJ th th1)))) THEN DISCH_THEN (fun th-> USE_THEN "F35"(fun th1-> REWRITE_TAC[SYM(MATCH_MP th1 th)])); ALL_TAC] THEN GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 (LABEL_TAC "H1") (LABEL_TAC "H2")) THEN SUBGOAL_THEN `(face_map (H:(A)hypermap) POWER (i:num)) (y:A) = (next (Q:(A)loop) POWER i) y` MP_TAC THENL[USE_THEN "F22" (fun th-> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN USE_THEN "F15" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `ny:num`) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN CONV_TAC (RAND_CONV (LAND_CONV (ONCE_DEPTH_CONV (REWR_CONV ADD_SYM)))) THEN USE_THEN "F16" (fun th-> USE_THEN "H2"(fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC] THEN DISCH_THEN (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) 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 THENL[X_GEN_TAC `j:num` THEN DISCH_THEN (LABEL_TAC "H3") THEN USE_THEN "F22" (fun th-> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN USE_THEN "F15" (SUBST1_TAC o SYM o REWRITE_RULE[LE_REFL] o SPEC `ny:num`) THEN REWRITE_TAC[GSYM lemma_add_exponent_function] THEN CONV_TAC (LAND_CONV (LAND_CONV (ONCE_DEPTH_CONV (REWR_CONV ADD_SYM)))) THEN ASM_CASES_TAC `j:num <= m` THENL[USE_THEN "F16" (fun th-> POP_ASSUM(fun th1-> REWRITE_TAC[MATCH_MP th th1])); ALL_TAC] THEN POP_ASSUM (MP_TAC o REWRITE_RULE[NOT_LE; GSYM LE_SUC_LT]) THEN USE_THEN "H3"(fun th-> DISCH_THEN (MP_TAC o REWRITE_RULE[LE_ANTISYM] o CONJ th)) THEN DISCH_THEN (SUBST1_TAC) THEN USE_THEN "F18" (SUBST1_TAC o SYM) THEN USE_THEN "F14"(MP_TAC o REWRITE_RULE[tpx]) 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])))) THEN DISCH_THEN (fun th-> REWRITE_TAC[ADD_SUC; SYM th; GSYM lemma_size; lemma_order_next; I_THM]); ALL_TAC] THEN SUBGOAL_THEN `y:A belong (Q:(A)loop)` (LABEL_TAC "H4") THENL[USE_THEN "F17" (fun th-> REWRITE_TAC[th]) THEN DISJ1_TAC THEN EXISTS_TAC `ny:num` THEN USE_THEN "F22" (fun th-> REWRITE_TAC[th; LE_REFL]); ALL_TAC] THEN SUBGOAL_THEN `head (H:(A)hypermap) G y = y` MP_TAC THENL[USE_THEN "H4" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (fun th-> REWRITE_TAC[MATCH_MP lemma_head_via_restricted th]) THEN MP_TAC (REWRITE_RULE[GE_1; GSYM ADD1] (SYM(SPECL[`SUC p`; `1`; `SUC m`] LE_ADD_LCANCEL))) THEN USE_THEN "F35"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP th)) THEN ONCE_REWRITE_TAC[GSYM COM_POWER_FUNCTION] THEN MP_TAC (SPECL[`SUC p`; `SUC m`] LE_ADD) THEN USE_THEN "F35"(fun th-> DISCH_THEN (MP_TAC o MATCH_MP th)) THEN DISCH_THEN SUBST1_TAC THEN MP_TAC (SPECL[`H:(A)hypermap`; `NF:(A)loop->bool`; `L:(A)loop`; `x:A`] heading) THEN USE_THEN "YEL"(fun th-> USE_THEN "PN"(fun th1-> REWRITE_TAC[th; th1])) THEN DISCH_THEN (SUBST1_TAC o SYM) THEN SIMP_TAC[]; ALL_TAC] THEN USE_THEN "H4" MP_TAC THEN USE_THEN "F30" MP_TAC THEN USE_THEN "F11" MP_TAC THEN USE_THEN "F3" MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o SPEC `i:num` o CONJUNCT1 o MATCH_MP lemma_face_contour_on_loop) THEN USE_THEN "H1"(fun th-> USE_THEN "H2"(fun th1->REWRITE_TAC[th; th1])));;
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`,
REPEAT GEN_TAC 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"))))) 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)))) 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 THENL[EXISTS_TAC `index (L:(A)loop) (y:A) (x:A)` THEN USE_THEN "F6"(fun th-> USE_THEN "F7" (fun th1-> REWRITE_TAC[th; SYM th1; atom_reflect])); ALL_TAC] THEN DISCH_THEN (MP_TAC o ONCE_REWRITE_RULE[num_WOP]) THEN DISCH_THEN (X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 (LABEL_TAC "F8") (LABEL_TAC "F9")) (LABEL_TAC "F10"))) THEN SUBGOAL_THEN `0 < n:num` MP_TAC THENL[REMOVE_THEN "F5" MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT; CONJUNCT1 LE] THEN DISCH_TAC THEN USE_THEN "F9" MP_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC[POWER_0; I_THM]; ALL_TAC] THEN DISCH_THEN (MP_TAC o REWRITE_RULE[LT_EXISTS; CONJUNCT1 ADD]) THEN DISCH_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN ABBREV_TAC `z = (next (L:(A)loop) POWER (SUC d)) y` THEN POP_ASSUM (LABEL_TAC "F11") THEN SUBGOAL_THEN `~(z:A = inverse (node_map (H:(A)hypermap)) (back (L:(A)loop) z))` (LABEL_TAC "F12") THENL[USE_THEN "F10" (MP_TAC o REWRITE_RULE[LT_PLUS] o SPEC `d:num`) THEN REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN ASSUME_TAC THEN USE_THEN "F8"(fun th-> REWRITE_TAC[MATCH_MP LE_TRANS (CONJ (SPEC `d:num` LE_PLUS) th)]) THEN USE_THEN "F11" (MP_TAC o REWRITE_RULE[GSYM COM_POWER_FUNCTION]) THEN DISCH_THEN (MP_TAC o AP_TERM `back (L:(A)loop)`) THEN DISCH_THEN (SUBST1_TAC o REWRITE_RULE[lemma_inverse_evaluation]) THEN USE_THEN "F9"(fun th->POP_ASSUM (fun th1-> REWRITE_TAC[MATCH_MP lemma_second_absorb_quark (CONJ th th1)])); ALL_TAC] 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 THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN DISCH_THEN (MP_TAC o MATCH_MP lemma_unique_tail) THEN DISCH_THEN SUBST1_TAC 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))))))) THEN DISCH_THEN SUBST1_TAC THEN USE_THEN "F10" (MP_TAC o SPEC `index (L:(A)loop) y x`) THEN USE_THEN "F7"(fun th-> USE_THEN "F6"(fun th1-> REWRITE_TAC[th1; SYM th; atom_reflect; NOT_LT])));;
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`,
REPEAT GEN_TAC THEN REWRITE_TAC[plain_hypermap] THEN REWRITE_TAC[MATCH_MP convolution_inv (CONJUNCT2 (SPEC `H:(A)hypermap` edge_map_and_darts))] THEN ONCE_REWRITE_TAC[CONJUNCT1(SPEC `H:(A)hypermap` inverse_hypermap_maps)] THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (fun th-> MP_TAC (AP_THM th `x:A`)) THEN REWRITE_TAC[o_THM; I_THM]);;
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`,
REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM node_map_injective] THEN ABBREV_TAC `y = node_map (H:(A)hypermap) x` THEN ASM_MESON_TAC[square_edge_convolution]);;
(* deprecated *) let lemma_card_inverse_map_eq = lemma_orbit_inverse_map_eq;; prioritize_real();; end;;