(* ========================================================================== *)
(* 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`,

   REWRITE_TAC[lemma_inj_orbit_via_list; lemma_sub_list]);;
  

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))`,

   SIMP_TAC[lemma_planar_index_on_walkup_at_degenerate_dart]
   THEN SIMP_TAC[lemma_planar_index_on_nondegenerate]
   THEN SIMP_TAC[lemma_walkup_count_nodes; lemma_walkup_count_faces]
   THEN SIMP_TAC[lemma_merge_case_count_edges; lemma_splitting_case_count_edges]
   THEN REWRITE_TAC[is_splitting_component]
   THEN MESON_TAC[lemma_walkup_count_not_splitting_components; lemma_walkup_count_splitting_components]);;

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`,

   REWRITE_TAC[lemma_inj_list; lemma_def_inj_contour]);;

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)`,

   MESON_TAC[lemma_power_next_in_loop; lemma_next_power_representation]);;

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)`,
 MESON_TAC[loop_lemma; lemma_permute_loop]);;

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))`,

   REWRITE_TAC[is_edge_nondegenerate] THEN  MESON_TAC[is_edge_nondegenerate; lemma_edge_degenerate]);;

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)`,

   MESON_TAC[lemma_inc_injective; lemma_inc_monotone; LE_LT]);;

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;;