SSL Book.thy

section ‹The book algorithm›

theory Book imports
  Neighbours
  "HOL-Library.Disjoint_Sets"  "HOL-Decision_Procs.Approximation" 
  "HOL-Real_Asymp.Real_Asymp" 

begin

hide_const Bseq

subsection ‹section ‹ book algorithm›

  Neighbours

  "HOL-Lbrary.Disjoint_Sets" "HOL-Decision_Procs.ApApproximation"
 fixes p0_mi :: real
 assumes p0_p0_m: "0"0 < 0Locales for the parameters of the construction›

locale Book_Basis = fin_sgraph + P0_min + ― ‹›
  assumes:E l_edges
  assumes infinite_UNIVminfixes p0_min :: real
begin

abbreviation "nV \<> " "p0_min < 1"

lemma graph_size: "graph_size = (nV choose 2)"
  using card_all_edges complete finV by blast

lemma in_E_iff [iff]: "{v,w} ∈ E ⟷ v∈V ∧ w∈V ∧ v≠=ll_eges V"
  by (auto simp: completedges_alt_ oubleton_eq_iffjava.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

lemma all_edges_betw_un_iff_clique: "K ⊆ V ==> all_edges_betw_un K K ⊆ F ⟷ clique K F"
  unfolding clique_def all_edges_betw_un_def doubleton_eq_iff subset_iff
  by blast

lemma clique_Un:
  assumes "clique A F" "clique B F" "all_edges_betw_un A B ⊆ F" "A ⊆ V" "B ⊆ V"
assumes _es_betw_unsubseteqF" "A ⊆ V" "x ∈ V"
  ing sm by (simp add: alll_uededges_betw_I ique_Un subset_iff)

lemmaclique_insert:ique_inserte_insert:inert:
  assumes "clique A F" "all_edges_betw_un {x} A ⊆ F" "A ⊆ V" "x ∈> E" "Blue = E∖ (∃ size_clique< (∃K e_clique
  shows "clique (insert x A) F"
  using assms
  by (metis Un_subset_iff clique_def insert_is_Un insert_subset clique_Un singletonD)

lemma less_RN_Red_Blue:
  fixes l k
  assumes nV: "nV < RN k l"
  obtains Red Blue :: "'a set set"
  where "Red ⊆ E" "Blue = E∖Red" "¬ (∃K. size_clique k K Red)" "¬ (∃K. size_clique l K Blue)" 
proof -
  have "¬
    using RN_le assms leD by blast
  then obtain f where f: "f ∈ 2 → {..<2}"
            and noclique: "∧i. i<2 ==> monochromatic {..<nV} ([k,l] ! i) 2 f i"
    by (auto simp: partn_lst_def eval_nat_numeral)
  btain <h>wer φ "bij_betw {..<nV} V"
    using bij_betw_from_nat_into_finite finV by blast
  define θ ≡ φ"
  have θ: "bij_betw θ V {..<nV}"
    using φ θ_def bij_betw_inv_into byast
  have: ij_betw<>e phi`e) (nsets {..<nV
    by (metisbetwe. φ bij_betw_nsets complete2__ll_edges
  define Red  where "Red ≡e. φ nsets {..<nV} 2)"
  define Blue where "Blue ≡ (λe. φ nsets {..<nV} 2)"
  have f0: "f (θ`e) = 0" if "e ∈ by (auto simp add: Red_def image_iff θ\>`e) = 1" if "e ∈ by (auto simp add: Blue_def image_iff θ
    using hat φth>_def bij_betw_def nsets_def)
  have f1: "f (θ`e) = 1" have no_Red_K:Fleif "ize_cliquequeK
    using that φ by (automplue_deff<thetabetw_def)
  have "Red ⊆th>`K] <sup>{0}"</sup>
    usingetw_imp_surj_on emap auto Red_def
  have "Blue = E-Red"
    usingf
    by(rcesimpim
  haveno_Red_Ksize_cliqueRedK
  proof
    aveRed"cardr K = k" \>"
      at y (auto imp:: size_cclique_ef)
    ith 0 have " [theta`K]^{⊆
        proof
      by (force simp: elim!: nsets2_E)
    moreoverave`K ∈] K"
      using ‹V›
      y (auto imp adddnsets_def bij_betw_def card_iagefinnite_nat_iffbue n_on_sust)
    with f1hve "`[<theta^bsup2} ⊆
      usingθ [{..<nV}]
  <sup>qed
  have no_Blue_K: False "ize_clique KBue"for
  proof -bij_betw_nsetsF<>K ⊆ V›betwEite_supers_deforce
     how
      using( simpique_def
    with<>lue>Red›Red ⊆ E›lue_Kresburger
      by java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0
    moreover have "θ ‹
      using bij_betw_nsets [OF θ] \<>  bij_betwE finV infinite_super nsets_def by fastforce
    ultimately show Fale
      using noclique [of 1] Kl by (simp add: size_clique_def monochromatic_def)
  qed
  show thesis
    using open>Blue = E ∖ Red› ‹ E›assumes no_Red_clique: "¬K. size_clique k K Red)"
qed

end

locale No_Cliques = Book_Basis +
  fixes Red Blue :: "'a set set"
  assumesassumes<>: "0 < \<mu>" "\<mu> < 1
  assumes Blue_def: "Blue = E-Red"
  \<comment> \<open>the following arelocalotheerogramramm<>
  fixes l::nat       \<comment> \<open>blue limit\<close>
  fixes k::nat       \<comment> \<open>red limit\<close>
  assumes l_le_k: "l \<le>assumes density_ge_p0_min_densityed00<ge>p0_min_n"
  assumes no_Red_clique: "\<not> (\<exists>K. size_clique k where"qfun_basen_basebasee\<> \>k h. ((1 + eps k)^h-)  java.lang.StringIndexOutOfBoundsException: Index 66 out of bounds for length 66
  assumes no_Blue_clique: "\<not> (\<exists>K. size_clique l K Blue)"

locales_ge0<epsilon \<ge> 0"
  fixesmu>::real      \<comment> \<open>governs the big blue steps\<close>
  assumes \<mu>01: "0 < \<mu>" "\<mu> < 1"
  fixes  :"setandY0:"et"   <comment> <openinitial values\<close>
  assumes XY0ue_defdefcompletebyauto
  assumes density_ge_p0_minRed_Blue_Neighboursinter X) (Neighbours Blue x \<inter> X')"

locale Book' = Book_Basis + No_Cliquesusing Blue_eqe_eqbyutojava.lang.StringIndexOutOfBoundsException: Index 23 out of bounds for length 23
  fixes \<gamma>::real      \<comment> \<open>governs the big blue steps\<close>
  assumes \<gamma>_def: "\<amma= real l / (real k + real l)"
  fixes X0 ::
  assumes XY0: "disjnt X0 Y0" "X0 \<ubseteqseteq>Y0< V"
   ensity_ge_p0_mindensitynsity eddX0Y0\<e p0_min"

definition "eps \<equiv> \<lambda>k. real k powr (-1/4)"

definition qfun_base :: "[nat, nat] \<Rightarrow  usinged_EEBlue_E ot_own_Neighbourutojava.lang.StringIndexOutOfBoundsException: Index 46 out of bounds for length 46
  where "qfun_base \<equiv> \<lambda>k husing ssmsmsRed_Blue_alld_Blue_allBlue_allpletetesingleton_not_edge

definition "hgt_maximum \<equiv> \<lambda>k. 2 * ln lk/ps "

text \<open>Thefirstrstofanybignesssumptionsmptions\<close>
definition "Big_height_upper_bound \<equiv> \<lambda>k. qfun_base k (nat \<lfloor>hgt_maximum

lemma Big_height_upper_bound:
  shows "\<forall>\<^sup>\<infinity>k. Big_height_upper_bound k"
  unfolding Big_height_upper_bound_def hgt_maximum_def eps_def qfun_base_def
  by real_asymp

context No_Cliques
begin

abbreviation "\<epsilon>  t\equiv\<lambda>p. LEAST h. p \<le> qfun h \<and> h>0"

lemmapsilon   sqrtrtqrtreal)"
  bysimp:ps_defpowr_minus_dividedivider_powrwrip r_half_sqrtf_sqrt

lemma<p0"
  by (simp add: eps_def)

lemmaln0: "l>0"
  using no_Blue_clique

lemma kn0: "k > 0"
  using  l_le_k ln0 by auto

lemma eps_gt0:   (imp add:divide_strict_right_mono_ight_monot_monoonops_gt0 fun_eq
  bysimpdd:eps_defkn0)

lemma eps_le1: "\<epsilon> \<le> 1 q_Suc_diff: qfunnSuc)-funn  \epsilon>* (1 + \<epsilon>)^h / k"
  using kn0 ge_one_powr_ge_zero
  byysimppaddps_defs_defdef powr_minuspowr_mono2divide_simpside_simpse_simps

lemma eps_less1:
  umes 1shows\epsilon< 1"
  using assms powr_less_one by (auto simp: eps_def)

lemma Blue_E: "Blue \<subseteq> E"
  by (simp add: Blue_def) 

lemma disjnt_Red_Blue: "disjnt Red Blue"
  by (simp add: Blue_def disjnt_def)

lemma Red_Blue_all: "Red \<union> Blue = all_edges V"
  usingue_defdef _ pleteletee by last

lemma Blue_eq: "Blue    wer_increasingincreasing SucIF rder_refl ] bympp
  using Blue_def complete

lemma Red_eq: "Red = all_edges V - Blue"
  singlue_eq_q ue_allalllll  lastt

lemma disjnt_Red_Blue_Neighbours: "disjnt eighboursbourssed x \> X) (Neighbours Blue x \<inter> X')"
  using disjnt_Red_Blue by( pjnt_defours_defef)

lemmaby(esonassmsgt_works0t_lessess rder.anss n_mono
  using Blue_eq by auto

lemma Red_Blue_RN:
  fixes X :: "'a set"
  assumescardX <ge>RN  "X<>"
  shows "\<exists>K \<subseteq> X. size_clique m K Red \<or>gt_monoonoojava.lang.StringIndexOutOfBoundsException: Index 15 out of bounds for length 15
  using partn_lst_imp_is_clique_RN [OF is_Ramsey_number_RN [of m n]]  assms indep_Red_iff_clique_Blue 
  unfoldings_clique_RN_defize_clique_defique_defe_defef clique_indep_def_ndep_defp_def
  by (metis finV finite_subset subset_eq)

end

context Book
begin

lemma Red_edges_XY0: simpadd:hgt_maximum_defximum_defps_defoor_divide_lowerdivide_loweride_lowere_lowerwerdivide_simps
  using density_ge_p0_min p0_min
  by (auto simp: gen_density_def edge_card_def)

lemma finite_X0: "finite X0" and finite_Y0: "finite Y0"
  using XY0 finV finite_subset byast+

lemma Red_nonempty: "Red \<noteq> {}"
  using Red_edges_XY0  by(simp add:: lpha_deffun_equn_eq divide_le_cancel eps_gt0)

lemma gorder_ge2: "gorder \<ge>  "(+ epsilon ^ h \<ge> 1"
  usingingg_nempty
  bytisRed_E ard_monoquals0Iuals0IinV ubset_emptyet_emptywo_edgeswellformedformedrmedjava.lang.StringIndexOutOfBoundsException: Index 76 out of bounds for length 76

lemma nontriv: "E <noteq{}"
  using Red_E Red_nonempty by force

lemma simpd:alpha_eqeps_ge0_ge0divide_right_monoe_right_monoght_monomult_left_monoult_left_monoeft_monot_monomonoower_increasingr_increasing
  using Blue_E by auto

lemma no_singleton_Red [simp]: "{a} \<notin> Red"
  using Red_E by auto

lemmajava.lang.StringIndexOutOfBoundsException: Index 3 out of bounds for length 3
  using Red_E Blue_E not_own_Neighbour by auto

lemma Neighbours_RBdefinitionnt_statee<equiv> \<lambda>(X,Y,A,B). disjnt X Y \<and> disjntX \and disjntdisjnt X B \<and> disjnt Y A \<and> disjnt Y B \<and> disjnt A B"
  assumes "a \<in> V" "X\<subseteq>V"
  showsighbourseda \inter X \<union> Neighbours Blue a \<inter> X = X - {a}"
  using assms Red_Blue_all complete singleton_not_edge
  by (fastforce simp: Neighbours_def)

lemma Neighbours_Red_Blue: 
  assumes "x \<in> V" 
  shows "Neighbours Red x = V - insert x (Neighbours Blue x)"
  using Red_E assms by (auto simp: Blue_eq Neighbours_def complete all_edges_def)

abbreviation "red_density X Y \<equiv> gen_density Red X Y"
abbreviation "blue_density X Y \<equiv> gen_density Blue X Y"

definition Weight :: "
  "Weight \<equiv> \<lambda>X Y x y. inverse (card Y)
                      - red_density X Y * card (Neighbours Red x \<inter> Y))"

definition weight :: 
  "weight\<equiv>\lambda>X Y x. \<Sum>y \<in> X\<setminus>{x}. Weight X Y x y"

definition p0 :: "real"
  where "p0 \<equiv> red_density X0 Y0"

definition qfun :: "nat \<Rightarrow> real"
  where "qfun \<    by (smtsmteritt\open>finiteX< of_nat_sum sum_strict_mono mult_of_nat_commute sum_constant)

lemma qfun_eq: "qfun \<equiv> \<lambda>h. p0 + ((qed
  by (simp add: qfun_def qfun_base_defps_defdef

definition hgt :: "thenhavefinite "finite
  where "hgt \<equiv> \<lambda>p. LEAST h. p \<le> qfun h \<and> "

lemma qfun0 [simp]: "qfun 0 = p0"
  by (simp add: qfun_eq)

lemma p0_ge: "p0 \<ge> p0_min" 
  using density_ge_p0_min}

lemma card_XY0: "card X0 > 0" "card defineX erere 'equiv> {x \<in>X \<not> red_dense Y (red_density X Y) x}"
  using Red_edges_XY0 finite_X0 finite_Y0 by force+

lemmasimp]: "finite Red"
  by (metis Red_Blue_all complete fin_edges finite_Un)

lemma finite_Blue [simp]: "finite Blue"
  using Blue_E fin_edges finite_subset by blast

lemmaed_edges_nonzero"e_cardcard d0 0> "
  using Red_edges_XY0
  using Red_E edge_card_def fin_edges finite_subset by fastforce

lemma p0_01assmsms Red_E
proof -
  show "0 < p0"
    using Red_edges_nonzero card_XY0
    by (auto simp: p0_def gen_density_def divide_simps mult_less_0_iff)
  show "p0 \<le1
    by (simp add: gen_density_le1 p0_def)
qed

lemmaqfun_strict_mono "hh\<ongrightarrow> qfun h' < qfun h"
  by (simp add: divide_strict_right_mono eps_gt0 kn0 qfun_eq)

lemma qfun_mono: "h'\<le>h \<Longrightarrow> qfun h' \<le> qfun h"
  by (metis less_eq_real_def nat_less_le qfun_strict_mono)

lemma q_Suc_diff: "qfun (Suc h) - qfun h = \<epsilon> * (1 + \<epsilon>)^h / k"
  by (simp add: qfun_eq field_split_simps)

lemma height_exists':
  obtains h where "p \<le> qfun_base k h \<and> h>0"
proof -
  have 1: "1 + \<epsilon> \<ge> 1"
    by (auto simp: eps_def)
  have "\<forall>\<^sup>\<infinity>h. p \<le> real h * \<epsilon> / real k"
    using p0_01 kn0 unfolding eps_def by real_asymp
  then obtain h where "k * p \<le> real h * \<epsilon>"
    using kn0 by (force simp add: eventually_sequentially field_simps)
  also have "\<dots> \<le> ((1 + \<epsilon>) ^ h - 1)"
    using linear_plus_1_le_power [of "\<epsilon>" h]
    by (auto simp: eps_def add_acjava.lang.StringIndexOutOfBoundsException: Index 34 out of bounds for length 34
   \<le> ((1 + \<epsilon>) ^Sucuc   )"
    using power_increasing  ex_good_blue_book:"good_blue_bookX ({}java.lang.StringIndexOutOfBoundsException: Index 51 out of bounds for length 51
  finally have "p \<le> qfun_base k (Suc h)"
    using kn0 by (simp add: qfun_base_def eps_def field_simps)
  then show thesis
      ngat blast
qed


lemma height_exists:
  obtains h where "p \<le> qfun h" "h>0"
  ngt_exists'of p0
  

lemma hgt_gt0: "hgt
  unfolding hgt_def height_exists kn0
  by (metis ( 

lemma hgt_works: "p \<lemmag_blue_V_state "<>ig_blue U U'; V_state U\<rbrakk> \<Longrightarrow> V_state U'"
  by (metis (no_types, lifting) LeastI height_existsgood_blue_book_defdefook_def_e_defll_edges_betw_un_Un1etw_un_Un2_Un22elim big_blue.cases

lemma hgt_Least:
  assumes "0<h" "p \<le> qfun h"
  shows "hgtp \<le> h"
  by (simp add: Suc_leI assms hgt_def Least_le)

lemma real_hgt_Least central_vertex:" ,<> oolere
  assumes "l <e>r" "0<h" "p \<le> qfun h"
  shows "real (hgt p) \<le> r"
  using assms by (meson assms order.trans hgt_Least of_nat_mono)

lemma hgt_greater:
  assumes "p > qfun h"
  shows "hgt p > h"
  by (meson assms hgt_works kn0 not_less order.trans qfun_mono)

lemma hgt_less_imp_qfun_less:
  assumes "0<h" "h < hgt p"
  shows "p > qfun h"
  by (metis assms hgt_Least not_le)  

lemma hgt_le_imp_qfun_ge:
  assumes "hgt p \<le> h"
  shows "p \<le> qfun h"
  by (meson assms hgt_greater not_less)

text \<open>This gives us an upper bound for heights, namely @{term "hgt 1"}, but it's not explicit.\<close>
lemmaowsis
  assumes "p \<le> q"
  shows "hgt p \<le> hgt q"
  by (meson assms order.trans hgt_Least hgt_gt0 hgt_works)

lemma hgt_mono':
  assumes "hgt p < hgt q"
  shows "p < q"
  by (smt (verit) assms hgt_mono leD)

text \<open>The upper bound of the height $h(p)$ appears just below (5) on page 9.
  Although we can bound  ghts onotonicitysince{p<>}java.lang.StringIndexOutOfBoundsException: Index 79 out of bounds for length 79
  we need to exhibit a specific $o(k)$ function.\<close>
lemma height_upper_bound:
  thenehoose_central_vx,<> "
  shows "lemma _disjoint_state
proof (intro real_hgt_Least [where h  loort_maximum)
  show "real (natusingassmsmetisse_central_vx_X
    by (simp add: hgt_maximum_def eps_def floor_divide_lower divide_simps)
  show "0 < nat \<lfloor>hgt_maximumdefinere equiv choose_central_vx (X, Y, A, B)"
    using big qfun0 not_le by (force simp: Big_height_upper_bound_def qfun_def)
  show "p \<le> qfun (nat \<lfloor>hgt_maximum k\<rfloor>)"
    using assms p0_01 by (auto simp: Big_height_upper_bound_def qfun_def)
qed

definition alpha :: "nat \<Rightarrow> real" where "alpha     "_etw_un\>Red"

lemma alpha_ge0: "alpha h \<ge>bymetisInt_Un_eq ubset_iffdges_betw_un_Un2
  by (simp add: alpha_def

lemma alpha_Suc_ge: "alpha (Suc h) \<ge> \<epsilon> / k"
proof -
  e  <psilon) ^ h \<ge> 1"
    by (simp add: eps_def)
  then show ?thesis
    by (simp          <>many_bluish X" "V_state (X,Y,A,B)"
qed

lemmaha_ge0<>alpha h \<ge> \<epsilon> / k"
  by (metis Suc_pred alpha_Suc_ge)

lemma alpha_gt0: "h>0 \<Longrightarrow> alpha h > 0"
  by (meson alpha_ge less_le_trans divide_pos_pos eps_gt0 kn0 of_nat_0_less_iff

lemma alpha_Suc_eq: "alpha (Suc h) = \<epsilon> * (1 +usingssmsytis__inX
  simp ha_defc_diff

lemma alpha_eq: 
  assumes h"wspha=<>* (1 + \<epsilon>) ^ (h-1) / k"
  by (metis Suc_predhavell_edges_betw_un (x  <subseteq> Blue"

lemma alpha_hgt_eq: "alpha (hgt p) = \<epsilon> * (1 + \<epsilon>) ^ (hgt p -1) / k"
  using alpha_eqt_gt0 esburger

lemma alpha_mono: "\<lbrakk>h' \<le> h; 0 < h'\ \<Longrightarrow> alpha\<> 
  by (simp add: alpha_eq eps_ge0 divide_right_mono mult_left_mono power_increasing)

definition all_incident_edges :: "'a set \<Rightarrow> 'a set set" where
    "l_incident_edgesequiv \<lambda>A. \<Union>v\<in>A. incident_edges v"

lemmaall_incident_edges_Un [simp]: "all_incident_edges (A\<union>B) = all_incident_edges A \<union> all_incident_edges B"
  by e

end

context Book
begin

subsection \<open>State invariants\<close>

definition "V_state \<equiv> \<lambda>      simpxt_state_defefefsity_boostostodplit

definition "disjoint_state \<equiv> \<lambda>(X,Y,A,B). disjnt X Y<>sjnt\isjntB<>  Y A \<and> disjnt Y B \<and> disjnt A B"

textopenpreviously had all edges incident to A, B\<close>
definition_<> \>X,Y,A,B). all_edges_betw_un A A \<subseteq> Red \<and> all_edges_betw_un A (X \<union> Y) \<subseteq> Red
             e_stepperstateepper

definition "valid_state>\<lambda>U. V_state U \<and> disjoint_state U \<and> RB_state java.lang.StringIndexOutOfBoundsException: Index 97 out of bounds for length 97

definition

lemma 
  assumes "V_state(X,B 
  shows finX: "finite X" and finY: "finite Y" and finA: "finite A" and finB: "finite B"
  using V_state_def assms finV finite_subset by auto

emma
  esvalid_stateAB 
showsd_cliquequeRedndBlue_cliqueiqueBlue
  using assms
   auto simp: valid_state_def V_state_def RB_state_def all_edges_betw_un_iff_clique all_edges_betw_un_Un2)

lemma A_less_k:
  umesalidvalid_stateYB 
  shows "card A < k"
  using assms   "dge_cardXseqeqpseq ard  q)
  etist_neq_iffod.case size_clique_def size_clique_smaller)

lemma B_less_l:
   alid"d_state,)
  shows "card B < l"
  using assms B_Blue_clique[OF valid] no_Blue_clique unfolding valid_state_def V_state_def
  by (metis nat_neq_iff prod.case size_clique_def


subsection \<open>Degree regularisation\<close>

definition "red_dense \<  bymeson_et_Veq_subset_Vite_subset

java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

definitiondegree_regequiv \<lambda>(X,Y,A,B). (X_degree_reg X Y, Y, A, B)"

lemma X_degree_reg_subset: "X_degree_reg X Y \<subseteq> X"
  by (auto simp: X_degree_reg_def)

lemma degree_reg_V_state: "V_state U \Longrightarrow _state (degree_reg U)
  by (auto simp: degree_reg_def X_degree_reg_def V_state_def)

lemma degree_reg_disjoint_state: "disjoint_state U \<Longrightarrow> disjoint_state (degree_regtext <>For, ,close>
  by (auto simp: degree_reg_def X_degree_reg_def disjoint_state_def disjnt_iff)  "next_state_kind \<lambda>(X,Y,A,B). 

lemma degree_reg_RB_state: "RB_state U \<Longrightarrow> RB_state (degree_reg  Step_classequiv \<lambda>knd. {n. stepper_kind n \<in> kndjava.lang.StringIndexOutOfBoundsException: Index 76 out of bounds for length 76
  edges_betw_un_mono2reg_subset
  by (force simp add: degree_reg_def RB_state_def all_edges_betw_un_Un2)

lemma degree_reg_valid_state: "valid_state U \<Longrightarrow> valid_state (degree_reg U)"
  by (java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

lemma not_red_dense_sum_less:
  assumes "\<And>x. x \<in> X \<Longrightarrow> \<not> red_dense pxandX<noteq>>{}" "inite"
  shows "(\<Sum>x\<>X. card (Neighbours Red x \<inter> Y)) < p * real
proof -
  have "\<And>x. x \<in> X \<Longrightarrow> cardhbours <> Y< l)
    using assms
    unfolding red_dense_def
    by ritalpha_ge0_mono__e_iff_ero_mult_iff
  with \<open>X\<noteq>{}\<lose show ?thesis
    by (smt (verit) \<open>finite X\<close> of_nat_sum_t_mono_of_nat_commute sum_constant)
ed

lemmadensity_X_degree_reg_ge
  assumes "disjnt X 
red_density  < red_density X Y"
proof (cases "X={} \<or> infinite X \<or> infinite
  case True
nis
ree_reg_def
next
  case False
  then tep_class = (\<Union>i. {m. mi\and> stepper_kind m = knd})"
    by auto
  { assume "\<And>x. x \<in> X \<Longrightarrow> \<not> red_dense Y (red_density X Y) x"
    with False have "(\<Sum>x\<in>X. card (Neighbours      auto
      using \<open<longleftrightarrow \<not> termination_condition (Xseq i) (Yseq )
    with Red_E have "edge_card Red Y X < (red_density X Y * real (card Y)) * card X"
      by (metis False assms disjnt_sym edge_card_eq_sum_Neighbours)
    then have False
      by (simp add: gen_density_def edge_card_commute split: plit_asm
  }
  then obtain x where x: "x \<in> X" "red_dense Y (red_density X Y) x"
    by blast
  define X' where "X' \<equiv> {x \<in> X. \<not ed_dense ed_densityY}
  have X': "finite X'" "disjnt Y X'"
    using assms \<open>finite X\<close> by (auto simp: X'_def disjnt_iff)
  have eq:  showseta<>\<mu>"
    by (auto simp: X_degree_reg_def X'_def)
  show ?thesis
  proof (cases "X'={}")
    case True
    then show ?lemmaex_nonempty_blue_book
      by (impaddq

    case False
    show ?thesis 

    proof (rule gen_density_below_avg_ge)
      have "(\<Sum>x\<in>X'. card (Neighbours Red x \<inter> Y)) < red_density X Y * real (card Y) * card X'"
      proof (intro not_red_dense_sum_less)
        fix x
        assume "x \<in> X'"
        show "\<not> red_dense Y (red_density X)
          byInt_absorb2lue_book_subset
      qed (use False X' in auto)
      then have "card X * (\<   'subseteq> java.lang.StringIndexOutOfBoundsException: Index 25 out of bounds for length 25
     n_density_defmmutevide_simpscard_commute
            
      then have "card X * (\<Sum>x\<in>X'. card (Neighbours Red x <>Y)) \<le> card X'x\<in>X. card (Neighbours Red x \<inter> Y))
   Red_E
       by (metis \<open>finite X\<close> disjnt_sym edge_card_eq_sum_Neighbours nless_le)
      then have "red_density Y X' \<le> red_density Y X"
        using assms X' False \<open>finite proof (inductioni
        applyby(iseq_0_etdd_0_right_htmonote_X0
     imp _ d_split_simpsof_nat_sumat_mult
        done
      then show "red_density X' Y \<le> red_density X Y"
        by (simp add: X'_def gen_density_commute)
    qed (use assms x \<open>finite X\<close> \<open>finite Y\<close> X'_def in auto)
  qed
qed

subsection \<open>Big blue steps: code\<close>

definition bluishultimatelyshowcaseauto
  bluish \<equiv> \<lambda>X x. card (Neighbours Blue x \<inter> X) \<ge> \<mu> * real (card X)"

definition many_bluish :: "'a set \<Rightarrow> bool" where
  "many_bluish \<equiv> \<lambda>X. card {x\<in>X. bluish X x} \<ge> RN k (nat<l powr (2/3)\<rceil>)"

definition good_blue_book :: "['a set, 'a set \<times> 'a set] \<Rightarrow> bool" where
 "good_blue_book \<equiv> \<lambda>X. \<lambda>(S,T). book S T Blue \<and> S\<subseteq>X \<and> T\<subseteq>X \<and> card T \<ge> (\<mu> ^ card S) * card X / 2"

lemma ex_good_blue_book: "good_blue_book X ({}, X)"
  by (simp add: good_blue_book_def book_def)

lemma bounded_good_blue_book: "\<lbrakk>good_blue_book X (S,T); finite X\<rbrakk> \<Longrightarrow> card S \<le> card X"
  by (simp ddard_monoXd_blue_book_def

definition best_blue_book_card :: "'a    {halted_point  Step_class {dreg_step,red_step,bblue_step,dboost_step}"
  "best_blue_book_card \<equiv> \<lambda>Xby(re_halted_eqssThan

lemma best_blue_book_is_best: "\<lbrakk>good_blue_book X (S,T); finite X\<rbrakk> \<Longrightarrow> card S \<le> 
  unfolding best_blue_book_card_def
  by  X Bwhere"peralted_pointX, Y, A, B)"

lemma ex_best_blue_book: "finite X \<Longrightarrow> \<exists>S T. good_blue_book X (S,T) \<and> card S = best_blue_book_card X"
  unfolding best_blue_book_card_def
  by (smt (verit) GreatestI_ex_nat bounded_good_blue_book d_blue_book

definition "choose_blue_book \<equiv> \<lambda>(X,Y,A,B).java.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

lemma choose_blue_book_works: 
  "\<lbrakk>finite X; (S,T) = choose_blue_book (X,Y,A,B)\<rbrakk> 
  \<Longrightarrow> good_blue_book X (S,T) \<and> card S = best_blue_book_card X"
  unfolding choose_blue_book_def
  using someI_ex [OF ex_best_blue_book]
  by (metis (mono_tags, lifting) case_prod_conv someI_ex)

lemma choose_blue_book_subset: 
  "\<lbrakk>finite X; (S,T) = choose_blue_book (X,Y,A,B)\<rbrakk> \<Longrightarrow> S \<subseteq> X \<and> T \<subseteq> X \<and> disjnt S T"
  using choose_blue_book_works good_blue_book_def book_def by fastforce


text \<open>expressing the complicated preconditions inductively\<close>
inductive big_blue
  where "\<lbrakk>many_bluish X; good_blue_book X (S,T); card S = best_blue_book_card X\<rbrakk> \<Longrightarrow> big_blue (X,Y,A,B) (T, Y, A, B\<union>S)"

lemma big_blue_V_state: "\<lbrakk>big_blue U U'; V_state U\<rbrakk> \<Longrightarrow> V_state U'"
  by (force simp: good_blue_book_def V_state_def elim!: big_blue.cases)

lemma big_blue_disjoint_state: "\<lbrakk>big_blue U U'; disjoint_state U\<rbrakk> \<Longrightarrow> disjoint_state U'"
  by (elim big_blue.cases) (auto simp: book_def disjnt_iff good_blue_book_def disjoint_state_def)


lemma big_blue_RB_state: "\<lbrakk>big_blue U U'; RB_state U\<rbrakk> \<Longrightarrow> RB_state U'"
  apply (clarsimp simp add: good_blue_book_def book_def RB_state_def all_edges_betw_un_Un1 all_edges_betw_un_Un2 elim!: big_blue.cases)
  by (metis all_edges_betw_un_commute all_edges_betw_un_mono1 le_supI2 sup.orderE)

lemma big_blue_valid_state: "\<lbrakk>big_blue U U'; valid_state U\<rbrakk> \<Longrightarrow> valid_state U'"
  by (meson big_blue_RB_state big_blue_V_state big_blue_disjoint_state valid_state_def)

subsection \<open>The central vertex\<close>

definition central_vertex :: "['a set,'a] \<Rightarrow> bool" where
  "central_vertex \<equiv> \<lambda>X x. x \<in> X \<and> card (Neighbours Blue x \<inter> X) \<le> \<mu> * real (card X)"

lemma ex_central_vertex:
  assumes "\<not> termination_condition X Y" "\<not> many_bluish X"
  shows "\<exists>x. central_vertex X x"
proof -
  have "l \<noteq> 0"
    using linorder_not_less assms unfolding many_bluish_def by force
  then have *: "real l powr (2/3) \<le> real l powr (3/4)"
    using powr_mono by force
  then have "card {x \<in> X. bluish X x} < card X"
    using assms RN_mono
    unfolding termination_condition_def many_bluish_def not_le
    by (smt (verit, ccfv_SIG) linorder_not_le nat_ceiling_le_eq of_nat_le_iff)
  then obtain x where "x \<in> X" "\<not> bluish X x"
    by (metis (mono_tags, lifting) mem_Collect_eq nat_neq_iff subsetI subset_antisym)
  then show ?thesis
    by (meson bluish_def central_vertex_def linorder_linear)
qed

lemma finite_central_vertex_set: "finite X \<Longrightarrow> finite {x. central_vertex X x}"
  by (simp add: central_vertex_def)

definition max_central_vx :: "['a set,'a set] \<Rightarrow> real" where
  "max_central_vx \<equiv> \<lambda>X Y. Max (weight X Y ` {x. central_vertex X x})"

lemma central_vx_is_best: 
  "\<lbrakk>central_vertex X x; finite X\<rbrakk> \<Longrightarrow> weight X Y x \<le> max_central_vx X Y"
  unfolding max_central_vx_def by (simp add: finite_central_vertex_set)

lemma ex_best_central_vx: 
  "\<lbrakk>\<not> termination_condition X Y; \<not> many_bluish X; finite X\<rbrakk> 
  \<Longrightarrow> \<exists>x. central_vertex X x \<and> weight X Y x = max_central_vx X Y"
  unfolding max_central_vx_def
  by (metis empty_iff ex_central_vertex finite_central_vertex_set mem_Collect_eq obtains_MAX)

text \<open>it's necessary to make a specific choice; a relational treatment might allow different vertices 
  to be chosen, making a nonsense of the choice between steps 4 and 5\<close>
definition "choose_central_vx \<equiv> \<lambda>(X,Y,A,B). @x. central_vertex X x \<and> weight X Y x = max_central_vx X Y"

lemma choose_central_vx_works: 
  "\<lbrakk>\<not> termination_condition X Y; \<not> many_bluish X; finite X\<rbrakk> 
  \<Longrightarrow> central_vertex X (choose_central_vx (X,Y,A,B)) \<and> weight X Y (choose_central_vx (X,Y,A,B)) = max_central_vx X Y"
  unfolding choose_central_vx_def
  using someI_ex [OF ex_best_central_vx] by force

lemma choose_central_vx_X: 
  "\<lbrakk>\<not> many_bluish X; \<not> termination_condition X Y; finite X\<rbrakk> \<Longrightarrow> choose_central_vx (X,Y,A,B) \<in> X"
  using central_vertex_def choose_central_vx_works by fastforce

subsection \<open>Red step\<close>

definition "reddish \<equiv> \<lambda>k X Y p x. red_density (Neighbours Red x \<inter> X) (Neighbours Red x \<inter> Y) \<ge> p - alpha (hgt p)"

inductive red_step 
  where "\<lbrakk>reddish k X Y (red_density X Y) x; x = choose_central_vx (X,Y,A,B)\<rbrakk> 
         \<Longrightarrow> red_step (X,Y,A,B) (Neighbours Red x \<inter> X, Neighbours Red x \<inter> Y, insert x A, B)"

lemma red_step_V_state: 
  assumes "red_step (X,Y,A,B) U'" "\<not> termination_condition X Y" 
          "\<not> many_bluish X" "V_state (X,Y,A,B)"
  shows "V_state U'"
proof -
  have "X \<subseteq> V"
    using assms by (auto simp: V_state_def)
  then have "choose_central_vx (X, Y, A, B) \<in> V"
    using assms choose_central_vx_X by (fastforce simp: finX)
  with assms show ?thesis
    by (auto simp: V_state_def elim!: red_step.cases)
qed

lemma red_step_disjoint_state:
  assumes "red_step (X,Y,A,B) U'" "\<not> termination_condition X Y" 
          "\<not> many_bluish X" "V_state (X,Y,A,B)" "disjoint_state (X,Y,A,B)"
  shows "disjoint_state U'"
proof -
  have "choose_central_vx (X, Y, A, B) \<in> X"
    using assms by (metis choose_central_vx_X finX)
  with assms show ?thesis
    by (auto simp: disjoint_state_def disjnt_iff not_own_Neighbour elim!: red_step.cases)
qed

lemma red_step_RB_state: 
  assumes "red_step (X,Y,A,B) U'" "\<not> termination_condition X Y"
          "\<not> many_bluish X" "V_state (X,Y,A,B)" "RB_state (X,Y,A,B)"
  shows "RB_state U'"
proof -
  define x where "x \<equiv> choose_central_vx (X, Y, A, B)"
  have [simp]: "finite X"
    using assms by (simp add: finX)
  have "x \<in> X"
    using assms choose_central_vx_X by (metis \<open>finite X\<close> x_def)
  have A: "all_edges_betw_un (insert x A) (insert x A) \<subseteq> Red"
    if "all_edges_betw_un A A \<subseteq> Red" "all_edges_betw_un A (X \<union> Y) \<subseteq> Red"
    using that \<open>x \<in> X\<close> all_edges_betw_un_commute 
    by (auto simp: all_edges_betw_un_insert2 all_edges_betw_un_Un2 intro!: all_uedges_betw_I)
  have B1: "all_edges_betw_un (insert x A) (Neighbours Red x \<inter> X) \<subseteq> Red"
    if "all_edges_betw_un A X \<subseteq> Red"
    using that \<open>x \<in> X\<close> by (force simp: all_edges_betw_un_def in_Neighbours_iff)
  have B2: "all_edges_betw_un (insert x A) (Neighbours Red x \<inter> Y) \<subseteq> Red"
    if "all_edges_betw_un A Y \<subseteq> Red"
    using that \<open>x \<in> X\<close> by (force simp: all_edges_betw_un_def in_Neighbours_iff)
  from assms A B1 B2 show ?thesis
    apply (clarsimp simp: RB_state_def simp flip: x_def elim!: red_step.cases)
    by (metis Int_Un_eq(2) Un_subset_iff all_edges_betw_un_Un2)
qed

lemma red_step_valid_state: 
  assumes "red_step (X,Y,A,B) U'" "\<not> termination_condition X Y" 
          "\<not> many_bluish X" "valid_state (X,Y,A,B)"
  shows "valid_state U'"
  by (meson assms red_step_RB_state red_step_V_state red_step_disjoint_state valid_state_def)

subsection \<open>Density-boost step\<close>

inductive density_boost
  where "\<lbrakk>\<not> reddish k X Y (red_density X Y) x; x = choose_central_vx (X,Y,A,B)\<rbrakk> 
         \<Longrightarrow> density_boost (X,Y,A,B) (Neighbours Blue x \<inter> X, Neighbours Red x \<inter> Y, A, insert x B)"

lemma density_boost_V_state: 
  assumes "density_boost (X,Y,A,B) U'" "\<not> termination_condition X Y" 
          "\<not> many_bluish X" "V_state (X,Y,A,B)"
  shows "V_state U'"
proof -
  have "X \<subseteq> V"
    using assms by (auto simp: V_state_def)
  then have "choose_central_vx (X, Y, A, B) \<in> V"
    using assms choose_central_vx_X finX by fastforce 
  with assms show ?thesis
    by (auto simp: V_state_def elim!: density_boost.cases)
qed

lemma density_boost_disjoint_state:
  assumes "density_boost (X,Y,A,B) U'" "\<not> termination_condition X Y"  
          "\<not> many_bluish X" "V_state (X,Y,A,B)" "disjoint_state (X,Y,A,B)"
  shows "disjoint_state U'"
proof -
  have "X \<subseteq> V"
    using assms by (auto simp: V_state_def)
  then have "choose_central_vx (X, Y, A, B) \<in> X"
    using assms by (metis choose_central_vx_X finX)
  with assms show ?thesis
    by (auto simp: disjoint_state_def disjnt_iff not_own_Neighbour elim!: density_boost.cases)
qed

lemma density_boost_RB_state: 
  assumes "density_boost (X,Y,A,B) U'" "\<not> termination_condition X Y" "\<not> many_bluish X" "V_state (X,Y,A,B)" 
    and rb: "RB_state (X,Y,A,B)"
  shows "RB_state U'"
proof -
  define x where "x \<equiv> choose_central_vx (X, Y, A, B)"
  have "x \<in> X"
    using assms by (metis choose_central_vx_X finX x_def)
  have "all_edges_betw_un A (Neighbours Blue x \<inter> X \<union> Neighbours Red x \<inter> Y) \<subseteq> Red"
    if "all_edges_betw_un A (X \<union> Y) \<subseteq> Red"
    using that by (metis Int_Un_eq(4) Un_subset_iff all_edges_betw_un_Un2)
  moreover
  have "all_edges_betw_un (insert x B) (insert x B) \<subseteq> Blue"
    if "all_edges_betw_un B (B \<union> X) \<subseteq> Blue"
    using that \<open>x \<in> X\<close> by (fastforce simp add: all_edges_betw_un_def)
  moreover
  have "all_edges_betw_un (insert x B) (Neighbours Blue x \<inter> X) \<subseteq> Blue"
    if "all_edges_betw_un B (B \<union> X) \<subseteq> Blue"
    using \<open>x \<in> X\<close> that  by (auto simp: all_edges_betw_un_def subset_iff in_Neighbours_iff)
  ultimately show ?thesis
    using assms
    by (auto simp: RB_state_def all_edges_betw_un_Un2 x_def [symmetric]  elim!: density_boost.cases)
qed

lemma density_boost_valid_state:
  assumes "density_boost (X,Y,A,B) U'" "\<not> termination_condition X Y" "\<not> many_bluish X" "valid_state (X,Y,A,B)"
  shows "valid_state U'"
  by (meson assms density_boost_RB_state density_boost_V_state density_boost_disjoint_state valid_state_def)

subsection \<open>Execution steps 2--5 as a function\<close>

definition next_state :: "'a config \<Rightarrow> 'a config" where
  "next_state \<equiv> \<lambda>(X,Y,A,B). 
       if many_bluish X 
       then let (S,T) = choose_blue_book (X,Y,A,B) in (T, Y, A, B\<union>S) 
       else let x = choose_central_vx (X,Y,A,B) in
            if reddish k X Y (red_density X Y) x 
            then (Neighbours Red x \<inter> X, Neighbours Red x \<inter> Y, insert x A, B)
            else (Neighbours Blue x \<inter> X, Neighbours Red x \<inter> Y, A, insert x B)"

lemma next_state_valid:
  assumes "valid_state (X,Y,A,B)" "\<not> termination_condition X Y"
  shows "valid_state (next_state (X,Y,A,B))"
proof (cases "many_bluish X")
  case True
  with assms finX have "\<And>S T. \<lbrakk>choose_blue_book (X, Y, A, B) = (S, T)\<rbrakk>
       \<Longrightarrow> big_blue (X, Y, A, B) (T, Y, A, B \<union> S)"
    by (metis big_blue.intros choose_blue_book_works valid_state_def)
  with True have "big_blue (X,Y,A,B) (next_state (X,Y,A,B))"
    by (auto simp: next_state_def split: prod.split)
  then show ?thesis
    using assms big_blue_valid_state by blast
next
  case non_bluish: False
  define x where "x = choose_central_vx (X,Y,A,B)"
  show ?thesis
  proof (cases "reddish k X Y (red_density X Y) x")
    case True
    with non_bluish have "red_step (X,Y,A,B) (next_state (X,Y,A,B))"
      by (simp add: next_state_def Let_def x_def red_step.intros split: prod.split)
    then show ?thesis
      using assms non_bluish red_step_valid_state by blast      
  next
    case False
    with non_bluish have "density_boost (X,Y,A,B) (next_state (X,Y,A,B))"
      by (simp add: next_state_def Let_def x_def density_boost.intros split: prod.split)
    then show ?thesis
      using assms density_boost_valid_state non_bluish by blast
  qed
qed

primrec stepper :: "nat \<Rightarrow> 'a config" where
  "stepper 0 = (X0,Y0,{},{})"
| "stepper (Suc n) = 
     (let (X,Y,A,B) = stepper n in 
      if termination_condition X Y then (X,Y,A,B) 
      else if even n then degree_reg (X,Y,A,B) else next_state (X,Y,A,B))"

lemma degree_reg_subset:
  assumes "degree_reg (X,Y,A,B) = (X',Y',A',B')" 
  shows "X' \<subseteq> X \<and> Y' \<subseteq> Y"
  using assms by (auto simp: degree_reg_def X_degree_reg_def)

lemma next_state_subset:
  assumes "next_state (X,Y,A,B) = (X',Y',A',B')" "finite X"
  shows "X' \<subseteq> X \<and> Y' \<subseteq> Y"
  using assms choose_blue_book_subset
  apply (clarsimp simp: next_state_def valid_state_def Let_def split: if_split_asm prod.splits)
  by (smt (verit) choose_blue_book_subset subset_eq)

lemma valid_state0: "valid_state (X0, Y0, {}, {})"
  using XY0 by (simp add: valid_state_def V_state_def disjoint_state_def RB_state_def)

lemma valid_state_stepper [simp]: "valid_state (stepper n)"
proof (induction n)
  case 0
  then show ?case
    by (simp add: stepper_def valid_state0)
next
  case (Suc n)
  then show ?case
    by (force simp: next_state_valid degree_reg_valid_state split: prod.split)
qed

lemma V_state_stepper: "V_state (stepper n)"
  using valid_state_def valid_state_stepper by force

lemma RB_state_stepper: "RB_state (stepper n)"
  using valid_state_def valid_state_stepper by force

lemma
  assumes "stepper n = (X,Y,A,B)"
  shows stepper_A: "clique A Red \<and> A\<subseteq>V" and stepper_B: "clique B Blue \<and> B\<subseteq>V"
proof -
  have "A\<subseteq>V" "B\<subseteq>V"
    using V_state_stepper[of n] assms by (auto simp: V_state_def)
  moreover
  have "all_edges_betw_un A A \<subseteq> Red" "all_edges_betw_un B B \<subseteq> Blue"
    using RB_state_stepper[of n] assms by (auto simp: RB_state_def all_edges_betw_un_Un2)
  ultimately show "clique A Red \<and> A\<subseteq>V" "clique B Blue \<and> B\<subseteq>V"
    using all_edges_betw_un_iff_clique by auto
qed

lemma card_B_limit:
  assumes "stepper n = (X,Y,A,B)" shows "card B < l"
  by (metis B_less_l assms valid_state_stepper)

definition "Xseq \<equiv> (\<lambda>(X,Y,A,B). X) \<circ> stepper"
definition "Yseq \<equiv> (\<lambda>(X,Y,A,B). Y) \<circ> stepper"
definition "Aseq \<equiv> (\<lambda>(X,Y,A,B). A) \<circ> stepper"
definition "Bseq \<equiv> (\<lambda>(X,Y,A,B). B) \<circ> stepper"
definition "pseq \<equiv> \<lambda>i. red_density (Xseq i) (Yseq i)"

lemma Xseq_0 [simp]: "Xseq 0 = X0"
  by (simp add: Xseq_def)

lemma Xseq_Suc_subset: "Xseq (Suc i) \<subseteq> Xseq i" and   is_sentence_cons is_symbol_distinct split_u by
   apply
  by (metisV_state_stepperteppereregree_reg_subsetext_state_subset

lemmaeq_antimonoj\le> i <Longrightarrow>  i \<subseteq Xseq j"
  by (simp add: Xseq_Suc_subset lift_Suc_antimono_le)

lemmaXseq_subset_V: "Xseq i <subseteq> V"
  using XY0 Xseq_0 Xseq_antimono by blast

lemma finite_Xseq: "finite (Xseq i)"
  by (meson Xseq_subset_V finV finite_subset)

lemma Yseq_0 [simp]: "Yseq 0 = Y0"
  by (simp add: Yseq_def)

lemma Yseq_antimono:j <le i \<Longrightarrow>Yseq i \subseteq>Yseq"
  by (simp add: Yseq_Suc_subset lift_Suc_antimono_le)

lemma : "Yseq i \<subseteq> V"
  using XY0 Yseq_0 Yseq_antimono by blast

lemma finite_Yseq: "finite (Yseq i)"
 mesonq_subset_V nite_subset

emmaq_Yseq_disjntdisjnt (Xseq i) (Yseq i)"
  using XY0(1)
  unfolding disjnt_iff
  by (metis Xseq_0 Xseq_antimono Yseq_0 Yseq_antimono in_mono zero_le)

lemma edge_card_eq_pee: 
  "edge_card Red (Xseq i) (Yseq i) = pseq i * card (Xseq i) * card (Yseq i)"
         show ?ase

lemma valid_state_seq: "valid_state(Xseq i, Yseq i, Aseq i, Bseq i)"
  lid_state_stepper[of i]
  by (force simp: Xseq_def Yseq_def Aseq_def Bseq_def simp del valid_state_stepper split .split)

lemma Aseq_less_k: "card (Aseq i) < k"
  by (meson A_less_k valid_state_seq)

lemma Aseq_0 [simp]: "Aseq 0 = {}"
  by (simp add: Aseq_def)

lemma Aseq_Suc_subset
  by (auto simp: Aseq_def Bseq_def next_state_def degree_reg_def Let_def split: prod.split)

lemma
  assumes "j \<le> i"
  shows Aseq_mono: "Aseq j \<subseteq> Aseq i" and Bseq_mono: "Bseq j \<subseteq> Bseq i"
  using assms by (auto simp: Aseq_Suc_subset Bseq_Suc_subset lift_Suc_mono_le)

lemma Aseq_subset_V: "Aseq i \<subseteq> V"
  using stepper_A[of i] by (simp add: Aseq_def split: prod.split) 

lemma Bseq_subset_V: "Bseq i \<subseteq> V"
  using stepper_B[of i] by (simp add: Bseq_def split: prod.split) 

lemma finite_Aseq: "finite (Aseq i)" and finite_Bseq: "finite (Bseq i)"
  by (meson Aseq_subset_V Bseq_subset_V finV finite_subset)+

lemma Bseq_less_l: "card (Bseq i) < l"
  by (meson B_less_l valid_state_seq)

lemma Bseq_0 [simp]: "Bseq 0 = {}"
  by (simp add: Bseq_def)

lemma pee_eq_p0: "pseq 0 = p0"
  by (simp add: pseq_def p0_def)

lemma pee_ge0: "pseq i \<ge> 0"
  by (simp add: gen_density_ge0 pseq_def)

lemma pee_le1: "pseq i \<le> 1"
  using gen_density_le1 pseq_def by presburger

lemma pseq_0: "p0 = pseq 0"
  by (simp add: p0_def pseq_def Xseq_def Yseq_def)

text \<open>The central vertex at each step (though only defined in some cases), 
  @{term "x_i"} in the paper\<close>
definition "cvx \<equiv> \<lambda>i. choose_central_vx (stepper i)"

text \<open>the indexing of @{term beta} is as in the paper --- and different from that of @{term Xseq}\<close>
definition 
  "beta \<equiv> \<lambda>i. let (X,Y,A,B) = stepper i in card(Neighbours Blue (cvx i) \<inter> X) / card X"

lemma beta_eq: "beta i = card(Neighbours Blue (cvx i) \<inter> Xseq i) / card (Xseq i)"
  by (simp add: beta_def cvx_def Xseq_def split: prod.split)

lemma beta_ge0: "beta i \<ge> 0"
  by (simp add: beta_eq)


subsection \<open>The classes of execution steps\<close>

text \<open>For R, B, S, D\<close>
datatype stepkind = red_step | bblue_step | dboost_step | dreg_step | halted

definition next_state_kind :: "'a config \<Rightarrow> stepkind" where
  "next_state_kind \<equiv> \<lambda>(X,Y,A,B). 
       if many_bluish X then bblue_step 
       else let x = choose_central_vx (X,Y,A,B) in
            if reddish k X Y (red_density X Y) x then red_step
            else dboost_step"

definition stepper_kind :: "nat \<Rightarrow> stepkind" where
  "stepper_kind i = 
     (let (X,Y,A,B) = stepper i in 
      if termination_condition X Y then halted 
      else if even i then dreg_step else next_state_kind (X,Y,A,B))"

definition "Step_class \<equiv> \<lambda>knd. {n. stepper_kind n \<in> knd}"

lemma subset_Step_class: "\<lbrakk>i \<in> Step_class K'; K' \<subseteq> K\<rbrakk> \<Longrightarrow> i \<in> Step_class K"
  by (auto simp: Step_class_def)

lemma Step_class_Un: "Step_class (K' \<union> K) = Step_class K' \<union> Step_class K"
  by (auto simp: Step_class_def)

lemma Step_class_insert: "Step_class (insert knd K) = (Step_class {knd}) \<union> (Step_class K)"
  by (auto simp: Step_class_def)

lemma Step_class_insert_NO_MATCH:
  "NO_MATCH {} K \<Longrightarrow> Step_class (insert knd K) = (Step_class {knd}) \<union> (Step_class K)"
  by (auto simp: Step_class_def)

lemma Step_class_UNIV: "Step_class {red_step,bblue_step,dboost_step,dreg_step,halted} = UNIV"
  using Step_class_def stepkind.exhaust by auto

lemma Step_class_cases:
   "i \<in> Step_class {stepkind.red_step} \<or> i \<in> Step_class {bblue_step} \<or>
    i \<in> Step_class {dboost_step} \<or> i \<in> Step_class {dreg_step} \<or>
    i \<in> Step_class {halted}"
  using Step_class_def stepkind.exhaust by auto

lemmas step_kind_defs = Step_class_def stepper_kind_def next_state_kind_def
                        Xseq_def Yseq_def Aseq_def Bseq_def cvx_def Let_def

lemma disjnt_Step_class: 
  "disjnt knd knd' \<Longrightarrow> disjnt (Step_class knd) (Step_class knd')"
  by (auto simp: Step_class_def disjnt_iff)

lemma halted_imp_next_halted: "stepper_kind i = halted \<Longrightarrow> stepper_kind (Suc i) = halted"
  by (auto simp: step_kind_defs split: prod.split if_split_asm)

lemma halted_imp_ge_halted: "stepper_kind i = halted \<Longrightarrow> stepper_kind (i+n) = halted"
  by (induction n) (auto simp: halted_imp_next_halted)

lemma Step_class_halted_forever: "\<lbrakk>i \<in> Step_class {halted}; i\<le>j\<rbrakk> \<Longrightarrow> j \<in> Step_class {halted}"
  by (simp add: Step_class_def) (metis halted_imp_ge_halted le_iff_add)

lemma Step_class_not_halted: "\<lbrakk>i \<notin> Step_class {halted}; i\<ge>j\<rbrakk> \<Longrightarrow> j \<notin> Step_class {halted}"
  using Step_class_halted_forever by blast

lemma
  assumes "i \<notin> Step_class {halted}" 
  shows not_halted_pee_gt: "pseq i > 1/k"
    and Xseq_gt0: "card (Xseq i) > 0"
    and Xseq_gt_RN: "card (Xseq i) > RN k (nat \<lceil>real l powr (3/4)\<rceil>)"
    and not_termination_condition: "\<not> termination_condition (Xseq i) (Yseq i)"
  using assms
  by (auto simp: step_kind_defs termination_condition_def pseq_def split: if_split_asm prod.split_asm)

lemma not_halted_pee_gt0:
  assumes "i \<notin> Step_class {halted}" 
  shows "pseq i > 0" 
  using not_halted_pee_gt [OF assms] linorder_not_le order_less_le_trans by fastforce

lemma Yseq_gt0:
  assumes "i \<notin> Step_class {halted}"
  shows "card (Yseq i) > 0"
  using not_halted_pee_gt [OF assms]
  using card_gt_0_iff finite_Yseq pseq_def by fastforce 

lemma step_odd: "i \<in> Step_class {red_step,bblue_step,dboost_step} \<Longrightarrow> odd i" 
  by (auto simp: Step_class_def stepper_kind_def split: if_split_asm prod.split_asm)

lemma step_even: "i \<in> Step_class {dreg_step} \<Longrightarrow> even i" 
  by (auto simp: Step_class_def stepper_kind_def next_state_kind_def split: if_split_asm prod.split_asm)

lemma not_halted_odd_RBS: "\<lbrakk>i \<notin> Step_class {halted}; odd i\<rbrakk> \<Longrightarrow> i \<in> Step_class {red_step,bblue_step,dboost_step}" 
  by (auto simp: Step_class_def stepper_kind_def next_state_kind_def split: prod.split_asm)

lemma not_halted_even_dreg: "\<lbrakk>i \<notin> Step_class {halted}; even i\<rbrakk> \<Longrightarrow> i \<in> Step_class {dreg_step}" 
  by (auto simp: Step_class_def stepper_kind_def next_state_kind_def split: prod.split_asm)

lemma step_before_dreg:
  assumes "Suc i \<in> Step_class {dreg_step}"
  shows "i \<in> Step_class {red_step,bblue_step,dboost_step}"
  using assms by (auto simp: step_kind_defs split: if_split_asm prod.split_asm)

lemma dreg_before_step:
  assumes "Suc i \<in> Step_class {red_step,bblue_step,dboost_step}" 
  shows "i \<in> Step_class {dreg_step}"
  using assms by (auto simp: Step_class_def stepper_kind_def split: if_split_asm prod.split_asm)

lemma 
  assumes "i \<in> Step_class {red_step,bblue_step,dboost_step}" 
  shows dreg_before_step': "i - Suc 0 \<in> Step_class {dreg_step}" 
    and dreg_before_gt0: "i>0"
proof -
  show "i>0"
    using assms gr0I step_odd by force
  then show "i - Suc 0 \<in> Step_class {dreg_step}"
    using assms dreg_before_step Suc_pred by force
qed

lemma dreg_before_step1:
  assumes "i \<in> Step_class {red_step,bblue_step,dboost_step}" 
  shows "i-1 \<in> Step_class {dreg_step}" 
  using dreg_before_step' [OF assms] by auto

lemma step_odd_minus2: 
  assumes "i \<in> Step_class {red_step,bblue_step,dboost_step}" "i>1"
  shows "i-2 \<in> Step_class {red_step,bblue_step,dboost_step}"
  by (metis Suc_1 Suc_diff_Suc assms dreg_before_step1 step_before_dreg) 

lemma Step_class_iterates:
  assumes "finite (Step_class {knd})"
  obtains n where "Step_class {knd} = {m. m<n \<and> stepper_kind m = knd}"
proof -
  have eq: "(Step_class {knd}) = (\<Union>i. {m. m<i \<and> stepper_kind m = knd})"
    by (auto simp: Step_class_def)
  then obtain n where n: "(Step_class {knd}) = (\<Union>i<n. {m. m<i \<and> stepper_kind m = knd})"
    using finite_countable_equals[OF assms] by blast
  with Step_class_def 
  have "{m. m<n \<and> stepper_kind m = knd} = (\<Union>i<n. {m. m<i \<and> stepper_kind m = knd})"
    by auto
  then show ?thesis
    by (metis n that)
qed

lemma step_non_terminating_iff:
     "i \<in> Step_class {red_step,bblue_step,dboost_step,dreg_step} 
     \<longleftrightarrow> \<not> termination_condition (Xseq i) (Yseq i)"
  by (auto simp: step_kind_defs split: if_split_asm prod.split_asm)

lemma step_terminating_iff:
  "i \<in> Step_class {halted} \<longleftrightarrow> termination_condition (Xseq i) (Yseq i)"
  by (auto simp: step_kind_defs split: if_split_asm prod.split_asm)

lemma not_many_bluish:
  assumes "i \<in> Step_class {red_step,dboost_step}"
  shows "\<not> many_bluish (Xseq i)"
  using assms
  by (simp add: step_kind_defs split: if_split_asm prod.split_asm)

lemma stepper_XYseq: "stepper i = (X,Y,A,B) \<Longrightarrow> X = Xseq i \<and> Y = Yseq i"
  using Xseq_def Yseq_def by fastforce

lemma cvx_works:
  assumes "i \<in> Step_class {red_step,dboost_step}"
  shows "central_vertex (Xseq i) (cvx i)
       \<and> weight (Xseq i) (Yseq i) (cvx i) = max_central_vx (Xseq i) (Yseq i)"
proof -
  have "\<not> termination_condition (Xseq i) (Yseq i)"
    using Step_class_def assms step_non_terminating_iff by fastforce
  then show ?thesis
    using assms not_many_bluish[OF assms] 
    apply (simp add: Step_class_def Xseq_def cvx_def Yseq_def split: prod.split prod.split_asm)
    by (metis V_state_stepper choose_central_vx_works finX)
qed

lemma cvx_in_Xseq:
  assumes "i \<in> Step_class {red_step,dboost_step}"
  shows "cvx i \<in> Xseq i"
  using assms cvx_works[OF assms] 
  by (simp add: Xseq_def central_vertex_def cvx_def split: prod.split_asm)

lemma card_Xseq_pos:
  assumes "i \<in> Step_class {red_step,dboost_step}"
  shows "card (Xseq i) > 0"
  by (metis assms card_0_eq cvx_in_Xseq empty_iff finite_Xseq gr0I)

lemma beta_le:
  assumes "i \<in> Step_class {red_step,dboost_step}"
  shows "beta i \<le> \<mu>"
  using assms cvx_works[OF assms] \<mu>01
  by (simp add: beta_def central_vertex_def Xseq_def divide_simps split: prod.split_asm)

subsection \<open>Termination proof\<close>

text \<open>Each step decreases the size of @{term X}\<close>

lemma ex_nonempty_blue_book:
  assumes mb: "many_bluish X"
    shows "\<exists>x\<in>X. good_blue_book X ({x}, Neighbours Blue x \<inter> X)"
proof -
  have "RN k (nat \<lceil>real l powr (2 / 3)\<rceil>) > 0"
    by (metis kn0 ln0 RN_eq_0_iff gr0I of_nat_ceiling of_nat_eq_0_iff powr_nonneg_iff)
  then have "{x \<in> X. bluish X x} \<noteq> {}"
    using mb by (force simp: many_bluish_def)
  then obtain x where "x\<in>X" and x: "bluish X x"
    by auto
  have "book {x} (Neighbours Blue x \<inter> X) Blue"
    by (force simp: book_def all_edges_betw_un_def in_Neighbours_iff)
  with x show ?thesis
    by (auto simp: bluish_def good_blue_book_def \<open>x \<in> X\<close>)
qed

lemma choose_blue_book_psubset: 
  assumes "many_bluish X" and ST: "choose_blue_book (X,Y,A,B) = (S,T)"
    and "finite X"
    shows "T \<noteq> X"
proof -
  obtain x where "x\<in>X" and x: "good_blue_book X ({x}, Neighbours Blue x \<inter> X)"
    using ex_nonempty_blue_book assms by blast
  with \<open>finite X\<close> have "best_blue_book_card X \<noteq> 0"
    unfolding valid_state_def
    by (metis best_blue_book_is_best card.empty card_seteq empty_not_insert finite.intros singleton_insert_inj_eq)
  then have "S \<noteq> {}"
    by (metis \<open>finite X\<close> ST choose_blue_book_works card.empty)
  with \<open>finite X\<close> ST show ?thesis
    by (metis Int_absorb2 choose_blue_book_subset disjnt_def)
qed

lemma next_state_smaller:
  assumes "next_state (X,Y,A,B) = (X',Y',A',B')" 
    and "finite X" and nont: "\<not> termination_condition X Y"  
  shows "X' \<subset> X"
proof -
  have "X' \<subseteq> X"
    using assms next_state_subset by auto
  moreover have "X' \<noteq> X"
  proof -
    have *: "\<not> X \<subseteq> Neighbours rb x \<inter> X" if "x \<in> X" "rb \<subseteq> E" for x rb
      using that by (auto simp: Neighbours_def subset_iff)
    show ?thesis
    proof (cases "many_bluish X")
      case True
      with assms show ?thesis 
        by (auto simp: next_state_def split: if_split_asm prod.split_asm
            dest!:  choose_blue_book_psubset [OF True])
    next
      case False
      then have "choose_central_vx (X,Y,A,B) \<in> X"
        by (simp add: \<open>finite X\<close> choose_central_vx_X nont)
      with assms *[of _ Red] *[of _ Blue] \<open>X' \<subseteq> X\<close> Red_E Blue_E False
      choose_central_vx_X [OF False nont]
      show ?thesis
        by (fastforce simp: next_state_def Let_def split: if_split_asm prod.split_asm)
    qed
  qed
  ultimately show ?thesis
    by auto
qed

lemma do_next_state:
  assumes "odd i" "\<not> termination_condition (Xseq i) (Yseq i)"
  obtains A B A' B' where "next_state (Xseq i, Yseq i, A, B) 
                        = (Xseq (Suc i), Yseq (Suc i), A',B')"
  using assms
  by (force simp: Xseq_def Yseq_def split: if_split_asm prod.split_asm prod.split)

lemma step_bound: 
  assumes i: "Suc (2*i) \<in> Step_class {red_step,bblue_step,dboost_step}"
  shows "card (Xseq (Suc (2*i))) + i \<le> card X0"
  using i
proof (induction i)
  case 0
  then show ?case
    by (metis Xseq_0 Xseq_Suc_subset add_0_right mult_0_right card_mono finite_X0)
next
  case (Suc i)
  then have nt: "\<not> termination_condition (Xseq (Suc (2*i))) (Yseq (Suc (2*i)))"  
    unfolding step_non_terminating_iff [symmetric]
    by (metis Step_class_insert Suc_1 Un_iff dreg_before_step mult_Suc_right plus_1_eq_Suc plus_nat.simps(2) step_before_dreg)
  obtain A B A' B' where 2:
    "next_state (Xseq (Suc (2*i)), Yseq (Suc (2*i)), A, B) = (Xseq (Suc (Suc (2*i))), Yseq (Suc (Suc (2*i))), A',B')"
    by (meson "nt" Suc_double_not_eq_double do_next_state evenE)
  have "Xseq (Suc (Suc (2*i))) \<subset> Xseq (Suc (2*i))"
    by (meson "2" finite_Xseq assms next_state_smaller nt)
  then have "card (Xseq (Suc (Suc (Suc (2*i))))) < card (Xseq (Suc (2*i)))"
    by (meson Xseq_Suc_subset le_less_trans finite_Xseq psubset_card_mono)
  moreover have "card (Xseq (Suc (2*i))) + i \<le> card X0"
    using Suc dreg_before_step step_before_dreg by force
  ultimately show ?case by auto
qed

lemma Step_class_halted_nonempty: "Step_class {halted} \<noteq> {}"
proof -
  define i where "i \<equiv> Suc (2 * Suc (card X0))" 
  have "odd i"
    by (auto simp: i_def)
  then have "i \<notin> Step_class {dreg_step}"
    using step_even by blast
  moreover have "i \<notin> Step_class {red_step,bblue_step,dboost_step}"
    unfolding i_def using step_bound le_add2 not_less_eq_eq by blast
  ultimately show ?thesis
    using \<open>odd i\<close> not_halted_odd_RBS by blast
qed

definition "halted_point \<equiv> Inf (Step_class {halted})"

lemma halted_point_halted: "halted_point \<in> Step_class {halted}"
  using Step_class_halted_nonempty  Inf_nat_def1 
  by (auto simp: halted_point_def)

lemma halted_point_minimal:
  shows "i \<notin> Step_class {halted} \<longleftrightarrow> i < halted_point"
  using Step_class_halted_nonempty  
  by (metis wellorder_Inf_le1 Inf_nat_def1 Step_class_not_halted halted_point_def less_le_not_le nle_le) 

lemma halted_point_minimal': "stepper_kind i \<noteq> halted \<longleftrightarrow> i < halted_point"
  by (simp add: Step_class_def flip: halted_point_minimal)

lemma halted_eq_Compl:
  "Step_class {dreg_step,red_step,bblue_step,dboost_step} = - Step_class {halted}"
  using Step_class_UNIV [of] by (auto simp: Step_class_def)

lemma before_halted_eq:
  shows "{..<halted_point} = Step_class {dreg_step,red_step,bblue_step,dboost_step}"
  using halted_point_minimal by (force simp: halted_eq_Compl)

lemma finite_components:
  shows "finite (Step_class {dreg_step,red_step,bblue_step,dboost_step})"
  by (metis before_halted_eq finite_lessThan)

lemma
  shows dreg_step_finite  [simp]: "finite (Step_class {dreg_step})"
    and red_step_finite   [simp]: "finite (Step_class {red_step})"
    and bblue_step_finite [simp]: "finite (Step_class {bblue_step})"
    and dboost_step_finite[simp]: "finite (Step_class {dboost_step})"
  using finite_components by (auto simp: Step_class_insert_NO_MATCH)

lemma halted_stepper_add_eq: "stepper (halted_point + i) = stepper (halted_point)"
proof (induction i)
  case 0
  then show ?case
    by auto
next
  case (Suc i)
  have hlt: "stepper_kind (halted_point) = halted"
    using Step_class_def halted_point_halted by force
  obtain X Y A B where *: "stepper (halted_point) = (X, Y, A, B)"
    by (metis surj_pair)
  with hlt have "termination_condition X Y"
    by (simp add: stepper_kind_def next_state_kind_def split: if_split_asm)
  with * show ?case
    by (simp add: Suc)
qed

lemma halted_stepper_eq:
  assumes i: "i \<ge> halted_point"
  shows "stepper i = stepper (halted_point)"
  using \<mu>01 by (metis assms halted_stepper_add_eq le_iff_add)

lemma below_halted_point_cardX:
  assumes "i < halted_point"
  shows  "card (Xseq i) > 0"
  using Xseq_gt0 assms halted_point_minimal halted_stepper_eq \<mu>01 
  by blast

end

sublocale Book' \<subseteq> Book where \<mu>=\<gamma>
proof
  show "0 < \<gamma>" "\<gamma> < 1"
    using ln0 kn0 by (auto simp: \<gamma>_def)
qed (use XY0 density_ge_p0_min in auto)

lemma (in Book) Book':
  assumes "\<gamma> = real l / (real k + real l)"
  shows "Book' V E p0_min Red Blue l k \<gamma> X0 Y0"
proof qed (use assms XY0 density_ge_p0_min in auto)

end</sup>